Initial commit

bundled/Data/Memory/Internal/Compat.hs

@@ -0,0 +1,76 @@
+-- |
+-- Module      : Data.Memory.Internal.Compat
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- Stability   : stable
+-- Portability : Good
+--
+-- This module try to keep all the difference between versions of base
+-- or other needed packages, so that modules don't need to use CPP
+--
+{-# LANGUAGE CPP #-}
+module Data.Memory.Internal.Compat
+    ( unsafeDoIO
+    , popCount
+    , unsafeShiftL
+    , unsafeShiftR
+    , byteSwap64
+    , byteSwap32
+    , byteSwap16
+    ) where
+
+import System.IO.Unsafe
+import Data.Word
+import Data.Bits
+
+-- | perform io for hashes that do allocation and ffi.
+-- unsafeDupablePerformIO is used when possible as the
+-- computation is pure and the output is directly linked
+-- to the input. we also do not modify anything after it has
+-- been returned to the user.
+unsafeDoIO :: IO a -> a
+#if __GLASGOW_HASKELL__ > 704
+unsafeDoIO = unsafeDupablePerformIO
+#else
+unsafeDoIO = unsafePerformIO
+#endif
+
+#if !(MIN_VERSION_base(4,5,0))
+popCount :: Word64 -> Int
+popCount n = loop 0 n
+  where loop c 0 = c
+        loop c i = loop (c + if testBit c 0 then 1 else 0) (i `shiftR` 1)
+#endif
+
+#if !(MIN_VERSION_base(4,7,0))
+byteSwap64 :: Word64 -> Word64
+byteSwap64 w =
+        (w `shiftR` 56)                  .|. (w `shiftL` 56)
+    .|. ((w `shiftR` 40) .&. 0xff00)     .|. ((w .&. 0xff00) `shiftL` 40)
+    .|. ((w `shiftR` 24) .&. 0xff0000)   .|. ((w .&. 0xff0000) `shiftL` 24)
+    .|. ((w `shiftR` 8)  .&. 0xff000000) .|. ((w .&. 0xff000000) `shiftL` 8)
+#endif
+
+#if !(MIN_VERSION_base(4,7,0))
+byteSwap32 :: Word32 -> Word32
+byteSwap32 w =
+        (w `shiftR` 24)
+    .|. (w `shiftL` 24)
+    .|. ((w `shiftR` 8) .&. 0xff00)
+    .|. ((w .&. 0xff00) `shiftL` 8)
+#endif
+
+#if !(MIN_VERSION_base(4,7,0))
+byteSwap16 :: Word16 -> Word16
+byteSwap16 w =
+    (w `shiftR` 8) .|. (w `shiftL` 8)
+#endif
+
+#if !(MIN_VERSION_base(4,5,0))
+unsafeShiftL :: Bits a => a -> Int -> a
+unsafeShiftL = shiftL
+
+unsafeShiftR :: Bits a => a -> Int -> a
+unsafeShiftR = shiftR
+#endif
+

bundled/Data/Memory/Internal/CompatPrim.hs

@@ -0,0 +1,70 @@
+-- |
+-- Module      : Data.Memory.Internal.CompatPrim
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- Stability   : stable
+-- Portability : Compat
+--
+-- This module try to keep all the difference between versions of ghc primitive
+-- or other needed packages, so that modules don't need to use CPP.
+--
+-- Note that MagicHash and CPP conflicts in places, making it "more interesting"
+-- to write compat code for primitives
+--
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+module Data.Memory.Internal.CompatPrim
+    ( be32Prim
+    , le32Prim
+    , byteswap32Prim
+    , booleanPrim
+    ) where
+
+import GHC.Prim
+
+-- | byteswap Word# to or from Big Endian
+--
+-- on a big endian machine, this function is a nop.
+be32Prim :: Word# -> Word#
+#ifdef ARCH_IS_LITTLE_ENDIAN
+be32Prim = byteswap32Prim
+#else
+be32Prim w = w
+#endif
+
+-- | byteswap Word# to or from Little Endian
+--
+-- on a little endian machine, this function is a nop.
+le32Prim :: Word# -> Word#
+#ifdef ARCH_IS_LITTLE_ENDIAN
+le32Prim w = w
+#else
+le32Prim = byteswap32Prim
+#endif
+
+-- | Simple compatibility for byteswap the lower 32 bits of a Word#
+-- at the primitive level
+byteswap32Prim :: Word# -> Word#
+#if __GLASGOW_HASKELL__ >= 708
+byteswap32Prim w = byteSwap32# w
+#else
+byteswap32Prim w =
+    let !a =       uncheckedShiftL# w 24#
+        !b = and# (uncheckedShiftL# w 8#) 0x00ff0000##
+        !c = and# (uncheckedShiftRL# w 8#) 0x0000ff00##
+        !d = and# (uncheckedShiftRL# w 24#) 0x000000ff##
+     in or# a (or# b (or# c d))
+#endif
+
+-- | Simple wrapper to handle pre 7.8 and future, where
+-- most comparaison functions don't returns a boolean
+-- anymore.
+#if __GLASGOW_HASKELL__ >= 708
+booleanPrim :: Int# -> Bool
+booleanPrim v = tagToEnum# v
+#else
+booleanPrim :: Bool -> Bool
+booleanPrim b = b
+#endif
+{-# INLINE booleanPrim #-}

bundled/Data/Memory/Internal/CompatPrim64.hs

@@ -0,0 +1,169 @@
+-- |
+-- Module      : Data.Memory.Internal.CompatPrim
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- Stability   : stable
+-- Portability : Compat
+--
+-- This module try to keep all the difference between versions of ghc primitive
+-- or other needed packages, so that modules don't need to use CPP.
+--
+-- Note that MagicHash and CPP conflicts in places, making it "more interesting"
+-- to write compat code for primitives
+--
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+#include "MachDeps.h"
+module Data.Memory.Internal.CompatPrim64
+    ( Word64#
+    , Int64#
+    , eqInt64#
+    , neInt64#
+    , ltInt64#
+    , leInt64#
+    , gtInt64#
+    , geInt64#
+    , quotInt64#
+    , remInt64#
+    , eqWord64#
+    , neWord64#
+    , ltWord64#
+    , leWord64#
+    , gtWord64#
+    , geWord64#
+    , and64#
+    , or64#
+    , xor64#
+    , not64#
+    , timesWord64#
+    , uncheckedShiftL64#
+    , uncheckedShiftRL64#
+
+    , int64ToWord64#
+    , word64ToInt64#
+    , intToInt64#
+    , int64ToInt#
+    , wordToWord64#
+    , word64ToWord#
+    , w64#
+    ) where
+
+
+#if WORD_SIZE_IN_BITS == 64
+import GHC.Prim hiding (Word64#, Int64#)
+
+#if __GLASGOW_HASKELL__ >= 708
+type OutBool = Int#
+#else
+type OutBool = Bool
+#endif
+
+type Word64# = Word#
+type Int64# = Int#
+
+#if __GLASGOW_HASKELL__ < 904
+eqWord64# :: Word64# -> Word64# -> OutBool
+eqWord64# = eqWord#
+
+neWord64# :: Word64# -> Word64# -> OutBool
+neWord64# = neWord#
+
+ltWord64# :: Word64# -> Word64# -> OutBool
+ltWord64# = ltWord#
+
+leWord64# :: Word64# -> Word64# -> OutBool
+leWord64# = leWord#
+
+gtWord64# :: Word64# -> Word64# -> OutBool
+gtWord64# = gtWord#
+
+geWord64# :: Word64# -> Word64# -> OutBool
+geWord64# = geWord#
+
+eqInt64# :: Int64# -> Int64# -> OutBool
+eqInt64# = (==#)
+
+neInt64# :: Int64# -> Int64# -> OutBool
+neInt64# = (/=#)
+
+ltInt64# :: Int64# -> Int64# -> OutBool
+ltInt64# = (<#)
+
+leInt64# :: Int64# -> Int64# -> OutBool
+leInt64# = (<=#)
+
+gtInt64# :: Int64# -> Int64# -> OutBool
+gtInt64# = (>#)
+
+geInt64# :: Int64# -> Int64# -> OutBool
+geInt64# = (<=#)
+
+quotInt64# :: Int64# -> Int64# -> Int64#
+quotInt64# = quotInt#
+
+remInt64# :: Int64# -> Int64# -> Int64#
+remInt64# = remInt#
+
+and64# :: Word64# -> Word64# -> Word64#
+and64# = and#
+
+or64# :: Word64# -> Word64# -> Word64#
+or64# = or#
+
+xor64# :: Word64# -> Word64# -> Word64#
+xor64# = xor#
+
+not64# :: Word64# -> Word64#
+not64# = not#
+
+uncheckedShiftL64# :: Word64# -> Int# -> Word64#
+uncheckedShiftL64# = uncheckedShiftL#
+
+uncheckedShiftRL64#  :: Word64# -> Int# -> Word64#
+uncheckedShiftRL64# = uncheckedShiftL#
+
+int64ToWord64# :: Int64# -> Word64#
+int64ToWord64# = int2Word#
+
+word64ToInt64# :: Word64# -> Int64#
+word64ToInt64# = word2Int#
+
+intToInt64# :: Int# -> Int64#
+intToInt64# w = w
+
+int64ToInt# :: Int64# -> Int#
+int64ToInt# w = w
+
+wordToWord64# :: Word# -> Word64#
+wordToWord64# w = w
+
+word64ToWord# :: Word64# -> Word#
+word64ToWord# w = w
+
+timesWord64# :: Word64# -> Word64# -> Word64#
+timesWord64# = timesWord#
+#endif
+
+w64# :: Word# -> Word# -> Word# -> Word64#
+w64# w _ _ = w
+
+#elif WORD_SIZE_IN_BITS == 32
+import GHC.IntWord64
+import GHC.Prim (Word#)
+
+timesWord64# :: Word64# -> Word64# -> Word64#
+timesWord64# a b =
+    let !ai = word64ToInt64# a
+        !bi = word64ToInt64# b
+     in int64ToWord64# (timesInt64# ai bi)
+
+w64# :: Word# -> Word# -> Word# -> Word64#
+w64# _ hw lw =
+    let !h = wordToWord64# hw
+        !l = wordToWord64# lw
+     in or64# (uncheckedShiftL64# h 32#) l
+#else
+#error "not a supported architecture. supported WORD_SIZE_IN_BITS is 32 bits or 64 bits"
+#endif

bundled/Data/Memory/Internal/DeepSeq.hs

@@ -0,0 +1,28 @@
+-- |
+-- Module      : Data.Memory.Internal.DeepSeq
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- Stability   : experimental
+-- Portability : unknown
+--
+-- Simple abstraction module to allow compilation without deepseq
+-- by defining our own NFData class if not compiling with deepseq
+-- support.
+--
+{-# LANGUAGE CPP #-}
+module Data.Memory.Internal.DeepSeq
+    ( NFData(..)
+    ) where
+
+#ifdef WITH_DEEPSEQ_SUPPORT
+import Control.DeepSeq
+#else
+import Data.Word
+
+class NFData a where rnf :: a -> ()
+
+instance NFData Word8 where rnf w = w `seq` ()
+instance NFData Word16 where rnf w = w `seq` ()
+instance NFData Word32 where rnf w = w `seq` ()
+instance NFData Word64 where rnf w = w `seq` ()
+#endif

bundled/Data/Memory/Internal/Imports.hs

@@ -0,0 +1,17 @@
+-- |
+-- Module      : Data.Memory.Internal.Imports
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- Stability   : experimental
+-- Portability : unknown
+--
+{-# LANGUAGE CPP #-}
+module Data.Memory.Internal.Imports
+    ( module X
+    ) where
+
+import Data.Word                    as X
+import Control.Applicative          as X
+import Control.Monad                as X (forM, forM_, void, when)
+import Control.Arrow                as X (first, second)
+import Data.Memory.Internal.DeepSeq as X