contiguous 0.6.4.2 → 0.6.5.0

raw patch · 5 files changed

+260/−92 lines, 5 filesdep ~primitivedep ~primitive-unliftedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: primitive, primitive-unlifted

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• contiguous.cabal +5/−3
• src/Data/Primitive/Contiguous.hs +4/−1
• src/Data/Primitive/Contiguous/Class.hs +210/−32
• src/Data/Primitive/Contiguous/Shim.hs +32/−56

@@ -1,5 +1,14 @@ # Revision history for contiguous +## 0.6.5.0 -- 2025-04-07++* Implement Contiguous and ContiguousU for SmallUnliftedArray+* Re-export Small(Mutable)UnliftedArray from Data.Primitive.Contiguous+* Use functions from newer primitive and primitive-unlifted. The implementation+  of UnliftedArray in primitive-unlifted-2.1 penalizes the creation of an+  uninitialized unlifted array. When shrinking and resizing unlifted arrays,+  there are primitives that we can use to avoid this.+ ## 0.6.4.2 -- 2024-02-06  * Restore support for versions of base that do not export `liftA2`

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               contiguous-version:            0.6.4.2+version:            0.6.5.0 homepage:           https://github.com/byteverse/contiguous bug-reports:        https://github.com/byteverse/contiguous/issues author:             Andrew Martin@@ -21,6 +21,8 @@   unified interface to working with `Array`, `SmallArray`,   `PrimArray`, and `UnliftedArray`. +tested-with:        GHC ==9.4.8 || ==9.6.3 || ==9.8.1+ common build-settings   default-language: Haskell2010   ghc-options:      -Wall -Wunused-packages@@ -36,8 +38,8 @@   build-depends:     , base                >=4.14    && <5     , deepseq             >=1.4-    , primitive           >=0.7.2   && <0.10-    , primitive-unlifted  >=2.1+    , primitive           >=0.9     && <0.10+    , primitive-unlifted  >=2.2     , run-st              >=0.1.3.2    ghc-options:     -O2

@@ -270,11 +270,14 @@   , MutablePrimArray   , UnliftedArray   , MutableUnliftedArray+  , SmallUnliftedArray+  , SmallMutableUnliftedArray   ) where  import Control.Monad.Primitive-import Data.Primitive hiding (fromList, fromListN)+import Data.Primitive import Data.Primitive.Unlifted.Array+import Data.Primitive.Unlifted.SmallArray import Prelude hiding (Foldable (..), all, any, filter, map, mapM, mapM_, read, replicate, reverse, scanl, sequence, sequence_, traverse, zip, zipWith, (<$))  import Control.Monad (when)

