comfort-array 0.1.1 → 0.1.2

raw patch · 8 files changed

+225/−4 lines, 8 filesdep +primitivedep +storable-recordPVP ok

version bump matches the API change (PVP)

Dependencies added: primitive, storable-record

API changes (from Hackage documentation)

Files

• comfort-array.cabal +9/−2
• src/Data/Array/Comfort/Boxed.hs +16/−0
• src/Data/Array/Comfort/Boxed/Internal.hs +44/−0
• src/Data/Array/Comfort/Shape.hs +25/−0
• src/Data/Array/Comfort/Storable.hs +1/−0
• src/Data/Array/Comfort/Storable/Internal.hs +20/−2
• src/Data/Array/Comfort/Storable/Mutable.hs +13/−0
• src/Data/Array/Comfort/Storable/Mutable/Internal.hs +97/−0

@@ -1,5 +1,5 @@ Name:             comfort-array-Version:          0.1.1+Version:          0.1.2 License:          BSD3 License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -53,7 +53,7 @@ Build-Type:       Simple  Source-Repository this-  Tag:         0.1.1+  Tag:         0.1.2   Type:        darcs   Location:    http://hub.darcs.net/thielema/comfort-array/ @@ -63,7 +63,9 @@  Library   Build-Depends:+    primitive >=0.6.4 && <0.7,     guarded-allocation >=0.0 && <0.1,+    storable-record >=0.0.1 && <0.1,     QuickCheck >=2 && <3,     transformers >=0.3 && <0.6,     utility-ht >=0.0.10 && <0.1,@@ -77,6 +79,11 @@     Data.Array.Comfort.Shape.Test     Data.Array.Comfort.Storable     Data.Array.Comfort.Storable.Internal+    Data.Array.Comfort.Storable.Mutable+    Data.Array.Comfort.Boxed+  Other-Modules:+    Data.Array.Comfort.Storable.Mutable.Internal+    Data.Array.Comfort.Boxed.Internal  Test-Suite comfort-array-test   Type: exitcode-stdio-1.0

@@ -0,0 +1,16 @@+{-# LANGUAGE TypeFamilies #-}+module Data.Array.Comfort.Boxed (+   Array.Array,+   shape,+   (Array.!),+   Array.toList,+   Array.fromList,+   Array.vectorFromList,++   Array.map,+   ) where++import qualified Data.Array.Comfort.Boxed.Internal as Array++shape :: Array.Array sh a -> sh+shape = Array.shape

@@ -0,0 +1,44 @@+{-# 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 Prelude hiding (map, )+++data Array sh a =+   Array {+      shape :: sh,+      buffer :: Prim.Array a+   }++-- 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++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

@@ -13,6 +13,7 @@    (:+:)(..),    ) where +import qualified Foreign.Storable.Newtype as Store import Foreign.Storable          (Storable, sizeOf, alignment, poke, peek, pokeElemOff, peekElemOff) import Foreign.Ptr (Ptr, castPtr)@@ -92,6 +93,15 @@ newtype ZeroBased n = ZeroBased {zeroBasedSize :: n}    deriving (Eq, Show) +instance Functor ZeroBased where+   fmap f (ZeroBased n) = ZeroBased $ f n++instance (Storable n) => Storable (ZeroBased n) where+   sizeOf = Store.sizeOf zeroBasedSize+   alignment = Store.alignment zeroBasedSize+   peek = Store.peek ZeroBased+   poke = Store.poke zeroBasedSize+ instance (Integral n) => C (ZeroBased n) where    size (ZeroBased len) = fromIntegral len    uncheckedSize (ZeroBased len) = fromIntegral len@@ -118,6 +128,15 @@ newtype OneBased n = OneBased {oneBasedSize :: n}    deriving (Eq, Show) +instance Functor OneBased where+   fmap f (OneBased n) = OneBased $ f n++instance (Storable n) => Storable (OneBased n) where+   sizeOf = Store.sizeOf oneBasedSize+   alignment = Store.alignment oneBasedSize+   peek = Store.peek OneBased+   poke = Store.poke oneBasedSize+ instance (Integral n) => C (OneBased n) where    size (OneBased len) = fromIntegral len    uncheckedSize (OneBased len) = fromIntegral len@@ -147,6 +166,9 @@ data Range n = Range {rangeFrom, rangeTo :: n}    deriving (Eq, Show) +instance Functor Range where+   fmap f (Range from to) = Range (f from) (f to)+ instance (Ix.Ix n) => C (Range n) where    size (Range from to) = Ix.rangeSize (from,to)    uncheckedSize (Range from to) = Ix.unsafeRangeSize (from,to)@@ -187,6 +209,9 @@ -} data Shifted n = Shifted {shiftedOffset, shiftedSize :: n}    deriving (Eq, Show)++instance Functor Shifted where+   fmap f (Shifted from to) = Shifted (f from) (f to)  instance (Integral n) => C (Shifted n) where    size (Shifted _offs len) = fromIntegral len

