comfort-array 0.2 → 0.3

raw patch · 17 files changed

+394/−337 lines, 17 filesdep ~guarded-allocationPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: guarded-allocation

API changes (from Hackage documentation)

Files

• Changes.md +11/−0
• comfort-array.cabal +7/−7
• src/Data/Array/Comfort/Boxed.hs +2/−2
• src/Data/Array/Comfort/Boxed/Internal.hs +0/−97
• src/Data/Array/Comfort/Boxed/Unchecked.hs +97/−0
• src/Data/Array/Comfort/Shape.hs +83/−57
• src/Data/Array/Comfort/Shape/Test.hs +5/−2
• src/Data/Array/Comfort/Storable.hs +8/−7
• src/Data/Array/Comfort/Storable/Internal.hs +0/−80
• src/Data/Array/Comfort/Storable/Internal/Monadic.hs +0/−30
• src/Data/Array/Comfort/Storable/Mutable.hs +8/−3
• src/Data/Array/Comfort/Storable/Mutable/Internal.hs +0/−28
• src/Data/Array/Comfort/Storable/Mutable/Private.hs +18/−18
• src/Data/Array/Comfort/Storable/Mutable/Unchecked.hs +29/−0
• src/Data/Array/Comfort/Storable/Private.hs +15/−6
• src/Data/Array/Comfort/Storable/Unchecked.hs +80/−0
• src/Data/Array/Comfort/Storable/Unchecked/Monadic.hs +31/−0

@@ -1,5 +1,16 @@ # Change log for the `comfort-array` package +## 0.3++ * `Storable.Mutable.Array`: Replace `ForeignPtr` by `Array.Guarded.MutablePtr`.+   In the last release we altered the arrays after initialization+   which corrupted the debugging by the `guarded-allocation` package.+   This should be fixed now.++ * `Shape.sizeOffset`: It does not return a single offset anymore+   but an offset computation function.+   This allows to cache a size computation across many offset computations.+ ## 0.2   * Add a monad parameter to the mutable `Storable` array type

@@ -1,5 +1,5 @@ Name:             comfort-array-Version:          0.2+Version:          0.3 License:          BSD3 License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -55,7 +55,7 @@   Changes.md  Source-Repository this-  Tag:         0.2+  Tag:         0.3   Type:        darcs   Location:    http://hub.darcs.net/thielema/comfort-array/ @@ -66,7 +66,7 @@ Library   Build-Depends:     primitive >=0.6.4 && <0.7,-    guarded-allocation >=0.0 && <0.1,+    guarded-allocation >=0.0.1 && <0.1,     storable-record >=0.0.1 && <0.1,     deepseq >=1.3 && <1.5,     QuickCheck >=2 && <3,@@ -82,15 +82,15 @@     Data.Array.Comfort.Shape     Data.Array.Comfort.Shape.Test     Data.Array.Comfort.Storable-    Data.Array.Comfort.Storable.Internal-    Data.Array.Comfort.Storable.Internal.Monadic+    Data.Array.Comfort.Storable.Unchecked+    Data.Array.Comfort.Storable.Unchecked.Monadic     Data.Array.Comfort.Storable.Private     Data.Array.Comfort.Storable.Mutable-    Data.Array.Comfort.Storable.Mutable.Internal+    Data.Array.Comfort.Storable.Mutable.Unchecked     Data.Array.Comfort.Storable.Mutable.Private     Data.Array.Comfort.Boxed   Other-Modules:-    Data.Array.Comfort.Boxed.Internal+    Data.Array.Comfort.Boxed.Unchecked  Test-Suite comfort-array-test   Type: exitcode-stdio-1.0

@@ -14,9 +14,9 @@    fromAssociations,    ) where -import qualified Data.Array.Comfort.Boxed.Internal as Array+import qualified Data.Array.Comfort.Boxed.Unchecked as Array import qualified Data.Array.Comfort.Shape as Shape-import Data.Array.Comfort.Boxed.Internal (Array(Array))+import Data.Array.Comfort.Boxed.Unchecked (Array(Array))  import qualified Data.Primitive.Array as Prim 

