diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/primitive-checked.cabal b/primitive-checked.cabal --- a/primitive-checked.cabal +++ b/primitive-checked.cabal @@ -1,11 +1,11 @@ cabal-version: 2.2 name: primitive-checked -version: 0.7.0.0 +version: 0.7.2.0 synopsis: primitive functions with bounds-checking homepage: https://github.com/andrewthad/primitive-checked#readme bug-reports: https://github.com/andrewthad/primitive-checked/issues author: Andrew Martin -maintainer: andrew.thaddeus@gmail.com +maintainer: Andrew Martin , konsumlamm copyright: 2018 Andrew Martin license: BSD-3-Clause license-file: LICENSE @@ -14,34 +14,34 @@ description: . This library is intended to be used as a drop-in replacement for - the `primitive` library in test environments. It adds bounds-checking - to all functions in `primitive` that are able to cause segfaults. + the @primitive@ library in test environments. It adds bounds-checking + to all functions in @primitive@ that are able to cause segfaults. It is not recommended to use this library in production. However, if you are testing a library or application you wrote that uses - `primitive`, you can temporarily replace your `primitive` dependency - with `primitive-checked`, and your segfaults will become normal - haskell exceptions that you can hunt down with GHC's stack trace + @primitive@, you can temporarily replace your @primitive@ dependency + with @primitive-checked@, and your segfaults will become normal + Haskell exceptions that you can hunt down with GHC's stack trace facilities. . - The versioning for this library matches the version of primitive - that is targeted. The first three digits of the version match the - version of `primitive`. The fourth digit is used for bug fixes. + The versioning for this library matches the version of @primitive@ + that is targeted. The first three numbers of the version match the + version of @primitive@. The fourth number is used for bug fixes. This packages deviates slightly from the PVP in that functions - can be added to the API with only a bump to the fourth digit. + can be added to the API with only a bump to the fourth number. extra-source-files: README.md source-repository head type: git - location: https://github.com/andrewthad/primitive-checked + location: https://github.com/andrewthad/primitive-checked.git library hs-source-dirs: src build-depends: - base >=4.9.1.0 && <5 - , primitive == 0.7.0.* + base >= 4.9.1.0 && < 5 + , primitive == 0.7.2.* exposed-modules: Data.Primitive Data.Primitive.Array @@ -57,4 +57,3 @@ , Data.Primitive.Types default-language: Haskell2010 ghc-options: -Wall - diff --git a/src/Data/Primitive.hs b/src/Data/Primitive.hs --- a/src/Data/Primitive.hs +++ b/src/Data/Primitive.hs @@ -1,11 +1,11 @@ -module Data.Primitive ( - module Data.Primitive.Types, - module Data.Primitive.Array, - module Data.Primitive.ByteArray, - module Data.Primitive.PrimArray, - module Data.Primitive.SmallArray, - module Data.Primitive.MutVar -) where +module Data.Primitive + ( module Data.Primitive.Types + , module Data.Primitive.Array + , module Data.Primitive.ByteArray + , module Data.Primitive.PrimArray + , module Data.Primitive.SmallArray + , module Data.Primitive.MutVar + ) where import Data.Primitive.Array import Data.Primitive.ByteArray diff --git a/src/Data/Primitive/Array.hs b/src/Data/Primitive/Array.hs --- a/src/Data/Primitive/Array.hs +++ b/src/Data/Primitive/Array.hs @@ -1,5 +1,7 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE PackageImports #-} +{-# LANGUAGE UnboxedTuples #-} module Data.Primitive.Array ( Array(..) @@ -9,8 +11,10 @@ , writeArray , indexArray , indexArrayM + , indexArray## , freezeArray , thawArray + , A.runArray , unsafeFreezeArray , A.unsafeThawArray , A.sameMutableArray @@ -20,48 +24,70 @@ , cloneMutableArray , A.sizeofArray , A.sizeofMutableArray + , A.fromListN + , A.fromList + , A.arrayFromListN + , A.arrayFromList + , A.mapArray' + , A.traverseArrayP ) where -import Control.Monad.Primitive (PrimMonad,PrimState) -import Control.Exception (throw, ArrayException(..)) +import Control.Monad.Primitive (PrimMonad, PrimState) +import Control.Exception (throw, ArrayException(..), Exception, toException) import qualified Data.List as L -import "primitive" Data.Primitive.Array (Array,MutableArray) +import "primitive" Data.Primitive.Array (Array, MutableArray) import qualified "primitive" Data.Primitive.Array as A +import GHC.Exts (raise#) import GHC.Stack check :: HasCallStack => String -> Bool -> a -> a check _ True x = x -check errMsg False _ = throw (IndexOutOfBounds $ "Data.Primitive.Array.Checked." ++ errMsg ++ "\n" ++ prettyCallStack callStack) +check errMsg False _ = throw (IndexOutOfBounds $ "Data.Primitive.Array." ++ errMsg ++ "\n" ++ prettyCallStack callStack) +checkUnary :: HasCallStack => String -> Bool -> (# a #) -> (# a #) +checkUnary _ True x = x +checkUnary errMsg False _ = throwUnary (IndexOutOfBounds $ "Data.Primitive.Array." ++ errMsg ++ "\n" ++ prettyCallStack callStack) + +throwUnary :: Exception e => e -> (# a #) +throwUnary e = raise# (toException e) + newArray :: (HasCallStack, PrimMonad m) => Int -> a -> m (MutableArray (PrimState m) a) -newArray n x = check "newArray: negative size" (n>=0) (A.newArray n x) +newArray n x = check "newArray: negative size" (n >= 0) (A.newArray n x) readArray :: (HasCallStack, PrimMonad m) => MutableArray (PrimState m) a -> Int -> m a readArray marr i = do let siz = A.sizeofMutableArray marr - check "readArray: index of out bounds" (i>=0 && i= 0 && i < siz) (A.readArray marr i) writeArray :: (HasCallStack, PrimMonad m) => MutableArray (PrimState m) a -> Int -> a -> m () writeArray marr i x = do let siz = A.sizeofMutableArray marr - check "writeArray: index of out bounds" (i>=0 && i= 0 && i < siz) (A.writeArray marr i x) indexArray :: HasCallStack => Array a -> Int -> a -indexArray arr i = check "indexArray: index of out bounds" - (i>=0 && i= 0 && i < A.sizeofArray arr) (A.indexArray arr i) -indexArrayM :: HasCallStack => Monad m => Array a -> Int -> m a -indexArrayM arr i = check "indexArrayM: index of out bounds" - (i>=0 && i Array a -> Int -> m a +indexArrayM arr i = check "indexArrayM: index out of bounds" + (i >= 0 && i < A.sizeofArray arr) + (A.indexArrayM arr i) +indexArray## :: HasCallStack => Array a -> Int -> (# a #) +indexArray## arr i = checkUnary "indexArray##: index out of bounds" + (i >= 0 && i < A.sizeofArray arr) + (A.indexArray## arr i) + {-# NOINLINE errorUnsafeFreeze #-} errorUnsafeFreeze :: a errorUnsafeFreeze = - error "Data.Primitive.Array.Checked.unsafeFreeze:\nAttempted to read from an array after unsafely freezing it." + error "Data.Primitive.Array.unsafeFreeze:\nAttempted to read from an array after unsafely freezing it." -unsafeFreezeArray :: (HasCallStack, PrimMonad m) +-- | This installs error thunks in the argument array so that +-- any attempt to use it after an unsafeFreeze will fail. +unsafeFreezeArray + :: (HasCallStack, PrimMonad m) => MutableArray (PrimState m) a -> m (Array a) unsafeFreezeArray marr = do @@ -79,11 +105,9 @@ -> Int -- ^ offset -> Int -- ^ length -> m (Array a) -freezeArray marr s l = do - let siz = A.sizeofMutableArray marr - check "freezeArray: index range of out bounds" - (s>=0 && l>=0 && (s+l)<=siz) - (A.freezeArray marr s l) +freezeArray marr s l = check "freezeArray: index range of out bounds" + (s >= 0 && l >= 0 && s + l <= A.sizeofMutableArray marr) + (A.freezeArray marr s l) thawArray :: (HasCallStack, PrimMonad m) @@ -91,68 +115,68 @@ -> Int -- ^ offset -> Int -- ^ length -> m (MutableArray (PrimState m) a) -thawArray arr s l = check "thawArr: index range of out bounds" - (s>=0 && l>=0 && (s+l)<=A.sizeofArray arr) - (A.thawArray arr s l) +thawArray arr s l = check "thawArray: index range of out bounds" + (s >= 0 && l >= 0 && s + l <= A.sizeofArray arr) + (A.thawArray arr s l) -copyArray :: (HasCallStack, 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 () +copyArray + :: (HasCallStack, 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 () copyArray marr s1 arr s2 l = do let siz = A.sizeofMutableArray marr check "copyArray: index range of out bounds" - (s1>=0 && s2>=0 && l>=0 && (s2+l)<=A.sizeofArray arr && (s1+l)<=siz) + (s1 >= 0 && s2 >= 0 && l >= 0 && s1 + l <= siz && s2 + l <= A.sizeofArray arr) (A.copyArray marr s1 arr s2 l) - -copyMutableArray :: (HasCallStack, 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 () +copyMutableArray + :: (HasCallStack, 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 () copyMutableArray marr1 s1 marr2 s2 l = do let siz1 = A.sizeofMutableArray marr1 let siz2 = A.sizeofMutableArray marr2 let explain = L.concat [ "[dst size: " , show siz1 - , ", dst off: " + , ", dst off: " , show s1 , ", src size: " , show siz2 - , ", src off: " + , ", src off: " , show s2 , ", copy size: " , show l , "]" ] check ("copyMutableArray: index range of out bounds " ++ explain) - (s1>=0 && s2>=0 && l>=0 && (s2+l)<=siz2 && (s1+l)<=siz1) + (s1 >= 0 && s2 >= 0 && l >= 0 && s1 + l <= siz1 && s2 + l <= siz2) (A.copyMutableArray marr1 s1 marr2 s2 l) - -cloneArray :: HasCallStack - => Array a -- ^ source array - -> Int -- ^ offset into destination array - -> Int -- ^ number of elements to copy - -> Array a +cloneArray + :: HasCallStack + => Array a -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of elements to copy + -> Array a cloneArray arr s l = check "cloneArray: index range of out bounds" - (s>=0 && l>=0 && (s+l)<=A.sizeofArray arr) - (A.cloneArray arr s l) + (s >= 0 && l >= 0 && s + l <= A.sizeofArray arr) + (A.cloneArray arr s l) -cloneMutableArray :: (HasCallStack, PrimMonad m) - => MutableArray (PrimState m) a -- ^ source array - -> Int -- ^ offset into destination array - -> Int -- ^ number of elements to copy - -> m (MutableArray (PrimState m) a) -cloneMutableArray marr s l = do - let siz = A.sizeofMutableArray marr - check "cloneMutableArray: index range of out bounds" - (s>=0 && l>=0 && (s+l)<=siz) - (A.cloneMutableArray marr s l) +cloneMutableArray + :: (HasCallStack, PrimMonad m) + => MutableArray (PrimState m) a -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of elements to copy + -> m (MutableArray (PrimState m) a) +cloneMutableArray marr s l = check "cloneMutableArray: index range of out bounds" + (s >= 0 && l >= 0 && s + l <= A.sizeofMutableArray marr) + (A.cloneMutableArray marr s l) diff --git a/src/Data/Primitive/ByteArray.hs b/src/Data/Primitive/ByteArray.hs --- a/src/Data/Primitive/ByteArray.hs +++ b/src/Data/Primitive/ByteArray.hs @@ -5,8 +5,8 @@ module Data.Primitive.ByteArray ( -- * Types - A.ByteArray(..) - , A.MutableByteArray(..) + ByteArray(..) + , MutableByteArray(..) , A.ByteArray# , A.MutableByteArray# -- * Allocation @@ -14,40 +14,54 @@ , newPinnedByteArray , newAlignedPinnedByteArray , resizeMutableByteArray + , shrinkMutableByteArray -- * Element access , readByteArray , writeByteArray , indexByteArray + -- * Constructing + , A.byteArrayFromList + , A.byteArrayFromListN -- * Folding , A.foldrByteArray + -- * Comparing + , compareByteArrays -- * Freezing and thawing + , freezeByteArray + , thawByteArray , A.unsafeFreezeByteArray , A.unsafeThawByteArray -- * Block operations , copyByteArray , copyMutableByteArray + , copyByteArrayToPtr + , copyMutableByteArrayToPtr + , copyByteArrayToAddr + , copyMutableByteArrayToAddr , moveByteArray , setByteArray , fillByteArray - , A.copyMutableByteArrayToAddr + , cloneByteArray + , cloneMutableByteArray -- * Information , A.sizeofByteArray , A.sizeofMutableByteArray , A.getSizeofMutableByteArray , A.sameMutableByteArray - , A.byteArrayContents - , A.mutableByteArrayContents , A.isByteArrayPinned , A.isMutableByteArrayPinned + , A.byteArrayContents + , A.mutableByteArrayContents ) where import Control.Monad.Primitive (PrimMonad,PrimState) import Control.Exception (throw, ArrayException(..)) -import Data.Primitive.Types (Prim,sizeOf) +import Data.Primitive.Types (Prim, Ptr, sizeOf) import Data.Proxy (Proxy(..)) import Data.Word (Word8) -import "primitive" Data.Primitive.ByteArray (ByteArray,MutableByteArray) +import "primitive" Data.Primitive.ByteArray (ByteArray, MutableByteArray) import qualified "primitive" Data.Primitive.ByteArray as A +import qualified Data.List as L import GHC.Stack check :: HasCallStack => String -> Bool -> a -> a @@ -55,44 +69,91 @@ check errMsg False _ = throw (IndexOutOfBounds $ "Data.Primitive.ByteArray." ++ errMsg ++ "\n" ++ prettyCallStack callStack) elementSizeofByteArray :: forall a. Prim a => Proxy a -> ByteArray -> Int -elementSizeofByteArray _ arr = div (A.sizeofByteArray arr) (sizeOf (undefined :: a)) +elementSizeofByteArray _ arr = A.sizeofByteArray arr `div` sizeOf (undefined :: a) -elementSizeofMutableByteArray :: forall s a. Prim a => Proxy a -> MutableByteArray s -> Int -elementSizeofMutableByteArray _ arr = div (A.sizeofMutableByteArray arr) (sizeOf (undefined :: a)) +getElementSizeofMutableByteArray :: forall m a. (PrimMonad m, Prim a) + => Proxy a -> MutableByteArray (PrimState m) -> m Int +getElementSizeofMutableByteArray _ arr = do + sz <- A.getSizeofMutableByteArray arr + return (sz `div` sizeOf (undefined :: a)) newByteArray :: (HasCallStack, PrimMonad m) => Int -> m (MutableByteArray (PrimState m)) newByteArray n = - check "newByteArray: negative size" (n>=0) - $ check ("newByteArray: reqeusted " ++ show n ++ " bytes") (n<1024*1024*1024) - $ (A.newByteArray n) + check "newByteArray: negative size" (n >= 0) + $ check ("newByteArray: requested " ++ show n ++ " bytes") (n < 1024*1024*1024) + $ A.newByteArray n newPinnedByteArray :: (HasCallStack, PrimMonad m) => Int -> m (MutableByteArray (PrimState m)) -newPinnedByteArray n = check "newPinnedByteArray: negative size" (n>=0) (A.newPinnedByteArray n) +newPinnedByteArray n = check "newPinnedByteArray: negative size" (n >= 0) (A.newPinnedByteArray n) newAlignedPinnedByteArray :: (HasCallStack, PrimMonad m) => Int -> Int -> m (MutableByteArray (PrimState m)) -newAlignedPinnedByteArray n k = check "newAlignedPinnedByteArray: negative size" (n>=0) (A.newAlignedPinnedByteArray n k) +newAlignedPinnedByteArray n k = check "newAlignedPinnedByteArray: negative size" (n >= 0) (A.newAlignedPinnedByteArray n k) resizeMutableByteArray :: PrimMonad m => MutableByteArray (PrimState m) -> Int -> m (MutableByteArray (PrimState m)) -resizeMutableByteArray a n = check "resizeMutableByteArray: negative size" (n>=0) (A.resizeMutableByteArray a n) +resizeMutableByteArray a n = check "resizeMutableByteArray: negative size" (n >= 0) (A.resizeMutableByteArray a n) +shrinkMutableByteArray :: (HasCallStack, PrimMonad m) + => MutableByteArray (PrimState m) + -> Int -- ^ new size + -> m () +shrinkMutableByteArray marr n = do + old <- A.getSizeofMutableByteArray marr + check "shrinkMutableByteArray: illegal new size" (n >= 0 && n <= old) (A.shrinkMutableByteArray marr n) + readByteArray :: forall m a. (HasCallStack, Prim a, PrimMonad m) => MutableByteArray (PrimState m) -> Int -> m a readByteArray marr i = do - let siz = elementSizeofMutableByteArray (Proxy :: Proxy a) marr - check "readByteArray: index of out bounds" (i>=0 && i= 0 && i < siz) (A.readByteArray marr i) writeByteArray :: forall m a. (HasCallStack, Prim a, PrimMonad m) => MutableByteArray (PrimState m) -> Int -> a -> m () writeByteArray marr i x = do - let siz = elementSizeofMutableByteArray (Proxy :: Proxy a) marr - check "writeByteArray: index of out bounds" (i>=0 && i= 0 && i < siz) + (A.writeByteArray marr i x) -- This one is a little special. We allow users to index past the -- end of the byte array as long as the content grabbed is within -- the last machine word of the byte array. indexByteArray :: forall a. (HasCallStack, Prim a) => ByteArray -> Int -> a -indexByteArray arr i = check "indexByteArray: index of out bounds" - (i>=0 && i< elementSizeofByteArray (Proxy :: Proxy a) arr) +indexByteArray arr i = check "indexByteArray: index out of bounds" + (i >= 0 && i < elementSizeofByteArray (Proxy :: Proxy a) arr) (A.indexByteArray arr i) +compareByteArrays :: ByteArray -> Int -> ByteArray -> Int -> Int -> Ordering +compareByteArrays arr1 off1 arr2 off2 len = check "compareByteArrays: index range out of bounds" + (off1 >= 0 && off2 >= 0 && off1 + len <= A.sizeofByteArray arr1 && off2 + len <= A.sizeofByteArray arr2) + (A.compareByteArrays arr1 off1 arr2 off2 len) + +freezeByteArray + :: (HasCallStack, PrimMonad m) + => MutableByteArray (PrimState m) -- ^ source + -> Int -- ^ offset + -> Int -- ^ length + -> m ByteArray +freezeByteArray marr s l = check "freezeByteArray: index range of out bounds" + (s >= 0 && l >= 0 && s + l <= A.sizeofMutableByteArray marr) + (A.freezeByteArray marr s l) + +thawByteArray + :: (HasCallStack, PrimMonad m) + => ByteArray -- ^ source + -> Int -- ^ offset + -> Int -- ^ length + -> m (MutableByteArray (PrimState m)) +thawByteArray arr s l = check "thawByteArray: index range of out bounds" + (s >= 0 && l >= 0 && s + l <= A.sizeofByteArray arr) + (A.thawByteArray arr s l) + copyByteArray :: forall m. (HasCallStack, PrimMonad m) => MutableByteArray (PrimState m) -- ^ destination array -> Int -- ^ offset into destination array @@ -103,10 +164,9 @@ copyByteArray marr s1 arr s2 l = do let siz = A.sizeofMutableByteArray marr check "copyByteArray: index range of out bounds" - (s1>=0 && s2>=0 && l>=0 && (s2+l)<= A.sizeofByteArray arr && (s1+l)<=siz) + (s1 >= 0 && s2 >= 0 && l >= 0 && s1 + l <= siz && s2 + l <= A.sizeofByteArray arr) (A.copyByteArray marr s1 arr s2 l) - copyMutableByteArray :: forall m. (HasCallStack, PrimMonad m) => MutableByteArray (PrimState m) -- ^ destination array -> Int -- ^ offset into destination array @@ -118,21 +178,105 @@ let siz1 = A.sizeofMutableByteArray marr1 let siz2 = A.sizeofMutableByteArray marr2 check "copyMutableByteArray: index range of out bounds" - (s1>=0 && s2>=0 && l>=0 && (s2+l)<=siz2 && (s1+l)<=siz1) + (s1 >= 0 && s2 >= 0 && l >= 0 && s1 + l <= siz1 && s2 + l <= siz2) (A.copyMutableByteArray marr1 s1 marr2 s2 l) +copyByteArrayToPtr :: forall m a. (HasCallStack, PrimMonad m, Prim a) + => Ptr a -- ^ destination pointer + -> ByteArray -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of elements to copy + -> m () +copyByteArrayToPtr ptr arr s l = do + let srcSz = elementSizeofByteArray (Proxy :: Proxy a) arr + let explain = L.concat + [ "[src_sz: " + , show srcSz + , ", src_off: " + , show s + , ", len: " + , show l + , "]" + ] + check ("copyByteArrayToPtr: index range of out bounds " ++ explain) + (s >= 0 && l >= 0 && s + l <= srcSz) + (A.copyByteArrayToPtr ptr arr s l) + +copyMutableByteArrayToPtr :: forall m a. (HasCallStack, PrimMonad m, Prim a) + => Ptr a -- ^ destination pointer + -> MutableByteArray (PrimState m) -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of elements to copy + -> m () +copyMutableByteArrayToPtr ptr marr s l = do + srcSz <- getElementSizeofMutableByteArray (Proxy :: Proxy a) marr + let explain = L.concat + [ "[src_sz: " + , show srcSz + , ", src_off: " + , show s + , ", len: " + , show l + , "]" + ] + check ("copyMutableByteArrayToPtr: index range of out bounds " ++ explain) + (s >= 0 && l >= 0 && s + l <= srcSz) + (A.copyMutableByteArrayToPtr ptr marr s l) + +copyByteArrayToAddr :: (HasCallStack, PrimMonad m) + => Ptr Word8 -- ^ destination pointer + -> ByteArray -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of bytes to copy + -> m () +copyByteArrayToAddr ptr arr s l = do + let srcSz = A.sizeofByteArray arr + let explain = L.concat + [ "[src_sz: " + , show srcSz + , ", src_off: " + , show s + , ", len: " + , show l + , "]" + ] + check ("copyByteArrayToAddr: index range of out bounds " ++ explain) + (s >= 0 && l >= 0 && s + l <= srcSz) + (A.copyByteArrayToAddr ptr arr s l) + +copyMutableByteArrayToAddr :: (HasCallStack, PrimMonad m) + => Ptr Word8 -- ^ destination pointer + -> MutableByteArray (PrimState m) -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of bytes to copy + -> m () +copyMutableByteArrayToAddr ptr marr s l = do + srcSz <- A.getSizeofMutableByteArray marr + let explain = L.concat + [ "[src_sz: " + , show srcSz + , ", src_off: " + , show s + , ", len: " + , show l + , "]" + ] + check ("copyMutableByteArrayToAddr: index range of out bounds " ++ explain) + (s >= 0 && l >= 0 && s + l <= srcSz) + (A.copyMutableByteArrayToAddr ptr marr s l) + moveByteArray :: forall m. (HasCallStack, 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 elements to copy + -> Int -- ^ number of bytes to copy -> m () moveByteArray marr1 s1 marr2 s2 l = do let siz1 = A.sizeofMutableByteArray marr1 let siz2 = A.sizeofMutableByteArray marr2 check "moveByteArray: index range of out bounds" - (s1>=0 && s2>=0 && l>=0 && (s2+l)<=siz2 && (s1+l)<=siz1) + (s1 >= 0 && s2 >= 0 && l >= 0 && s1 + l <= siz1 && s2 + l <= siz2) (A.moveByteArray marr1 s1 marr2 s2 l) fillByteArray :: (HasCallStack, PrimMonad m) @@ -149,8 +293,26 @@ -> Int -- ^ number of values to fill -> a -- ^ value to fill with -> m () -setByteArray dst doff sz x = +setByteArray dst doff sz x = do + siz <- getElementSizeofMutableByteArray (Proxy :: Proxy a) dst check "setByteArray: index range of out bounds" - (doff>=0 && (doff+sz)<=elementSizeofMutableByteArray (Proxy :: Proxy a) dst) + (doff >= 0 && doff + sz <= siz) (A.setByteArray dst doff sz x) +cloneByteArray :: HasCallStack + => ByteArray -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of bytes to copy + -> ByteArray +cloneByteArray arr s l = check "cloneByteArray: index range of out bounds" + (s >= 0 && l >= 0 && s + l <= A.sizeofByteArray arr) + (A.cloneByteArray arr s l) + +cloneMutableByteArray :: (HasCallStack, PrimMonad m) + => MutableByteArray (PrimState m) -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of bytes to copy + -> m (MutableByteArray (PrimState m)) +cloneMutableByteArray marr s l = check "cloneMutableByteArray: index range of out bounds" + (s >= 0 && l >= 0 && s + l <= A.sizeofMutableByteArray marr) + (A.cloneMutableByteArray marr s l) diff --git a/src/Data/Primitive/PrimArray.hs b/src/Data/Primitive/PrimArray.hs --- a/src/Data/Primitive/PrimArray.hs +++ b/src/Data/Primitive/PrimArray.hs @@ -1,44 +1,49 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} -{-# LANGUAGE MagicHash #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UnboxedTuples #-} -{-# OPTIONS_GHC -Wall #-} - module Data.Primitive.PrimArray ( -- * Types PrimArray(..) , MutablePrimArray(..) -- * Allocation , newPrimArray + , newPinnedPrimArray + , newAlignedPinnedPrimArray , resizeMutablePrimArray -#if __GLASGOW_HASKELL__ >= 710 , shrinkMutablePrimArray -#endif -- * Element Access , readPrimArray , writePrimArray , indexPrimArray -- * Freezing and Thawing + , freezePrimArray + , thawPrimArray , unsafeFreezePrimArray , A.unsafeThawPrimArray -- * Block Operations , copyPrimArray , copyMutablePrimArray -#if __GLASGOW_HASKELL__ >= 708 - , A.copyPrimArrayToPtr -- this is wrong. fix this - , A.copyMutablePrimArrayToPtr -- this is wrong. fix this -#endif + , copyPrimArrayToPtr + , copyMutablePrimArrayToPtr + , clonePrimArray + , cloneMutablePrimArray , setPrimArray -- * Information , A.sameMutablePrimArray , A.getSizeofMutablePrimArray , A.sizeofMutablePrimArray , A.sizeofPrimArray + , A.primArrayContents + , A.mutablePrimArrayContents + , A.isPrimArrayPinned + , A.isMutablePrimArrayPinned + -- * List Conversion + , A.primArrayToList + , A.primArrayFromList + , A.primArrayFromListN -- * Folding , A.foldrPrimArray , A.foldrPrimArray' @@ -56,7 +61,7 @@ , A.filterPrimArray , A.mapMaybePrimArray -- * Effectful Map/Create - -- $effectfulMapCreate + -- ** Lazy Applicative , A.traversePrimArray , A.itraversePrimArray @@ -73,11 +78,11 @@ , A.mapMaybePrimArrayP ) where -import Control.Monad.Primitive (PrimMonad,PrimState) +import Control.Monad.Primitive (PrimMonad, PrimState) import Control.Exception (throw, ArrayException(..)) -import Data.Primitive.Types (Prim,sizeOf) +import Data.Primitive.Types (Prim, Ptr, sizeOf) import Data.Word (Word8) -import "primitive" Data.Primitive.PrimArray (PrimArray,MutablePrimArray) +import "primitive" Data.Primitive.PrimArray (PrimArray, MutablePrimArray) import qualified "primitive" Data.Primitive.PrimArray as A import GHC.Stack import qualified Data.List as L @@ -88,49 +93,81 @@ newPrimArray :: forall m a. (HasCallStack, PrimMonad m, Prim a) => Int -> m (MutablePrimArray (PrimState m) a) newPrimArray n = - check "newPrimArray: negative size" (n>=0) + check "newPrimArray: negative size" (n >= 0) $ check ("newPrimArray: requested " ++ show n ++ " elements of size " ++ show elemSz) (n * elemSz < 1024*1024*1024) $ A.newPrimArray n where elemSz = sizeOf (undefined :: a) +newPinnedPrimArray :: forall m a. (HasCallStack, PrimMonad m, Prim a) => Int -> m (MutablePrimArray (PrimState m) a) +newPinnedPrimArray n = + check "newPinnedPrimArray: negative size" (n >= 0) + $ check ("newPinnedPrimArray: requested " ++ show n ++ " elements of size " ++ show elemSz) (n * elemSz < 1024*1024*1024) + $ A.newPinnedPrimArray n + where + elemSz = sizeOf (undefined :: a) + +newAlignedPinnedPrimArray :: forall m a. (HasCallStack, PrimMonad m, Prim a) => Int -> m (MutablePrimArray (PrimState m) a) +newAlignedPinnedPrimArray n = + check "newAlignedPinnedPrimArray: negative size" (n >= 0) + $ check ("newAlignedPinnedPrimArray: requested " ++ show n ++ " elements of size " ++ show elemSz) (n * elemSz < 1024*1024*1024) + $ A.newAlignedPinnedPrimArray n + where + elemSz = sizeOf (undefined :: a) + -- | After a call to resizeMutablePrimArray, the original reference to -- the mutable array should not be used again. This cannot truly be enforced -- except by linear types. To attempt to enforce this, we always make a --- copy of the mutable byte array and intentionally corrupt the original +-- copy of the mutable primitive array and intentionally corrupt the original -- of the original one. The strategy used here to corrupt the array is -- simply to write 1 to every bit. resizeMutablePrimArray :: forall m a. (HasCallStack, PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> Int -- ^ new size -> m (MutablePrimArray (PrimState m) a) -resizeMutablePrimArray marr@(A.MutablePrimArray x) n = check "resizeMutablePrimArray: negative size" (n>=0) $ do - sz <- A.getSizeofMutablePrimArray marr - marr' <- A.newPrimArray n - A.copyMutablePrimArray marr' 0 marr 0 (min sz n) +resizeMutablePrimArray marr@(A.MutablePrimArray x) n = check "resizeMutablePrimArray: negative size" (n >= 0) $ do + let sz = A.sizeofMutablePrimArray marr + marr' <- A.cloneMutablePrimArray marr 0 sz A.setPrimArray (A.MutablePrimArray x) 0 (sz * sizeOf (undefined :: a)) (0xFF :: Word8) return marr' +freezePrimArray + :: (HasCallStack, PrimMonad m, Prim a) + => MutablePrimArray (PrimState m) a -- ^ source + -> Int -- ^ offset + -> Int -- ^ length + -> m (PrimArray a) +freezePrimArray marr s l = check "freezePrimArray: index range of out bounds" + (s >= 0 && l >= 0 && s + l <= A.sizeofMutablePrimArray marr) + (A.freezePrimArray marr s l) + +thawPrimArray + :: (HasCallStack, PrimMonad m, Prim a) + => PrimArray a -- ^ source + -> Int -- ^ offset + -> Int -- ^ length + -> m (MutablePrimArray (PrimState m) a) +thawPrimArray arr s l = check "thawPrimArray: index range of out bounds" + (s >= 0 && l >= 0 && s + l <= A.sizeofPrimArray arr) + (A.thawPrimArray arr s l) + -- | This corrupts the contents of the argument array. unsafeFreezePrimArray :: forall m a. (HasCallStack, PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> m (PrimArray a) unsafeFreezePrimArray marr@(A.MutablePrimArray x) = do - sz <- A.getSizeofMutablePrimArray marr - marr' <- A.newPrimArray sz - A.copyMutablePrimArray marr' 0 marr 0 sz + let sz = A.sizeofMutablePrimArray marr + arr <- A.freezePrimArray marr 0 sz A.setPrimArray (A.MutablePrimArray x) 0 (sz * sizeOf (undefined :: a)) (0xFF :: Word8) - A.unsafeFreezePrimArray marr' + return arr -#if __GLASGOW_HASKELL__ >= 710 shrinkMutablePrimArray :: forall m a. (HasCallStack, PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> Int -- ^ new size -> m () shrinkMutablePrimArray marr n = do old <- A.getSizeofMutablePrimArray marr - check "shrinkMutablePrimArray: illegal new size" (n>=0 && n <= old) (A.shrinkMutablePrimArray marr n) -#endif + check "shrinkMutablePrimArray: illegal new size" (n >= 0 && n <= old) (A.shrinkMutablePrimArray marr n) readPrimArray :: (HasCallStack, Prim a, PrimMonad m) => MutablePrimArray (PrimState m) a -> Int -> m a readPrimArray marr i = do @@ -142,10 +179,9 @@ , show i , "]" ] - check ("readPrimArray: index of out bounds " ++ explain) (i>=0 && i= 0 && i < siz) (A.readPrimArray marr i) -writePrimArray :: - (HasCallStack, Prim a, PrimMonad m) +writePrimArray :: (HasCallStack, Prim a, PrimMonad m) => MutablePrimArray (PrimState m) a -- ^ array -> Int -- ^ index -> a -- ^ element @@ -159,10 +195,10 @@ , show i , "]" ] - check ("writePrimArray: index of out bounds " ++ explain) (i>=0 && i= 0 && i < siz) (A.writePrimArray marr i x) indexPrimArray :: forall a. Prim a => PrimArray a -> Int -> a -indexPrimArray arr i = +indexPrimArray arr i = let sz = A.sizeofPrimArray arr explain = L.concat [ "[size: " @@ -171,8 +207,8 @@ , show i , "]" ] - in check ("indexPrimArray: index of out bounds " ++ explain) - (i>=0 && i< sz) + in check ("indexPrimArray: index out of bounds " ++ explain) + (i >= 0 && i < sz) (A.indexPrimArray arr i) setPrimArray :: forall m a. (HasCallStack, Prim a, PrimMonad m) @@ -193,9 +229,36 @@ , "]" ] check ("setPrimArray: index range of out bounds " ++ explain) - (doff>=0 && (doff+sz)<=arrSz) + (doff >= 0 && doff + sz <= arrSz) (A.setPrimArray dst doff sz x) +copyPrimArray :: forall m a. (HasCallStack, PrimMonad m, Prim a) + => MutablePrimArray (PrimState m) a -- ^ destination array + -> Int -- ^ offset into destination array + -> PrimArray a -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of elements to copy + -> m () +copyPrimArray marr s1 arr s2 l = do + dstSz <- A.getSizeofMutablePrimArray marr + let srcSz = A.sizeofPrimArray arr + let explain = L.concat + [ "[dst_sz: " + , show dstSz + , ", dst_off: " + , show s1 + , ", src_sz: " + , show srcSz + , ", src_off: " + , show s2 + , ", len: " + , show l + , "]" + ] + check ("copyPrimArray: index range of out bounds " ++ explain) + (s1 >= 0 && s2 >= 0 && l >= 0 && s1 + l <= dstSz && s2 + l <= srcSz) + (A.copyPrimArray marr s1 arr s2 l) + copyMutablePrimArray :: forall m a. (HasCallStack, PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -- ^ destination array -> Int -- ^ offset into destination array @@ -204,23 +267,81 @@ -> Int -- ^ number of elements to copy -> m () copyMutablePrimArray marr1 s1 marr2 s2 l = do - siz1 <- A.getSizeofMutablePrimArray marr1 - siz2 <- A.getSizeofMutablePrimArray marr2 - check "copyMutablePrimArray: index range of out bounds" - (s1>=0 && s2>=0 && l>=0 && (s2+l)<=siz2 && (s1+l)<=siz1) + dstSz <- A.getSizeofMutablePrimArray marr1 + srcSz <- A.getSizeofMutablePrimArray marr2 + let explain = L.concat + [ "[dst_sz: " + , show dstSz + , ", dst_off: " + , show s1 + , ", src_sz: " + , show srcSz + , ", src_off: " + , show s2 + , ", len: " + , show l + , "]" + ] + check ("copyMutablePrimArray: index range of out bounds " ++ explain) + (s1 >= 0 && s2 >= 0 && l >= 0 && s1 + l <= dstSz && s2 + l <= srcSz) (A.copyMutablePrimArray marr1 s1 marr2 s2 l) -copyPrimArray :: forall m a. - (HasCallStack, PrimMonad m, Prim a) - => MutablePrimArray (PrimState m) a -- ^ destination array - -> Int -- ^ offset into destination array +copyPrimArrayToPtr :: forall m a. (HasCallStack, PrimMonad m, Prim a) + => Ptr a -- ^ destination pointer -> PrimArray a -- ^ source array -> Int -- ^ offset into source array -> Int -- ^ number of elements to copy -> m () -copyPrimArray marr s1 arr s2 l = do - siz <- A.getSizeofMutablePrimArray marr - check "copyPrimArray: index range of out bounds" - (s1>=0 && s2>=0 && l>=0 && (s2+l)<= A.sizeofPrimArray arr && (s1+l)<=siz) - (A.copyPrimArray marr s1 arr s2 l) +copyPrimArrayToPtr ptr arr s l = do + let srcSz = A.sizeofPrimArray arr + let explain = L.concat + [ "[src_sz: " + , show srcSz + , ", src_off: " + , show s + , ", len: " + , show l + , "]" + ] + check ("copyPrimArrayToPtr: index range of out bounds " ++ explain) + (s >= 0 && l >= 0 && s + l <= srcSz) + (A.copyPrimArrayToPtr ptr arr s l) +copyMutablePrimArrayToPtr :: forall m a. (HasCallStack, PrimMonad m, Prim a) + => Ptr a -- ^ destination pointer + -> MutablePrimArray (PrimState m) a -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of elements to copy + -> m () +copyMutablePrimArrayToPtr ptr marr s l = do + srcSz <- A.getSizeofMutablePrimArray marr + let explain = L.concat + [ "[src_sz: " + , show srcSz + , ", src_off: " + , show s + , ", len: " + , show l + , "]" + ] + check ("copyMutablePrimArrayToPtr: index range of out bounds " ++ explain) + (s >= 0 && l >= 0 && s + l <= srcSz) + (A.copyMutablePrimArrayToPtr ptr marr s l) + +clonePrimArray :: (HasCallStack, Prim a) + => PrimArray a -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of elements to copy + -> PrimArray a +clonePrimArray arr s l = check "clonePrimArray: index range of out bounds" + (s >= 0 && l >= 0 && s + l <= A.sizeofPrimArray arr) + (A.clonePrimArray arr s l) + +cloneMutablePrimArray :: (HasCallStack, PrimMonad m, Prim a) + => MutablePrimArray (PrimState m) a -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of elements to copy + -> m (MutablePrimArray (PrimState m) a) +cloneMutablePrimArray marr s l = check "cloneMutablePrimArray: index range of out bounds" + (s >= 0 && l >= 0 && s + l <= A.sizeofMutablePrimArray marr) + (A.cloneMutablePrimArray marr s l) diff --git a/src/Data/Primitive/SmallArray.hs b/src/Data/Primitive/SmallArray.hs --- a/src/Data/Primitive/SmallArray.hs +++ b/src/Data/Primitive/SmallArray.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE UnboxedTuples #-} @@ -9,28 +10,34 @@ , newSmallArray , readSmallArray , writeSmallArray + , copySmallArray + , copySmallMutableArray , indexSmallArray - , indexSmallArray## , indexSmallArrayM + , indexSmallArray## + , cloneSmallArray + , cloneSmallMutableArray , freezeSmallArray - , thawSmallArray , unsafeFreezeSmallArray + , thawSmallArray + , A.runSmallArray , A.unsafeThawSmallArray - , copySmallArray - , copySmallMutableArray - , cloneSmallArray - , cloneSmallMutableArray , A.sizeofSmallArray , A.sizeofSmallMutableArray +#if MIN_VERSION_base(4,14,0) + , shrinkSmallMutableArray +#endif , A.smallArrayFromList , A.smallArrayFromListN + , A.mapSmallArray' + , A.traverseSmallArrayP ) where import "primitive" Data.Primitive (sizeOf) -import "primitive" Data.Primitive.SmallArray (SmallArray,SmallMutableArray) +import "primitive" Data.Primitive.SmallArray (SmallArray, SmallMutableArray) import Control.Exception (throw, ArrayException(..), Exception, toException) -import Control.Monad.Primitive (PrimMonad,PrimState) +import Control.Monad.Primitive (PrimMonad, PrimState) import GHC.Exts (raise#) import GHC.Stack @@ -39,18 +46,18 @@ check :: HasCallStack => String -> Bool -> a -> a check _ True x = x -check errMsg False _ = throw (IndexOutOfBounds $ "Data.Primitive.SmallArray.Checked." ++ errMsg ++ "\n" ++ prettyCallStack callStack) +check errMsg False _ = throw (IndexOutOfBounds $ "Data.Primitive.SmallArray." ++ errMsg ++ "\n" ++ prettyCallStack callStack) checkUnary :: HasCallStack => String -> Bool -> (# a #) -> (# a #) checkUnary _ True x = x -checkUnary errMsg False _ = throwUnary (IndexOutOfBounds $ "Data.Primitive.SmallArray.Checked." ++ errMsg ++ "\n" ++ prettyCallStack callStack) +checkUnary errMsg False _ = throwUnary (IndexOutOfBounds $ "Data.Primitive.SmallArray." ++ errMsg ++ "\n" ++ prettyCallStack callStack) throwUnary :: Exception e => e -> (# a #) throwUnary e = raise# (toException e) newSmallArray :: (HasCallStack, PrimMonad m) => Int -> a -> m (SmallMutableArray (PrimState m) a) newSmallArray n x = - check "newSmallArray: negative size" (n>=0) + check "newSmallArray: negative size" (n >= 0) $ check ("newSmallArray: requested " ++ show n ++ " elements") (n * ptrSz < 1024*1024*1024) $ A.newSmallArray n x where @@ -66,7 +73,7 @@ , show i , "]" ] - check ("readSmallArray: index of out bounds " ++ explain) (i>=0 && i= 0 && i < siz) (A.readSmallArray marr i) writeSmallArray :: (HasCallStack, PrimMonad m) => SmallMutableArray (PrimState m) a -> Int -> a -> m () writeSmallArray marr i x = do @@ -78,11 +85,11 @@ , show i , "]" ] - check ("writeSmallArray: index of out bounds " ++ explain) (i>=0 && i= 0 && i < siz) (A.writeSmallArray marr i x) indexSmallArray :: HasCallStack => SmallArray a -> Int -> a -indexSmallArray arr i = check ("indexSmallArray: index of out bounds " ++ explain) - (i>=0 && i= 0 && i < A.sizeofSmallArray arr) (A.indexSmallArray arr i) where explain = L.concat @@ -94,19 +101,19 @@ ] indexSmallArray## :: HasCallStack => SmallArray a -> Int -> (# a #) -indexSmallArray## arr i = checkUnary "indexSmallArray##: index of out bounds" - (i>=0 && i= 0 && i < A.sizeofSmallArray arr) (A.indexSmallArray## arr i) indexSmallArrayM :: (HasCallStack, Monad m) => SmallArray a -> Int -> m a -indexSmallArrayM arr i = check "indexSmallArrayM: index of out bounds" - (i>=0 && i= 0 && i < A.sizeofSmallArray arr) + (A.indexSmallArrayM arr i) {-# NOINLINE errorUnsafeFreeze #-} errorUnsafeFreeze :: a errorUnsafeFreeze = - error "Data.Primitive.Array.Checked.unsafeFreeze:\nAttempted to read from an array after unsafely freezing it." + error "Data.Primitive.Array.unsafeFreeze:\nAttempted to read from an array after unsafely freezing it." -- | This installs error thunks in the argument array so that -- any attempt to use it after an unsafeFreeze will fail. @@ -125,70 +132,71 @@ freezeSmallArray :: (HasCallStack, PrimMonad m) => SmallMutableArray (PrimState m) a -- ^ source - -> Int -- ^ offset - -> Int -- ^ length + -> Int -- ^ offset + -> Int -- ^ length -> m (SmallArray a) -freezeSmallArray marr s l = do - let siz = A.sizeofSmallMutableArray marr - check "freezeSmallArray: index range of out bounds" - (s>=0 && l>=0 && (s+l)<=siz) - (A.freezeSmallArray marr s l) +freezeSmallArray marr s l = check "freezeSmallArray: index range of out bounds" + (s >= 0 && l >= 0 && s + l <= A.sizeofSmallMutableArray marr) + (A.freezeSmallArray marr s l) thawSmallArray :: (HasCallStack, PrimMonad m) => SmallArray a -- ^ source - -> Int -- ^ offset - -> Int -- ^ length + -> Int -- ^ offset + -> Int -- ^ length -> m (SmallMutableArray (PrimState m) a) -thawSmallArray arr s l = check "thawArr: index range of out bounds" - (s>=0 && l>=0 && (s+l)<=A.sizeofSmallArray arr) - (A.thawSmallArray arr s l) +thawSmallArray arr s l = check "thawSmallArray: index range of out bounds" + (s >= 0 && l >= 0 && s + l <= A.sizeofSmallArray arr) + (A.thawSmallArray arr s l) copySmallArray :: (HasCallStack, PrimMonad m) - => SmallMutableArray (PrimState m) a -- ^ destination array - -> Int -- ^ offset into destination array - -> SmallArray a -- ^ source array - -> Int -- ^ offset into source array - -> Int -- ^ number of elements to copy - -> m () + => SmallMutableArray (PrimState m) a -- ^ destination array + -> Int -- ^ offset into destination array + -> SmallArray a -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of elements to copy + -> m () copySmallArray marr s1 arr s2 l = do let siz = A.sizeofSmallMutableArray marr check "copySmallArray: index range of out bounds" - (s1>=0 && s2>=0 && l>=0 && (s2+l)<=A.sizeofSmallArray arr && (s1+l)<=siz) + (s1 >= 0 && s2 >= 0 && l >= 0 && s1 + l <= siz && s2 + l <= A.sizeofSmallArray arr) (A.copySmallArray marr s1 arr s2 l) - copySmallMutableArray :: (HasCallStack, PrimMonad m) - => SmallMutableArray (PrimState m) a -- ^ destination array - -> Int -- ^ offset into destination array - -> SmallMutableArray (PrimState m) a -- ^ source array - -> Int -- ^ offset into source array - -> Int -- ^ number of elements to copy - -> m () + => SmallMutableArray (PrimState m) a -- ^ destination array + -> Int -- ^ offset into destination array + -> SmallMutableArray (PrimState m) a -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of elements to copy + -> m () copySmallMutableArray marr1 s1 marr2 s2 l = do let siz1 = A.sizeofSmallMutableArray marr1 let siz2 = A.sizeofSmallMutableArray marr2 check "copySmallMutableArray: index range of out bounds" - (s1>=0 && s2>=0 && l>=0 && (s2+l)<=siz2 && (s1+l)<=siz1) + (s1 >= 0 && s2 >= 0 && l >= 0 && s1 + l <= siz1 && s2 + l <= siz2) (A.copySmallMutableArray marr1 s1 marr2 s2 l) - cloneSmallArray :: HasCallStack - => SmallArray a -- ^ source array - -> Int -- ^ offset into destination array - -> Int -- ^ number of elements to copy - -> SmallArray a + => SmallArray a -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of elements to copy + -> SmallArray a cloneSmallArray arr s l = check "cloneSmallArray: index range of out bounds" - (s>=0 && l>=0 && (s+l)<=A.sizeofSmallArray arr) - (A.cloneSmallArray arr s l) + (s >= 0 && l >= 0 && s + l <= A.sizeofSmallArray arr) + (A.cloneSmallArray arr s l) cloneSmallMutableArray :: (HasCallStack, PrimMonad m) - => SmallMutableArray (PrimState m) a -- ^ source array - -> Int -- ^ offset into destination array - -> Int -- ^ number of elements to copy - -> m (SmallMutableArray (PrimState m) a) -cloneSmallMutableArray marr s l = do - let siz = A.sizeofSmallMutableArray marr - check "cloneSmallMutableArray: index range of out bounds" - (s>=0 && l>=0 && (s+l)<=siz) - (A.cloneSmallMutableArray marr s l) + => SmallMutableArray (PrimState m) a -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of elements to copy + -> m (SmallMutableArray (PrimState m) a) +cloneSmallMutableArray marr s l = check "cloneSmallMutableArray: index range of out bounds" + (s >= 0 && l >= 0 && s + l <= A.sizeofSmallMutableArray marr) + (A.cloneSmallMutableArray marr s l) + +#if MIN_VERSION_base(4,14,0) +shrinkSmallMutableArray :: (HasCallStack, PrimMonad m) => SmallMutableArray (PrimState m) a -> Int -> m () +shrinkSmallMutableArray marr n = do + let old = A.sizeofSmallMutableArray marr + check "shrinkSmallMutableArray: illegal new size" (n >= 0 && n <= old) (A.shrinkSmallMutableArray marr n) +#endif