primitive-0.6.1.0/0000755000000000000000000000000012577424530012063 5ustar0000000000000000primitive-0.6.1.0/primitive.cabal0000644000000000000000000000350212577424530015057 0ustar0000000000000000Name: primitive Version: 0.6.1.0 License: BSD3 License-File: LICENSE Author: Roman Leshchinskiy Maintainer: libraries@haskell.org Copyright: (c) Roman Leshchinskiy 2009-2012 Homepage: https://github.com/haskell/primitive Bug-Reports: https://github.com/haskell/primitive/issues Category: Data Synopsis: Primitive memory-related operations Cabal-Version: >= 1.10 Build-Type: Simple Description: This package provides various primitive memory-related operations. Extra-Source-Files: changelog.md Library Default-Language: Haskell2010 Other-Extensions: BangPatterns, CPP, DeriveDataTypeable, MagicHash, TypeFamilies, UnboxedTuples, UnliftedFFITypes Exposed-Modules: Control.Monad.Primitive Data.Primitive Data.Primitive.MachDeps Data.Primitive.Types Data.Primitive.Array Data.Primitive.ByteArray Data.Primitive.Addr Data.Primitive.MutVar Other-Modules: Data.Primitive.Internal.Compat Data.Primitive.Internal.Operations Build-Depends: base >= 4.3 && < 4.9 , ghc-prim >= 0.2 && < 0.5 , transformers >= 0.2 && < 0.5 Ghc-Options: -O2 -Wall Include-Dirs: cbits Install-Includes: primitive-memops.h includes: primitive-memops.h c-sources: cbits/primitive-memops.c cc-options: -O3 -fomit-frame-pointer -Wall if !os(solaris) cc-options: -ftree-vectorize if arch(i386) || arch(x86_64) cc-options: -msse2 test-suite test Default-Language: Haskell2010 hs-source-dirs: test main-is: main.hs type: exitcode-stdio-1.0 build-depends: base , ghc-prim , primitive ghc-options: -O2 source-repository head type: git location: https://github.com/haskell/primitive primitive-0.6.1.0/changelog.md0000644000000000000000000000403412577424530014335 0ustar0000000000000000## Changes in version 0.6.1.0 * Use more appropriate types in internal memset functions, which prevents overflows/segfaults on 64-bit systems. * Fixed a warning on GHC 7.10 * Worked around a -dcore-lint bug in GHC 7.6/7.7 ## Changes in version 0.6 * Split PrimMonad into two classes to allow automatic lifting of primitive operations into monad transformers. The `internal` operation has moved to the `PrimBase` class. * Fixed the test suite on older GHCs ## Changes in version 0.5.4.0 * Changed primitive_ to work around an oddity with GHC's code generation on certain versions that led to side effects not happening when used in conjunction with certain very unsafe IO performers. * Allow primitive to build on GHC 7.9 ## Changes in version 0.5.3.0 * Implement `cloneArray` and `cloneMutableArray` primitives (with fall-back implementations for GHCs prior to version 7.2.1) ## Changes in version 0.5.2.1 * Add strict variants of `MutVar` modification functions `atomicModifyMutVar'` and `modifyMutVar'` * Fix compilation on Solaris 10 with GNU C 3.4.3 ## Changes in version 0.5.1.0 * Add support for GHC 7.7's new primitive `Bool` representation ## Changes in version 0.5.0.1 * Disable array copying primitives for GHC 7.6.* and earlier ## Changes in version 0.5 * New in `Data.Primitive.MutVar`: `atomicModifyMutVar` * Efficient block fill operations: `setByteArray`, `setAddr` ## 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` * New in `Data.Primitive.Array`: `copyArray`, `copyMutableByteArray` * New in `Data.Primitive.Addr`: `copyAddr`, `moveAddr` * Deprecated in `Data.Primitive.Addr`: `memcpyAddr` primitive-0.6.1.0/LICENSE0000644000000000000000000000301612577424530013070 0ustar0000000000000000Copyright (c) 2008-2009, Roman Leshchinskiy 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. primitive-0.6.1.0/Setup.hs0000644000000000000000000000005712577424530013521 0ustar0000000000000000import Distribution.Simple main = defaultMain primitive-0.6.1.0/Data/0000755000000000000000000000000012577424530012734 5ustar0000000000000000primitive-0.6.1.0/Data/Primitive.hs0000644000000000000000000000157512577424530015250 0ustar0000000000000000{-# LANGUAGE MagicHash #-} {-# OPTIONS_GHC -fno-warn-duplicate-exports #-} -- | -- Module : Data.Primitive -- Copyright : (c) Roman Leshchinskiy 2009-2012 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Portability : non-portable -- -- Reexports all primitive operations -- module Data.Primitive ( module Data.Primitive.Types, module Data.Primitive.Array, module Data.Primitive.ByteArray, module Data.Primitive.Addr, sizeOf, alignment ) where import Data.Primitive.Types import Data.Primitive.Array import Data.Primitive.ByteArray import Data.Primitive.Addr import GHC.Base ( Int(..) ) -- | Size of values of type @a@. The argument is not used. sizeOf :: Prim a => a -> Int sizeOf x = I# (sizeOf# x) -- | Alignment of values of type @a@. The argument is not used. alignment :: Prim a => a -> Int alignment x = I# (alignment# x) primitive-0.6.1.0/Data/Primitive/0000755000000000000000000000000012577424530014704 5ustar0000000000000000primitive-0.6.1.0/Data/Primitive/Array.hs0000644000000000000000000002051712577424530016323 0ustar0000000000000000{-# LANGUAGE CPP, MagicHash, UnboxedTuples, DeriveDataTypeable, BangPatterns #-} -- | -- Module : Data.Primitive.Array -- Copyright : (c) Roman Leshchinskiy 2009-2012 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Portability : non-portable -- -- Primitive boxed arrays -- module Data.Primitive.Array ( Array(..), MutableArray(..), newArray, readArray, writeArray, indexArray, indexArrayM, unsafeFreezeArray, unsafeThawArray, sameMutableArray, copyArray, copyMutableArray, cloneArray, cloneMutableArray ) where import Control.Monad.Primitive import GHC.Base ( Int(..) ) import GHC.Prim import Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) import Data.Primitive.Internal.Compat ( isTrue#, mkNoRepType ) #if !(__GLASGOW_HASKELL__ >= 702) import Control.Monad.ST(runST) #endif -- | Boxed arrays data Array a = Array (Array# a) deriving ( Typeable ) -- | Mutable boxed arrays associated with a primitive state token. data MutableArray s a = MutableArray (MutableArray# s a) deriving ( Typeable ) -- | Create a new mutable array of the specified size and initialise all -- elements with the given value. newArray :: PrimMonad m => Int -> a -> m (MutableArray (PrimState m) a) {-# INLINE newArray #-} newArray (I# n#) x = primitive (\s# -> case newArray# n# x s# of (# s'#, arr# #) -> (# s'#, MutableArray arr# #)) -- | Read a value from the array at the given index. readArray :: PrimMonad m => MutableArray (PrimState m) a -> Int -> m a {-# INLINE readArray #-} readArray (MutableArray arr#) (I# i#) = primitive (readArray# arr# i#) -- | Write a value to the array at the given index. writeArray :: PrimMonad m => MutableArray (PrimState m) a -> Int -> a -> m () {-# INLINE writeArray #-} writeArray (MutableArray arr#) (I# i#) x = primitive_ (writeArray# arr# i# x) -- | Read a value from the immutable array at the given index. indexArray :: Array a -> Int -> a {-# INLINE indexArray #-} indexArray (Array arr#) (I# i#) = case indexArray# arr# i# of (# x #) -> x -- | Monadically read a value from the immutable array at the given index. -- This allows us to be strict in the array while remaining lazy in the read -- element which is very useful for collective operations. Suppose we want to -- copy an array. We could do something like this: -- -- > copy marr arr ... = do ... -- > writeArray marr i (indexArray arr i) ... -- > ... -- -- But since primitive arrays are lazy, the calls to 'indexArray' will not be -- evaluated. Rather, @marr@ will be filled with thunks each of which would -- retain a reference to @arr@. This is definitely not what we want! -- -- With 'indexArrayM', we can instead write -- -- > copy marr arr ... = do ... -- > x <- indexArrayM arr i -- > writeArray marr i x -- > ... -- -- Now, indexing is executed immediately although the returned element is -- still not evaluated. -- indexArrayM :: Monad m => Array a -> Int -> m a {-# INLINE indexArrayM #-} indexArrayM (Array arr#) (I# i#) = case indexArray# arr# i# of (# x #) -> return x -- | Convert a mutable array to an immutable one without copying. The -- array should not be modified after the conversion. unsafeFreezeArray :: PrimMonad m => MutableArray (PrimState m) a -> m (Array a) {-# INLINE unsafeFreezeArray #-} unsafeFreezeArray (MutableArray arr#) = primitive (\s# -> case unsafeFreezeArray# arr# s# of (# s'#, arr'# #) -> (# s'#, Array arr'# #)) -- | Convert an immutable array to an mutable one without copying. The -- immutable array should not be used after the conversion. unsafeThawArray :: PrimMonad m => Array a -> m (MutableArray (PrimState m) a) {-# INLINE unsafeThawArray #-} unsafeThawArray (Array arr#) = primitive (\s# -> case unsafeThawArray# arr# s# of (# s'#, arr'# #) -> (# s'#, MutableArray arr'# #)) -- | Check whether the two arrays refer to the same memory block. sameMutableArray :: MutableArray s a -> MutableArray s a -> Bool {-# INLINE sameMutableArray #-} sameMutableArray (MutableArray arr#) (MutableArray brr#) = isTrue# (sameMutableArray# arr# brr#) -- | Copy a slice of an immutable array to a mutable array. copyArray :: PrimMonad m => MutableArray (PrimState m) a -- ^ destination array -> Int -- ^ offset into destination array -> Array a -- ^ source array -> Int -- ^ offset into source array -> Int -- ^ number of elements to copy -> m () {-# INLINE copyArray #-} #if __GLASGOW_HASKELL__ > 706 -- NOTE: copyArray# and copyMutableArray# are slightly broken in GHC 7.6.* and earlier copyArray (MutableArray dst#) (I# doff#) (Array src#) (I# soff#) (I# len#) = primitive_ (copyArray# src# soff# dst# doff# len#) #else copyArray !dst !doff !src !soff !len = go 0 where go i | i < len = do x <- indexArrayM src (soff+i) writeArray dst (doff+i) x go (i+1) | otherwise = return () #endif -- | Copy a slice of a mutable array to another array. The two arrays may -- not be the same. copyMutableArray :: PrimMonad m => MutableArray (PrimState m) a -- ^ destination array -> Int -- ^ offset into destination array -> MutableArray (PrimState m) a -- ^ source array -> Int -- ^ offset into source array -> Int -- ^ number of elements to copy -> m () {-# INLINE copyMutableArray #-} #if __GLASGOW_HASKELL__ >= 706 -- NOTE: copyArray# and copyMutableArray# are slightly broken in GHC 7.6.* and earlier copyMutableArray (MutableArray dst#) (I# doff#) (MutableArray src#) (I# soff#) (I# len#) = primitive_ (copyMutableArray# src# soff# dst# doff# len#) #else copyMutableArray !dst !doff !src !soff !len = go 0 where go i | i < len = do x <- readArray src (soff+i) writeArray dst (doff+i) x go (i+1) | otherwise = return () #endif -- | Return a newly allocated Array with the specified subrange of the -- provided Array. The provided Array should contain the full subrange -- specified by the two Ints, but this is not checked. cloneArray :: Array a -- ^ source array -> Int -- ^ offset into destination array -> Int -- ^ number of elements to copy -> Array a {-# INLINE cloneArray #-} #if __GLASGOW_HASKELL__ >= 702 cloneArray (Array arr#) (I# off#) (I# len#) = case cloneArray# arr# off# len# of arr'# -> Array arr'# #else cloneArray arr off len = runST $ do marr2 <- newArray len (error "Undefined element") copyArray marr2 0 arr off len unsafeFreezeArray marr2 #endif -- | Return a newly allocated MutableArray. with the specified subrange of -- the provided MutableArray. The provided MutableArray should contain the -- full subrange specified by the two Ints, but this is not checked. cloneMutableArray :: PrimMonad m => MutableArray (PrimState m) a -- ^ source array -> Int -- ^ offset into destination array -> Int -- ^ number of elements to copy -> m (MutableArray (PrimState m) a) {-# INLINE cloneMutableArray #-} #if __GLASGOW_HASKELL__ >= 702 cloneMutableArray (MutableArray arr#) (I# off#) (I# len#) = primitive (\s# -> case cloneMutableArray# arr# off# len# s# of (# s'#, arr'# #) -> (# s'#, MutableArray arr'# #)) #else cloneMutableArray marr off len = do marr2 <- newArray len (error "Undefined element") let go !i !j c | c >= len = return marr2 | otherwise = do b <- readArray marr i writeArray marr2 j b go (i+1) (j+1) (c+1) go off 0 0 #endif instance Typeable a => Data (Array a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNoRepType "Data.Primitive.Array.Array" instance (Typeable s, Typeable a) => Data (MutableArray s a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNoRepType "Data.Primitive.Array.MutableArray" primitive-0.6.1.0/Data/Primitive/MutVar.hs0000644000000000000000000000550712577424530016465 0ustar0000000000000000{-# LANGUAGE MagicHash, UnboxedTuples, DeriveDataTypeable #-} -- | -- Module : Data.Primitive.MutVar -- Copyright : (c) Justin Bonnar 2011, Roman Leshchinskiy 2011-2012 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Portability : non-portable -- -- Primitive boxed mutable variables -- module Data.Primitive.MutVar ( MutVar(..), newMutVar, readMutVar, writeMutVar, atomicModifyMutVar, atomicModifyMutVar', modifyMutVar, modifyMutVar' ) where import Control.Monad.Primitive ( PrimMonad(..), primitive_ ) import GHC.Prim ( MutVar#, sameMutVar#, newMutVar#, readMutVar#, writeMutVar#, atomicModifyMutVar# ) import Data.Primitive.Internal.Compat ( isTrue# ) import Data.Typeable ( Typeable ) -- | A 'MutVar' behaves like a single-element mutable array associated -- with a primitive state token. data MutVar s a = MutVar (MutVar# s a) deriving ( Typeable ) instance Eq (MutVar s a) where MutVar mva# == MutVar mvb# = isTrue# (sameMutVar# mva# mvb#) -- | Create a new 'MutVar' with the specified initial value newMutVar :: PrimMonad m => a -> m (MutVar (PrimState m) a) {-# INLINE newMutVar #-} newMutVar initialValue = primitive $ \s# -> case newMutVar# initialValue s# of (# s'#, mv# #) -> (# s'#, MutVar mv# #) -- | Read the value of a 'MutVar' readMutVar :: PrimMonad m => MutVar (PrimState m) a -> m a {-# INLINE readMutVar #-} readMutVar (MutVar mv#) = primitive (readMutVar# mv#) -- | Write a new value into a 'MutVar' 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 -- | Strict version of 'atomicModifyMutVar'. This forces both the value stored -- in the 'MutVar' as well as the value returned. atomicModifyMutVar' :: PrimMonad m => MutVar (PrimState m) a -> (a -> (a, b)) -> m b {-# INLINE atomicModifyMutVar' #-} atomicModifyMutVar' mv f = do b <- atomicModifyMutVar mv force b `seq` return b where force x = let (a, b) = f x in (a, a `seq` b) -- | Mutate the contents of a 'MutVar' modifyMutVar :: PrimMonad m => MutVar (PrimState m) a -> (a -> a) -> m () {-# INLINE modifyMutVar #-} modifyMutVar (MutVar mv#) g = primitive_ $ \s# -> case readMutVar# mv# s# of (# s'#, a #) -> writeMutVar# mv# (g a) s'# -- | Strict version of 'modifyMutVar' modifyMutVar' :: PrimMonad m => MutVar (PrimState m) a -> (a -> a) -> m () {-# INLINE modifyMutVar' #-} modifyMutVar' (MutVar mv#) g = primitive_ $ \s# -> case readMutVar# mv# s# of (# s'#, a #) -> let a' = g a in a' `seq` writeMutVar# mv# a' s'# primitive-0.6.1.0/Data/Primitive/Addr.hs0000644000000000000000000000645112577424530016120 0ustar0000000000000000{-# LANGUAGE MagicHash, UnboxedTuples #-} -- | -- Module : Data.Primitive.Addr -- Copyright : (c) Roman Leshchinskiy 2009-2012 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Portability : non-portable -- -- Primitive operations on machine addresses -- module Data.Primitive.Addr ( -- * Types Addr(..), -- * Address arithmetic nullAddr, plusAddr, minusAddr, remAddr, -- * Element access indexOffAddr, readOffAddr, writeOffAddr, -- * Block operations copyAddr, moveAddr, setAddr ) where import Control.Monad.Primitive import Data.Primitive.Types import GHC.Base ( Int(..) ) import GHC.Prim import GHC.Ptr import Foreign.Marshal.Utils -- | The null address nullAddr :: Addr nullAddr = Addr nullAddr# infixl 6 `plusAddr`, `minusAddr` infixl 7 `remAddr` -- | Offset an address by the given number of bytes plusAddr :: Addr -> Int -> Addr plusAddr (Addr a#) (I# i#) = Addr (plusAddr# a# i#) -- | Distance in bytes between two addresses. The result is only valid if the -- difference fits in an 'Int'. minusAddr :: Addr -> Addr -> Int minusAddr (Addr a#) (Addr b#) = I# (minusAddr# a# b#) -- | The remainder of the address and the integer. remAddr :: Addr -> Int -> Int remAddr (Addr a#) (I# i#) = I# (remAddr# a# i#) -- | 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. indexOffAddr :: Prim a => Addr -> Int -> a {-# INLINE indexOffAddr #-} indexOffAddr (Addr addr#) (I# i#) = indexOffAddr# addr# i# -- | Read a value from a memory position given by an address and an offset. -- The offset is in elements of type @a@ rather than in bytes. readOffAddr :: (Prim a, PrimMonad m) => Addr -> Int -> m a {-# INLINE readOffAddr #-} readOffAddr (Addr addr#) (I# i#) = primitive (readOffAddr# addr# i#) -- | Write a value to a memory position given by an address and an offset. -- The offset is in elements of type @a@ rather than in bytes. writeOffAddr :: (Prim a, PrimMonad m) => Addr -> Int -> a -> m () {-# INLINE writeOffAddr #-} writeOffAddr (Addr addr#) (I# i#) x = primitive_ (writeOffAddr# addr# i# x) -- | Copy the given number of bytes from the second 'Addr' to the first. The -- areas may not overlap. copyAddr :: PrimMonad m => Addr -- ^ destination address -> Addr -- ^ source address -> Int -- ^ number of bytes -> m () {-# INLINE copyAddr #-} copyAddr (Addr dst#) (Addr src#) n = unsafePrimToPrim $ copyBytes (Ptr dst#) (Ptr src#) n -- | Copy the given number of bytes from the second 'Addr' to the first. The -- areas may overlap. moveAddr :: PrimMonad m => Addr -- ^ destination address -> Addr -- ^ source address -> Int -- ^ number of bytes -> m () {-# INLINE moveAddr #-} moveAddr (Addr dst#) (Addr src#) n = unsafePrimToPrim $ moveBytes (Ptr dst#) (Ptr src#) n -- | 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) primitive-0.6.1.0/Data/Primitive/Types.hs0000644000000000000000000002133212577424530016345 0ustar0000000000000000{-# LANGUAGE CPP, UnboxedTuples, MagicHash, DeriveDataTypeable #-} -- | -- Module : Data.Primitive.Types -- Copyright : (c) Roman Leshchinskiy 2009-2012 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Portability : non-portable -- -- Basic types and classes for primitive array operations -- module Data.Primitive.Types ( Prim(..), Addr(..), ) where import Control.Monad.Primitive import Data.Primitive.MachDeps import Data.Primitive.Internal.Operations import GHC.Base ( Int(..), Char(..), ) import GHC.Float ( Float(..), Double(..) ) import GHC.Word ( Word(..), Word8(..), Word16(..), Word32(..), Word64(..) ) import GHC.Int ( Int8(..), Int16(..), Int32(..), Int64(..) ) import GHC.Prim #if __GLASGOW_HASKELL__ >= 706 hiding (setByteArray#) #endif import Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) import Data.Primitive.Internal.Compat ( isTrue#, mkNoRepType ) -- | A machine address data Addr = Addr Addr# deriving ( Typeable ) instance Eq Addr where Addr a# == Addr b# = isTrue# (eqAddr# a# b#) Addr a# /= Addr b# = isTrue# (neAddr# a# b#) instance Ord Addr where Addr a# > Addr b# = isTrue# (gtAddr# a# b#) Addr a# >= Addr b# = isTrue# (geAddr# a# b#) Addr a# < Addr b# = isTrue# (ltAddr# a# b#) Addr a# <= Addr b# = isTrue# (leAddr# a# b#) instance Data Addr where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNoRepType "Data.Primitive.Types.Addr" -- | Class of types supporting primitive array operations class Prim a where -- | Size of values of type @a@. The argument is not used. sizeOf# :: a -> Int# -- | Alignment of values of type @a@. The argument is not used. alignment# :: a -> Int# -- | Read a value from the array. The offset is in elements of type -- @a@ rather than in bytes. indexByteArray# :: ByteArray# -> Int# -> a -- | Read a value from the mutable array. The offset is in elements of type -- @a@ rather than in bytes. readByteArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #) -- | Write a value to the mutable array. The offset is in elements of type -- @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. indexOffAddr# :: Addr# -> Int# -> a -- | Read a value from a memory position given by an address and an offset. -- The offset is in elements of type @a@ rather than in bytes. readOffAddr# :: Addr# -> Int# -> State# s -> (# State# s, a #) -- | Write a value to a memory position given by an address and an offset. -- The offset is in elements of type @a@ rather than in bytes. writeOffAddr# :: Addr# -> Int# -> a -> State# s -> State# s -- | 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 \ ; indexByteArray# arr# i# = ctr (idx_arr arr# i#) \ ; 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# \ = let { i = fromIntegral (I# i#) \ ; n = fromIntegral (I# n#) \ } in \ case unsafeCoerce# (internal (set_arr arr# i n x#)) s# of \ { (# s1#, _ #) -> 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# \ ; setOffAddr# addr# i# n# (ctr x#) s# \ = let { i = fromIntegral (I# i#) \ ; n = fromIntegral (I# n#) \ } in \ case unsafeCoerce# (internal (set_addr addr# i n x#)) s# of \ { (# s1#, _ #) -> 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#, setWordArray#, indexWordOffAddr#, readWordOffAddr#, writeWordOffAddr#, setWordOffAddr#) derivePrim(Word8, W8#, sIZEOF_WORD8, aLIGNMENT_WORD8, indexWord8Array#, readWord8Array#, writeWord8Array#, setWord8Array#, indexWord8OffAddr#, readWord8OffAddr#, writeWord8OffAddr#, setWord8OffAddr#) derivePrim(Word16, W16#, sIZEOF_WORD16, aLIGNMENT_WORD16, indexWord16Array#, readWord16Array#, writeWord16Array#, setWord16Array#, indexWord16OffAddr#, readWord16OffAddr#, writeWord16OffAddr#, setWord16OffAddr#) derivePrim(Word32, W32#, sIZEOF_WORD32, aLIGNMENT_WORD32, indexWord32Array#, readWord32Array#, writeWord32Array#, setWord32Array#, indexWord32OffAddr#, readWord32OffAddr#, writeWord32OffAddr#, setWord32OffAddr#) derivePrim(Word64, W64#, sIZEOF_WORD64, aLIGNMENT_WORD64, indexWord64Array#, readWord64Array#, writeWord64Array#, setWord64Array#, indexWord64OffAddr#, readWord64OffAddr#, writeWord64OffAddr#, setWord64OffAddr#) derivePrim(Int, I#, sIZEOF_INT, aLIGNMENT_INT, indexIntArray#, readIntArray#, writeIntArray#, setIntArray#, indexIntOffAddr#, readIntOffAddr#, writeIntOffAddr#, setIntOffAddr#) derivePrim(Int8, I8#, sIZEOF_INT8, aLIGNMENT_INT8, indexInt8Array#, readInt8Array#, writeInt8Array#, setInt8Array#, indexInt8OffAddr#, readInt8OffAddr#, writeInt8OffAddr#, setInt8OffAddr#) derivePrim(Int16, I16#, sIZEOF_INT16, aLIGNMENT_INT16, indexInt16Array#, readInt16Array#, writeInt16Array#, setInt16Array#, indexInt16OffAddr#, readInt16OffAddr#, writeInt16OffAddr#, setInt16OffAddr#) derivePrim(Int32, I32#, sIZEOF_INT32, aLIGNMENT_INT32, indexInt32Array#, readInt32Array#, writeInt32Array#, setInt32Array#, indexInt32OffAddr#, readInt32OffAddr#, writeInt32OffAddr#, setInt32OffAddr#) derivePrim(Int64, I64#, sIZEOF_INT64, aLIGNMENT_INT64, indexInt64Array#, readInt64Array#, writeInt64Array#, setInt64Array#, indexInt64OffAddr#, readInt64OffAddr#, writeInt64OffAddr#, setInt64OffAddr#) derivePrim(Float, F#, sIZEOF_FLOAT, aLIGNMENT_FLOAT, indexFloatArray#, readFloatArray#, writeFloatArray#, setFloatArray#, indexFloatOffAddr#, readFloatOffAddr#, writeFloatOffAddr#, setFloatOffAddr#) derivePrim(Double, D#, sIZEOF_DOUBLE, aLIGNMENT_DOUBLE, indexDoubleArray#, readDoubleArray#, writeDoubleArray#, setDoubleArray#, indexDoubleOffAddr#, readDoubleOffAddr#, writeDoubleOffAddr#, setDoubleOffAddr#) derivePrim(Char, C#, sIZEOF_CHAR, aLIGNMENT_CHAR, indexWideCharArray#, readWideCharArray#, writeWideCharArray#, setWideCharArray#, indexWideCharOffAddr#, readWideCharOffAddr#, writeWideCharOffAddr#, setWideCharOffAddr#) derivePrim(Addr, Addr, sIZEOF_PTR, aLIGNMENT_PTR, indexAddrArray#, readAddrArray#, writeAddrArray#, setAddrArray#, indexAddrOffAddr#, readAddrOffAddr#, writeAddrOffAddr#, setAddrOffAddr#) primitive-0.6.1.0/Data/Primitive/ByteArray.hs0000644000000000000000000002437112577424530017151 0ustar0000000000000000{-# LANGUAGE CPP, MagicHash, UnboxedTuples, UnliftedFFITypes, DeriveDataTypeable #-} -- | -- Module : Data.Primitive.ByteArray -- Copyright : (c) Roman Leshchinskiy 2009-2012 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Portability : non-portable -- -- Primitive operations on ByteArrays -- module Data.Primitive.ByteArray ( -- * Types ByteArray(..), MutableByteArray(..), ByteArray#, MutableByteArray#, -- * Allocation newByteArray, newPinnedByteArray, newAlignedPinnedByteArray, -- * Element access readByteArray, writeByteArray, indexByteArray, -- * Freezing and thawing unsafeFreezeByteArray, unsafeThawByteArray, -- * Block operations copyByteArray, copyMutableByteArray, moveByteArray, setByteArray, fillByteArray, -- * Information sizeofByteArray, sizeofMutableByteArray, sameMutableByteArray, byteArrayContents, mutableByteArrayContents ) where import Control.Monad.Primitive import Data.Primitive.Types import Foreign.C.Types 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(..) ) import Data.Primitive.Internal.Compat ( isTrue#, mkNoRepType ) -- | Byte arrays data ByteArray = ByteArray ByteArray# deriving ( Typeable ) -- | Mutable byte arrays associated with a primitive state token data MutableByteArray s = MutableByteArray (MutableByteArray# s) deriving( Typeable ) -- | Create a new mutable byte array of the specified size. newByteArray :: PrimMonad m => Int -> m (MutableByteArray (PrimState m)) {-# INLINE newByteArray #-} newByteArray (I# n#) = primitive (\s# -> case newByteArray# n# s# of (# s'#, arr# #) -> (# s'#, MutableByteArray arr# #)) -- | Create a /pinned/ byte array of the specified size. The garbage collector -- is guaranteed not to move it. newPinnedByteArray :: PrimMonad m => Int -> m (MutableByteArray (PrimState m)) {-# INLINE newPinnedByteArray #-} newPinnedByteArray (I# n#) = primitive (\s# -> case newPinnedByteArray# n# s# of (# s'#, arr# #) -> (# s'#, MutableByteArray arr# #)) -- | Create a /pinned/ byte array of the specified size and with the give -- alignment. The garbage collector is guaranteed not to move it. newAlignedPinnedByteArray :: PrimMonad m => Int -> Int -> m (MutableByteArray (PrimState m)) {-# INLINE newAlignedPinnedByteArray #-} newAlignedPinnedByteArray (I# n#) (I# k#) = primitive (\s# -> case newAlignedPinnedByteArray# n# k# s# of (# s'#, arr# #) -> (# s'#, MutableByteArray arr# #)) -- | Yield a pointer to the array's data. This operation is only safe on -- /pinned/ byte arrays allocated by 'newPinnedByteArray' or -- 'newAlignedPinnedByteArray'. byteArrayContents :: ByteArray -> Addr {-# INLINE byteArrayContents #-} byteArrayContents (ByteArray arr#) = Addr (byteArrayContents# arr#) -- | Yield a pointer to the array's data. This operation is only safe on -- /pinned/ byte arrays allocated by 'newPinnedByteArray' or -- 'newAlignedPinnedByteArray'. mutableByteArrayContents :: MutableByteArray s -> Addr {-# INLINE mutableByteArrayContents #-} mutableByteArrayContents (MutableByteArray arr#) = Addr (byteArrayContents# (unsafeCoerce# arr#)) -- | Check if the two arrays refer to the same memory block. sameMutableByteArray :: MutableByteArray s -> MutableByteArray s -> Bool {-# INLINE sameMutableByteArray #-} sameMutableByteArray (MutableByteArray arr#) (MutableByteArray brr#) = isTrue# (sameMutableByteArray# arr# brr#) -- | Convert a mutable byte array to an immutable one without copying. The -- array should not be modified after the conversion. unsafeFreezeByteArray :: PrimMonad m => MutableByteArray (PrimState m) -> m ByteArray {-# INLINE unsafeFreezeByteArray #-} unsafeFreezeByteArray (MutableByteArray arr#) = primitive (\s# -> case unsafeFreezeByteArray# arr# s# of (# s'#, arr'# #) -> (# s'#, ByteArray arr'# #)) -- | Convert an immutable byte array to a mutable one without copying. The -- original array should not be used after the conversion. unsafeThawByteArray :: PrimMonad m => ByteArray -> m (MutableByteArray (PrimState m)) {-# INLINE unsafeThawByteArray #-} unsafeThawByteArray (ByteArray arr#) = primitive (\s# -> (# s#, MutableByteArray (unsafeCoerce# arr#) #)) -- | Size of the byte array. sizeofByteArray :: ByteArray -> Int {-# INLINE sizeofByteArray #-} sizeofByteArray (ByteArray arr#) = I# (sizeofByteArray# arr#) -- | Size of the mutable byte array. sizeofMutableByteArray :: MutableByteArray s -> Int {-# INLINE sizeofMutableByteArray #-} sizeofMutableByteArray (MutableByteArray arr#) = I# (sizeofMutableByteArray# arr#) -- | Read a primitive value from the byte array. The offset is given in -- elements of type @a@ rather than in bytes. indexByteArray :: Prim a => ByteArray -> Int -> a {-# INLINE indexByteArray #-} indexByteArray (ByteArray arr#) (I# i#) = indexByteArray# arr# i# -- | Read a primitive value from the byte array. The offset is given in -- elements of type @a@ rather than in bytes. readByteArray :: (Prim a, PrimMonad m) => MutableByteArray (PrimState m) -> Int -> m a {-# INLINE readByteArray #-} readByteArray (MutableByteArray arr#) (I# i#) = primitive (readByteArray# arr# i#) -- | Write a primitive value to the byte array. The offset is given in -- elements of type @a@ rather than in bytes. writeByteArray :: (Prim a, PrimMonad m) => MutableByteArray (PrimState m) -> Int -> a -> m () {-# INLINE writeByteArray #-} writeByteArray (MutableByteArray arr#) (I# i#) x = primitive_ (writeByteArray# arr# i# x) #if __GLASGOW_HASKELL__ >= 702 unI# :: Int -> Int# unI# (I# n#) = n# #endif -- | Copy a slice of an immutable byte array to a mutable byte array. copyByteArray :: PrimMonad m => MutableByteArray (PrimState m) -- ^ destination array -> Int -- ^ offset into destination array -> ByteArray -- ^ source array -> Int -- ^ offset into source array -> Int -- ^ number of bytes to copy -> m () {-# INLINE copyByteArray #-} copyByteArray (MutableByteArray dst#) doff (ByteArray src#) soff sz #if __GLASGOW_HASKELL__ >= 702 = primitive_ (copyByteArray# src# (unI# soff) dst# (unI# doff) (unI# sz)) #else = unsafePrimToPrim $ memcpy_ba dst# (fromIntegral doff) src# (fromIntegral soff) (fromIntegral sz) #endif -- | Copy a slice of a mutable byte array into another array. The two slices -- may not overlap. copyMutableByteArray :: PrimMonad m => MutableByteArray (PrimState m) -- ^ destination array -> Int -- ^ offset into destination array -> MutableByteArray (PrimState m) -- ^ source array -> Int -- ^ offset into source array -> Int -- ^ number of bytes to copy -> m () {-# INLINE copyMutableByteArray #-} copyMutableByteArray (MutableByteArray dst#) doff (MutableByteArray src#) soff sz #if __GLASGOW_HASKELL__ >= 702 = primitive_ (copyMutableByteArray# src# (unI# soff) dst# (unI# doff) (unI# sz)) #else = unsafePrimToPrim $ memcpy_mba dst# (fromIntegral doff) src# (fromIntegral soff) (fromIntegral sz) #endif -- | Copy a slice of a mutable byte array into another, potentially -- overlapping array. moveByteArray :: PrimMonad m => MutableByteArray (PrimState m) -- ^ destination array -> Int -- ^ offset into destination array -> MutableByteArray (PrimState m) -- ^ source array -> Int -- ^ offset into source array -> Int -- ^ number of bytes to copy -> m () {-# INLINE moveByteArray #-} moveByteArray (MutableByteArray dst#) doff (MutableByteArray src#) soff sz = unsafePrimToPrim $ memmove_mba dst# (fromIntegral doff) src# (fromIntegral soff) (fromIntegral sz) -- | 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 -- ^ byte to fill with -> m () {-# INLINE fillByteArray #-} fillByteArray = setByteArray #if __GLASGOW_HASKELL__ < 702 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 hsprimitive_memcpy" memcpy_ba :: MutableByteArray# s -> CInt -> ByteArray# -> CInt -> CSize -> IO () #endif foreign import ccall unsafe "primitive-memops.h hsprimitive_memmove" memmove_mba :: MutableByteArray# s -> CInt -> MutableByteArray# s -> CInt -> CSize -> IO () instance Data ByteArray where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNoRepType "Data.Primitive.ByteArray.ByteArray" instance Typeable s => Data (MutableByteArray s) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNoRepType "Data.Primitive.ByteArray.MutableByteArray" primitive-0.6.1.0/Data/Primitive/MachDeps.hs0000644000000000000000000000405512577424530016730 0ustar0000000000000000{-# LANGUAGE CPP, MagicHash #-} -- | -- Module : Data.Primitive.MachDeps -- Copyright : (c) Roman Leshchinskiy 2009-2012 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Portability : non-portable -- -- Machine-dependent constants -- module Data.Primitive.MachDeps where #include "MachDeps.h" import GHC.Prim sIZEOF_CHAR, aLIGNMENT_CHAR, sIZEOF_INT, aLIGNMENT_INT, sIZEOF_WORD, aLIGNMENT_WORD, sIZEOF_DOUBLE, aLIGNMENT_DOUBLE, sIZEOF_FLOAT, aLIGNMENT_FLOAT, sIZEOF_PTR, aLIGNMENT_PTR, sIZEOF_FUNPTR, aLIGNMENT_FUNPTR, sIZEOF_STABLEPTR, aLIGNMENT_STABLEPTR, sIZEOF_INT8, aLIGNMENT_INT8, sIZEOF_WORD8, aLIGNMENT_WORD8, sIZEOF_INT16, aLIGNMENT_INT16, sIZEOF_WORD16, aLIGNMENT_WORD16, sIZEOF_INT32, aLIGNMENT_INT32, sIZEOF_WORD32, aLIGNMENT_WORD32, sIZEOF_INT64, aLIGNMENT_INT64, sIZEOF_WORD64, aLIGNMENT_WORD64 :: Int sIZEOF_CHAR = SIZEOF_HSCHAR aLIGNMENT_CHAR = ALIGNMENT_HSCHAR sIZEOF_INT = SIZEOF_HSINT aLIGNMENT_INT = ALIGNMENT_HSINT sIZEOF_WORD = SIZEOF_HSWORD aLIGNMENT_WORD = ALIGNMENT_HSWORD sIZEOF_DOUBLE = SIZEOF_HSDOUBLE aLIGNMENT_DOUBLE = ALIGNMENT_HSDOUBLE sIZEOF_FLOAT = SIZEOF_HSFLOAT aLIGNMENT_FLOAT = ALIGNMENT_HSFLOAT sIZEOF_PTR = SIZEOF_HSPTR aLIGNMENT_PTR = ALIGNMENT_HSPTR sIZEOF_FUNPTR = SIZEOF_HSFUNPTR aLIGNMENT_FUNPTR = ALIGNMENT_HSFUNPTR sIZEOF_STABLEPTR = SIZEOF_HSSTABLEPTR aLIGNMENT_STABLEPTR = ALIGNMENT_HSSTABLEPTR sIZEOF_INT8 = SIZEOF_INT8 aLIGNMENT_INT8 = ALIGNMENT_INT8 sIZEOF_WORD8 = SIZEOF_WORD8 aLIGNMENT_WORD8 = ALIGNMENT_WORD8 sIZEOF_INT16 = SIZEOF_INT16 aLIGNMENT_INT16 = ALIGNMENT_INT16 sIZEOF_WORD16 = SIZEOF_WORD16 aLIGNMENT_WORD16 = ALIGNMENT_WORD16 sIZEOF_INT32 = SIZEOF_INT32 aLIGNMENT_INT32 = ALIGNMENT_INT32 sIZEOF_WORD32 = SIZEOF_WORD32 aLIGNMENT_WORD32 = ALIGNMENT_WORD32 sIZEOF_INT64 = SIZEOF_INT64 aLIGNMENT_INT64 = ALIGNMENT_INT64 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 primitive-0.6.1.0/Data/Primitive/Internal/0000755000000000000000000000000012577424530016460 5ustar0000000000000000primitive-0.6.1.0/Data/Primitive/Internal/Compat.hs0000644000000000000000000000123712577424530020242 0ustar0000000000000000{-# LANGUAGE CPP, MagicHash #-} -- | -- Module : Data.Primitive.Internal.Compat -- Copyright : (c) Roman Leshchinskiy 2011-2012 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Portability : non-portable -- -- Compatibility functions -- module Data.Primitive.Internal.Compat ( isTrue# , mkNoRepType ) where #if MIN_VERSION_base(4,2,0) import Data.Data (mkNoRepType) #else import Data.Data (mkNorepType) #endif #if MIN_VERSION_base(4,7,0) import GHC.Exts (isTrue#) #endif #if !MIN_VERSION_base(4,2,0) mkNoRepType = mkNorepType #endif #if !MIN_VERSION_base(4,7,0) isTrue# :: Bool -> Bool isTrue# b = b #endif primitive-0.6.1.0/Data/Primitive/Internal/Operations.hs0000644000000000000000000001172712577424530021147 0ustar0000000000000000{-# LANGUAGE MagicHash, UnliftedFFITypes #-} -- | -- Module : Data.Primitive.Internal.Operations -- Copyright : (c) Roman Leshchinskiy 2011-2012 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- 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 Foreign.C.Types import GHC.Prim foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word8" setWord8Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word16" setWord16Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word32" setWord32Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word64" setWord64Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word64_# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word" setWordArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word8" setInt8Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word16" setInt16Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word32" setInt32Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word64" setInt64Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int64_# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word" setIntArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Ptr" setAddrArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Addr# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Float" setFloatArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Float# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Double" setDoubleArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Double# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Char" setWideCharArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Char# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word8" setWord8OffAddr# :: Addr# -> CPtrdiff -> CSize -> Word# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word16" setWord16OffAddr# :: Addr# -> CPtrdiff -> CSize -> Word# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word32" setWord32OffAddr# :: Addr# -> CPtrdiff -> CSize -> Word# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word64" setWord64OffAddr# :: Addr# -> CPtrdiff -> CSize -> Word64_# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word" setWordOffAddr# :: Addr# -> CPtrdiff -> CSize -> Word# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word8" setInt8OffAddr# :: Addr# -> CPtrdiff -> CSize -> Int# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word16" setInt16OffAddr# :: Addr# -> CPtrdiff -> CSize -> Int# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word32" setInt32OffAddr# :: Addr# -> CPtrdiff -> CSize -> Int# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word64" setInt64OffAddr# :: Addr# -> CPtrdiff -> CSize -> Int64_# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word" setIntOffAddr# :: Addr# -> CPtrdiff -> CSize -> Int# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Ptr" setAddrOffAddr# :: Addr# -> CPtrdiff -> CSize -> Addr# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Float" setFloatOffAddr# :: Addr# -> CPtrdiff -> CSize -> Float# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Double" setDoubleOffAddr# :: Addr# -> CPtrdiff -> CSize -> Double# -> IO () foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Char" setWideCharOffAddr# :: Addr# -> CPtrdiff -> CSize -> Char# -> IO () primitive-0.6.1.0/test/0000755000000000000000000000000012577424530013042 5ustar0000000000000000primitive-0.6.1.0/test/main.hs0000644000000000000000000000132212577424530014320 0ustar0000000000000000{-# LANGUAGE MagicHash, UnboxedTuples #-} import Control.Monad.Primitive import Data.Primitive.Array import GHC.IO import GHC.Prim -- Since we only have a single test case right now, I'm going to avoid the -- issue of choosing a test framework for the moment. This also keeps the -- package as a whole light on dependencies. main :: IO () main = do arr <- newArray 1 'A' let unit = case writeArray arr 0 'B' of IO f -> case f realWorld# of (# _, _ #) -> () c1 <- readArray arr 0 return $! unit c2 <- readArray arr 0 if c1 == 'A' && c2 == 'B' then return () else error $ "Expected AB, got: " ++ show (c1, c2) primitive-0.6.1.0/Control/0000755000000000000000000000000012577424530013503 5ustar0000000000000000primitive-0.6.1.0/Control/Monad/0000755000000000000000000000000012577424530014541 5ustar0000000000000000primitive-0.6.1.0/Control/Monad/Primitive.hs0000644000000000000000000001545712577424530017061 0ustar0000000000000000{-# LANGUAGE CPP, MagicHash, UnboxedTuples, TypeFamilies #-} {-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-} -- | -- Module : Control.Monad.Primitive -- Copyright : (c) Roman Leshchinskiy 2009 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy -- Portability : non-portable -- -- Primitive state-transformer monads -- module Control.Monad.Primitive ( PrimMonad(..), RealWorld, primitive_, PrimBase(..), liftPrim, primToPrim, primToIO, primToST, unsafePrimToPrim, unsafePrimToIO, unsafePrimToST, unsafeInlinePrim, unsafeInlineIO, unsafeInlineST, touch ) where import GHC.Prim ( State#, RealWorld, touch# ) import GHC.Base ( unsafeCoerce#, realWorld# ) #if MIN_VERSION_base(4,2,0) import GHC.IO ( IO(..) ) #else import GHC.IOBase ( IO(..) ) #endif import GHC.ST ( ST(..) ) import Control.Monad.Trans.Class (lift) #if !MIN_VERSION_base(4,8,0) import Data.Monoid (Monoid) #endif import Control.Monad.Trans.Identity ( IdentityT) import Control.Monad.Trans.List ( ListT ) import Control.Monad.Trans.Maybe ( MaybeT ) import Control.Monad.Trans.Error ( ErrorT, Error) import Control.Monad.Trans.Reader ( ReaderT ) import Control.Monad.Trans.State ( StateT ) import Control.Monad.Trans.Writer ( WriterT ) import Control.Monad.Trans.RWS ( RWST ) #if MIN_VERSION_transformers(0,4,0) import Control.Monad.Trans.Except ( ExceptT ) #endif import qualified Control.Monad.Trans.RWS.Strict as Strict ( RWST ) import qualified Control.Monad.Trans.State.Strict as Strict ( StateT ) import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT ) -- | Class of monads which can perform primitive state-transformer actions class Monad m => PrimMonad m where -- | State token type type PrimState m -- | Execute a primitive operation primitive :: (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a -- | Class of primitive monads for state-transformer actions. -- -- Unlike 'PrimMonad', this typeclass requires that the @Monad@ be fully -- expressed as a state transformer, therefore disallowing other monad -- transformers on top of the base @IO@ or @ST@. class PrimMonad m => PrimBase m where -- | Expose the internal structure of the monad internal :: m a -> State# (PrimState m) -> (# State# (PrimState m), a #) -- | Execute a primitive operation with no result primitive_ :: PrimMonad m => (State# (PrimState m) -> State# (PrimState m)) -> m () {-# INLINE primitive_ #-} primitive_ f = primitive (\s# -> case f s# of s'# -> (# s'#, () #)) instance PrimMonad IO where type PrimState IO = RealWorld primitive = IO {-# INLINE primitive #-} instance PrimBase IO where internal (IO p) = p {-# INLINE internal #-} instance PrimMonad m => PrimMonad (IdentityT m) where type PrimState (IdentityT m) = PrimState m primitive = lift . primitive {-# INLINE primitive #-} instance PrimMonad m => PrimMonad (ListT m) where type PrimState (ListT m) = PrimState m primitive = lift . primitive {-# INLINE primitive #-} instance PrimMonad m => PrimMonad (MaybeT m) where type PrimState (MaybeT m) = PrimState m primitive = lift . primitive {-# INLINE primitive #-} instance (Error e, PrimMonad m) => PrimMonad (ErrorT e m) where type PrimState (ErrorT e m) = PrimState m primitive = lift . primitive {-# INLINE primitive #-} instance PrimMonad m => PrimMonad (ReaderT r m) where type PrimState (ReaderT r m) = PrimState m primitive = lift . primitive {-# INLINE primitive #-} instance PrimMonad m => PrimMonad (StateT s m) where type PrimState (StateT s m) = PrimState m primitive = lift . primitive {-# INLINE primitive #-} instance (Monoid w, PrimMonad m) => PrimMonad (WriterT w m) where type PrimState (WriterT w m) = PrimState m primitive = lift . primitive {-# INLINE primitive #-} instance (Monoid w, PrimMonad m) => PrimMonad (RWST r w s m) where type PrimState (RWST r w s m) = PrimState m primitive = lift . primitive {-# INLINE primitive #-} #if MIN_VERSION_transformers(0,4,0) instance PrimMonad m => PrimMonad (ExceptT e m) where type PrimState (ExceptT e m) = PrimState m primitive = lift . primitive {-# INLINE primitive #-} #endif instance PrimMonad m => PrimMonad (Strict.StateT s m) where type PrimState (Strict.StateT s m) = PrimState m primitive = lift . primitive {-# INLINE primitive #-} instance (Monoid w, PrimMonad m) => PrimMonad (Strict.WriterT w m) where type PrimState (Strict.WriterT w m) = PrimState m primitive = lift . primitive {-# INLINE primitive #-} instance (Monoid w, PrimMonad m) => PrimMonad (Strict.RWST r w s m) where type PrimState (Strict.RWST r w s m) = PrimState m primitive = lift . primitive {-# INLINE primitive #-} instance PrimMonad (ST s) where type PrimState (ST s) = s primitive = ST {-# INLINE primitive #-} instance PrimBase (ST s) where internal (ST p) = p {-# INLINE internal #-} -- | Lifts a 'PrimBase' into another 'PrimMonad' with the same underlying state -- token type. liftPrim :: (PrimBase m1, PrimMonad m2, PrimState m1 ~ PrimState m2) => m1 a -> m2 a {-# INLINE liftPrim #-} liftPrim = primToPrim -- | Convert a 'PrimBase' to another monad with the same state token. primToPrim :: (PrimBase m1, PrimMonad m2, PrimState m1 ~ PrimState m2) => m1 a -> m2 a {-# INLINE primToPrim #-} primToPrim m = primitive (internal m) -- | Convert a 'PrimBase' with a 'RealWorld' state token to 'IO' primToIO :: (PrimBase m, PrimState m ~ RealWorld) => m a -> IO a {-# INLINE primToIO #-} primToIO = primToPrim -- | Convert a 'PrimBase' to 'ST' primToST :: PrimBase m => m a -> ST (PrimState m) a {-# INLINE primToST #-} primToST = primToPrim -- | Convert a 'PrimBase' to another monad with a possibly different state -- token. This operation is highly unsafe! unsafePrimToPrim :: (PrimBase m1, PrimMonad m2) => m1 a -> m2 a {-# INLINE unsafePrimToPrim #-} unsafePrimToPrim m = primitive (unsafeCoerce# (internal m)) -- | Convert any 'PrimBase' to 'ST' with an arbitrary state token. This -- operation is highly unsafe! unsafePrimToST :: PrimBase m => m a -> ST s a {-# INLINE unsafePrimToST #-} unsafePrimToST = unsafePrimToPrim -- | Convert any 'PrimBase' to 'IO'. This operation is highly unsafe! unsafePrimToIO :: PrimBase m => m a -> IO a {-# INLINE unsafePrimToIO #-} unsafePrimToIO = unsafePrimToPrim unsafeInlinePrim :: PrimBase m => m a -> a {-# INLINE unsafeInlinePrim #-} unsafeInlinePrim m = unsafeInlineIO (unsafePrimToIO m) unsafeInlineIO :: IO a -> a {-# INLINE unsafeInlineIO #-} unsafeInlineIO m = case internal m realWorld# of (# _, r #) -> r unsafeInlineST :: ST s a -> a {-# INLINE unsafeInlineST #-} unsafeInlineST = unsafeInlinePrim touch :: PrimMonad m => a -> m () {-# INLINE touch #-} touch x = unsafePrimToPrim $ (primitive (\s -> case touch# x s of { s' -> (# s', () #) }) :: IO ()) primitive-0.6.1.0/cbits/0000755000000000000000000000000012577424530013167 5ustar0000000000000000primitive-0.6.1.0/cbits/primitive-memops.h0000644000000000000000000000170212577424530016646 0ustar0000000000000000#ifndef haskell_primitive_memops_h #define haskell_primitive_memops_h #include #include #include void hsprimitive_memcpy( void *dst, ptrdiff_t doff, void *src, ptrdiff_t soff, size_t len ); void hsprimitive_memmove( void *dst, ptrdiff_t doff, void *src, ptrdiff_t soff, size_t len ); void hsprimitive_memset_Word8 (HsWord8 *, ptrdiff_t, size_t, HsWord); void hsprimitive_memset_Word16 (HsWord16 *, ptrdiff_t, size_t, HsWord); void hsprimitive_memset_Word32 (HsWord32 *, ptrdiff_t, size_t, HsWord); void hsprimitive_memset_Word64 (HsWord64 *, ptrdiff_t, size_t, HsWord64); void hsprimitive_memset_Word (HsWord *, ptrdiff_t, size_t, HsWord); void hsprimitive_memset_Ptr (HsPtr *, ptrdiff_t, size_t, HsPtr); void hsprimitive_memset_Float (HsFloat *, ptrdiff_t, size_t, HsFloat); void hsprimitive_memset_Double (HsDouble *, ptrdiff_t, size_t, HsDouble); void hsprimitive_memset_Char (HsChar *, ptrdiff_t, size_t, HsChar); #endif primitive-0.6.1.0/cbits/primitive-memops.c0000644000000000000000000000460412577424530016645 0ustar0000000000000000#include #include "primitive-memops.h" void hsprimitive_memcpy( void *dst, ptrdiff_t doff, void *src, ptrdiff_t soff, size_t len ) { memcpy( (char *)dst + doff, (char *)src + soff, len ); } void hsprimitive_memmove( void *dst, ptrdiff_t doff, void *src, ptrdiff_t soff, size_t len ) { memmove( (char *)dst + doff, (char *)src + soff, len ); } #define MEMSET(TYPE, ATYPE) \ void hsprimitive_memset_ ## TYPE (Hs ## TYPE *p, ptrdiff_t off, size_t 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 *)(void *)&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, ptrdiff_t off, size_t n, HsWord x) { 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)