@@ -1,97 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-module Data.Array.Comfort.Boxed.Internal where--import qualified Data.Array.Comfort.Shape as Shape-import qualified Data.Primitive.Array as Prim--import qualified Control.Monad.ST.Strict as STStrict-import qualified Control.Monad.Trans.Class as MT-import qualified Control.Monad.Trans.State as MS-import Control.Monad (liftM)-import Control.Applicative ((<$>))-import Control.DeepSeq (NFData, rnf)--import qualified Data.Traversable as Trav-import qualified Data.Foldable as Fold-import qualified Data.List as List-import Prelude hiding (map, )---data Array sh a =-   Array {-      shape :: sh,-      buffer :: Prim.Array a-   }--instance (Shape.C sh, Show sh, Show a) => Show (Array sh a) where-   show arr =-      "BoxedArray.fromList " ++-      showsPrec 11 (shape arr) (' ' : show (toListLazy arr))---instance (Shape.C sh, NFData sh, NFData a) => NFData (Array sh a) where-   rnf a@(Array sh _arr) = rnf (sh, toListLazy a)--instance (Shape.C sh) => Functor (Array sh) where-   fmap = map--instance (Shape.C sh) => Fold.Foldable (Array sh) where-   fold = Fold.fold . buffer-   foldMap f = Fold.foldMap f . buffer-   foldl f a = Fold.foldl f a . buffer-   foldr f a = Fold.foldr f a . buffer-   foldl1 f = Fold.foldl1 f . buffer-   foldr1 f = Fold.foldr1 f . buffer--instance (Shape.C sh) => Trav.Traversable (Array sh) where-   traverse f (Array sh arr) = Array sh <$> Trav.traverse f arr-   sequenceA (Array sh arr) = Array sh <$> Trav.sequenceA arr-   mapM f (Array sh arr) = liftM (Array sh) $ Trav.mapM f arr-   sequence (Array sh arr) = liftM (Array sh) $ Trav.sequence arr----- add assertion, at least in an exposed version-reshape :: sh1 -> Array sh0 a -> Array sh1 a-reshape sh (Array _ arr) = Array sh arr--mapShape :: (sh0 -> sh1) -> Array sh0 a -> Array sh1 a-mapShape f (Array sh arr) = Array (f sh) arr---infixl 9 !--(!) :: (Shape.Indexed sh) => Array sh a -> Shape.Index sh -> a-(!) (Array sh arr) ix = Prim.indexArray arr $ Shape.offset sh ix--toListLazy :: (Shape.C sh) => Array sh a -> [a]-toListLazy (Array sh arr) =-   List.map (Prim.indexArray arr) $ take (Shape.size sh) [0..]--toList :: (Shape.C sh) => Array sh a -> [a]-toList (Array sh arr) =-   STStrict.runST (mapM (Prim.indexArrayM arr) $ take (Shape.size sh) [0..])--fromList :: (Shape.C sh) => sh -> [a] -> Array sh a-fromList sh xs = Array sh $ Prim.fromListN (Shape.size sh) xs--vectorFromList :: [a] -> Array (Shape.ZeroBased Int) a-vectorFromList xs =-   let arr = Prim.fromList xs-   in Array (Shape.ZeroBased $ Prim.sizeofArray arr) arr--map :: (Shape.C sh) => (a -> b) -> Array sh a -> Array sh b-map f (Array sh arr) = Array sh $ Prim.mapArray' f arr--zipWith ::-   (Shape.C sh) => (a -> b -> c) -> Array sh a -> Array sh b -> Array sh c-zipWith f (Array sha arra) (Array _shb arrb) =-   Array sha $-   STStrict.runST-      (flip MS.evalStateT 0 $-       Prim.traverseArrayP-         (\a -> do-            k <- MS.get-            b <- MT.lift $ Prim.indexArrayM arrb k-            MS.put (k+1)-            return $ f a b)-         arra)