@@ -8,6 +8,7 @@    Array.vectorFromList,     Array.map,+   (Array.//),    ) where  import qualified Data.Array.Comfort.Storable.Internal as Array

@@ -13,6 +13,8 @@    vectorFromList,     map,+   copyIO,+   (//),     createIO,    createWithSizeIO,@@ -27,8 +29,8 @@ import qualified Data.Array.Comfort.Shape as Shape  import qualified Foreign.Marshal.Array.Guarded as Alloc-import Foreign.Marshal.Array (pokeArray, peekArray, advancePtr, )-import Foreign.Storable (Storable, poke, peek, peekElemOff, )+import Foreign.Marshal.Array (copyArray, pokeArray, peekArray, advancePtr, )+import Foreign.Storable (Storable, poke, pokeElemOff, peek, peekElemOff, ) import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, ) import Foreign.Ptr (Ptr, ) @@ -96,6 +98,22 @@          (\src dst -> poke dst . f =<< peek src)          (iterate (flip advancePtr 1) srcPtr)          (iterate (flip advancePtr 1) dstPtr)++copyIO :: (Shape.C sh, Storable a) => Array sh a -> IO (Array sh a)+copyIO (Array sh srcFPtr) =+   withForeignPtr srcFPtr $ \srcPtr ->+   createWithSizeIO sh $ \n dstPtr ->+      copyArray dstPtr srcPtr n++(//) ::+   (Shape.Indexed sh, Storable a) =>+   Array sh a -> [(Shape.Index sh, a)] -> Array sh a+(//) (Array sh fptr) xs =+   unsafeCreateWithSize sh $ \n dstPtr ->+   withForeignPtr fptr $ \srcPtr -> do+      copyArray dstPtr srcPtr n+      mapM_ (\(ix,a) -> pokeElemOff dstPtr (Shape.offset sh ix) a) xs+   createIO ::

@@ -0,0 +1,13 @@+module Data.Array.Comfort.Storable.Mutable (+   Array.Array,+   shape,+   Array.read,+   Array.write,+   Array.thaw,+   Array.freeze,+   ) where++import qualified Data.Array.Comfort.Storable.Mutable.Internal as Array++shape :: Array.Array sh a -> sh+shape = Array.shape

@@ -0,0 +1,97 @@+{-# LANGUAGE TypeFamilies #-}+module Data.Array.Comfort.Storable.Mutable.Internal where++import qualified Data.Array.Comfort.Storable.Internal as Imm+import qualified Data.Array.Comfort.Shape as Shape++import qualified Foreign.Marshal.Array.Guarded as Alloc+import Foreign.Marshal.Array (pokeArray, peekArray, )+import Foreign.Storable (Storable, pokeElemOff, peekElemOff, )+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, )+import Foreign.Ptr (Ptr, )++import System.IO.Unsafe (unsafePerformIO, )++import Control.Applicative ((<$>))+import Control.Monad ((<=<))++import Data.Tuple.HT (mapFst)++import Prelude hiding (map, read, )+++data Array sh a =+   Array {+      shape :: sh,+      buffer :: ForeignPtr a+   }++instance (Shape.C sh, Show sh, Storable a, Show a) => Show (Array sh a) where+   show = unsafePerformIO . showIO++reshape :: sh1 -> Array sh0 a -> Array sh1 a+reshape sh (Array _ fptr) = Array sh fptr++mapShape :: (sh0 -> sh1) -> Array sh0 a -> Array sh1 a+mapShape f (Array sh fptr) = Array (f sh) fptr+++create ::+   (Shape.C sh, Storable a) => sh -> (Ptr a -> IO ()) -> IO (Array sh a)+create sh f = createWithSize sh $ const f++createWithSize ::+   (Shape.C sh, Storable a) => sh -> (Int -> Ptr a -> IO ()) -> IO (Array sh a)+createWithSize sh f =+   fst <$> createWithSizeAndResult sh f++createWithSizeAndResult ::+   (Shape.C sh, Storable a) =>+   sh -> (Int -> Ptr a -> IO b) -> IO (Array sh a, b)+createWithSizeAndResult sh f =+   let size = Shape.size sh+   in fmap (mapFst (Array sh)) $ Alloc.create size $ f size++showIO :: (Shape.C sh, Show sh, Storable a, Show a) => Array sh a -> IO String+showIO arr = do+   xs <- toList arr+   return $ "fromList " ++ showsPrec 11 (shape arr) (' ' : show xs)++read :: (Shape.Indexed sh, Storable a) => Array sh a -> Shape.Index sh -> IO a+read (Array sh fptr) ix =+   withForeignPtr fptr $ flip peekElemOff (Shape.offset sh ix)++write ::+   (Shape.Indexed sh, Storable a) => Array sh a -> Shape.Index sh -> a -> IO ()+write (Array sh fptr) ix a =+   withForeignPtr fptr $ \ptr -> pokeElemOff ptr (Shape.offset sh ix) a++toList :: (Shape.C sh, Storable a) => Array sh a -> IO [a]+toList (Array sh fptr) =+   withForeignPtr fptr $ peekArray (Shape.size sh)++fromList :: (Shape.C sh, Storable a) => sh -> [a] -> IO (Array sh a)+fromList sh xs =+   createWithSize sh $ \size ptr ->+      pokeArray ptr $ take size $+      xs +++      repeat (error "Array.Comfort.Storable.fromList: list too short for shape")++vectorFromList :: (Storable a) => [a] -> IO (Array (Shape.ZeroBased Int) a)+vectorFromList xs =+   create (Shape.ZeroBased $ length xs) $ flip pokeArray xs+++freeze :: (Shape.Indexed sh, Storable a) => Array sh a -> IO (Imm.Array sh a)+freeze = Imm.copyIO <=< unsafeFreeze++thaw :: (Shape.Indexed sh, Storable a) => Imm.Array sh a -> IO (Array sh a)+thaw = unsafeThaw <=< Imm.copyIO++unsafeFreeze ::+   (Shape.Indexed sh, Storable a) => Array sh a -> IO (Imm.Array sh a)+unsafeFreeze (Array sh fptr) = return (Imm.Array sh fptr)++unsafeThaw ::+   (Shape.Indexed sh, Storable a) => Imm.Array sh a -> IO (Array sh a)+unsafeThaw (Imm.Array sh fptr) = return (Array sh fptr)