primitive-checked 0.7.0.0 → 0.7.2.0

raw patch · 7 files changed

+539/−227 lines, 7 filesdep ~primitivesetup-changednew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: primitive

API changes (from Hackage documentation)

Files

• Setup.hs +0/−2
• primitive-checked.cabal +14/−15
• src/Data/Primitive.hs +8/−8
• src/Data/Primitive/Array.hs +84/−60
• src/Data/Primitive/ByteArray.hs +191/−29
• src/Data/Primitive/PrimArray.hs +170/−49
• src/Data/Primitive/SmallArray.hs +72/−64

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -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 <andrew.thaddeus@gmail.com>, konsumlamm <konsumlamm@gmail.com> 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-

@@ -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

@@ -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<siz) (A.readArray marr i)+  check "readArray: index out of bounds" (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<siz) (A.writeArray marr i x)+  check "writeArray: index out of bounds" (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<A.sizeofArray arr)+indexArray arr i = check "indexArray: index out of bounds"+  (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<A.sizeofArray arr)-    (A.indexArrayM arr i)+indexArrayM :: (HasCallStack, Monad m) => 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)

@@ -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<siz) (A.readByteArray marr i)+  siz <- getElementSizeofMutableByteArray (Proxy :: Proxy a) marr+  check "readByteArray: index out of bounds" (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<siz) (A.writeByteArray marr i x)+  siz <- getElementSizeofMutableByteArray (Proxy :: Proxy a) marr+  let explain = L.concat+        [ "[size: "+        , show siz+        , ", index: "+        , show i+        , ", elem_sz: "+        , show (sizeOf (undefined :: a))+        , "]"+        ]+  check ("writeByteArray: index out of bounds " ++ explain)+    (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)

@@ -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<siz) (A.readPrimArray marr i)+  check ("readPrimArray: index out of bounds " ++ explain) (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<siz) (A.writePrimArray marr i x)+  check ("writePrimArray: index out of bounds " ++ explain) (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)

@@ -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<siz) (A.readSmallArray marr i)+  check ("readSmallArray: index out of bounds " ++ explain) (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<siz) (A.writeSmallArray marr i x)+  check ("writeSmallArray: index out of bounds " ++ explain) (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<A.sizeofSmallArray arr)+indexSmallArray arr i = check ("indexSmallArray: index out of bounds " ++ explain)+  (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<A.sizeofSmallArray arr)+indexSmallArray## arr i = checkUnary "indexSmallArray##: index out of bounds"+  (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<A.sizeofSmallArray arr)-    (A.indexSmallArrayM arr i)+indexSmallArrayM arr i = check "indexSmallArrayM: index out of bounds"+  (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