diff --git a/Data/ByteString/Builder/Prim/Binary.hs b/Data/ByteString/Builder/Prim/Binary.hs index 06fc77845..437f6ab90 100644 --- a/Data/ByteString/Builder/Prim/Binary.hs +++ b/Data/ByteString/Builder/Prim/Binary.hs @@ -1,12 +1,7 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeApplications #-} -#include "MachDeps.h" -#include "bytestring-cpp-macros.h" - - -- | Copyright : (c) 2010-2011 Simon Meier -- License : BSD3-style (see LICENSE) -- @@ -61,6 +56,7 @@ module Data.ByteString.Builder.Prim.Binary ( import Data.ByteString.Builder.Prim.Internal import Data.ByteString.Builder.Prim.Internal.Floating +import Data.ByteString.Utils.ByteOrder import Data.ByteString.Utils.UnalignedWrite import Foreign @@ -86,38 +82,22 @@ word8 = fixedPrim 1 (flip poke) -- Word8 is always aligned -- | Encoding 'Word16's in big endian format. {-# INLINE word16BE #-} word16BE :: FixedPrim Word16 -#ifdef WORDS_BIGENDIAN -word16BE = word16Host -#else -word16BE = byteSwap16 >$< word16Host -#endif +word16BE = whenLittleEndian byteSwap16 >$< word16Host -- | Encoding 'Word16's in little endian format. {-# INLINE word16LE #-} word16LE :: FixedPrim Word16 -#ifdef WORDS_BIGENDIAN -word16LE = byteSwap16 >$< word16Host -#else -word16LE = word16Host -#endif +word16LE = whenBigEndian byteSwap16 >$< word16Host -- | Encoding 'Word32's in big endian format. {-# INLINE word32BE #-} word32BE :: FixedPrim Word32 -#ifdef WORDS_BIGENDIAN -word32BE = word32Host -#else -word32BE = byteSwap32 >$< word32Host -#endif +word32BE = whenLittleEndian byteSwap32 >$< word32Host -- | Encoding 'Word32's in little endian format. {-# INLINE word32LE #-} word32LE :: FixedPrim Word32 -#ifdef WORDS_BIGENDIAN -word32LE = byteSwap32 >$< word32Host -#else -word32LE = word32Host -#endif +word32LE = whenBigEndian byteSwap32 >$< word32Host -- on a little endian machine: -- word32LE w32 = fixedPrim 4 (\w p -> poke (castPtr p) w32) @@ -125,20 +105,12 @@ word32LE = word32Host -- | Encoding 'Word64's in big endian format. {-# INLINE word64BE #-} word64BE :: FixedPrim Word64 -#ifdef WORDS_BIGENDIAN -word64BE = word64Host -#else -word64BE = byteSwap64 >$< word64Host -#endif +word64BE = whenLittleEndian byteSwap64 >$< word64Host -- | Encoding 'Word64's in little endian format. {-# INLINE word64LE #-} word64LE :: FixedPrim Word64 -#ifdef WORDS_BIGENDIAN -word64LE = byteSwap64 >$< word64Host -#else -word64LE = word64Host -#endif +word64LE = whenBigEndian byteSwap64 >$< word64Host -- | Encode a single native machine 'Word'. The 'Word's is encoded in host order, diff --git a/Data/ByteString/Builder/RealFloat/Internal.hs b/Data/ByteString/Builder/RealFloat/Internal.hs index 1b6b7f1d8..1d3ec08d4 100644 --- a/Data/ByteString/Builder/RealFloat/Internal.hs +++ b/Data/ByteString/Builder/RealFloat/Internal.hs @@ -72,6 +72,7 @@ import Data.Bits (Bits(..), FiniteBits(..)) import Data.ByteString.Internal (c2w) import Data.ByteString.Builder.Prim.Internal (BoundedPrim, boundedPrim) import Data.ByteString.Builder.RealFloat.TableGenerator +import Data.ByteString.Utils.ByteOrder import Data.ByteString.Utils.UnalignedWrite #if PURE_HASKELL import qualified Data.ByteString.Internal.Pure as Pure @@ -408,25 +409,23 @@ wrapped f (I# w) = I# (f w) #if WORD_SIZE_IN_BITS == 32 -- | Packs 2 32-bit system words (hi, lo) into a Word64 packWord64 :: Word# -> Word# -> Word64# -packWord64 hi lo = -#if defined(WORDS_BIGENDIAN) +packWord64 hi lo = case hostByteOrder of + BigEndian -> ((wordToWord64# lo) `uncheckedShiftL64#` 32#) `or64#` (wordToWord64# hi) -#else + LittleEndian -> ((wordToWord64# hi) `uncheckedShiftL64#` 32#) `or64#` (wordToWord64# lo) -#endif -- | Unpacks a Word64 into 2 32-bit words (hi, lo) unpackWord64 :: Word64# -> (# Word#, Word# #) -unpackWord64 w = -#if defined(WORDS_BIGENDIAN) +unpackWord64 w = case hostByteOrder of + BigEndian -> (# word64ToWord# w , word64ToWord# (w `uncheckedShiftRL64#` 32#) #) -#else + LittleEndian -> (# word64ToWord# (w `uncheckedShiftRL64#` 32#) , word64ToWord# w #) -#endif -- | Adds 2 Word64's with 32-bit addition and manual carrying plusWord64 :: Word64# -> Word64# -> Word64# @@ -731,21 +730,19 @@ getWord128At (Ptr arr) (I# i) = let -- | Packs 2 bytes [lsb, msb] into 16-bit word packWord16 :: Word# -> Word# -> Word# -packWord16 l h = -#if defined(WORDS_BIGENDIAN) +packWord16 l h = case hostByteOrder of + BigEndian -> (h `uncheckedShiftL#` 8#) `or#` l -#else + LittleEndian -> (l `uncheckedShiftL#` 8#) `or#` h -#endif -- | Unpacks a 16-bit word into 2 bytes [lsb, msb] unpackWord16 :: Word# -> (# Word#, Word# #) -unpackWord16 w = -#if defined(WORDS_BIGENDIAN) +unpackWord16 w = case hostByteOrder of + BigEndian -> (# w `and#` 0xff##, w `uncheckedShiftRL#` 8# #) -#else + LittleEndian -> (# w `uncheckedShiftRL#` 8#, w `and#` 0xff## #) -#endif -- | Static array of 2-digit pairs 00..99 for faster ascii rendering diff --git a/Data/ByteString/Utils/ByteOrder.hs b/Data/ByteString/Utils/ByteOrder.hs new file mode 100644 index 000000000..9248b7cad --- /dev/null +++ b/Data/ByteString/Utils/ByteOrder.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE CPP #-} + +-- | Why does this module exist? There is "GHC.ByteOrder" in base. +-- But that module is /broken/ until base-4.14/ghc-8.10, so we +-- can't rely on it until we drop support for older ghcs. +-- See https://gitlab.haskell.org/ghc/ghc/-/issues/20338 +-- and https://gitlab.haskell.org/ghc/ghc/-/issues/18445 + +#include "MachDeps.h" + +module Data.ByteString.Utils.ByteOrder + ( ByteOrder(..) + , hostByteOrder + , whenLittleEndian + , whenBigEndian + ) where + +data ByteOrder + = LittleEndian + | BigEndian + +hostByteOrder :: ByteOrder +hostByteOrder = +#ifdef WORDS_BIGENDIAN + BigEndian +#else + LittleEndian +#endif + +-- | If the host is little-endian, applies the given function to the given arg. +-- If the host is big-endian, returns the second argument unchanged. +whenLittleEndian :: (a -> a) -> a -> a +whenLittleEndian fun val = case hostByteOrder of + LittleEndian -> fun val + BigEndian -> val + +-- | If the host is little-endian, returns the second argument unchanged. +-- If the host is big-endian, applies the given function to the given arg. +whenBigEndian :: (a -> a) -> a -> a +whenBigEndian fun val = case hostByteOrder of + LittleEndian -> val + BigEndian -> fun val diff --git a/bytestring.cabal b/bytestring.cabal index a680197ca..1de5c78b4 100644 --- a/bytestring.cabal +++ b/bytestring.cabal @@ -120,6 +120,7 @@ library Data.ByteString.Lazy.ReadNat Data.ByteString.ReadInt Data.ByteString.ReadNat + Data.ByteString.Utils.ByteOrder Data.ByteString.Utils.UnalignedWrite default-language: Haskell2010 @@ -140,7 +141,7 @@ library -fmax-simplifier-iterations=10 -fdicts-cheap -fspec-constr-count=6 - + if arch(javascript) || flag(pure-haskell) cpp-options: -DPURE_HASKELL=1 other-modules: Data.ByteString.Internal.Pure