@@ -27,9 +27,10 @@   , Always   ) where -import Data.Primitive hiding (fromList, fromListN)+import Data.Primitive import Data.Primitive.Contiguous.Shim import Data.Primitive.Unlifted.Array+import Data.Primitive.Unlifted.SmallArray import Prelude hiding   ( all   , any@@ -64,8 +65,10 @@ import Data.Kind (Type) import Data.Primitive.Unlifted.Array () import Data.Primitive.Unlifted.Array.Primops (MutableUnliftedArray# (MutableUnliftedArray#), UnliftedArray# (UnliftedArray#))+import Data.Primitive.Unlifted.SmallArray.Primops (SmallUnliftedArray# (SmallUnliftedArray#), SmallMutableUnliftedArray# (SmallMutableUnliftedArray#)) import Data.Primitive.Unlifted.Class (PrimUnlifted) import GHC.Exts (Array#, Constraint, MutableArray#, SmallArray#, SmallMutableArray#, TYPE, sizeofArray#, sizeofByteArray#)+import GHC.ST (ST (ST))  import qualified Control.DeepSeq as DS import qualified Data.Primitive.Unlifted.Class as Class@@ -139,7 +142,7 @@     b -> -- fill element     m (Mutable arr (PrimState m) b) -  -- | Resize an array without growing it.+  -- | Resize an array without growing it. It may be shrunk in place.   --   -- @since 0.6.0   shrink ::@@ -148,16 +151,6 @@     -- | new length     Int ->     m (Mutable arr (PrimState m) a)-  default shrink ::-    ( ContiguousU arr-    , PrimMonad m-    , Element arr a-    ) =>-    Mutable arr (PrimState m) a ->-    Int ->-    m (Mutable arr (PrimState m) a)-  {-# INLINE shrink #-}-  shrink = resize    -- | The empty array.   empty :: arr a@@ -380,8 +373,6 @@     (PrimMonad m, Element arr b) =>     Mutable arr (PrimState m) b ->     m (arr b)-  unsafeFreeze xs = unsafeShrinkAndFreeze xs =<< sizeMut xs-  {-# INLINE unsafeFreeze #-}    unsafeShrinkAndFreeze ::     (PrimMonad m, Element arr a) =>@@ -389,17 +380,6 @@     -- | final size     Int ->     m (arr a)-  default unsafeShrinkAndFreeze ::-    ( ContiguousU arr-    , PrimMonad m-    , Element arr a-    ) =>-    Mutable arr (PrimState m) a ->-    Int ->-    m (arr a)-  {-# INLINE unsafeShrinkAndFreeze #-}-  unsafeShrinkAndFreeze arr0 len' =-    resize arr0 len' >>= unsafeFreeze    -- | Copy a slice of an immutable array into a new mutable array.   thaw ::@@ -569,7 +549,13 @@   -- | The unifted version of the mutable array type (i.e. eliminates an indirection through a thunk).   type UnliftedMut arr = (r :: Type -> Type -> TYPE UnliftedRep) | r -> arr -  -- | Resize an array into one with the given size.+  -- | Resize an array into one with the given size. If the array is grown,+  -- then reading from any newly introduced element before writing to it is undefined behavior.+  -- The current behavior is that anything backed by @MutableByteArray#@ ends with+  -- uninitialized memory at these indices. But for @SmallMutableArray@ or @Array@, these+  -- are set to an error thunk, so reading from them and forcing the result+  -- causes the program to crash. For @UnliftedArray@, the new elements have undefined values of an unknown type.+  -- If the array is not grown, it may (or may not) be modified in place.   resize ::     (PrimMonad m, Element arr b) =>     Mutable arr (PrimState m) b ->@@ -618,6 +604,10 @@   replicateMut len x = do     baseMut <- replicateMut len x     pure MutableSlice {offsetMut = 0, lengthMut = len, baseMut = unliftMut baseMut}+  {-# INLINE unsafeFreeze #-}+  unsafeFreeze (MutableSlice off len base) = do+    base' <- unsafeFreeze (liftMut base)+    pure (Slice off len (unlift base'))   {-# INLINE shrink #-}   shrink xs len' = pure $ case compare len' (lengthMut xs) of     LT -> xs {lengthMut = len'}@@ -807,7 +797,7 @@   {-# INLINE size #-}   size = sizeofSmallArray   {-# INLINE sizeMut #-}-  sizeMut = (\x -> pure $! sizeofSmallMutableArray x)+  sizeMut = getSizeofSmallMutableArray   {-# INLINE thaw_ #-}   thaw_ = thawSmallArray   {-# INLINE equals #-}@@ -872,15 +862,23 @@   {-# INLINE copyMut_ #-}   copyMut_ = copySmallMutableArray   {-# INLINE replicateMut #-}-  replicateMut = replicateSmallMutableArray+  replicateMut = newSmallArray   {-# INLINE run #-}   run = runSmallArrayST+  {-# INLINE shrink #-}+  shrink !arr !n = do+    shrinkSmallMutableArray arr n+    pure arr+  {-# INLINE unsafeShrinkAndFreeze #-}+  unsafeShrinkAndFreeze !arr !n = do+    shrinkSmallMutableArray arr n+    unsafeFreezeSmallArray arr  instance ContiguousU SmallArray where   type Unlifted SmallArray = SmallArray#   type UnliftedMut SmallArray = SmallMutableArray#   {-# INLINE resize #-}-  resize = resizeSmallArray+  resize !arr !n = resizeSmallMutableArray arr n resizeSmallMutableArrayUninitializedElement   {-# INLINE unlift #-}   unlift (SmallArray x) = x   {-# INLINE unliftMut #-}@@ -890,6 +888,150 @@   {-# INLINE liftMut #-}   liftMut x = SmallMutableArray x +instance Contiguous (SmallUnliftedArray_ unlifted_a) where+  type Mutable (SmallUnliftedArray_ unlifted_a) = SmallMutableUnliftedArray_ unlifted_a+  type Element (SmallUnliftedArray_ unlifted_a) = PrimUnliftsInto unlifted_a+  type Sliced (SmallUnliftedArray_ unlifted_a) = Slice (SmallUnliftedArray_ unlifted_a)+  type MutableSliced (SmallUnliftedArray_ unlifted_a) = MutableSlice (SmallUnliftedArray_ unlifted_a)+  {-# INLINE new #-}+  new n = unsafeNewSmallUnliftedArray n+  {-# INLINE empty #-}+  empty = emptySmallUnliftedArray+  {-# INLINE index #-}+  index = indexSmallUnliftedArray+  {-# INLINE indexM #-}+  indexM arr ix = pure (indexSmallUnliftedArray arr ix)+  {-# INLINE index# #-}+  index# arr ix = (# indexSmallUnliftedArray arr ix #)+  {-# INLINE read #-}+  read = readSmallUnliftedArray+  {-# INLINE write #-}+  write = writeSmallUnliftedArray+  {-# INLINE null #-}+  null a = case sizeofSmallUnliftedArray a of+    0 -> True+    _ -> False+  {-# INLINE slice #-}+  slice base offset length = Slice {offset, length, base = unlift base}+  {-# INLINE sliceMut #-}+  sliceMut baseMut offsetMut lengthMut = MutableSlice {offsetMut, lengthMut, baseMut = unliftMut baseMut}+  {-# INLINE toSlice #-}+  toSlice base = Slice {offset = 0, length = size base, base = unlift base}+  {-# INLINE toSliceMut #-}+  toSliceMut baseMut = do+    lengthMut <- sizeMut baseMut+    pure MutableSlice {offsetMut = 0, lengthMut, baseMut = unliftMut baseMut}+  {-# INLINE freeze_ #-}+  freeze_ = freezeSmallUnliftedArray+  {-# INLINE unsafeFreeze #-}+  unsafeFreeze = unsafeFreezeSmallUnliftedArray+  {-# INLINE size #-}+  size = sizeofSmallUnliftedArray+  {-# INLINE sizeMut #-}+  sizeMut = getSizeofSmallMutableUnliftedArray+  {-# INLINE thaw_ #-}+  thaw_ = thawSmallUnliftedArray+  {-# INLINE equals #-}+  equals = (==)+  {-# INLINE equalsMut #-}+  equalsMut = sameSmallMutableUnliftedArray+  {-# INLINE singleton #-}+  singleton a = runST $ do+    marr <- newSmallUnliftedArray 1 a+    unsafeFreezeSmallUnliftedArray marr+  {-# INLINE doubleton #-}+  doubleton a b = runST $ do+    m <- newSmallUnliftedArray 2 a+    writeSmallUnliftedArray m 1 b+    unsafeFreezeSmallUnliftedArray m+  {-# INLINE tripleton #-}+  tripleton a b c = runST $ do+    m <- newSmallUnliftedArray 3 a+    writeSmallUnliftedArray m 1 b+    writeSmallUnliftedArray m 2 c+    unsafeFreezeSmallUnliftedArray m+  {-# INLINE quadrupleton #-}+  quadrupleton a b c d = runST $ do+    m <- newSmallUnliftedArray 4 a+    writeSmallUnliftedArray m 1 b+    writeSmallUnliftedArray m 2 c+    writeSmallUnliftedArray m 3 d+    unsafeFreezeSmallUnliftedArray m+  {-# INLINE quintupleton #-}+  quintupleton a b c d e = runST $ do+    m <- newSmallUnliftedArray 5 a+    writeSmallUnliftedArray m 1 b+    writeSmallUnliftedArray m 2 c+    writeSmallUnliftedArray m 3 d+    writeSmallUnliftedArray m 4 e+    unsafeFreezeSmallUnliftedArray m+  {-# INLINE sextupleton #-}+  sextupleton a b c d e f = runST $ do+    m <- newSmallUnliftedArray 6 a+    writeSmallUnliftedArray m 1 b+    writeSmallUnliftedArray m 2 c+    writeSmallUnliftedArray m 3 d+    writeSmallUnliftedArray m 4 e+    writeSmallUnliftedArray m 5 f+    unsafeFreezeSmallUnliftedArray m+  {-# INLINE rnf #-}+  rnf !ary =+    let !sz = sizeofSmallUnliftedArray ary+        go !ix =+          if ix < sz+            then+              let !x = indexSmallUnliftedArray ary ix+               in DS.rnf x `seq` go (ix + 1)+            else ()+     in go 0+  {-# INLINE clone_ #-}+  clone_ = cloneSmallUnliftedArray+  {-# INLINE cloneMut_ #-}+  cloneMut_ = cloneSmallMutableUnliftedArray+  {-# INLINE copy_ #-}+  copy_ = copySmallUnliftedArray+  {-# INLINE copyMut_ #-}+  copyMut_ = copySmallMutableUnliftedArray+  {-# INLINE replicateMut #-}+  replicateMut = newSmallUnliftedArray+  {-# INLINE run #-}+  run = runSmallUnliftedArrayST+  {-# INLINE shrink #-}+  shrink !arr !n = do+    shrinkSmallMutableUnliftedArray arr n+    pure arr+  {-# INLINE unsafeShrinkAndFreeze #-}+  unsafeShrinkAndFreeze !arr !n = do+    shrinkSmallMutableUnliftedArray arr n+    unsafeFreezeSmallUnliftedArray arr+++newtype SmallUnliftedArray## (u :: TYPE UnliftedRep) (a :: Type)+  = SmallUnliftedArray## (Exts.SmallArray# u)+newtype SmallMutableUnliftedArray## (u :: TYPE UnliftedRep) s (a :: Type)+  = SmallMutableUnliftedArray## (Exts.SmallMutableArray# s u)++instance ContiguousU (SmallUnliftedArray_ unlifted_a) where+  type Unlifted (SmallUnliftedArray_ unlifted_a) = SmallUnliftedArray## unlifted_a+  type UnliftedMut (SmallUnliftedArray_ unlifted_a) = SmallMutableUnliftedArray## unlifted_a+  {-# INLINE resize #-}+  resize = resizeSmallUnliftedArray+  {-# INLINE unlift #-}+  unlift (SmallUnliftedArray (SmallUnliftedArray# x)) = SmallUnliftedArray## x+  {-# INLINE unliftMut #-}+  unliftMut (SmallMutableUnliftedArray (SmallMutableUnliftedArray# x)) = SmallMutableUnliftedArray## x+  {-# INLINE lift #-}+  lift (SmallUnliftedArray## x) = SmallUnliftedArray (SmallUnliftedArray# x)+  {-# INLINE liftMut #-}+  liftMut (SmallMutableUnliftedArray## x) = SmallMutableUnliftedArray (SmallMutableUnliftedArray# x)+++-- NOTE: Currently missing from the `run-st` library+-- c.f. https://github.com/byteverse/run-st/issues/5+runSmallUnliftedArrayST :: (forall s. ST s (SmallUnliftedArray_ unlifted_a a)) -> SmallUnliftedArray_ unlifted_a a+{-# INLINE runSmallUnliftedArrayST #-}+runSmallUnliftedArrayST f = SmallUnliftedArray (Exts.runRW# (\s0 -> case f of ST g -> case g s0 of (# _, SmallUnliftedArray r #) -> r))+ instance Contiguous PrimArray where   type Mutable PrimArray = MutablePrimArray   type Element PrimArray = Prim@@ -926,7 +1068,7 @@     lengthMut <- sizeMut baseMut     pure MutableSlice {offsetMut = 0, lengthMut, baseMut = unliftMut baseMut}   {-# INLINE freeze_ #-}-  freeze_ = freezePrimArrayShim+  freeze_ = freezePrimArray   {-# INLINE unsafeFreeze #-}   unsafeFreeze = unsafeFreezePrimArray   {-# INLINE thaw_ #-}@@ -936,9 +1078,9 @@   {-# INLINE copyMut_ #-}   copyMut_ = copyMutablePrimArray   {-# INLINE clone_ #-}-  clone_ = clonePrimArrayShim+  clone_ = clonePrimArray   {-# INLINE cloneMut_ #-}-  cloneMut_ = cloneMutablePrimArrayShim+  cloneMut_ = cloneMutablePrimArray   {-# INLINE equals #-}   equals = (==)   {-# INLINE null #-}@@ -1003,6 +1145,14 @@     unsafeFreeze dst   {-# INLINE run #-}   run = runPrimArrayST+  {-# INLINE shrink #-}+  shrink !arr !n = do+    shrinkMutablePrimArray arr n+    pure arr+  {-# INLINE unsafeShrinkAndFreeze #-}+  unsafeShrinkAndFreeze !arr !n = do+    shrinkMutablePrimArray arr n+    unsafeFreezePrimArray arr  newtype PrimArray# a = PrimArray# ByteArray# newtype MutablePrimArray# s a = MutablePrimArray# (MutableByteArray# s)@@ -1127,6 +1277,14 @@     unsafeFreezeArray m   {-# INLINE run #-}   run = runArrayST+  {-# INLINE shrink #-}+  shrink !arr !n = do+    -- See Note [Shrinking Arrays Without a Shrink Primop]+    cloneMutableArray arr 0 n+  {-# INLINE unsafeShrinkAndFreeze #-}+  unsafeShrinkAndFreeze !arr !n =+    -- See Note [Shrinking Arrays Without a Shrink Primop]+    freezeArray arr 0 n  instance ContiguousU Array where   type Unlifted Array = Array#@@ -1250,7 +1408,23 @@     unsafeFreezeUnliftedArray m   {-# INLINE run #-}   run = runUnliftedArrayST+  {-# INLINE shrink #-}+  shrink !arr !n = do+    -- See Note [Shrinking Arrays Without a Shrink Primop]+    cloneMutableUnliftedArray arr 0 n+  {-# INLINE unsafeShrinkAndFreeze #-}+  unsafeShrinkAndFreeze !arr !n =+    -- See Note [Shrinking Arrays Without a Shrink Primop]+    freezeUnliftedArray arr 0 n +-- Note [Shrinking Arrays Without a Shrink Primop]+-- ===============================================+-- GHC's Array# type has a card table and cannot currently be shrunk in place.+-- (SmallArray#, however, can be shrunk in place.) These implementations copy+-- the array rather than freezing it in place. But at least they are able to+-- avoid assigning all of the elements to a nonsense value before replacing+-- them with memcpy.+ newtype UnliftedArray## (u :: TYPE UnliftedRep) (a :: Type)   = UnliftedArray## (Exts.Array# u) newtype MutableUnliftedArray## (u :: TYPE UnliftedRep) s (a :: Type)@@ -1269,3 +1443,7 @@   lift (UnliftedArray## x) = UnliftedArray (UnliftedArray# x)   {-# INLINE liftMut #-}   liftMut (MutableUnliftedArray## x) = MutableUnliftedArray (MutableUnliftedArray# x)++resizeSmallMutableArrayUninitializedElement :: a+{-# noinline resizeSmallMutableArrayUninitializedElement #-}+resizeSmallMutableArrayUninitializedElement = errorWithoutStackTrace "uninitialized element of resizeSmallMutableArray"

@@ -4,19 +4,14 @@ module Data.Primitive.Contiguous.Shim   ( errorThunk   , resizeArray-  , resizeSmallArray-  , replicateSmallMutableArray   , resizeUnliftedArray+  , resizeSmallUnliftedArray   , replicateMutablePrimArray-  , clonePrimArrayShim-  , cloneMutablePrimArrayShim-  , freezePrimArrayShim   ) where -import Control.Monad (when)-import Control.Monad.ST.Run (runPrimArrayST)-import Data.Primitive hiding (fromList, fromListN)+import Data.Primitive import Data.Primitive.Unlifted.Array+import Data.Primitive.Unlifted.SmallArray import Prelude hiding (all, any, elem, filter, foldMap, foldl, foldr, map, mapM, mapM_, maximum, minimum, null, read, replicate, reverse, scanl, sequence, sequence_, traverse, zip, zipWith, (<$))  import Control.Monad.Primitive (PrimMonad (..), PrimState)@@ -28,39 +23,41 @@  resizeArray :: (PrimMonad m) => MutableArray (PrimState m) a -> Int -> m (MutableArray (PrimState m) a) resizeArray !src !sz = do-  dst <- newArray sz errorThunk-  copyMutableArray dst 0 src 0 (min sz (sizeofMutableArray src))-  pure dst+  let !srcSz = sizeofMutableArray src+  case compare sz srcSz of+    EQ -> pure src+    LT -> cloneMutableArray src 0 sz+    GT -> do+      dst <- newArray sz errorThunk+      copyMutableArray dst 0 src 0 srcSz+      pure dst {-# INLINE resizeArray #-} -resizeSmallArray :: (PrimMonad m) => SmallMutableArray (PrimState m) a -> Int -> m (SmallMutableArray (PrimState m) a)-resizeSmallArray !src !sz = do-  dst <- newSmallArray sz errorThunk-  copySmallMutableArray dst 0 src 0 (min sz (sizeofSmallMutableArray src))-  pure dst-{-# INLINE resizeSmallArray #-}--replicateSmallMutableArray ::-  (PrimMonad m) =>-  Int ->-  a ->-  m (SmallMutableArray (PrimState m) a)-replicateSmallMutableArray len a = do-  marr <- newSmallArray len errorThunk-  let go !ix = when (ix < len) $ do-        writeSmallArray marr ix a-        go (ix + 1)-  go 0-  pure marr-{-# INLINE replicateSmallMutableArray #-}- resizeUnliftedArray :: (PrimMonad m, PrimUnlifted a) => MutableUnliftedArray (PrimState m) a -> Int -> m (MutableUnliftedArray (PrimState m) a) resizeUnliftedArray !src !sz = do-  dst <- unsafeNewUnliftedArray sz-  copyMutableUnliftedArray dst 0 src 0 (min sz (sizeofMutableUnliftedArray src))-  pure dst+  let !srcSz = sizeofMutableUnliftedArray src+  case compare sz srcSz of+    EQ -> pure src+    LT -> cloneMutableUnliftedArray src 0 sz+    GT -> do+      dst <- unsafeNewUnliftedArray sz+      copyMutableUnliftedArray dst 0 src 0 srcSz+      pure dst {-# INLINE resizeUnliftedArray #-} +resizeSmallUnliftedArray :: (PrimMonad m, PrimUnlifted a) => SmallMutableUnliftedArray (PrimState m) a -> Int -> m (SmallMutableUnliftedArray (PrimState m) a)+resizeSmallUnliftedArray !src !sz = do+  srcSz <- getSizeofSmallMutableUnliftedArray src+  case compare sz srcSz of+    EQ -> pure src+    LT -> cloneSmallMutableUnliftedArray src 0 sz+    GT -> do+      dst <- unsafeNewSmallUnliftedArray sz+      copySmallMutableUnliftedArray dst 0 src 0 srcSz+      pure dst+{-# INLINE resizeSmallUnliftedArray #-}++ replicateMutablePrimArray ::   (PrimMonad m, Prim a) =>   -- | length@@ -73,24 +70,3 @@   setPrimArray marr 0 len a   pure marr {-# INLINE replicateMutablePrimArray #-}--clonePrimArrayShim :: (Prim a) => PrimArray a -> Int -> Int -> PrimArray a-clonePrimArrayShim !arr !off !len = runPrimArrayST $ do-  marr <- newPrimArray len-  copyPrimArray marr 0 arr off len-  unsafeFreezePrimArray marr-{-# INLINE clonePrimArrayShim #-}--cloneMutablePrimArrayShim :: (PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> Int -> Int -> m (MutablePrimArray (PrimState m) a)-cloneMutablePrimArrayShim !arr !off !len = do-  marr <- newPrimArray len-  copyMutablePrimArray marr 0 arr off len-  pure marr-{-# INLINE cloneMutablePrimArrayShim #-}--freezePrimArrayShim :: (PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> Int -> Int -> m (PrimArray a)-freezePrimArrayShim !src !off !len = do-  dst <- newPrimArray len-  copyMutablePrimArray dst 0 src off len-  unsafeFreezePrimArray dst-{-# INLINE freezePrimArrayShim #-}