diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Andrew Martin (c) 2018 + +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 the name of Andrew Martin nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND 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 COPYRIGHT +OWNER OR 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +# primitive-checked + +A drop-in replacement for the `primitive` library that adds bounds-checking +to prevent segfaults. This is only intended to be used in test environments. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/primitive-checked.cabal b/primitive-checked.cabal new file mode 100644 --- /dev/null +++ b/primitive-checked.cabal @@ -0,0 +1,54 @@ +name: primitive-checked +version: 0.6.3.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 +copyright: 2018 Andrew Martin +license: BSD3 +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.21 +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. + 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 + 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. + +extra-source-files: + README.md + +source-repository head + type: git + location: https://github.com/andrewthad/primitive-checked + +library + hs-source-dirs: + src + build-depends: + base >=4.7 && <5 + , primitive == 0.6.3.* + exposed-modules: + Data.Primitive.Array + Data.Primitive.SmallArray + Data.Primitive.ByteArray + Data.Primitive.UnliftedArray + reexported-modules: + Control.Monad.Primitive + , Data.Primitive.Addr + , Data.Primitive.MachDeps + , Data.Primitive.MutVar + , Data.Primitive.Types + default-language: Haskell2010 + diff --git a/src/Data/Primitive/Array.hs b/src/Data/Primitive/Array.hs new file mode 100644 --- /dev/null +++ b/src/Data/Primitive/Array.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE PackageImports #-} + +module Data.Primitive.Array + ( Array(..) + , MutableArray(..) + , newArray + , readArray + , writeArray + , indexArray + , indexArrayM + , freezeArray + , thawArray + , A.unsafeFreezeArray + , A.unsafeThawArray + , A.sameMutableArray + , copyArray + , copyMutableArray + , cloneArray + , cloneMutableArray + , A.sizeofArray + , A.sizeofMutableArray + ) where + +import Control.Monad.Primitive (PrimMonad,PrimState) +import Control.Exception (throw, ArrayException(..)) +import "primitive" Data.Primitive.Array (Array,MutableArray) +import qualified "primitive" Data.Primitive.Array as A + +check :: String -> Bool -> a -> a +check _ True x = x +check errMsg False _ = throw (IndexOutOfBounds $ "Data.Primitive.Array.Checked." ++ errMsg) + +newArray :: PrimMonad m => Int -> a -> m (MutableArray (PrimState m) a) +newArray n x = check "newArray: negative size" (n>=0) (A.newArray n x) + +readArray :: 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 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 Int -> a +indexArray arr i = check "indexArray: index of out bounds" + (i>=0 && i Array a -> Int -> m a +indexArrayM arr i = check "indexArrayM: index of out bounds" + (i>=0 && i MutableArray (PrimState m) a -- ^ source + -> 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) + +thawArray + :: PrimMonad m + => Array a -- ^ source + -> 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) + +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 () +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) + (A.copyArray marr s1 arr s2 l) + + +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 () +copyMutableArray marr1 s1 marr2 s2 l = do + let siz1 = A.sizeofMutableArray marr1 + let siz2 = A.sizeofMutableArray marr2 + check "copyMutableArray: index range of out bounds" + (s1>=0 && s2>=0 && l>=0 && (s2+l)<=siz2 && (s1+l)<=siz1) + (A.copyMutableArray marr1 s1 marr2 s2 l) + + +cloneArray :: Array a -- ^ source array + -> Int -- ^ offset into destination 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) + +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) +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) diff --git a/src/Data/Primitive/ByteArray.hs b/src/Data/Primitive/ByteArray.hs new file mode 100644 --- /dev/null +++ b/src/Data/Primitive/ByteArray.hs @@ -0,0 +1,142 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Data.Primitive.ByteArray + ( -- * Types + A.ByteArray(..) + , A.MutableByteArray(..) + , A.ByteArray# + , A.MutableByteArray# + -- * Allocation + , newByteArray + , newPinnedByteArray + , newAlignedPinnedByteArray + -- * Element access + , readByteArray + , writeByteArray + , indexByteArray + -- * Folding + , A.foldrByteArray + -- * Freezing and thawing + , A.unsafeFreezeByteArray + , A.unsafeThawByteArray + -- * Block operations + , copyByteArray + , copyMutableByteArray + , moveByteArray + , setByteArray + , fillByteArray + -- * Information + , A.sizeofByteArray + , A.sizeofMutableByteArray + , A.sameMutableByteArray + , A.byteArrayContents + , A.mutableByteArrayContents + ) where + +import Control.Monad.Primitive (PrimMonad,PrimState) +import Control.Exception (throw, ArrayException(..)) +import Data.Primitive.Types (Prim,sizeOf) +import Data.Proxy (Proxy(..)) +import Data.Word (Word8) +import "primitive" Data.Primitive.ByteArray (ByteArray,MutableByteArray) +import qualified "primitive" Data.Primitive.ByteArray as A + +check :: String -> Bool -> a -> a +check _ True x = x +check errMsg False _ = throw (IndexOutOfBounds $ "Data.Primitive.SmallArray.Checked." ++ errMsg) + +elementSizeofByteArray :: forall a. Prim a => Proxy a -> ByteArray -> Int +elementSizeofByteArray _ arr = div (A.sizeofByteArray arr) (sizeOf (undefined :: a)) + +elementSizeofMutableByteArray :: forall s a. Prim a => Proxy a -> MutableByteArray s -> Int +elementSizeofMutableByteArray _ arr = div (A.sizeofMutableByteArray arr) (sizeOf (undefined :: a)) + +newByteArray :: PrimMonad m => Int -> m (MutableByteArray (PrimState m)) +newByteArray n = check "newByteArray: negative size" (n>=0) (A.newByteArray n) + +newPinnedByteArray :: PrimMonad m => Int -> m (MutableByteArray (PrimState m)) +newPinnedByteArray n = check "newPinnedByteArray: negative size" (n>=0) (A.newPinnedByteArray n) + +newAlignedPinnedByteArray :: PrimMonad m => Int -> Int -> m (MutableByteArray (PrimState m)) +newAlignedPinnedByteArray n k = check "newAlignedPinnedByteArray: negative size" (n>=0) (A.newAlignedPinnedByteArray n k) + +readByteArray :: forall m a. (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 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 ByteArray -> Int -> a +indexByteArray arr i = check "indexSmallArray: index of out bounds" + (i>=0 && i< elementSizeofByteArray (Proxy :: Proxy a) arr) + (A.indexByteArray arr i) + +copyByteArray :: forall m. PrimMonad m + => MutableByteArray (PrimState m) -- ^ destination array + -> Int -- ^ offset into destination array + -> ByteArray -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of elements to copy + -> m () +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) + (A.copyByteArray marr s1 arr s2 l) + + +copyMutableByteArray :: forall m. 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 + -> m () +copyMutableByteArray marr1 s1 marr2 s2 l = do + 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) + (A.copyMutableByteArray marr1 s1 marr2 s2 l) + +moveByteArray :: forall m. 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 + -> 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) + (A.moveByteArray marr1 s1 marr2 s2 l) + +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 () +fillByteArray = setByteArray + +setByteArray :: forall m a. (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 dst doff sz x = + check "copyMutableByteArray: index range of out bounds" + (doff>=0 && (doff+sz)<=elementSizeofMutableByteArray (Proxy :: Proxy a) dst) + (A.setByteArray dst doff sz x) + diff --git a/src/Data/Primitive/SmallArray.hs b/src/Data/Primitive/SmallArray.hs new file mode 100644 --- /dev/null +++ b/src/Data/Primitive/SmallArray.hs @@ -0,0 +1,123 @@ +{-# LANGUAGE PackageImports #-} + +module Data.Primitive.SmallArray + ( SmallArray(..) + , SmallMutableArray(..) + , newSmallArray + , readSmallArray + , writeSmallArray + , indexSmallArray + , indexSmallArrayM + , freezeSmallArray + , thawSmallArray + , A.unsafeFreezeSmallArray + , A.unsafeThawSmallArray + , copySmallArray + , copySmallMutableArray + , cloneSmallArray + , cloneSmallMutableArray + , A.sizeofSmallArray + , A.sizeofSmallMutableArray + ) where + +import Control.Monad.Primitive (PrimMonad,PrimState) +import Control.Exception (throw, ArrayException(..)) +import "primitive" Data.Primitive.SmallArray (SmallArray,SmallMutableArray) +import qualified "primitive" Data.Primitive.SmallArray as A + +check :: String -> Bool -> a -> a +check _ True x = x +check errMsg False _ = throw (IndexOutOfBounds $ "Data.Primitive.SmallArray.Checked." ++ errMsg) + +newSmallArray :: PrimMonad m => Int -> a -> m (SmallMutableArray (PrimState m) a) +newSmallArray n x = check "newSmallArray: negative size" (n>=0) (A.newSmallArray n x) + +readSmallArray :: PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> m a +readSmallArray marr i = do + let siz = A.sizeofSmallMutableArray marr + check "readSmallArray: index of out bounds" (i>=0 && i SmallMutableArray (PrimState m) a -> Int -> a -> m () +writeSmallArray marr i x = do + let siz = A.sizeofSmallMutableArray marr + check "writeSmallArray: index of out bounds" (i>=0 && i Int -> a +indexSmallArray arr i = check "indexSmallArray: index of out bounds" + (i>=0 && i SmallArray a -> Int -> m a +indexSmallArrayM arr i = check "indexSmallArrayM: index of out bounds" + (i>=0 && i SmallMutableArray (PrimState m) a -- ^ source + -> 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) + +thawSmallArray + :: PrimMonad m + => SmallArray a -- ^ source + -> 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) + +copySmallArray :: 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 () +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) + (A.copySmallArray marr s1 arr s2 l) + + +copySmallMutableArray :: 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 () +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) + (A.copySmallMutableArray marr1 s1 marr2 s2 l) + + +cloneSmallArray :: SmallArray a -- ^ source array + -> Int -- ^ offset into destination 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) + +cloneSmallMutableArray :: 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) diff --git a/src/Data/Primitive/UnliftedArray.hs b/src/Data/Primitive/UnliftedArray.hs new file mode 100644 --- /dev/null +++ b/src/Data/Primitive/UnliftedArray.hs @@ -0,0 +1,131 @@ +{-# LANGUAGE PackageImports #-} + +module Data.Primitive.UnliftedArray + ( UnliftedArray(..) + , MutableUnliftedArray(..) + , PrimUnlifted(..) + , unsafeNewUnliftedArray + , newUnliftedArray + , A.setUnliftedArray + , A.sizeofUnliftedArray + , A.sizeofMutableUnliftedArray + , readUnliftedArray + , writeUnliftedArray + , indexUnliftedArray + , indexUnliftedArrayM + , A.unsafeFreezeUnliftedArray + , freezeUnliftedArray + , thawUnliftedArray + , A.sameMutableUnliftedArray + , copyUnliftedArray + , copyMutableUnliftedArray + , cloneUnliftedArray + , cloneMutableUnliftedArray + ) where + +import Control.Monad.Primitive (PrimMonad,PrimState) +import Control.Exception (throw, ArrayException(..)) +import "primitive" Data.Primitive.UnliftedArray (UnliftedArray,MutableUnliftedArray,PrimUnlifted) +import qualified "primitive" Data.Primitive.UnliftedArray as A + +check :: String -> Bool -> a -> a +check _ True x = x +check errMsg False _ = throw (IndexOutOfBounds $ "Data.Primitive.UnliftedArray.Checked." ++ errMsg) + +newUnliftedArray :: (PrimMonad m, PrimUnlifted a) => Int -> a -> m (MutableUnliftedArray (PrimState m) a) +newUnliftedArray n x = check "newUnliftedArray: negative size" (n>=0) (A.newUnliftedArray n x) + +unsafeNewUnliftedArray :: PrimMonad m => Int -> m (MutableUnliftedArray (PrimState m) a) +unsafeNewUnliftedArray n = check "unsafeNewUnliftedArray: negative size" (n>=0) (A.unsafeNewUnliftedArray n) + +readUnliftedArray :: (PrimMonad m, PrimUnlifted a) => MutableUnliftedArray (PrimState m) a -> Int -> m a +readUnliftedArray marr i = do + let siz = A.sizeofMutableUnliftedArray marr + check "readUnliftedArray: index of out bounds" (i>=0 && i MutableUnliftedArray (PrimState m) a -> Int -> a -> m () +writeUnliftedArray marr i x = do + let siz = A.sizeofMutableUnliftedArray marr + check "writeUnliftedArray: index of out bounds" (i>=0 && i UnliftedArray a -> Int -> a +indexUnliftedArray arr i = check "indexUnliftedArray: index of out bounds" + (i>=0 && i UnliftedArray a -> Int -> m a +indexUnliftedArrayM arr i = check "indexUnliftedArrayM: index of out bounds" + (i>=0 && i MutableUnliftedArray (PrimState m) a -- ^ source + -> Int -- ^ offset + -> Int -- ^ length + -> m (UnliftedArray a) +freezeUnliftedArray marr s l = do + let siz = A.sizeofMutableUnliftedArray marr + check "freezeUnliftedArray: index range of out bounds" + (s>=0 && l>=0 && (s+l)<=siz) + (A.freezeUnliftedArray marr s l) + +thawUnliftedArray + :: PrimMonad m + => UnliftedArray a -- ^ source + -> Int -- ^ offset + -> Int -- ^ length + -> m (MutableUnliftedArray (PrimState m) a) +thawUnliftedArray arr s l = check "thawArr: index range of out bounds" + (s>=0 && l>=0 && (s+l)<=A.sizeofUnliftedArray arr) + (A.thawUnliftedArray arr s l) + +copyUnliftedArray :: PrimMonad m + => MutableUnliftedArray (PrimState m) a -- ^ destination array + -> Int -- ^ offset into destination array + -> UnliftedArray a -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of elements to copy + -> m () +copyUnliftedArray marr s1 arr s2 l = do + let siz = A.sizeofMutableUnliftedArray marr + check "copyUnliftedArray: index range of out bounds" + (s1>=0 && s2>=0 && l>=0 && (s2+l)<=A.sizeofUnliftedArray arr && (s1+l)<=siz) + (A.copyUnliftedArray marr s1 arr s2 l) + + +copyMutableUnliftedArray :: PrimMonad m + => MutableUnliftedArray (PrimState m) a -- ^ destination array + -> Int -- ^ offset into destination array + -> MutableUnliftedArray (PrimState m) a -- ^ source array + -> Int -- ^ offset into source array + -> Int -- ^ number of elements to copy + -> m () +copyMutableUnliftedArray marr1 s1 marr2 s2 l = do + let siz1 = A.sizeofMutableUnliftedArray marr1 + let siz2 = A.sizeofMutableUnliftedArray marr2 + check "copyMutableUnliftedArray: index range of out bounds" + (s1>=0 && s2>=0 && l>=0 && (s2+l)<=siz2 && (s1+l)<=siz1) + (A.copyMutableUnliftedArray marr1 s1 marr2 s2 l) + + +cloneUnliftedArray :: + UnliftedArray a -- ^ source array + -> Int -- ^ offset into destination array + -> Int -- ^ number of elements to copy + -> UnliftedArray a +cloneUnliftedArray arr s l = check "cloneUnliftedArray: index range of out bounds" + (s>=0 && l>=0 && (s+l)<=A.sizeofUnliftedArray arr) + (A.cloneUnliftedArray arr s l) + +cloneMutableUnliftedArray :: PrimMonad m + => MutableUnliftedArray (PrimState m) a -- ^ source array + -> Int -- ^ offset into destination array + -> Int -- ^ number of elements to copy + -> m (MutableUnliftedArray (PrimState m) a) +cloneMutableUnliftedArray marr s l = do + let siz = A.sizeofMutableUnliftedArray marr + check "cloneMutableUnliftedArray: index range of out bounds" + (s>=0 && l>=0 && (s+l)<=siz) + (A.cloneMutableUnliftedArray marr s l) +