packages feed

primitive 0.4.1 → 0.5

raw patch · 13 files changed

+310/−127 lines, 13 files

Files

Control/Monad/Primitive.hs view
@@ -50,37 +50,47 @@   type PrimState IO = RealWorld   primitive = IO   internal (IO p) = p+  {-# INLINE primitive #-}+  {-# INLINE internal #-}  instance PrimMonad (ST s) where   type PrimState (ST s) = s   primitive = ST   internal (ST p) = p+  {-# INLINE primitive #-}+  {-# INLINE internal #-}  -- | Convert a 'PrimMonad' to another monad with the same state token. primToPrim :: (PrimMonad m1, PrimMonad m2, PrimState m1 ~ PrimState m2)         => m1 a -> m2 a+{-# INLINE primToPrim #-} primToPrim m = primitive (internal m)  -- | Convert a 'PrimMonad' with a 'RealWorld' state token to 'IO' primToIO :: (PrimMonad m, PrimState m ~ RealWorld) => m a -> IO a+{-# INLINE primToIO #-} primToIO = primToPrim  -- | Convert a 'PrimMonad' to 'ST' primToST :: PrimMonad m => m a -> ST (PrimState m) a+{-# INLINE primToST #-} primToST = primToPrim  -- | Convert a 'PrimMonad' to another monad with a possibly different state -- token. This operation is highly unsafe! unsafePrimToPrim :: (PrimMonad m1, PrimMonad m2) => m1 a -> m2 a+{-# INLINE unsafePrimToPrim #-} unsafePrimToPrim m = primitive (unsafeCoerce# (internal m))  -- | Convert any 'PrimMonad' to 'ST' with an arbitrary state token. This--- operations is highly unsafe!+-- operation is highly unsafe! unsafePrimToST :: PrimMonad m => m a -> ST s a+{-# INLINE unsafePrimToST #-} unsafePrimToST = unsafePrimToPrim  -- | Convert any 'PrimMonad' to 'IO'. This operation is highly unsafe! unsafePrimToIO :: PrimMonad m => m a -> IO a+{-# INLINE unsafePrimToIO #-} unsafePrimToIO = unsafePrimToPrim  unsafeInlinePrim :: PrimMonad m => m a -> a@@ -96,6 +106,7 @@ unsafeInlineST = unsafeInlinePrim  touch :: PrimMonad m => a -> m ()+{-# INLINE touch #-} touch x = unsafePrimToPrim         $ (primitive (\s -> case touch# x s of { s' -> (# s', () #) }) :: IO ()) 
Data/Primitive.hs view
@@ -2,7 +2,7 @@ {-# OPTIONS_GHC -fno-warn-duplicate-exports #-} -- | -- Module      : Data.Primitive--- Copyright   : (c) Roman Leshchinskiy 2009+-- Copyright   : (c) Roman Leshchinskiy 2009-2012 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
Data/Primitive/Addr.hs view
@@ -2,7 +2,7 @@  -- | -- Module      : Data.Primitive.Addr--- Copyright   : (c) Roman Leshchinskiy 2009-2010+-- Copyright   : (c) Roman Leshchinskiy 2009-2012 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -12,11 +12,17 @@ --  module Data.Primitive.Addr (+  -- * Types   Addr(..), +  -- * Address arithmetic   nullAddr, plusAddr, minusAddr, remAddr,++  -- * Element access   indexOffAddr, readOffAddr, writeOffAddr,-  copyAddr, moveAddr, memcpyAddr++  -- * Block operations+  copyAddr, moveAddr, setAddr ) where  import Control.Monad.Primitive@@ -88,8 +94,9 @@ moveAddr (Addr dst#) (Addr src#) n   = unsafePrimToPrim $ moveBytes (Ptr dst#) (Ptr src#) n -memcpyAddr :: PrimMonad m => Addr -> Addr -> Int -> m ()-{-# INLINE memcpyAddr #-}-{-# DEPRECATED memcpyAddr "Use copyAddr instead" #-}-memcpyAddr = copyAddr+-- | Fill a memory block of with the given value. The length is in+-- elements of type @a@ rather than in bytes.+setAddr :: (Prim a, PrimMonad m) => Addr -> Int -> a -> m ()+{-# INLINE setAddr #-}+setAddr (Addr addr#) (I# n#) x = primitive_ (setOffAddr# addr# 0# n# x) 
Data/Primitive/Array.hs view
@@ -2,7 +2,7 @@  -- | -- Module      : Data.Primitive.Array--- Copyright   : (c) Roman Leshchinskiy 2009-2010+-- Copyright   : (c) Roman Leshchinskiy 2009-2012 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
Data/Primitive/ByteArray.hs view
@@ -3,7 +3,7 @@  -- | -- Module      : Data.Primitive.ByteArray--- Copyright   : (c) Roman Leshchinskiy 2009-2010+-- Copyright   : (c) Roman Leshchinskiy 2009-2012 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -13,17 +13,25 @@ --  module Data.Primitive.ByteArray (+  -- * Types   ByteArray(..), MutableByteArray(..), ByteArray#, MutableByteArray#, +  -- * Allocation   newByteArray, newPinnedByteArray, newAlignedPinnedByteArray,++  -- * Element access   readByteArray, writeByteArray, indexByteArray,++  -- * Freezing and thawing   unsafeFreezeByteArray, unsafeThawByteArray,-  sizeofByteArray, sizeofMutableByteArray, sameMutableByteArray,-  byteArrayContents, mutableByteArrayContents,-  copyByteArray, copyMutableByteArray, moveByteArray, fillByteArray, -  -- * Deprecated operations-  memcpyByteArray, memcpyByteArray', memmoveByteArray, memsetByteArray+  -- * Block operations+  copyByteArray, copyMutableByteArray, moveByteArray,+  setByteArray, fillByteArray,++  -- * Information+  sizeofByteArray, sizeofMutableByteArray, sameMutableByteArray,+  byteArrayContents, mutableByteArrayContents ) where  import Control.Monad.Primitive@@ -33,6 +41,9 @@ import Data.Word ( Word8 ) import GHC.Base ( Int(..) ) import GHC.Prim+#if __GLASGOW_HASKELL__ >= 706+    hiding (setByteArray#)+#endif  import Data.Typeable ( Typeable ) import Data.Data ( Data(..) )@@ -203,70 +214,45 @@   $ memmove_mba dst# (fromIntegral doff) src# (fromIntegral soff)                      (fromIntegral sz) --- | Fill a slice of a mutable byte array with a value.+-- | Fill a slice of a mutable byte array with a value. The offset and length+-- are given in elements of type @a@ rather than in bytes.+setByteArray+  :: (Prim a, PrimMonad m) => MutableByteArray (PrimState m) -- ^ array to fill+                           -> Int                 -- ^ offset into array+                           -> Int                 -- ^ number of values to fill+                           -> a                   -- ^ value to fill with+                           -> m ()+{-# INLINE setByteArray #-}+setByteArray (MutableByteArray dst#) (I# doff#) (I# sz#) x+  = primitive_ (setByteArray# dst# doff# sz# x)++-- | Fill a slice of a mutable byte array with a byte. fillByteArray   :: PrimMonad m => MutableByteArray (PrimState m)                                         -- ^ array to fill                  -> Int                 -- ^ offset into array                  -> Int                 -- ^ number of bytes to fill-                 -> Word8               -- ^ value to fill with+                 -> Word8               -- ^ byte to fill with                  -> m () {-# INLINE fillByteArray #-}-fillByteArray (MutableByteArray dst#) doff sz c-  = unsafePrimToPrim-  $ memset_mba dst# (fromIntegral doff) (fromIntegral c) (fromIntegral sz)+fillByteArray = setByteArray   -memcpyByteArray-  :: PrimMonad m => MutableByteArray (PrimState m) -> Int-                 -> MutableByteArray (PrimState m) -> Int-                 -> Int -> m ()-{-# DEPRECATED memcpyByteArray "Use copyMutableByteArray instead" #-}-{-# INLINE memcpyByteArray #-}-memcpyByteArray = copyMutableByteArray--memcpyByteArray'-  :: PrimMonad m => MutableByteArray (PrimState m) -> Int-                 -> ByteArray -> Int-                 -> Int -> m ()-{-# DEPRECATED memcpyByteArray' "Use copyByteArray instead" #-}-{-# INLINE memcpyByteArray' #-}-memcpyByteArray' = copyByteArray--memmoveByteArray-  :: PrimMonad m => MutableByteArray (PrimState m) -> Int-                 -> MutableByteArray (PrimState m) -> Int-                 -> Int -> m ()-{-# DEPRECATED memmoveByteArray "Use moveByteArray instead" #-}-{-# INLINE memmoveByteArray #-}-memmoveByteArray = moveByteArray--memsetByteArray-  :: PrimMonad m => MutableByteArray (PrimState m) -> Int -> Word8-                 -> Int -> m ()-{-# DEPRECATED memsetByteArray "Use fillByteArray instead (WARNING: order of arguments is different)" #-}-{-# INLINE memsetByteArray #-}-memsetByteArray dst off x sz = fillByteArray dst off sz x---foreign import ccall unsafe "primitive-memops.h memcpy_off"+foreign import ccall unsafe "primitive-memops.h hsprimitive_memcpy"   memcpy_mba :: MutableByteArray# s -> CInt              -> MutableByteArray# s -> CInt              -> CSize -> IO () -foreign import ccall unsafe "primitive-memops.h memcpy_off"+foreign import ccall unsafe "primitive-memops.h hsprimitive_memcpy"   memcpy_ba :: MutableByteArray# s -> CInt             -> ByteArray# -> CInt             -> CSize -> IO () -foreign import ccall unsafe "primitive-memops.h memmove_off"+foreign import ccall unsafe "primitive-memops.h hsprimitive_memmove"   memmove_mba :: MutableByteArray# s -> CInt               -> MutableByteArray# s -> CInt               -> CSize -> IO ()--foreign import ccall unsafe "primitive-memops.h memset_off"-  memset_mba :: MutableByteArray# s -> CInt -> CInt -> CSize -> IO ()  instance Data ByteArray where   toConstr _ = error "toConstr"
Data/Primitive/Internal/Compat.hs view
@@ -1,3 +1,14 @@+-- |+-- Module      : Data.Primitive.Internal.Compat+-- Copyright   : (c) Roman Leshchinskiy 2011-2012+-- License     : BSD-style+--+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Portability : non-portable+-- +-- Compatibility functions+--+ module Data.Primitive.Internal.Compat (mkNoRepType) where  #if MIN_VERSION_base(4,2,0)
+ Data/Primitive/Internal/Operations.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE MagicHash, ForeignFunctionInterface, UnliftedFFITypes #-}++-- |+-- Module      : Data.Primitive.Internal.Operations+-- Copyright   : (c) Roman Leshchinskiy 2011-2012+-- License     : BSD-style+--+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Portability : non-portable+-- +-- Internal operations+--+++module Data.Primitive.Internal.Operations (+  setWord8Array#, setWord16Array#, setWord32Array#,+  setWord64Array#, setWordArray#,+  setInt8Array#, setInt16Array#, setInt32Array#,+  setInt64Array#, setIntArray#,+  setAddrArray#, setFloatArray#, setDoubleArray#, setWideCharArray#,++  setWord8OffAddr#, setWord16OffAddr#, setWord32OffAddr#,+  setWord64OffAddr#, setWordOffAddr#,+  setInt8OffAddr#, setInt16OffAddr#, setInt32OffAddr#,+  setInt64OffAddr#, setIntOffAddr#,+  setAddrOffAddr#, setFloatOffAddr#, setDoubleOffAddr#, setWideCharOffAddr#+) where++import Data.Primitive.MachDeps (Word64_#, Int64_#)+import GHC.Prim++foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word8"+  setWord8Array# :: MutableByteArray# s -> Int# -> Int# -> Word# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word16"+  setWord16Array# :: MutableByteArray# s -> Int# -> Int# -> Word# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word32"+  setWord32Array# :: MutableByteArray# s -> Int# -> Int# -> Word# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word64"+  setWord64Array# :: MutableByteArray# s -> Int# -> Int# -> Word64_# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word"+  setWordArray# :: MutableByteArray# s -> Int# -> Int# -> Word# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word8"+  setInt8Array# :: MutableByteArray# s -> Int# -> Int# -> Int# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word16"+  setInt16Array# :: MutableByteArray# s -> Int# -> Int# -> Int# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word32"+  setInt32Array# :: MutableByteArray# s -> Int# -> Int# -> Int# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word64"+  setInt64Array# :: MutableByteArray# s -> Int# -> Int# -> Int64_# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word"+  setIntArray# :: MutableByteArray# s -> Int# -> Int# -> Int# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Ptr"+  setAddrArray# :: MutableByteArray# s -> Int# -> Int# -> Addr# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Float"+  setFloatArray# :: MutableByteArray# s -> Int# -> Int# -> Float# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Double"+  setDoubleArray# :: MutableByteArray# s -> Int# -> Int# -> Double# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Char"+  setWideCharArray# :: MutableByteArray# s -> Int# -> Int# -> Char# -> IO ()++foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word8"+  setWord8OffAddr# :: Addr# -> Int# -> Int# -> Word# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word16"+  setWord16OffAddr# :: Addr# -> Int# -> Int# -> Word# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word32"+  setWord32OffAddr# :: Addr# -> Int# -> Int# -> Word# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word64"+  setWord64OffAddr# :: Addr# -> Int# -> Int# -> Word64_# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word"+  setWordOffAddr# :: Addr# -> Int# -> Int# -> Word# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word8"+  setInt8OffAddr# :: Addr# -> Int# -> Int# -> Int# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word16"+  setInt16OffAddr# :: Addr# -> Int# -> Int# -> Int# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word32"+  setInt32OffAddr# :: Addr# -> Int# -> Int# -> Int# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word64"+  setInt64OffAddr# :: Addr# -> Int# -> Int# -> Int64_# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word"+  setIntOffAddr# :: Addr# -> Int# -> Int# -> Int# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Ptr"+  setAddrOffAddr# :: Addr# -> Int# -> Int# -> Addr# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Float"+  setFloatOffAddr# :: Addr# -> Int# -> Int# -> Float# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Double"+  setDoubleOffAddr# :: Addr# -> Int# -> Int# -> Double# -> IO ()+foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Char"+  setWideCharOffAddr# :: Addr# -> Int# -> Int# -> Char# -> IO ()+
Data/Primitive/MachDeps.hs view
@@ -1,6 +1,7 @@+{-# LANGUAGE MagicHash #-} -- | -- Module      : Data.Primitive.MachDeps--- Copyright   : (c) Roman Leshchinskiy 2009+-- Copyright   : (c) Roman Leshchinskiy 2009-2012 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -13,6 +14,8 @@  #include "MachDeps.h" +import GHC.Prim+ sIZEOF_CHAR,  aLIGNMENT_CHAR, @@ -109,4 +112,12 @@  sIZEOF_WORD64 = SIZEOF_WORD64 aLIGNMENT_WORD64 = ALIGNMENT_WORD64++#if WORD_SIZE_IN_BITS == 32+type Word64_# = Word64#+type Int64_# = Int64#+#else+type Word64_# = Word#+type Int64_# = Int#+#endif 
Data/Primitive/MutVar.hs view
@@ -2,10 +2,10 @@  -- | -- Module      : Data.Primitive.MutVar--- Copyright   : (c) Justin Bonnar 2011+-- Copyright   : (c) Justin Bonnar 2011, Roman Leshchinskiy 2011-2012 -- License     : BSD-style ----- Maintainer  : Justin Bonnar <justinbonnar@gmail.com>+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Portability : non-portable --  -- Primitive boxed mutable variables@@ -17,12 +17,14 @@   newMutVar,   readMutVar,   writeMutVar,-  ++  atomicModifyMutVar,   modifyMutVar ) where  import Control.Monad.Primitive ( PrimMonad(..), primitive_ )-import GHC.Prim ( MutVar#, sameMutVar#, newMutVar#, readMutVar#, writeMutVar# )+import GHC.Prim ( MutVar#, sameMutVar#, newMutVar#,+                  readMutVar#, writeMutVar#, atomicModifyMutVar# ) import Data.Typeable ( Typeable )  -- | A 'MutVar' behaves like a single-element mutable array associated@@ -49,6 +51,11 @@ writeMutVar :: PrimMonad m => MutVar (PrimState m) a -> a -> m () {-# INLINE writeMutVar #-} writeMutVar (MutVar mv#) newValue = primitive_ (writeMutVar# mv# newValue)++-- | Atomically mutate the contents of a 'MutVar'+atomicModifyMutVar :: PrimMonad m => MutVar (PrimState m) a -> (a -> (a,b)) -> m b+{-# INLINE atomicModifyMutVar #-}+atomicModifyMutVar (MutVar mv#) f = primitive $ atomicModifyMutVar# mv# f  -- | Mutate the contents of a 'MutVar'  modifyMutVar :: PrimMonad m => MutVar (PrimState m) a -> (a -> a) -> m ()
Data/Primitive/Types.hs view
@@ -2,7 +2,7 @@  -- | -- Module      : Data.Primitive.Types--- Copyright   : (c) Roman Leshchinskiy 2009-2010+-- Copyright   : (c) Roman Leshchinskiy 2009-2012 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -19,8 +19,10 @@  import Control.Monad.Primitive import Data.Primitive.MachDeps+import Data.Primitive.Internal.Operations  import GHC.Base (+    unsafeCoerce#,     Int(..), Char(..),   ) import GHC.Float (@@ -34,6 +36,9 @@   )  import GHC.Prim+#if __GLASGOW_HASKELL__ >= 706+    hiding (setByteArray#)+#endif  import Data.Typeable ( Typeable ) import Data.Data ( Data(..) )@@ -79,6 +84,10 @@   -- @a@ rather than in bytes.   writeByteArray# :: MutableByteArray# s -> Int# -> a -> State# s -> State# s +  -- | Fill a slice of the mutable array with a value. The offset and length+  -- of the chunk are in elements of type @a@ rather than in bytes.+  setByteArray# :: MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s+   -- | Read a value from a memory position given by an address and an offset.   -- The memory block the address refers to must be immutable. The offset is in   -- elements of type @a@ rather than in bytes.@@ -92,7 +101,11 @@   -- The offset is in elements of type @a@ rather than in bytes.   writeOffAddr# :: Addr# -> Int# -> a -> State# s -> State# s -#define derivePrim(ty, ctr, sz, align, idx_arr, rd_arr, wr_arr, idx_addr, rd_addr, wr_addr) \+  -- | Fill a memory block given by an address, an offset and a length.+  -- The offset and length are in elements of type @a@ rather than in bytes.+  setOffAddr# :: Addr# -> Int# -> Int# -> a -> State# s -> State# s++#define derivePrim(ty, ctr, sz, align, idx_arr, rd_arr, wr_arr, set_arr, idx_addr, rd_addr, wr_addr, set_addr) \ instance Prim ty where {                                        \   sizeOf# _ = unI# sz                                           \ ; alignment# _ = unI# align                                     \@@ -100,55 +113,72 @@ ; readByteArray#  arr# i# s# = case rd_arr arr# i# s# of        \                         { (# s1#, x# #) -> (# s1#, ctr x# #) }  \ ; writeByteArray# arr# i# (ctr x#) s# = wr_arr arr# i# x# s#    \+; setByteArray# arr# i# n# (ctr x#) s#                          \+    = case internal (set_arr arr# i# n# x#) (unsafeCoerce# s#) of \+        { (# s1#, _ #) -> unsafeCoerce# s1# }                   \                                                                 \ ; indexOffAddr# addr# i# = ctr (idx_addr addr# i#)              \ ; readOffAddr#  addr# i# s# = case rd_addr addr# i# s# of       \                         { (# s1#, x# #) -> (# s1#, ctr x# #) }  \-; writeOffAddr# addr# i# (ctr x#) s# = wr_addr addr# i# x# s#   }+; writeOffAddr# addr# i# (ctr x#) s# = wr_addr addr# i# x# s#   \+; setOffAddr# addr# i# n# (ctr x#) s#                           \+    = case internal (set_addr addr# i# n# x#) (unsafeCoerce# s#) of \+        { (# s1#, _ #) -> unsafeCoerce# s1# }                   \+; {-# INLINE sizeOf# #-}                                        \+; {-# INLINE alignment# #-}                                     \+; {-# INLINE indexByteArray# #-}                                \+; {-# INLINE readByteArray# #-}                                 \+; {-# INLINE writeByteArray# #-}                                \+; {-# INLINE setByteArray# #-}                                  \+; {-# INLINE indexOffAddr# #-}                                  \+; {-# INLINE readOffAddr# #-}                                   \+; {-# INLINE writeOffAddr# #-}                                  \+; {-# INLINE setOffAddr# #-}                                    \+}  unI# :: Int -> Int# unI# (I# n#) = n#  derivePrim(Word, W#, sIZEOF_WORD, aLIGNMENT_WORD,-           indexWordArray#, readWordArray#, writeWordArray#,-           indexWordOffAddr#, readWordOffAddr#, writeWordOffAddr#)+           indexWordArray#, readWordArray#, writeWordArray#, setWordArray#,+           indexWordOffAddr#, readWordOffAddr#, writeWordOffAddr#, setWordOffAddr#) derivePrim(Word8, W8#, sIZEOF_WORD8, aLIGNMENT_WORD8,-           indexWord8Array#, readWord8Array#, writeWord8Array#,-           indexWord8OffAddr#, readWord8OffAddr#, writeWord8OffAddr#)+           indexWord8Array#, readWord8Array#, writeWord8Array#, setWord8Array#,+           indexWord8OffAddr#, readWord8OffAddr#, writeWord8OffAddr#, setWord8OffAddr#) derivePrim(Word16, W16#, sIZEOF_WORD16, aLIGNMENT_WORD16,-           indexWord16Array#, readWord16Array#, writeWord16Array#,-           indexWord16OffAddr#, readWord16OffAddr#, writeWord16OffAddr#)+           indexWord16Array#, readWord16Array#, writeWord16Array#, setWord16Array#,+           indexWord16OffAddr#, readWord16OffAddr#, writeWord16OffAddr#, setWord16OffAddr#) derivePrim(Word32, W32#, sIZEOF_WORD32, aLIGNMENT_WORD32,-           indexWord32Array#, readWord32Array#, writeWord32Array#,-           indexWord32OffAddr#, readWord32OffAddr#, writeWord32OffAddr#)+           indexWord32Array#, readWord32Array#, writeWord32Array#, setWord32Array#,+           indexWord32OffAddr#, readWord32OffAddr#, writeWord32OffAddr#, setWord32OffAddr#) derivePrim(Word64, W64#, sIZEOF_WORD64, aLIGNMENT_WORD64,-           indexWord64Array#, readWord64Array#, writeWord64Array#,-           indexWord64OffAddr#, readWord64OffAddr#, writeWord64OffAddr#)+           indexWord64Array#, readWord64Array#, writeWord64Array#, setWord64Array#,+           indexWord64OffAddr#, readWord64OffAddr#, writeWord64OffAddr#, setWord64OffAddr#) derivePrim(Int, I#, sIZEOF_INT, aLIGNMENT_INT,-           indexIntArray#, readIntArray#, writeIntArray#,-           indexIntOffAddr#, readIntOffAddr#, writeIntOffAddr#)+           indexIntArray#, readIntArray#, writeIntArray#, setIntArray#,+           indexIntOffAddr#, readIntOffAddr#, writeIntOffAddr#, setIntOffAddr#) derivePrim(Int8, I8#, sIZEOF_INT8, aLIGNMENT_INT8,-           indexInt8Array#, readInt8Array#, writeInt8Array#,-           indexInt8OffAddr#, readInt8OffAddr#, writeInt8OffAddr#)+           indexInt8Array#, readInt8Array#, writeInt8Array#, setInt8Array#,+           indexInt8OffAddr#, readInt8OffAddr#, writeInt8OffAddr#, setInt8OffAddr#) derivePrim(Int16, I16#, sIZEOF_INT16, aLIGNMENT_INT16,-           indexInt16Array#, readInt16Array#, writeInt16Array#,-           indexInt16OffAddr#, readInt16OffAddr#, writeInt16OffAddr#)+           indexInt16Array#, readInt16Array#, writeInt16Array#, setInt16Array#,+           indexInt16OffAddr#, readInt16OffAddr#, writeInt16OffAddr#, setInt16OffAddr#) derivePrim(Int32, I32#, sIZEOF_INT32, aLIGNMENT_INT32,-           indexInt32Array#, readInt32Array#, writeInt32Array#,-           indexInt32OffAddr#, readInt32OffAddr#, writeInt32OffAddr#)+           indexInt32Array#, readInt32Array#, writeInt32Array#, setInt32Array#,+           indexInt32OffAddr#, readInt32OffAddr#, writeInt32OffAddr#, setInt32OffAddr#) derivePrim(Int64, I64#, sIZEOF_INT64, aLIGNMENT_INT64,-           indexInt64Array#, readInt64Array#, writeInt64Array#,-           indexInt64OffAddr#, readInt64OffAddr#, writeInt64OffAddr#)+           indexInt64Array#, readInt64Array#, writeInt64Array#, setInt64Array#,+           indexInt64OffAddr#, readInt64OffAddr#, writeInt64OffAddr#, setInt64OffAddr#) derivePrim(Float, F#, sIZEOF_FLOAT, aLIGNMENT_FLOAT,-           indexFloatArray#, readFloatArray#, writeFloatArray#,-           indexFloatOffAddr#, readFloatOffAddr#, writeFloatOffAddr#)+           indexFloatArray#, readFloatArray#, writeFloatArray#, setFloatArray#,+           indexFloatOffAddr#, readFloatOffAddr#, writeFloatOffAddr#, setFloatOffAddr#) derivePrim(Double, D#, sIZEOF_DOUBLE, aLIGNMENT_DOUBLE,-           indexDoubleArray#, readDoubleArray#, writeDoubleArray#,-           indexDoubleOffAddr#, readDoubleOffAddr#, writeDoubleOffAddr#)+           indexDoubleArray#, readDoubleArray#, writeDoubleArray#, setDoubleArray#,+           indexDoubleOffAddr#, readDoubleOffAddr#, writeDoubleOffAddr#, setDoubleOffAddr#) derivePrim(Char, C#, sIZEOF_CHAR, aLIGNMENT_CHAR,-           indexWideCharArray#, readWideCharArray#, writeWideCharArray#,-           indexWideCharOffAddr#, readWideCharOffAddr#, writeWideCharOffAddr#)+           indexWideCharArray#, readWideCharArray#, writeWideCharArray#, setWideCharArray#,+           indexWideCharOffAddr#, readWideCharOffAddr#, writeWideCharOffAddr#, setWideCharOffAddr#) derivePrim(Addr, Addr, sIZEOF_PTR, aLIGNMENT_PTR,-           indexAddrArray#, readAddrArray#, writeAddrArray#,-           indexAddrOffAddr#, readAddrOffAddr#, writeAddrOffAddr#)+           indexAddrArray#, readAddrArray#, writeAddrArray#, setAddrArray#,+           indexAddrOffAddr#, readAddrOffAddr#, writeAddrOffAddr#, setAddrOffAddr#) 
cbits/primitive-memops.c view
@@ -1,17 +1,52 @@ #include <string.h>+#include "primitive-memops.h" -void memcpy_off( void *dst, int doff, void *src, int soff, size_t len )+void hsprimitive_memcpy( void *dst, int doff, void *src, int soff, size_t len ) {   memcpy( (char *)dst + doff, (char *)src + soff, len ); } -void memmove_off( void *dst, int doff, void *src, int soff, size_t len )+void hsprimitive_memmove( void *dst, int doff, void *src, int soff, size_t len ) {   memmove( (char *)dst + doff, (char *)src + soff, len ); } -void memset_off( void *dst, int doff, int c, size_t len )+#define MEMSET(TYPE, ATYPE)                                                  \+void hsprimitive_memset_ ## TYPE (Hs ## TYPE *p, int off, int n, ATYPE x)    \+{                                                                            \+  p += off;                                                                  \+  if (x == 0)                                                                \+    memset(p, 0, n * sizeof(Hs ## TYPE));                                    \+  else if (sizeof(Hs ## TYPE) == sizeof(int)*2) {                            \+    int *q = (int *)p;                                                       \+    const int *r = (const int *)&x;                                          \+    while (n>0) {                                                            \+      q[0] = r[0];                                                           \+      q[1] = r[1];                                                           \+      q += 2;                                                                \+      --n;                                                                   \+    }                                                                        \+  }                                                                          \+  else {                                                                     \+    while (n>0) {                                                            \+      *p++ = x;                                                              \+      --n;                                                                   \+    }                                                                        \+  }                                                                          \+}++void hsprimitive_memset_Word8 (HsWord8 *p, int off, int n, HsWord x) {-  memset( (char *)dst + doff, c, len );+  memset( (char *)(p+off), x, n ); }++/* MEMSET(HsWord8, HsWord) */+MEMSET(Word16, HsWord)+MEMSET(Word32, HsWord)+MEMSET(Word64, HsWord64)+MEMSET(Word, HsWord)+MEMSET(Ptr, HsPtr)+MEMSET(Float, HsFloat)+MEMSET(Double, HsDouble)+MEMSET(Char, HsChar) 
cbits/primitive-memops.h view
@@ -2,10 +2,20 @@ #define haskell_primitive_memops_h  #include <stdlib.h>+#include <HsFFI.h> -void memcpy_off( void *dst, int doff, void *src, int soff, size_t len );-void memmove_off( void *dst, int doff, void *src, int soff, size_t len );-void memset_off( void *dst, int doff, int c, size_t len );+void hsprimitive_memcpy( void *dst, int doff, void *src, int soff, size_t len );+void hsprimitive_memmove( void *dst, int doff, void *src, int soff, size_t len );++void hsprimitive_memset_Word8 (HsWord8 *, int, int, HsWord);+void hsprimitive_memset_Word16 (HsWord16 *, int, int, HsWord);+void hsprimitive_memset_Word32 (HsWord32 *, int, int, HsWord);+void hsprimitive_memset_Word64 (HsWord64 *, int, int, HsWord64);+void hsprimitive_memset_Word (HsWord *, int, int, HsWord);+void hsprimitive_memset_Ptr (HsPtr *, int, int, HsPtr);+void hsprimitive_memset_Float (HsFloat *, int, int, HsFloat);+void hsprimitive_memset_Double (HsDouble *, int, int, HsDouble);+void hsprimitive_memset_Char (HsChar *, int, int, HsChar);  #endif 
primitive.cabal view
@@ -1,41 +1,22 @@ Name:           primitive-Version:        0.4.1+Version:        0.5 License:        BSD3 License-File:   LICENSE Author:         Roman Leshchinskiy <rl@cse.unsw.edu.au> Maintainer:     Roman Leshchinskiy <rl@cse.unsw.edu.au>-Copyright:      (c) Roman Leshchinskiy 2009-2010+Copyright:      (c) Roman Leshchinskiy 2009-2012 Homepage:       http://code.haskell.org/primitive Category:       Data-Synopsis:       Wrappers for primitive operations+Synopsis:       Primitive memory-related operations Description:         .-        This package provides wrappers for primitive array operations from-        GHC.Prim.-        .-        Changes in version 0.4.1-        .-        * New module "Data.Primitive.MutVar"-        .-        Changes in version 0.4.0.1-        .-        * Critical bug fix in @fillByteArray@-        .-        Changes in version 0.4-        .-        * Support for GHC 7.2 array copying primitives-        .-        * New in "Data.Primitive.ByteArray": @copyByteArray@,-          @copyMutableByteArray@, @moveByteArray@, @fillByteArray@-        .-        * Deprecated in "Data.Primitive.ByteArray": @memcpyByteArray@,-          @memcpyByteArray'@, @memmoveByteArray@, @memsetByteArray@+        This package provides various primitive memory-related operations.         .-        * New in "Data.Primitive.Array": @copyArray@, @copyMutableByteArray@+        Changes in version 0.5         .-        * New in "Data.Primitive.Addr": @copyAddr@, @moveAddr@+        * New in "Data.Primitive.MutVar": @atomicModifyMutVar@         .-        * Deprecated in "Data.Primitive.Addr": @memcpyAddr@+        * Efficient block fill operations: @setByteArray@, @setAddr@         .  Cabal-Version:  >= 1.2@@ -55,6 +36,7 @@    Other-Modules:         Data.Primitive.Internal.Compat+        Data.Primitive.Internal.Operations    Build-Depends: base >= 4 && < 5, ghc-prim @@ -64,4 +46,8 @@   Install-Includes: primitive-memops.h   includes: primitive-memops.h   c-sources: cbits/primitive-memops.c+  cc-options: -O3 -ftree-vectorize -fomit-frame-pointer+  if arch(i386) || arch(x86_64) {+    cc-options: -msse2+  }