diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2020, Herbert Valerio Riedel + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Herbert Valerio Riedel nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/LICENSE.base b/LICENSE.base new file mode 100644 --- /dev/null +++ b/LICENSE.base @@ -0,0 +1,83 @@ +This library (libraries/base) is derived from code from several +sources: + + * Code from the GHC project which is largely (c) The University of + Glasgow, and distributable under a BSD-style license (see below), + + * Code from the Haskell 98 Report which is (c) Simon Peyton Jones + and freely redistributable (but see the full license for + restrictions). + + * Code from the Haskell Foreign Function Interface specification, + which is (c) Manuel M. T. Chakravarty and freely redistributable + (but see the full license for restrictions). + +The full text of these licenses is reproduced below. All of the +licenses are BSD-style or compatible. + +----------------------------------------------------------------------------- + +The Glasgow Haskell Compiler License + +Copyright 2004, The University Court of the University of Glasgow. +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +- Redistributions of source code must retain the above copyright notice, +this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright notice, +this list of conditions and the following disclaimer in the documentation +and/or other materials provided with the distribution. + +- Neither name of the University nor the names of its contributors may be +used to endorse or promote products derived from this software without +specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF +GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, +INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH +DAMAGE. + +----------------------------------------------------------------------------- + +Code derived from the document "Report on the Programming Language +Haskell 98", is distributed under the following license: + + Copyright (c) 2002 Simon Peyton Jones + + The authors intend this Report to belong to the entire Haskell + community, and so we grant permission to copy and distribute it for + any purpose, provided that it is reproduced in its entirety, + including this Notice. Modified versions of this Report may also be + copied and distributed for any purpose, provided that the modified + version is clearly presented as such, and that it does not claim to + be a definition of the Haskell 98 Language. + +----------------------------------------------------------------------------- + +Code derived from the document "The Haskell 98 Foreign Function +Interface, An Addendum to the Haskell 98 Report" is distributed under +the following license: + + Copyright (c) 2002 Manuel M. T. Chakravarty + + The authors intend this Report to belong to the entire Haskell + community, and so we grant permission to copy and distribute it for + any purpose, provided that it is reproduced in its entirety, + including this Notice. Modified versions of this Report may also be + copied and distributed for any purpose, provided that the modified + version is clearly presented as such, and that it does not claim to + be a definition of the Haskell 98 Foreign Function Interface. + +----------------------------------------------------------------------------- diff --git a/ghc-byteorder.cabal b/ghc-byteorder.cabal new file mode 100644 --- /dev/null +++ b/ghc-byteorder.cabal @@ -0,0 +1,61 @@ +cabal-version: 1.12 +name: ghc-byteorder +version: 4.11.0.0 + +build-type: Simple +license: BSD3 +license-files: LICENSE LICENSE.base +maintainer: Herbert Valerio Riedel +bug-reports: https://github.com/hvr/ghc-byteorder/issues +synopsis: "GHC.ByteOrder" API Compatibility Layer +category: FFI +description: + This package transparently supplies the "GHC.ByteOrder" API as provided in @base-4.11.0.0@ for legacy GHC releases which didn't provide it yet (i.e. GHC 7.0 through GHC 8.2). + . + This release provides a backported "GHC.ByteOrder" module. For GHC 8.4 and later a different release of @ghc-byteorder@ (with the same minor version) is eligible by the Cabal solver which reexports "GHC.ByteOrder" from @base@ via Cabal's @reexported-modules@ mechanism. + . + In order to use this compatibility layer, simply declare a dependency on @ghc-byteorder@ in your @.cabal@ package description like so + . + > build-depends: ghc-byteorder ^>= 4.11.0.0 + . + And your code will be able to access this respective API version of the module via the usual + . + > import GHC.ByteOrder + . + mechanism. + +source-repository head + type: git + location: https://github.com/hvr/ghc-byteorder.git + +library + default-language: Haskell2010 + other-extensions: CPP + if impl(ghc >= 7.2) + default-extensions: Safe + + hs-source-dirs: src + exposed-modules: GHC.ByteOrder + + build-depends: base >=4.3 && <4.11 + + -- This package relies on GHC-isms + if !(impl(ghc) || impl(ghcjs)) + build-depends: base<0 + + -- place-holder for GHCJS-specific revisions + if impl(ghcjs) + build-depends: base + + ghc-options: -Wall + +test-suite tests + type: exitcode-stdio-1.0 + default-language: Haskell2010 + + hs-source-dirs: src-test + main-is: tests.hs + + build-depends: base, ghc-byteorder + + ghc-options: -Wall diff --git a/src-test/tests.hs b/src-test/tests.hs new file mode 100644 --- /dev/null +++ b/src-test/tests.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE Haskell2010 #-} + +module Main(main) where + +import qualified Data.List as L +import Data.Word (Word16, Word32, Word64, Word8) +import qualified GHC.ByteOrder as IUT + +-- Haskell2010 +import qualified Foreign.Marshal.Array as FFI +import qualified Foreign.Marshal.Utils as FFI +import qualified Foreign.Ptr as FFI +import qualified Foreign.Storable as FFI + +asOctets :: FFI.Storable a => a -> IO [Word8] +asOctets w = FFI.with w $ \p -> FFI.peekArray (FFI.sizeOf w) (FFI.castPtr p) + +runtimeByteOrder :: IO IUT.ByteOrder +runtimeByteOrder = do + w16octets <- asOctets (0x1234 :: Word16) + w32octets <- asOctets (0x12345678 :: Word32) + w64octets <- asOctets (0x123456789abcdef0 :: Word64) + + let octectsLst = [w16octets,w32octets,w64octets] + + case (L.nub $ zipWith inferBO octectsLst [beOctets16,beOctets32,beOctets64]) of + [Just x] -> return x + _ -> fail ("runtimeByteOrder failed " ++ show octectsLst) + + where + beOctets64 = [0x12, 0x34, 0x56, 0x78, 0x9a, 0xbc, 0xde, 0xf0] + beOctets32 = take 4 beOctets64 + beOctets16 = take 2 beOctets64 + + inferBO host beRef + | host == beRef = Just IUT.BigEndian + | host == L.reverse beRef = Just IUT.LittleEndian + | otherwise = Nothing + +main :: IO () +main = do + putStrLn $ "GHC.ByteOrder.targetByteOrder = " ++ show IUT.targetByteOrder + + hostBO <- runtimeByteOrder + putStrLn $ "probed byte-order = " ++ show hostBO + + if IUT.targetByteOrder == hostBO + then putStrLn "success!" + else do + print =<< asOctets (0x1234 :: Word16) + print =<< asOctets (0x12345678 :: Word32) + print =<< asOctets (0x123456789abcdef0 :: Word64) + fail "static 'targetByteOrder' doesn't match probed ByteOrder" + diff --git a/src/GHC/ByteOrder.hs b/src/GHC/ByteOrder.hs new file mode 100644 --- /dev/null +++ b/src/GHC/ByteOrder.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE CPP #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.ByteOrder +-- Copyright : (c) The University of Glasgow, 1994-2000 +-- License : BSD-3-Clause +-- +-- Target byte ordering. +-- +-- @since 4.11.0.0 +----------------------------------------------------------------------------- + +module GHC.ByteOrder where + +-- Required for WORDS_BIGENDIAN +#include + +-- | Byte ordering. +data ByteOrder + = BigEndian -- ^ most-significant-byte occurs in lowest address. + | LittleEndian -- ^ least-significant-byte occurs in lowest address. + deriving ( Eq -- @since 4.11.0.0 + , Ord -- @since 4.11.0.0 + , Bounded -- @since 4.11.0.0 + , Enum -- @since 4.11.0.0 + , Read -- @since 4.11.0.0 + , Show -- @since 4.11.0.0 + ) + +-- | The byte ordering of the target machine. +targetByteOrder :: ByteOrder +#if defined(WORDS_BIGENDIAN) +targetByteOrder = BigEndian +#else +targetByteOrder = LittleEndian +#endif