@@ -0,0 +1,97 @@+{-# LANGUAGE TypeFamilies #-}+module Data.Array.Comfort.Boxed.Unchecked where++import qualified Data.Array.Comfort.Shape as Shape+import qualified Data.Primitive.Array as Prim++import qualified Control.Monad.ST.Strict as STStrict+import qualified Control.Monad.Trans.Class as MT+import qualified Control.Monad.Trans.State as MS+import Control.Monad (liftM)+import Control.Applicative ((<$>))+import Control.DeepSeq (NFData, rnf)++import qualified Data.Traversable as Trav+import qualified Data.Foldable as Fold+import qualified Data.List as List+import Prelude hiding (map, )+++data Array sh a =+   Array {+      shape :: sh,+      buffer :: Prim.Array a+   }++instance (Shape.C sh, Show sh, Show a) => Show (Array sh a) where+   show arr =+      "BoxedArray.fromList " +++      showsPrec 11 (shape arr) (' ' : show (toListLazy arr))+++instance (Shape.C sh, NFData sh, NFData a) => NFData (Array sh a) where+   rnf a@(Array sh _arr) = rnf (sh, toListLazy a)++instance (Shape.C sh) => Functor (Array sh) where+   fmap = map++instance (Shape.C sh) => Fold.Foldable (Array sh) where+   fold = Fold.fold . buffer+   foldMap f = Fold.foldMap f . buffer+   foldl f a = Fold.foldl f a . buffer+   foldr f a = Fold.foldr f a . buffer+   foldl1 f = Fold.foldl1 f . buffer+   foldr1 f = Fold.foldr1 f . buffer++instance (Shape.C sh) => Trav.Traversable (Array sh) where+   traverse f (Array sh arr) = Array sh <$> Trav.traverse f arr+   sequenceA (Array sh arr) = Array sh <$> Trav.sequenceA arr+   mapM f (Array sh arr) = liftM (Array sh) $ Trav.mapM f arr+   sequence (Array sh arr) = liftM (Array sh) $ Trav.sequence arr+++-- add assertion, at least in an exposed version+reshape :: sh1 -> Array sh0 a -> Array sh1 a+reshape sh (Array _ arr) = Array sh arr++mapShape :: (sh0 -> sh1) -> Array sh0 a -> Array sh1 a+mapShape f (Array sh arr) = Array (f sh) arr+++infixl 9 !++(!) :: (Shape.Indexed sh) => Array sh a -> Shape.Index sh -> a+(!) (Array sh arr) ix = Prim.indexArray arr $ Shape.uncheckedOffset sh ix++toListLazy :: (Shape.C sh) => Array sh a -> [a]+toListLazy (Array sh arr) =+   List.map (Prim.indexArray arr) $ take (Shape.size sh) [0..]++toList :: (Shape.C sh) => Array sh a -> [a]+toList (Array sh arr) =+   STStrict.runST (mapM (Prim.indexArrayM arr) $ take (Shape.size sh) [0..])++fromList :: (Shape.C sh) => sh -> [a] -> Array sh a+fromList sh xs = Array sh $ Prim.fromListN (Shape.size sh) xs++vectorFromList :: [a] -> Array (Shape.ZeroBased Int) a+vectorFromList xs =+   let arr = Prim.fromList xs+   in Array (Shape.ZeroBased $ Prim.sizeofArray arr) arr++map :: (Shape.C sh) => (a -> b) -> Array sh a -> Array sh b+map f (Array sh arr) = Array sh $ Prim.mapArray' f arr++zipWith ::+   (Shape.C sh) => (a -> b -> c) -> Array sh a -> Array sh b -> Array sh c+zipWith f (Array sha arra) (Array _shb arrb) =+   Array sha $+   STStrict.runST+      (flip MS.evalStateT 0 $+       Prim.traverseArrayP+         (\a -> do+            k <- MS.get+            b <- MT.lift $ Prim.indexArrayM arrb k+            MS.put (k+1)+            return $ f a b)+         arra)

@@ -14,7 +14,11 @@    Deferred(..), DeferredIndex, deferIndex, revealIndex,     (:+:)(..),-   Triangular(..), Lower(Lower), Upper(Upper), triangleSize, triangleRoot,++   Triangular(..), Lower(Lower), Upper(Upper),+   LowerTriangular, UpperTriangular,+   lowerTriangular, upperTriangular,+   triangleSize, triangleRoot,    ) where  import qualified Foreign.Storable.Newtype as Store@@ -35,7 +39,7 @@  import qualified Data.NonEmpty as NonEmpty import Data.List.HT (tails)-import Data.Tuple.HT (mapFst, mapPair, swap)+import Data.Tuple.HT (mapSnd, mapPair, swap, fst3, snd3, thd3)   class C sh where@@ -52,17 +56,17 @@    indices :: sh -> [Index sh]    -- Ix.index    offset :: sh -> Index sh -> Int-   offset sh ix = snd $ sizeOffset sh ix+   offset sh = snd $ sizeOffset sh    -- Ix.unsafeIndex    uncheckedOffset :: sh -> Index sh -> Int    uncheckedOffset = offset    -- Ix.inRange    inBounds :: sh -> Index sh -> Bool -   sizeOffset :: sh -> Index sh -> (Int,Int)-   sizeOffset sh ix = (size sh, offset sh ix)-   uncheckedSizeOffset :: sh -> Index sh -> (Int,Int)-   uncheckedSizeOffset sh ix = (uncheckedSize sh, uncheckedOffset sh ix)+   sizeOffset :: sh -> (Int, Index sh -> Int)+   sizeOffset sh = (size sh, offset sh)+   uncheckedSizeOffset :: sh -> (Int, Index sh -> Int)+   uncheckedSizeOffset sh = (uncheckedSize sh, uncheckedOffset sh)  class Indexed sh => InvIndexed sh where    {- |@@ -405,16 +409,22 @@ instance (Indexed sh0, Indexed sh1) => Indexed (sh0,sh1) where    type Index (sh0,sh1) = (Index sh0, Index sh1)    indices (sh0,sh1) = Monad.lift2 (,) (indices sh0) (indices sh1)-   offset (sh0,sh1) (ix0,ix1) =-      offset sh0 ix0 `combineOffset` sizeOffset sh1 ix1-   uncheckedOffset (sh0,sh1) (ix0,ix1) =-      uncheckedOffset sh0 ix0 `combineOffset` uncheckedSizeOffset sh1 ix1-   sizeOffset (sh0,sh1) (ix0,ix1) =-      sizeOffset sh0 ix0 `combineSizeOffset` sizeOffset sh1 ix1-   uncheckedSizeOffset (sh0,sh1) (ix0,ix1) =-      uncheckedSizeOffset sh0 ix0+   offset (sh0,sh1) =+      offset sh0 . fst+      `combineOffset`+      mapSnd (.snd) (sizeOffset sh1)+   uncheckedOffset (sh0,sh1) =+      uncheckedOffset sh0 . fst+      `combineOffset`+      mapSnd (.snd) (uncheckedSizeOffset sh1)+   sizeOffset (sh0,sh1) =+      mapSnd (.fst) (sizeOffset sh0)       `combineSizeOffset`-      uncheckedSizeOffset sh1 ix1+      mapSnd (.snd) (sizeOffset sh1)+   uncheckedSizeOffset (sh0,sh1) =+      mapSnd (.fst) (uncheckedSizeOffset sh0)+      `combineSizeOffset`+      mapSnd (.snd) (uncheckedSizeOffset sh1)    inBounds (sh0,sh1) (ix0,ix1) = inBounds sh0 ix0 && inBounds sh1 ix1  instance (InvIndexed sh0, InvIndexed sh1) => InvIndexed (sh0,sh1) where@@ -433,24 +443,24 @@    type Index (sh0,sh1,sh2) = (Index sh0, Index sh1, Index sh2)    indices (sh0,sh1,sh2) =       Monad.lift3 (,,) (indices sh0) (indices sh1) (indices sh2)-   uncheckedOffset (sh0,sh1,sh2) (ix0,ix1,ix2) =-      uncheckedOffset sh0 ix0+   uncheckedOffset (sh0,sh1,sh2) =+      uncheckedOffset sh0 . fst3       `combineOffset`-      uncheckedSizeOffset sh1 ix1+      mapSnd (.snd3) (uncheckedSizeOffset sh1)       `combineSizeOffset`-      uncheckedSizeOffset sh2 ix2-   sizeOffset (sh0,sh1,sh2) (ix0,ix1,ix2) =-      sizeOffset sh0 ix0+      mapSnd (.thd3) (uncheckedSizeOffset sh2)+   sizeOffset (sh0,sh1,sh2) =+      mapSnd (.fst3) (sizeOffset sh0)       `combineSizeOffset`-      sizeOffset sh1 ix1+      mapSnd (.snd3) (sizeOffset sh1)       `combineSizeOffset`-      sizeOffset sh2 ix2-   uncheckedSizeOffset (sh0,sh1,sh2) (ix0,ix1,ix2) =-      uncheckedSizeOffset sh0 ix0+      mapSnd (.thd3) (sizeOffset sh2)+   uncheckedSizeOffset (sh0,sh1,sh2) =+      mapSnd (.fst3) (uncheckedSizeOffset sh0)       `combineSizeOffset`-      uncheckedSizeOffset sh1 ix1+      mapSnd (.snd3) (uncheckedSizeOffset sh1)       `combineSizeOffset`-      uncheckedSizeOffset sh2 ix2+      mapSnd (.thd3) (uncheckedSizeOffset sh2)    inBounds (sh0,sh1,sh2) (ix0,ix1,ix2) =       inBounds sh0 ix0 && inBounds sh1 ix1 && inBounds sh2 ix2 @@ -487,13 +497,13 @@ infixr 7 `combineOffset`, `combineSizeOffset`  {-# INLINE combineOffset #-}-combineOffset :: Num a => a -> (a, a) -> a-combineOffset offset0 (size1,offset1) = offset0 * size1 + offset1+combineOffset :: Num a => (ix -> a) -> (a, ix -> a) -> ix -> a+combineOffset offset0 (size1,offset1) ix = offset0 ix * size1 + offset1 ix  {-# INLINE combineSizeOffset #-}-combineSizeOffset :: Num a => (a, a) -> (a, a) -> (a, a)+combineSizeOffset :: Num a => (a, ix -> a) -> (a, ix -> a) -> (a, ix -> a) combineSizeOffset (size0,offset0) (size1,offset1) =-   (size0*size1, offset0 * size1 + offset1)+   (size0*size1, \ix -> offset0 ix * size1 + offset1 ix)   @@ -518,6 +528,15 @@       triangularSize :: size    } deriving (Eq, Show) +type LowerTriangular = Triangular Lower+type UpperTriangular = Triangular Upper++lowerTriangular :: size -> LowerTriangular size+lowerTriangular = Triangular Lower++upperTriangular :: size -> UpperTriangular size+upperTriangular = Triangular Upper+ -- cf. Data.Bifunctor.Flip newtype Flip f b a = Flip {getFlip :: f a b} @@ -546,26 +565,37 @@                (NonEmpty.tail $ NonEmpty.inits ixs) ixs)             (zipWith (\r cs -> map ((,) r) cs) ixs $ tails ixs) -   uncheckedOffset sh ix = snd $ uncheckedSizeOffset sh ix+   uncheckedOffset sh = snd $ uncheckedSizeOffset sh -   sizeOffset sh ix =-      if inBounds sh ix-        then uncheckedSizeOffset sh ix-        else error "Shape.Triangular.sizeOffset: wrong array part"+   sizeOffset (Triangular part sz) =+      let (n, getOffset) = sizeOffset sz+      in (triangleSize n, \(rs,cs) ->+            let r = getOffset rs+                c = getOffset cs+            in if compareIndices part r c+                  then triangleOffset part n (r,c)+                  else error "Shape.Triangular.sizeOffset: wrong array part") -   uncheckedSizeOffset (Triangular part sz) (rs,cs) =-      let (n,r) = uncheckedSizeOffset sz rs-          c = uncheckedOffset sz cs-      in (triangleSize n,-          caseTriangularPart part-            (triangleSize r + c)-            (triangleSize n - triangleSize (n-r) + c-r))+   uncheckedSizeOffset (Triangular part sz) =+      let (n, getOffset) = uncheckedSizeOffset sz+      in (triangleSize n, \(rs,cs) ->+            triangleOffset part n (getOffset rs, getOffset cs))     inBounds (Triangular part sz) ix@(r,c) =       inBounds (sz,sz) ix       &&-      caseTriangularPart part (>=) (<=) (offset sz r) (offset sz c)+      let getOffset = offset sz+      in compareIndices part (getOffset r) (getOffset c) +triangleOffset :: TriangularPart part => part -> Int -> (Int, Int) -> Int+triangleOffset part n (r,c) =+   caseTriangularPart part+      (triangleSize r + c)+      (triangleSize n - triangleSize (n-r) + c-r)++compareIndices :: (TriangularPart part, Ord a) => part -> a -> a -> Bool+compareIndices part = caseTriangularPart part (>=) (<=)+ instance    (TriangularPart part, InvIndexed size) =>       InvIndexed (Triangular part size) where@@ -621,18 +651,14 @@       case ix of          Left ix0 -> uncheckedOffset sh0 ix0          Right ix1 -> uncheckedSize sh0 + uncheckedOffset sh1 ix1-   sizeOffset (sh0:+:sh1) ix =-      case ix of-         Left ix0 -> mapFst (+ size sh1) $ sizeOffset sh0 ix0-         Right ix1 ->-            let size0 = size sh0-            in  mapPair ((size0+), (size0+)) $ sizeOffset sh1 ix1-   uncheckedSizeOffset (sh0:+:sh1) ix =-      case ix of-         Left ix0 -> mapFst (+ uncheckedSize sh1) $ uncheckedSizeOffset sh0 ix0-         Right ix1 ->-            let size0 = uncheckedSize sh0-            in  mapPair ((size0+), (size0+)) $ uncheckedSizeOffset sh1 ix1+   sizeOffset (sh0:+:sh1) =+      let (n0, getOffset0) = sizeOffset sh0+          (n1, getOffset1) = sizeOffset sh1+      in (n0+n1, either getOffset0 ((n0+) . getOffset1))+   uncheckedSizeOffset (sh0:+:sh1) =+      let (n0, getOffset0) = uncheckedSizeOffset sh0+          (n1, getOffset1) = uncheckedSizeOffset sh1+      in (n0+n1, either getOffset0 ((n0+) . getOffset1))    inBounds (sh0:+:sh1) = either (inBounds sh0) (inBounds sh1)  instance (InvIndexed sh0, InvIndexed sh1) => InvIndexed (sh0:+:sh1) where

@@ -2,6 +2,7 @@ module Data.Array.Comfort.Shape.Test (tests) where  import qualified Data.Array.Comfort.Shape as Shape+import Data.Tuple.HT (mapSnd)  import qualified Test.QuickCheck as QC @@ -24,13 +25,15 @@    (Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) => sh -> QC.Property sizeOffset sh =    forAllIndices sh $ \ix ->-      Shape.sizeOffset sh ix == (Shape.size sh, Shape.offset sh ix)+      mapSnd ($ix) (Shape.sizeOffset sh)+      ==+      (Shape.size sh, Shape.offset sh ix)  uncheckedSizeOffset ::    (Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) => sh -> QC.Property uncheckedSizeOffset sh =    forAllIndices sh $ \ix ->-      Shape.uncheckedSizeOffset sh ix ==+      mapSnd ($ix) (Shape.uncheckedSizeOffset sh) ==          (Shape.uncheckedSize sh, Shape.uncheckedOffset sh ix)  uncheckedOffset ::

@@ -16,10 +16,11 @@    fromAssociations,    ) where -import qualified Data.Array.Comfort.Storable.Mutable.Internal as MutArray-import qualified Data.Array.Comfort.Storable.Internal as Array+import qualified Data.Array.Comfort.Storable.Mutable.Unchecked as MutArrayNC+import qualified Data.Array.Comfort.Storable.Mutable as MutArray+import qualified Data.Array.Comfort.Storable.Unchecked as Array import qualified Data.Array.Comfort.Shape as Shape-import Data.Array.Comfort.Storable.Internal (Array)+import Data.Array.Comfort.Storable.Unchecked (Array)  import Foreign.Storable (Storable) @@ -56,7 +57,7 @@  (!) :: (Shape.Indexed sh, Storable a) => Array sh a -> Shape.Index sh -> a (!) arr ix = runST (do-   marr <- MutArray.unsafeThaw arr+   marr <- MutArrayNC.unsafeThaw arr    MutArray.read marr ix)  @@ -66,7 +67,7 @@ (//) arr xs = runST (do    marr <- MutArray.thaw arr    forM_ xs $ uncurry $ MutArray.write marr-   MutArray.unsafeFreeze marr)+   MutArrayNC.unsafeFreeze marr)  accumulate ::    (Shape.Indexed sh, Storable a) =>@@ -74,7 +75,7 @@ accumulate f arr xs = runST (do    marr <- MutArray.thaw arr    forM_ xs $ \(ix,b) -> MutArray.update marr ix $ flip f b-   MutArray.unsafeFreeze marr)+   MutArrayNC.unsafeFreeze marr)  fromAssociations ::    (Shape.Indexed sh, Storable a) =>@@ -82,4 +83,4 @@ fromAssociations sh a xs = runST (do    marr <- MutArray.new sh a    forM_ xs $ uncurry $ MutArray.write marr-   MutArray.unsafeFreeze marr)+   MutArrayNC.unsafeFreeze marr)

@@ -1,80 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-{- |-The functions in this module miss any bound checking.--}-module Data.Array.Comfort.Storable.Internal (-   Priv.Array(Array, shape, buffer),-   Priv.reshape,-   Priv.mapShape,--   (Priv.!),-   unsafeCreate,-   unsafeCreateWithSize,-   unsafeCreateWithSizeAndResult,-   Priv.toList,-   Priv.fromList,-   Priv.vectorFromList,--   map,-   mapWithIndex,-   (Priv.//),-   Priv.accumulate,-   Priv.fromAssociations,-   ) where--import qualified Data.Array.Comfort.Storable.Internal.Monadic as Monadic-import qualified Data.Array.Comfort.Storable.Private as Priv-import qualified Data.Array.Comfort.Shape as Shape-import Data.Array.Comfort.Storable.Private (Array(Array))--import Foreign.Marshal.Array (advancePtr)-import Foreign.Storable (Storable, poke, peek)-import Foreign.ForeignPtr (withForeignPtr)-import Foreign.Ptr (Ptr)--import Control.Monad.ST (runST)--import Prelude hiding (map)---unsafeCreate ::-   (Shape.C sh, Storable a) =>-   sh -> (Ptr a -> IO ()) -> Array sh a-unsafeCreate sh arr = runST (Monadic.unsafeCreate sh arr)--unsafeCreateWithSize ::-   (Shape.C sh, Storable a) =>-   sh -> (Int -> Ptr a -> IO ()) -> Array sh a-unsafeCreateWithSize sh arr = runST (Monadic.unsafeCreateWithSize sh arr)--unsafeCreateWithSizeAndResult ::-   (Shape.C sh, Storable a) =>-   sh -> (Int -> Ptr a -> IO b) -> (Array sh a, b)-unsafeCreateWithSizeAndResult sh arr =-   runST (Monadic.unsafeCreateWithSizeAndResult sh arr)---map ::-   (Shape.C sh, Storable a, Storable b) =>-   (a -> b) -> Array sh a -> Array sh b-map f (Array sh a) =-   unsafeCreate sh $ \dstPtr ->-   withForeignPtr a $ \srcPtr ->-   sequence_ $ take (Shape.size sh) $-      zipWith-         (\src dst -> poke dst . f =<< peek src)-         (iterate (flip advancePtr 1) srcPtr)-         (iterate (flip advancePtr 1) dstPtr)--mapWithIndex ::-   (Shape.Indexed sh, Shape.Index sh ~ ix, Storable a, Storable b) =>-   (ix -> a -> b) -> Array sh a -> Array sh b-mapWithIndex f (Array sh a) =-   unsafeCreate sh $ \dstPtr ->-   withForeignPtr a $ \srcPtr ->-   sequence_ $-      zipWith3-         (\ix src dst -> poke dst . f ix =<< peek src)-         (Shape.indices sh)-         (iterate (flip advancePtr 1) srcPtr)-         (iterate (flip advancePtr 1) dstPtr)

@@ -1,30 +0,0 @@-module Data.Array.Comfort.Storable.Internal.Monadic where--import qualified Data.Array.Comfort.Storable.Mutable.Private as MutArray-import qualified Data.Array.Comfort.Shape as Shape-import Data.Array.Comfort.Storable.Private (Array, unsafeFreeze)--import Foreign.Storable (Storable, )-import Foreign.Ptr (Ptr, )--import Control.Monad.Primitive (PrimMonad)-import Control.Monad.HT ((<=<))---unsafeCreate ::-   (PrimMonad m, Shape.C sh, Storable a) =>-   sh -> (Ptr a -> IO ()) -> m (Array sh a)-unsafeCreate sh = unsafeFreeze <=< MutArray.unsafeCreate sh--unsafeCreateWithSize ::-   (PrimMonad m, Shape.C sh, Storable a) =>-   sh -> (Int -> Ptr a -> IO ()) -> m (Array sh a)-unsafeCreateWithSize sh = unsafeFreeze <=< MutArray.unsafeCreateWithSize sh--unsafeCreateWithSizeAndResult ::-   (PrimMonad m, Shape.C sh, Storable a) =>-   sh -> (Int -> Ptr a -> IO b) -> m (Array sh a, b)-unsafeCreateWithSizeAndResult sh f = do-   (arr, b) <- MutArray.unsafeCreateWithSizeAndResult sh f-   marr <- unsafeFreeze arr-   return (marr, b)

@@ -16,10 +16,11 @@    MutArray.freeze,    ) where -import qualified Data.Array.Comfort.Storable.Mutable.Internal as MutArray+import qualified Data.Array.Comfort.Storable.Mutable.Unchecked as MutArray import qualified Data.Array.Comfort.Shape as Shape-import Data.Array.Comfort.Storable.Mutable.Internal (Array)+import Data.Array.Comfort.Storable.Mutable.Unchecked (Array) +import Foreign.Marshal.Array (pokeArray) import Foreign.Storable (Storable)  import Control.Monad.Primitive (PrimMonad)@@ -60,7 +61,11 @@  fromList ::    (PrimMonad m, Shape.C sh, Storable a) => sh -> [a] -> m (Array m sh a)-fromList = MutArray.fromList+fromList sh xs =+   MutArray.unsafeCreateWithSize sh $ \size ptr ->+      pokeArray ptr $ take size $+      xs +++      repeat (error "Array.Comfort.Storable.fromList: list too short for shape")  vectorFromList ::    (PrimMonad m, Storable a) => [a] -> m (Array m (Shape.ZeroBased Int) a)

@@ -1,28 +0,0 @@-{- |-The functions in this module miss any bound checking.--}-module Data.Array.Comfort.Storable.Mutable.Internal (-   MutArray.Array(Array, shape, buffer),-   MutArray.STArray,-   MutArray.IOArray,-   MutArray.new,-   MutArray.copy,-   MutArray.create,-   MutArray.createWithSize,-   MutArray.createWithSizeAndResult,-   MutArray.unsafeCreate,-   MutArray.unsafeCreateWithSize,-   MutArray.unsafeCreateWithSizeAndResult,-   MutArray.read,-   MutArray.write,-   MutArray.update,-   MutArray.toList,-   MutArray.fromList,-   MutArray.vectorFromList,--   ImmArray.freeze, ImmArray.unsafeFreeze,-   ImmArray.thaw, ImmArray.unsafeThaw,-   ) where--import qualified Data.Array.Comfort.Storable.Private as ImmArray-import qualified Data.Array.Comfort.Storable.Mutable.Private as MutArray

@@ -6,7 +6,6 @@ import qualified Foreign.Marshal.Array.Guarded as Alloc import Foreign.Marshal.Array (copyArray, pokeArray, peekArray) import Foreign.Storable (Storable, pokeElemOff, peekElemOff)-import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) import Foreign.Ptr (Ptr)  import Control.Monad.Primitive (PrimMonad, unsafeIOToPrim)@@ -23,7 +22,7 @@ data Array (m :: * -> *) sh a =    Array {       shape :: sh,-      buffer :: ForeignPtr a+      buffer :: Alloc.MutablePtr a    }  type STArray s = Array (ST s)@@ -35,7 +34,7 @@    Array m sh a -> m (Array m sh a) copy (Array sh srcFPtr) =    unsafeCreateWithSize sh $ \n dstPtr ->-   withForeignPtr srcFPtr $ \srcPtr ->+   Alloc.withMutablePtr srcFPtr $ \srcPtr ->       copyArray dstPtr srcPtr n  @@ -53,9 +52,11 @@ createWithSizeAndResult ::    (Shape.C sh, Storable a) =>    sh -> (Int -> Ptr a -> IO b) -> IO (IOArray sh a, b)-createWithSizeAndResult sh f =+createWithSizeAndResult sh f = do    let size = Shape.size sh-   in fmap (mapFst (Array sh)) $ Alloc.create size $ f size+   mfptr <- Alloc.new size+   b <- Alloc.withMutablePtr mfptr $ f size+   return (Array sh mfptr, b)   unsafeCreate ::@@ -88,42 +89,41 @@    return $       "StorableArray.fromList " ++ showsPrec 11 (shape arr) (' ' : P.show xs) +withArrayPtr :: (PrimMonad m) => Alloc.MutablePtr a -> (Ptr a -> IO b) -> m b+withArrayPtr fptr = unsafeIOToPrim . Alloc.withMutablePtr fptr++withPtr :: (PrimMonad m) => Array m sh a -> (Ptr a -> IO b) -> m b+withPtr (Array _sh fptr) = withArrayPtr fptr+ read ::    (PrimMonad m, Shape.Indexed sh, Storable a) =>    Array m sh a -> Shape.Index sh -> m a read (Array sh fptr) ix =-   unsafeIOToPrim $ withForeignPtr fptr $ flip peekElemOff (Shape.offset sh ix)+   withArrayPtr fptr $ flip peekElemOff (Shape.uncheckedOffset sh ix)  write ::    (PrimMonad m, Shape.Indexed sh, Storable a) =>    Array m sh a -> Shape.Index sh -> a -> m () write (Array sh fptr) ix a =-   unsafeIOToPrim $-   withForeignPtr fptr $ \ptr -> pokeElemOff ptr (Shape.offset sh ix) a+   withArrayPtr fptr $ \ptr -> pokeElemOff ptr (Shape.uncheckedOffset sh ix) a  update ::    (PrimMonad m, Shape.Indexed sh, Storable a) =>    Array m sh a -> Shape.Index sh -> (a -> a) -> m () update (Array sh fptr) ix f =-   unsafeIOToPrim $-   let k = Shape.offset sh ix-   in withForeignPtr fptr $ \ptr -> pokeElemOff ptr k . f =<< peekElemOff ptr k+   let k = Shape.uncheckedOffset sh ix+   in withArrayPtr fptr $ \ptr -> pokeElemOff ptr k . f =<< peekElemOff ptr k  new :: (PrimMonad m, Shape.C sh, Storable a) => sh -> a -> m (Array m sh a) new sh x =    unsafeCreateWithSize sh $ \size ptr -> pokeArray ptr $ replicate size x  toList :: (PrimMonad m, Shape.C sh, Storable a) => Array m sh a -> m [a]-toList (Array sh fptr) =-   unsafeIOToPrim $ withForeignPtr fptr $ peekArray (Shape.size sh)+toList (Array sh fptr) = withArrayPtr fptr $ peekArray (Shape.size sh)  fromList ::    (PrimMonad m, Shape.C sh, Storable a) => sh -> [a] -> m (Array m sh a)-fromList sh xs =-   unsafeCreateWithSize sh $ \size ptr ->-      pokeArray ptr $ take size $-      xs ++-      repeat (error "Array.Comfort.Storable.fromList: list too short for shape")+fromList sh xs = unsafeCreate sh $ \ptr -> pokeArray ptr xs  vectorFromList ::    (PrimMonad m, Storable a) => [a] -> m (Array m (Shape.ZeroBased Int) a)

@@ -0,0 +1,29 @@+{- |+The functions in this module miss any bound checking.+-}+module Data.Array.Comfort.Storable.Mutable.Unchecked (+   MutArray.Array(Array, shape, buffer),+   MutArray.STArray,+   MutArray.IOArray,+   MutArray.new,+   MutArray.copy,+   MutArray.create,+   MutArray.createWithSize,+   MutArray.createWithSizeAndResult,+   MutArray.unsafeCreate,+   MutArray.unsafeCreateWithSize,+   MutArray.unsafeCreateWithSizeAndResult,+   MutArray.withPtr,+   MutArray.read,+   MutArray.write,+   MutArray.update,+   MutArray.toList,+   MutArray.fromList,+   MutArray.vectorFromList,++   ImmArray.freeze, ImmArray.unsafeFreeze,+   ImmArray.thaw, ImmArray.unsafeThaw,+   ) where++import qualified Data.Array.Comfort.Storable.Private as ImmArray+import qualified Data.Array.Comfort.Storable.Mutable.Private as MutArray

@@ -4,13 +4,14 @@ import qualified Data.Array.Comfort.Storable.Mutable.Private as MutArray import qualified Data.Array.Comfort.Shape as Shape +import qualified Foreign.Marshal.Array.Guarded as Alloc import Foreign.Storable (Storable, ) import Foreign.ForeignPtr (ForeignPtr, )  import Control.DeepSeq (NFData, rnf)-import Control.Monad.Primitive (PrimMonad)+import Control.Monad.Primitive (PrimMonad, unsafeIOToPrim) import Control.Monad.ST (runST)-import Control.Monad.HT ((<=<))+import Control.Monad (liftM)  import Data.Foldable (forM_) @@ -77,19 +78,27 @@ freeze ::    (PrimMonad m, Shape.C sh, Storable a) =>    MutArray.Array m sh a -> m (Array sh a)-freeze = unsafeFreeze <=< MutArray.copy+freeze (MutArray.Array sh fptr) =+   unsafeIOToPrim $+   liftM (Array sh) $ Alloc.freeze (Shape.size sh) fptr  thaw ::    (PrimMonad m, Shape.C sh, Storable a) =>    Array sh a -> m (MutArray.Array m sh a)-thaw = MutArray.copy <=< unsafeThaw+thaw (Array sh fptr) =+   unsafeIOToPrim $+   liftM (MutArray.Array sh) $ Alloc.thaw (Shape.size sh) fptr  unsafeFreeze ::    (PrimMonad m, Shape.C sh, Storable a) =>    MutArray.Array m sh a -> m (Array sh a)-unsafeFreeze (MutArray.Array sh fptr) = return (Array sh fptr)+unsafeFreeze (MutArray.Array sh fptr) =+   unsafeIOToPrim $+   liftM (Array sh) $ Alloc.freezeInplace (Shape.size sh) fptr  unsafeThaw ::    (PrimMonad m, Shape.C sh, Storable a) =>    Array sh a -> m (MutArray.Array m sh a)-unsafeThaw (Array sh fptr) = return (MutArray.Array sh fptr)+unsafeThaw (Array sh fptr) =+   unsafeIOToPrim $+   liftM (MutArray.Array sh) $ Alloc.thawInplace (Shape.size sh) fptr

@@ -0,0 +1,80 @@+{-# LANGUAGE TypeFamilies #-}+{- |+The functions in this module miss any bound checking.+-}+module Data.Array.Comfort.Storable.Unchecked (+   Priv.Array(Array, shape, buffer),+   Priv.reshape,+   Priv.mapShape,++   (Priv.!),+   unsafeCreate,+   unsafeCreateWithSize,+   unsafeCreateWithSizeAndResult,+   Priv.toList,+   Priv.fromList,+   Priv.vectorFromList,++   map,+   mapWithIndex,+   (Priv.//),+   Priv.accumulate,+   Priv.fromAssociations,+   ) where++import qualified Data.Array.Comfort.Storable.Unchecked.Monadic as Monadic+import qualified Data.Array.Comfort.Storable.Private as Priv+import qualified Data.Array.Comfort.Shape as Shape+import Data.Array.Comfort.Storable.Private (Array(Array))++import Foreign.Marshal.Array (advancePtr)+import Foreign.Storable (Storable, poke, peek)+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Ptr (Ptr)++import Control.Monad.ST (runST)++import Prelude hiding (map)+++unsafeCreate ::+   (Shape.C sh, Storable a) =>+   sh -> (Ptr a -> IO ()) -> Array sh a+unsafeCreate sh arr = runST (Monadic.unsafeCreate sh arr)++unsafeCreateWithSize ::+   (Shape.C sh, Storable a) =>+   sh -> (Int -> Ptr a -> IO ()) -> Array sh a+unsafeCreateWithSize sh arr = runST (Monadic.unsafeCreateWithSize sh arr)++unsafeCreateWithSizeAndResult ::+   (Shape.C sh, Storable a) =>+   sh -> (Int -> Ptr a -> IO b) -> (Array sh a, b)+unsafeCreateWithSizeAndResult sh arr =+   runST (Monadic.unsafeCreateWithSizeAndResult sh arr)+++map ::+   (Shape.C sh, Storable a, Storable b) =>+   (a -> b) -> Array sh a -> Array sh b+map f (Array sh a) =+   unsafeCreate sh $ \dstPtr ->+   withForeignPtr a $ \srcPtr ->+   sequence_ $ take (Shape.size sh) $+      zipWith+         (\src dst -> poke dst . f =<< peek src)+         (iterate (flip advancePtr 1) srcPtr)+         (iterate (flip advancePtr 1) dstPtr)++mapWithIndex ::+   (Shape.Indexed sh, Shape.Index sh ~ ix, Storable a, Storable b) =>+   (ix -> a -> b) -> Array sh a -> Array sh b+mapWithIndex f (Array sh a) =+   unsafeCreate sh $ \dstPtr ->+   withForeignPtr a $ \srcPtr ->+   sequence_ $+      zipWith3+         (\ix src dst -> poke dst . f ix =<< peek src)+         (Shape.indices sh)+         (iterate (flip advancePtr 1) srcPtr)+         (iterate (flip advancePtr 1) dstPtr)

@@ -0,0 +1,31 @@+module Data.Array.Comfort.Storable.Unchecked.Monadic where++import qualified Data.Array.Comfort.Shape as Shape+import Data.Array.Comfort.Storable.Private (Array(Array))++import Foreign.Storable (Storable, )+import Foreign.Ptr (Ptr, )++import qualified Foreign.Marshal.Array.Guarded as Alloc+import Control.Monad.Primitive (PrimMonad, unsafeIOToPrim)+import Control.Monad (liftM)++import Data.Tuple.HT (mapFst)+++unsafeCreate ::+   (PrimMonad m, Shape.C sh, Storable a) =>+   sh -> (Ptr a -> IO ()) -> m (Array sh a)+unsafeCreate sh f = unsafeCreateWithSize sh $ const f++unsafeCreateWithSize ::+   (PrimMonad m, Shape.C sh, Storable a) =>+   sh -> (Int -> Ptr a -> IO ()) -> m (Array sh a)+unsafeCreateWithSize sh f = liftM fst $ unsafeCreateWithSizeAndResult sh f++unsafeCreateWithSizeAndResult ::+   (PrimMonad m, Shape.C sh, Storable a) =>+   sh -> (Int -> Ptr a -> IO b) -> m (Array sh a, b)+unsafeCreateWithSizeAndResult sh f = unsafeIOToPrim $+   let size = Shape.size sh+   in fmap (mapFst (Array sh)) $ Alloc.create size $ f size