comfort-array 0.0.1.1 → 0.1
raw patch · 7 files changed
+335/−39 lines, 7 filesdep +QuickCheckdep +comfort-arraydep +guarded-allocationdep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: QuickCheck, comfort-array, guarded-allocation, transformers
Dependency ranges changed: base
API changes (from Hackage documentation)
+ Data.Array.Comfort.Shape: class C sh => Indexed sh where {
+ Data.Array.Comfort.Shape: class Indexed sh => InvIndexed sh
+ Data.Array.Comfort.Shape: indexFromOffset :: InvIndexed sh => sh -> Int -> Index sh
+ Data.Array.Comfort.Shape: instance (Data.Array.Comfort.Shape.Indexed sh0, Data.Array.Comfort.Shape.Indexed sh1) => Data.Array.Comfort.Shape.Indexed (sh0 Data.Array.Comfort.Shape.:+: sh1)
+ Data.Array.Comfort.Shape: instance (Data.Array.Comfort.Shape.Indexed sh0, Data.Array.Comfort.Shape.Indexed sh1) => Data.Array.Comfort.Shape.Indexed (sh0, sh1)
+ Data.Array.Comfort.Shape: instance (Data.Array.Comfort.Shape.Indexed sh0, Data.Array.Comfort.Shape.Indexed sh1, Data.Array.Comfort.Shape.Indexed sh2) => Data.Array.Comfort.Shape.Indexed (sh0, sh1, sh2)
+ Data.Array.Comfort.Shape: instance (Data.Array.Comfort.Shape.InvIndexed sh0, Data.Array.Comfort.Shape.InvIndexed sh1) => Data.Array.Comfort.Shape.InvIndexed (sh0 Data.Array.Comfort.Shape.:+: sh1)
+ Data.Array.Comfort.Shape: instance (Data.Array.Comfort.Shape.InvIndexed sh0, Data.Array.Comfort.Shape.InvIndexed sh1) => Data.Array.Comfort.Shape.InvIndexed (sh0, sh1)
+ Data.Array.Comfort.Shape: instance (Data.Array.Comfort.Shape.InvIndexed sh0, Data.Array.Comfort.Shape.InvIndexed sh1, Data.Array.Comfort.Shape.InvIndexed sh2) => Data.Array.Comfort.Shape.InvIndexed (sh0, sh1, sh2)
+ Data.Array.Comfort.Shape: instance Data.Array.Comfort.Shape.Indexed ()
+ Data.Array.Comfort.Shape: instance Data.Array.Comfort.Shape.InvIndexed ()
+ Data.Array.Comfort.Shape: instance GHC.Arr.Ix n => Data.Array.Comfort.Shape.Indexed (Data.Array.Comfort.Shape.Range n)
+ Data.Array.Comfort.Shape: instance GHC.Arr.Ix n => Data.Array.Comfort.Shape.InvIndexed (Data.Array.Comfort.Shape.Range n)
+ Data.Array.Comfort.Shape: instance GHC.Real.Integral n => Data.Array.Comfort.Shape.Indexed (Data.Array.Comfort.Shape.OneBased n)
+ Data.Array.Comfort.Shape: instance GHC.Real.Integral n => Data.Array.Comfort.Shape.Indexed (Data.Array.Comfort.Shape.Shifted n)
+ Data.Array.Comfort.Shape: instance GHC.Real.Integral n => Data.Array.Comfort.Shape.Indexed (Data.Array.Comfort.Shape.ZeroBased n)
+ Data.Array.Comfort.Shape: instance GHC.Real.Integral n => Data.Array.Comfort.Shape.InvIndexed (Data.Array.Comfort.Shape.OneBased n)
+ Data.Array.Comfort.Shape: instance GHC.Real.Integral n => Data.Array.Comfort.Shape.InvIndexed (Data.Array.Comfort.Shape.Shifted n)
+ Data.Array.Comfort.Shape: instance GHC.Real.Integral n => Data.Array.Comfort.Shape.InvIndexed (Data.Array.Comfort.Shape.ZeroBased n)
+ Data.Array.Comfort.Shape: uncheckedIndexFromOffset :: InvIndexed sh => sh -> Int -> Index sh
+ Data.Array.Comfort.Shape.Test: tests :: (InvIndexed sh, Show sh, Index sh ~ ix, Eq ix, Show ix) => Gen sh -> [(String, Property)]
+ Data.Array.Comfort.Storable.Internal: createWithSizeAndResultIO :: (C sh, Storable a) => sh -> (Int -> Ptr a -> IO b) -> IO (Array sh a, b)
+ Data.Array.Comfort.Storable.Internal: unsafeCreateWithSizeAndResult :: (C sh, Storable a) => sh -> (Int -> Ptr a -> IO b) -> (Array sh a, b)
- Data.Array.Comfort.Shape: class C sh where {
+ Data.Array.Comfort.Shape: class C sh
- Data.Array.Comfort.Shape: inBounds :: C sh => sh -> Index sh -> Bool
+ Data.Array.Comfort.Shape: inBounds :: Indexed sh => sh -> Index sh -> Bool
- Data.Array.Comfort.Shape: indices :: C sh => sh -> [Index sh]
+ Data.Array.Comfort.Shape: indices :: Indexed sh => sh -> [Index sh]
- Data.Array.Comfort.Shape: offset :: C sh => sh -> Index sh -> Int
+ Data.Array.Comfort.Shape: offset :: Indexed sh => sh -> Index sh -> Int
- Data.Array.Comfort.Shape: sizeOffset :: C sh => sh -> Index sh -> (Int, Int)
+ Data.Array.Comfort.Shape: sizeOffset :: Indexed sh => sh -> Index sh -> (Int, Int)
- Data.Array.Comfort.Shape: uncheckedOffset :: C sh => sh -> Index sh -> Int
+ Data.Array.Comfort.Shape: uncheckedOffset :: Indexed sh => sh -> Index sh -> Int
- Data.Array.Comfort.Shape: uncheckedSizeOffset :: C sh => sh -> Index sh -> (Int, Int)
+ Data.Array.Comfort.Shape: uncheckedSizeOffset :: Indexed sh => sh -> Index sh -> (Int, Int)
- Data.Array.Comfort.Storable: (!) :: (C sh, Storable a) => Array sh a -> Index sh -> a
+ Data.Array.Comfort.Storable: (!) :: (Indexed sh, Storable a) => Array sh a -> Index sh -> a
- Data.Array.Comfort.Storable.Internal: (!) :: (C sh, Storable a) => Array sh a -> Index sh -> a
+ Data.Array.Comfort.Storable.Internal: (!) :: (Indexed sh, Storable a) => Array sh a -> Index sh -> a
- Data.Array.Comfort.Storable.Internal: readIO :: (C sh, Storable a) => Array sh a -> Index sh -> IO a
+ Data.Array.Comfort.Storable.Internal: readIO :: (Indexed sh, Storable a) => Array sh a -> Index sh -> IO a
Files
- comfort-array.cabal +32/−4
- src/Data/Array/Comfort/Shape.hs +149/−28
- src/Data/Array/Comfort/Shape/Test.hs +74/−0
- src/Data/Array/Comfort/Storable/Internal.hs +23/−7
- test/Main.hs +14/−0
- test/Test/Shape.hs +38/−0
- test/Test/Utility.hs +5/−0
comfort-array.cabal view
@@ -1,5 +1,5 @@ Name: comfort-array-Version: 0.0.1.1+Version: 0.1 License: BSD3 License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -10,7 +10,8 @@ Description: Arrays from the basic @array@ package are already very powerful compared with arrays in other languages.- It provides arrays of any dimension in a type safe and uniform way+ They may have any number of dimensions, are type safe+ and defined in a uniform way using the Ix class with free choice of the lower bounds (0, 1, or whatever you like). . This package goes one step further:@@ -38,14 +39,21 @@ * @ZeroBased, OneBased@: Arrays with fixed lower bound, either 0 or 1, respectively. .+ * @(:+:)@:+ The Append type constructor allows to respresent block arrays,+ e.g. block matrices.+ . * Arrays with indices like 'LT', 'EQ', 'GT' and dummy shape.+ .+ The @lapack@ package defines even more fancy shapes+ like tall rectangular matrices, triangular matrices and banded matrices. Tested-With: GHC==7.4.2, GHC==7.8.4, GHC==8.2.2-Cabal-Version: >=1.6+Cabal-Version: 1.14 Build-Type: Simple Source-Repository this- Tag: 0.0.1.1+ Tag: 0.1 Type: darcs Location: http://hub.darcs.net/thielema/comfort-array/ @@ -55,12 +63,32 @@ Library Build-Depends:+ guarded-allocation >=0.0 && <0.1,+ QuickCheck >=2 && <3,+ transformers >=0.3 && <0.6, utility-ht >=0.0.10 && <0.1, base >=4.5 && <5 GHC-Options: -Wall+ Default-Language: Haskell98 Hs-Source-Dirs: src Exposed-Modules: Data.Array.Comfort.Shape+ Data.Array.Comfort.Shape.Test Data.Array.Comfort.Storable Data.Array.Comfort.Storable.Internal++Test-Suite comfort-array-test+ Type: exitcode-stdio-1.0+ Build-Depends:+ comfort-array,+ QuickCheck,+ base++ GHC-Options: -Wall+ Default-Language: Haskell98+ Hs-Source-Dirs: test+ Main-Is: Main.hs+ Other-Modules:+ Test.Shape+ Test.Utility
src/Data/Array/Comfort/Shape.hs view
@@ -2,6 +2,8 @@ {-# LANGUAGE TypeOperators #-} module Data.Array.Comfort.Shape ( C(..),+ Indexed(..),+ InvIndexed(..), ZeroBased(..), OneBased(..),@@ -17,13 +19,25 @@ import qualified GHC.Arr as Ix +import qualified Control.Monad.Trans.State as MS import qualified Control.Monad.HT as Monad+import qualified Control.Applicative.Backwards as Back+import Control.Applicative (liftA2, liftA3) -import Data.Tuple.HT (mapFst, mapPair)+import Text.Printf (printf) +import Data.Tuple.HT (mapFst, mapPair, swap) + class C sh where- {-# MINIMAL indices, size, (sizeOffset|offset), inBounds #-}+ -- Ix.rangeSize+ size :: sh -> Int+ -- Ix.unsafeRangeSize+ uncheckedSize :: sh -> Int+ uncheckedSize = size++class C sh => Indexed sh where+ {-# MINIMAL indices, (sizeOffset|offset), inBounds #-} type Index sh :: * -- Ix.range indices :: sh -> [Index sh]@@ -35,28 +49,43 @@ uncheckedOffset = offset -- Ix.inRange inBounds :: sh -> Index sh -> Bool- -- Ix.rangeSize- size :: sh -> Int- -- Ix.unsafeRangeSize- uncheckedSize :: sh -> Int- uncheckedSize = size 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) +class Indexed sh => InvIndexed sh where+ {- |+ It should hold @indexFromOffset sh k == indices sh !! k@,+ but 'indexFromOffset' should generally be faster.+ -}+ indexFromOffset :: sh -> Int -> Index sh+ uncheckedIndexFromOffset :: sh -> Int -> Index sh+ uncheckedIndexFromOffset = indexFromOffset +errorIndexFromOffset :: String -> Int -> a+errorIndexFromOffset name k =+ error $ printf "indexFromOffset (%s): index %d out of range" name k++ instance C () where+ size () = 1+ uncheckedSize () = 1++instance Indexed () where type Index () = () indices () = [()] offset () () = 0 uncheckedOffset () () = 0 inBounds () () = True- size () = 1- uncheckedSize () = 1 +instance InvIndexed () where+ indexFromOffset () 0 = ()+ indexFromOffset () k = errorIndexFromOffset "()" k+ uncheckedIndexFromOffset () _ = () + {- | 'ZeroBased' denotes a range starting at zero and has a certain length. -}@@ -64,14 +93,25 @@ deriving (Eq, Show) instance (Integral n) => C (ZeroBased n) where+ size (ZeroBased len) = fromIntegral len+ uncheckedSize (ZeroBased len) = fromIntegral len++instance (Integral n) => Indexed (ZeroBased n) where type Index (ZeroBased n) = n indices (ZeroBased len) = indices $ Shifted 0 len offset (ZeroBased len) = offset $ Shifted 0 len uncheckedOffset _ ix = fromIntegral ix inBounds (ZeroBased len) ix = 0<=ix && ix<len- size (ZeroBased len) = fromIntegral len- uncheckedSize (ZeroBased len) = fromIntegral len +instance (Integral n) => InvIndexed (ZeroBased n) where+ indexFromOffset (ZeroBased len) k0 =+ let k = fromIntegral k0+ in if 0<=k && k<len+ then k+ else errorIndexFromOffset "ZeroBased" k0+ uncheckedIndexFromOffset _ k = fromIntegral k++ {- | 'OneBased' denotes a range starting at one and has a certain length. -}@@ -79,15 +119,25 @@ deriving (Eq, Show) instance (Integral n) => C (OneBased n) where+ size (OneBased len) = fromIntegral len+ uncheckedSize (OneBased len) = fromIntegral len++instance (Integral n) => Indexed (OneBased n) where type Index (OneBased n) = n indices (OneBased len) = indices $ Shifted 1 len offset (OneBased len) = offset $ Shifted 1 len uncheckedOffset _ ix = fromIntegral ix - 1 inBounds (OneBased len) ix = 0<ix && ix<=len- size (OneBased len) = fromIntegral len- uncheckedSize (OneBased len) = fromIntegral len +instance (Integral n) => InvIndexed (OneBased n) where+ indexFromOffset (OneBased len) k0 =+ let k = fromIntegral k0+ in if 0<=k && k<len+ then 1+k+ else errorIndexFromOffset "OneBased" k0+ uncheckedIndexFromOffset _ k = 1 + fromIntegral k + {- | 'Range' denotes an inclusive range like those of the Haskell 98 standard @Array@ type from the @array@ package.@@ -98,14 +148,24 @@ deriving (Eq, Show) instance (Ix.Ix n) => C (Range n) where+ size (Range from to) = Ix.rangeSize (from,to)+ uncheckedSize (Range from to) = Ix.unsafeRangeSize (from,to)++instance (Ix.Ix n) => Indexed (Range n) where type Index (Range n) = n indices (Range from to) = Ix.range (from,to) offset (Range from to) ix = Ix.index (from,to) ix uncheckedOffset (Range from to) ix = Ix.unsafeIndex (from,to) ix inBounds (Range from to) ix = Ix.inRange (from,to) ix- size (Range from to) = Ix.rangeSize (from,to)- uncheckedSize (Range from to) = Ix.unsafeRangeSize (from,to) +-- pretty inefficient when we rely solely on Ix+instance (Ix.Ix n) => InvIndexed (Range n) where+ indexFromOffset (Range from to) k =+ if 0<=k && k < Ix.rangeSize (from,to)+ then Ix.range (from,to) !! k+ else errorIndexFromOffset "Range" k+ uncheckedIndexFromOffset (Range from to) k = Ix.range (from,to) !! k+ -- cf. sample-frame:Stereo instance Storable n => Storable (Range n) where {-# INLINE sizeOf #-}@@ -129,6 +189,10 @@ deriving (Eq, Show) instance (Integral n) => C (Shifted n) where+ size (Shifted _offs len) = fromIntegral len+ uncheckedSize (Shifted _offs len) = fromIntegral len++instance (Integral n) => Indexed (Shifted n) where type Index (Shifted n) = n indices (Shifted offs len) = map snd $@@ -146,9 +210,15 @@ else error "Shape.Shifted: array index too big" uncheckedOffset (Shifted offs _len) ix = fromIntegral $ ix-offs inBounds (Shifted offs len) ix = ix < offs+len- size (Shifted _offs len) = fromIntegral len- uncheckedSize (Shifted _offs len) = fromIntegral len +instance (Integral n) => InvIndexed (Shifted n) where+ indexFromOffset (Shifted offs len) k0 =+ let k = fromIntegral k0+ in if 0<=k && k<len+ then offs+k+ else errorIndexFromOffset "Shifted" k0+ uncheckedIndexFromOffset (Shifted offs _len) k = offs + fromIntegral k+ -- cf. sample-frame:Stereo instance Storable n => Storable (Shifted n) where {-# INLINE sizeOf #-}@@ -175,6 +245,10 @@ Row-major composition of two dimensions. -} instance (C sh0, C sh1) => C (sh0,sh1) where+ size (sh0,sh1) = size sh0 * size sh1+ uncheckedSize (sh0,sh1) = uncheckedSize sh0 * uncheckedSize sh1++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) =@@ -188,10 +262,20 @@ `combineSizeOffset` uncheckedSizeOffset sh1 ix1 inBounds (sh0,sh1) (ix0,ix1) = inBounds sh0 ix0 && inBounds sh1 ix1- size (sh0,sh1) = size sh0 * size sh1- uncheckedSize (sh0,sh1) = uncheckedSize sh0 * uncheckedSize sh1 +instance (InvIndexed sh0, InvIndexed sh1) => InvIndexed (sh0,sh1) where+ indexFromOffset (sh0,sh1) k =+ runInvIndex k $ liftA2 (,) (pickLastIndex sh0) (pickIndex sh1)+ uncheckedIndexFromOffset (sh0,sh1) k =+ runInvIndex k $ liftA2 (,) (uncheckedPickLastIndex sh0) (pickIndex sh1)++ instance (C sh0, C sh1, C sh2) => C (sh0,sh1,sh2) where+ size (sh0,sh1,sh2) = size sh0 * size sh1 * size sh2+ uncheckedSize (sh0,sh1,sh2) =+ uncheckedSize sh0 * uncheckedSize sh1 * uncheckedSize sh2++instance (Indexed sh0, Indexed sh1, Indexed sh2) => Indexed (sh0,sh1,sh2) where type Index (sh0,sh1,sh2) = (Index sh0, Index sh1, Index sh2) indices (sh0,sh1,sh2) = Monad.lift3 (,,) (indices sh0) (indices sh1) (indices sh2)@@ -215,11 +299,37 @@ uncheckedSizeOffset sh2 ix2 inBounds (sh0,sh1,sh2) (ix0,ix1,ix2) = inBounds sh0 ix0 && inBounds sh1 ix1 && inBounds sh2 ix2- size (sh0,sh1,sh2) = size sh0 * size sh1 * size sh2- uncheckedSize (sh0,sh1,sh2) =- uncheckedSize sh0 * uncheckedSize sh1 * uncheckedSize sh2 +instance+ (InvIndexed sh0, InvIndexed sh1, InvIndexed sh2) =>+ InvIndexed (sh0,sh1,sh2) where+ indexFromOffset (sh0,sh1,sh2) k =+ runInvIndex k $+ liftA3 (,,) (pickLastIndex sh0) (pickIndex sh1) (pickIndex sh2)+ uncheckedIndexFromOffset (sh0,sh1,sh2) k =+ runInvIndex k $+ liftA3 (,,) (uncheckedPickLastIndex sh0) (pickIndex sh1) (pickIndex sh2) +runInvIndex :: s -> Back.Backwards (MS.State s) a -> a+runInvIndex k = flip MS.evalState k . Back.forwards++pickLastIndex ::+ (InvIndexed sh) => sh -> Back.Backwards (MS.State Int) (Index sh)+pickLastIndex sh =+ Back.Backwards $ MS.gets $ indexFromOffset sh++uncheckedPickLastIndex ::+ (InvIndexed sh) => sh -> Back.Backwards (MS.State Int) (Index sh)+uncheckedPickLastIndex sh =+ Back.Backwards $ MS.gets $ uncheckedIndexFromOffset sh++pickIndex :: (InvIndexed sh) => sh -> Back.Backwards (MS.State Int) (Index sh)+pickIndex sh =+ fmap (uncheckedIndexFromOffset sh) $+ Back.Backwards $ MS.state $ \k -> swap $ divMod k $ size sh+++ infixr 7 `combineOffset`, `combineSizeOffset` {-# INLINE combineOffset #-}@@ -239,6 +349,10 @@ deriving (Eq, Show) instance (C sh0, C sh1) => C (sh0:+:sh1) where+ size (sh0:+:sh1) = size sh0 + size sh1+ uncheckedSize (sh0:+:sh1) = uncheckedSize sh0 + uncheckedSize sh1++instance (Indexed sh0, Indexed sh1) => Indexed (sh0:+:sh1) where type Index (sh0:+:sh1) = Either (Index sh0) (Index sh1) indices (sh0:+:sh1) = map Left (indices sh0) ++ map Right (indices sh1) offset (sh0:+:sh1) ix =@@ -261,9 +375,16 @@ Right ix1 -> let size0 = uncheckedSize sh0 in mapPair ((size0+), (size0+)) $ uncheckedSizeOffset sh1 ix1- inBounds (sh0:+:sh1) ix =- case ix of- Left ix0 -> inBounds sh0 ix0- Right ix1 -> inBounds sh1 ix1- size (sh0:+:sh1) = size sh0 + size sh1- uncheckedSize (sh0:+:sh1) = uncheckedSize sh0 + uncheckedSize sh1+ inBounds (sh0:+:sh1) = either (inBounds sh0) (inBounds sh1)++instance (InvIndexed sh0, InvIndexed sh1) => InvIndexed (sh0:+:sh1) where+ indexFromOffset (sh0:+:sh1) k =+ let pivot = size sh0+ in if k < pivot+ then Left $ indexFromOffset sh0 k+ else Right $ indexFromOffset sh1 $ k-pivot+ uncheckedIndexFromOffset (sh0:+:sh1) k =+ let pivot = size sh0+ in if k < pivot+ then Left $ uncheckedIndexFromOffset sh0 k+ else Right $ uncheckedIndexFromOffset sh1 $ k-pivot
+ src/Data/Array/Comfort/Shape/Test.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE TypeFamilies #-}+module Data.Array.Comfort.Shape.Test (tests) where++import qualified Data.Array.Comfort.Shape as Shape++import qualified Test.QuickCheck as QC+++uncheckedSize :: (Shape.C sh) => sh -> Bool+uncheckedSize sh = Shape.size sh == Shape.uncheckedSize sh++inBounds :: (Shape.Indexed sh) => sh -> Bool+inBounds sh = all (Shape.inBounds sh) $ Shape.indices sh+++forAllIndices ::+ (Shape.Indexed sh, Shape.Index sh ~ ix, Show ix, QC.Testable prop) =>+ sh -> (ix -> prop) -> QC.Property+forAllIndices sh f =+ let ixs = Shape.indices sh+ in not (null ixs) QC.==> QC.forAll (QC.elements ixs) f++sizeOffset ::+ (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)++uncheckedSizeOffset ::+ (Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) => sh -> QC.Property+uncheckedSizeOffset sh =+ forAllIndices sh $ \ix ->+ Shape.uncheckedSizeOffset sh ix ==+ (Shape.uncheckedSize sh, Shape.uncheckedOffset sh ix)++uncheckedOffset ::+ (Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) => sh -> QC.Property+uncheckedOffset sh =+ forAllIndices sh $ \ix ->+ Shape.offset sh ix == Shape.uncheckedOffset sh ix++lengthIndices :: (Shape.Indexed sh) => sh -> Bool+lengthIndices sh = length (Shape.indices sh) == Shape.size sh++indexOffsets :: (Shape.Indexed sh) => sh -> Bool+indexOffsets sh =+ map (Shape.offset sh) (Shape.indices sh) == take (Shape.size sh) [0..]++invIndices :: (Shape.InvIndexed sh, Shape.Index sh ~ ix, Eq ix) => sh -> Bool+invIndices sh =+ Shape.indices sh ==+ map (Shape.indexFromOffset sh) (take (Shape.size sh) [0..])++uncheckedInvIndices ::+ (Shape.InvIndexed sh, Shape.Index sh ~ ix, Eq ix) => sh -> Bool+uncheckedInvIndices sh =+ Shape.indices sh ==+ map (Shape.uncheckedIndexFromOffset sh) (take (Shape.size sh) [0..])+++tests ::+ (Shape.InvIndexed sh, Show sh, Shape.Index sh ~ ix, Eq ix, Show ix) =>+ QC.Gen sh -> [(String, QC.Property)]+tests gen =+ ("uncheckedSize", QC.forAll gen uncheckedSize) :+ ("inBounds", QC.forAll gen inBounds) :+ ("sizeOffset", QC.forAll gen sizeOffset) :+ ("uncheckedSizeOffset", QC.forAll gen uncheckedSizeOffset) :+ ("uncheckedOffset", QC.forAll gen uncheckedOffset) :+ ("lengthIndices", QC.forAll gen lengthIndices) :+ ("indexOffsets", QC.forAll gen indexOffsets) :+ ("invIndices", QC.forAll gen invIndices) :+ ("uncheckedInvIndices", QC.forAll gen uncheckedInvIndices) :+ []
src/Data/Array/Comfort/Storable/Internal.hs view
@@ -7,6 +7,7 @@ (!), unsafeCreate, unsafeCreateWithSize,+ unsafeCreateWithSizeAndResult, toList, fromList, vectorFromList,@@ -15,6 +16,7 @@ createIO, createWithSizeIO,+ createWithSizeAndResultIO, showIO, readIO, toListIO,@@ -24,13 +26,18 @@ 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.ForeignPtr (ForeignPtr, withForeignPtr, mallocForeignPtrArray, )+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, ) import Foreign.Ptr (Ptr, ) import System.IO.Unsafe (unsafePerformIO, ) +import Control.Applicative ((<$>))++import Data.Tuple.HT (mapFst)+ import Prelude hiding (map, readIO, ) @@ -60,7 +67,12 @@ (Shape.C sh, Storable a) => sh -> (Int -> Ptr a -> IO ()) -> Array sh a unsafeCreateWithSize sh = unsafePerformIO . createWithSizeIO sh -(!) :: (Shape.C sh, Storable a) => Array sh a -> Shape.Index sh -> a+unsafeCreateWithSizeAndResult ::+ (Shape.C sh, Storable a) => sh -> (Int -> Ptr a -> IO b) -> (Array sh a, b)+unsafeCreateWithSizeAndResult sh =+ unsafePerformIO . createWithSizeAndResultIO sh++(!) :: (Shape.Indexed sh, Storable a) => Array sh a -> Shape.Index sh -> a (!) arr = unsafePerformIO . readIO arr toList :: (Shape.C sh, Storable a) => Array sh a -> [a]@@ -92,18 +104,22 @@ createWithSizeIO :: (Shape.C sh, Storable a) => sh -> (Int -> Ptr a -> IO ()) -> IO (Array sh a)-createWithSizeIO sh f = do+createWithSizeIO sh f =+ fst <$> createWithSizeAndResultIO sh f++createWithSizeAndResultIO ::+ (Shape.C sh, Storable a) =>+ sh -> (Int -> Ptr a -> IO b) -> IO (Array sh a, b)+createWithSizeAndResultIO sh f = let size = Shape.size sh- fptr <- mallocForeignPtrArray size- withForeignPtr fptr $ f size- return $ Array sh fptr+ 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 <- toListIO arr return $ "fromList " ++ showsPrec 11 (shape arr) (' ' : show xs) -readIO :: (Shape.C sh, Storable a) => Array sh a -> Shape.Index sh -> IO a+readIO :: (Shape.Indexed sh, Storable a) => Array sh a -> Shape.Index sh -> IO a readIO (Array sh fptr) ix = withForeignPtr fptr $ flip peekElemOff (Shape.offset sh ix)
+ test/Main.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE TypeFamilies #-}+module Main where++import qualified Test.Shape as TestShape+import Test.Utility (prefix)++import qualified Test.QuickCheck as QC+++main :: IO ()+main =+ mapM_ (\(name,prop) -> putStr (name ++ ": ") >> QC.quickCheck prop) $+ prefix "Shape" TestShape.tests +++ []
+ test/Test/Shape.hs view
@@ -0,0 +1,38 @@+module Test.Shape where++import qualified Data.Array.Comfort.Shape.Test as ShapeTest+import qualified Data.Array.Comfort.Shape as Shape+import Data.Array.Comfort.Shape ((:+:)((:+:)))++import qualified Test.QuickCheck as QC+import Test.Utility (prefix)++import Control.Applicative (liftA2, liftA3)+++genZeroBased :: Int -> QC.Gen (Shape.ZeroBased Int)+genZeroBased n = fmap Shape.ZeroBased $ QC.choose (0,n)++tests :: [(String, QC.Property)]+tests =+ prefix "ZeroBased"+ (ShapeTest.tests $ genZeroBased 10) +++ prefix "OneBased"+ (ShapeTest.tests $ fmap Shape.OneBased $ QC.choose (0,10::Int)) +++ prefix "Range"+ (ShapeTest.tests $ do+ from <- QC.choose (0,10::Int)+ to <- QC.choose (from-1, 10)+ return $ Shape.Range from to) +++ prefix "Shifted"+ (ShapeTest.tests $+ liftA2 Shape.Shifted+ (QC.choose (-10,10::Int)) (QC.choose (0,10::Int))) +++ prefix "Pair"+ (ShapeTest.tests $ liftA2 (,) (genZeroBased 10) (genZeroBased 10)) +++ prefix "Triple"+ (ShapeTest.tests $+ liftA3 (,,) (genZeroBased 10) (genZeroBased 10) (genZeroBased 10)) +++ prefix "Append"+ (ShapeTest.tests $ liftA2 (:+:) (genZeroBased 10) (genZeroBased 10)) +++ []
+ test/Test/Utility.hs view
@@ -0,0 +1,5 @@+module Test.Utility where++prefix :: String -> [(String, test)] -> [(String, test)]+prefix msg =+ map (\(str,test) -> (msg ++ "." ++ str, test))