comfort-array 0.5.4.2 → 0.5.5

raw patch · 15 files changed

+1579/−541 lines, 15 filesdep +bifunctorsdep ~containersdep ~transformers-compatPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: bifunctors

Dependency ranges changed: containers, transformers-compat

API changes (from Hackage documentation)

Files

• comfort-array.cabal +8/−3
• src/Data/Array/Comfort/Bool.hs +91/−0
• src/Data/Array/Comfort/Shape.hs +4/−0
• src/Data/Array/Comfort/Shape/SubSize.hs +105/−0
• src/Data/Array/Comfort/Storable.hs +63/−221
• src/Data/Array/Comfort/Storable/Dim2.hs +697/−0
• src/Data/Array/Comfort/Storable/Unchecked.hs +36/−4
• src/Data/Array/Comfort/Storable/Unchecked/Creator.hs +80/−0
• src/Data/Array/Comfort/Storable/Unchecked/Monadic.hs +24/−0
• test-module.list +0/−5
• test/DocTest/Data/Array/Comfort/Shape.hs +102/−102
• test/DocTest/Data/Array/Comfort/Storable.hs +35/−182
• test/DocTest/Data/Array/Comfort/Storable/Dim2.hs +308/−0
• test/DocTest/Data/Array/Comfort/Storable/Unchecked.hs +20/−20
• test/DocTest/Main.hs +6/−4

@@ -1,5 +1,5 @@ Name:             comfort-array-Version:          0.5.4.2+Version:          0.5.5 License:          BSD3 License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -97,10 +97,9 @@ Build-Type:       Simple Extra-Source-Files:   Changes.md-  test-module.list  Source-Repository this-  Tag:         0.5.4.2+  Tag:         0.5.5   Type:        darcs   Location:    https://hub.darcs.net/thielema/comfort-array/ @@ -127,6 +126,7 @@     -- transformers-compat required for Functor.Classes in GHC-7.8.4     transformers-compat >=0.6.6 && <0.8,     transformers >=0.3 && <0.7,+    bifunctors >=5.5 && <5.7,     non-empty >=0.3.2 && <0.4,     utility-ht >=0.0.10 && <0.1,     prelude-compat >=0.0 && <0.1,@@ -144,15 +144,19 @@   Exposed-Modules:     Data.Array.Comfort.Shape     Data.Array.Comfort.Shape.Test+    Data.Array.Comfort.Shape.SubSize     Data.Array.Comfort.Storable+    Data.Array.Comfort.Storable.Dim2     Data.Array.Comfort.Storable.Unchecked     Data.Array.Comfort.Storable.Unchecked.Monadic+    Data.Array.Comfort.Storable.Unchecked.Creator     Data.Array.Comfort.Storable.Private     Data.Array.Comfort.Storable.Mutable     Data.Array.Comfort.Storable.Mutable.Unchecked     Data.Array.Comfort.Storable.Mutable.Private     Data.Array.Comfort.Boxed     Data.Array.Comfort.Boxed.Unchecked+    Data.Array.Comfort.Bool     Data.Array.Comfort.Container   Other-Modules:     Data.Array.Comfort.Shape.Tuple@@ -184,6 +188,7 @@     DocTest.Data.Array.Comfort.Shape     DocTest.Data.Array.Comfort.Storable.Unchecked     DocTest.Data.Array.Comfort.Storable+    DocTest.Data.Array.Comfort.Storable.Dim2     DocTest.Data.Array.Comfort.Boxed.Unchecked     DocTest.Data.Array.Comfort.Boxed     DocTest.Main

@@ -0,0 +1,91 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{- |+Can be an alternative to the @enumset@ package.+-}+module Data.Array.Comfort.Bool (+   Array,+   shape,+   reshape,+   mapShape,++   fromList,+   toList,+   fromSet,+   toSet,++   member,+   union,+   difference,+   intersection,+   ) where++import qualified Data.Array.Comfort.Shape as Shape+import qualified Data.Array.Comfort.Check as Check++import qualified Data.IntSet as IntSet+import qualified Data.Set as Set+import qualified Data.List as List+import Data.IntSet (IntSet)+import Data.Set (Set)+++data Array sh =+   Array {+      shape_ :: sh,+      _intSet :: IntSet+   }+++shape :: Array sh -> sh+shape = shape_++reshape :: (Shape.C sh0, Shape.C sh1) => sh1 -> Array sh0 -> Array sh1+reshape = Check.reshape "Storable" shape (\sh arr -> arr{shape_ = sh})++mapShape ::+   (Shape.C sh0, Shape.C sh1) => (sh0 -> sh1) -> Array sh0 -> Array sh1+mapShape f arr = reshape (f $ shape arr) arr++++fromList :: (Shape.Indexed sh) => sh -> [Shape.Index sh] -> Array sh+fromList sh = Array sh . IntSet.fromList . List.map (Shape.offset sh)++toList :: (Shape.InvIndexed sh) => Array sh -> [Shape.Index sh]+toList (Array sh set) = map (Shape.indexFromOffset sh) $ IntSet.toList set++fromSet ::+   (Shape.Indexed sh, Shape.Index sh ~ ix, Ord ix) => sh -> Set ix -> Array sh+fromSet sh = fromList sh . Set.toList++toSet ::+   (Shape.InvIndexed sh, Shape.Index sh ~ ix, Ord ix) => Array sh -> Set ix+toSet = Set.fromList . toList+++errorArray :: String -> String -> a+errorArray name msg =+   error ("Array.Comfort.Bool." ++ name ++ ": " ++ msg)+++member :: (Shape.Indexed sh) => Shape.Index sh -> Array sh -> Bool+member ix (Array sh set) = IntSet.member (Shape.offset sh ix) set+++lift2 :: (Shape.Indexed sh, Eq sh) =>+   String -> (IntSet -> IntSet -> IntSet) ->+   Array sh -> Array sh -> Array sh+lift2 name op (Array shA setA) (Array shB setB) =+   if shA == shB+      then Array shA $ op setA setB+      else errorArray name "shapes mismatch"++union :: (Shape.Indexed sh, Eq sh) => Array sh -> Array sh -> Array sh+union = lift2 "union" IntSet.union++intersection :: (Shape.Indexed sh, Eq sh) => Array sh -> Array sh -> Array sh+intersection = lift2 "intersection" IntSet.intersection++difference :: (Shape.Indexed sh, Eq sh) => Array sh -> Array sh -> Array sh+difference = lift2 "difference" IntSet.difference

@@ -301,6 +301,7 @@   + {- | We cannot use 'Semigroup' because 'Semigroup' instances for '()' and '(a,b)' are already defined in a way,@@ -1929,6 +1930,9 @@   +{- |+Dynamically build a shape and its indices in the 'Construction' monad.+-} newtype Constructed tag = Constructed {constructedSize :: Int}    deriving (Eq, Show) 

@@ -0,0 +1,105 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{- |+Framework for extracting subsize in 'Array.unsafeCreateWithSizes'.+-}+module Data.Array.Comfort.Shape.SubSize (+   T(Cons, measure),+   auto,+   atom,+   Sub(Sub),+   sub,+   pair,+   triple,+   append,++   C(ToShape),+   Atom(Atom),+   evaluate,+   ) where++import qualified Data.Array.Comfort.Shape as Shape+import Data.Array.Comfort.Shape ((::+)((::+)))+++newtype T sh nsize = Cons {measure :: sh -> (Int,nsize)}++auto :: (C nsize) => T (ToShape nsize) nsize+auto = Cons evaluate++atom :: (Shape.C sh) => T sh Int+atom = Cons $ \sh -> let n = Shape.size sh in (n,n)++data Sub nsize = Sub Int nsize++sub :: T sh nsize -> T sh (Sub nsize)+sub (Cons s) =+   Cons $ \sh ->+      let (n,subSizes) = s sh+      in (n, Sub n subSizes)++pair ::+   T sh0 nsize0 ->+   T sh1 nsize1 ->+   T (sh0,sh1) (nsize0,nsize1)+pair (Cons s0) (Cons s1) =+   Cons $ \(sh0,sh1) ->+      let (n0,sub0) = s0 sh0+          (n1,sub1) = s1 sh1+      in (n0*n1, (sub0,sub1))++triple ::+   T sh0 nsize0 ->+   T sh1 nsize1 ->+   T sh2 nsize2 ->+   T (sh0,sh1,sh2) (nsize0,nsize1,nsize2)+triple (Cons s0) (Cons s1) (Cons s2) =+   Cons $ \(sh0,sh1,sh2) ->+      let (n0,sub0) = s0 sh0+          (n1,sub1) = s1 sh1+          (n2,sub2) = s2 sh2+      in (n0*n1*n2, (sub0,sub1,sub2))++append ::+   T sh0 nsize0 ->+   T sh1 nsize1 ->+   T (sh0::+sh1) (nsize0::+nsize1)+append (Cons s0) (Cons s1) =+   Cons $ \(sh0::+sh1) ->+      let (n0,sub0) = s0 sh0+          (n1,sub1) = s1 sh1+      in (n0+n1, sub0::+sub1)+++++class C nsize where+   type ToShape nsize+   {- |+   Compute the sizes of a shape and some sub-shapes.+   -}+   evaluate :: ToShape nsize -> (Int, nsize)++newtype Atom sh = Atom Int++instance (Shape.C sh) => C (Atom sh) where+   type ToShape (Atom sh) = sh+   evaluate sh = let n = Shape.size sh in (n, Atom n)++instance (C sub) => C (Sub sub) where+   type ToShape (Sub sub) = ToShape sub+   evaluate = measure $ sub auto++instance (C nsize0, C nsize1) => C (nsize0,nsize1) where+   type ToShape (nsize0,nsize1) =+            (ToShape nsize0, ToShape nsize1)+   evaluate = measure $ pair auto auto++instance (C nsize0, C nsize1, C nsize2) => C (nsize0,nsize1,nsize2) where+   type ToShape (nsize0,nsize1,nsize2) =+            (ToShape nsize0, ToShape nsize1, ToShape nsize2)+   evaluate = measure $ triple auto auto auto++instance (C nsize0, C nsize1) => C (nsize0::+nsize1) where+   type ToShape (nsize0::+nsize1) = (ToShape nsize0 ::+ ToShape nsize1)+   evaluate = measure $ append auto auto

@@ -1,3 +1,5 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} module Data.Array.Comfort.Storable (    Array,    shape,@@ -19,8 +21,8 @@    replicate,    fromBoxed,    toBoxed,-   fromStorableVector,-   toStorableVector,+   Array.fromStorableVector,+   Array.toStorableVector,    fromBlockArray1,    fromBlockArray2,    fromNonEmptyBlockArray2,@@ -40,6 +42,8 @@    Array.take, Array.drop,    Array.takeLeft, Array.takeRight, Array.split,    Array.takeCenter,+   takeSet,+   takeIntSet,     Array.sum, Array.product,    minimum, argMinimum,@@ -54,6 +58,7 @@ import qualified Data.Array.Comfort.Storable.Mutable.Private as MutArrayPriv import qualified Data.Array.Comfort.Storable.Mutable as MutArray import qualified Data.Array.Comfort.Storable.Unchecked as Array+import qualified Data.Array.Comfort.Storable.Dim2 as Array2 import qualified Data.Array.Comfort.Storable.Memory as Memory import qualified Data.Array.Comfort.Container as Container import qualified Data.Array.Comfort.Boxed as BoxedArray@@ -61,24 +66,22 @@ import qualified Data.Array.Comfort.Shape.Tuple as TupleShape import qualified Data.Array.Comfort.Shape as Shape import Data.Array.Comfort.Storable.Unchecked (Array(Array))-import Data.Array.Comfort.Shape ((::+)((::+)))  import System.IO.Unsafe (unsafePerformIO)-import Foreign.Marshal.Array (copyArray, advancePtr)-import Foreign.Storable (Storable)+import Foreign.Marshal.Array (advancePtr)+import Foreign.Storable (Storable, poke, peekElemOff) import Foreign.ForeignPtr (withForeignPtr)  import qualified Control.Monad.Trans.State as MS import Control.Monad.ST (runST)  import qualified Data.StorableVector as SV-import qualified Data.StorableVector.Base as SVB import qualified Data.IntMap as IntMap+import qualified Data.IntSet as IntSet import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.Traversable as Trav import qualified Data.Foldable as Fold-import qualified Data.List.HT as ListHT import qualified Data.List as List import qualified Data.Tuple.Strict as StrictTuple import Data.IntMap (IntMap)@@ -87,7 +90,6 @@ import Data.Set (Set) import Data.Foldable (forM_) import Data.Either.HT (maybeRight)-import Data.Tuple.HT (mapPair) import Data.Semigroup          (Semigroup, (<>), Min(Min,getMin), Max(Max,getMax), Arg(Arg)) @@ -96,9 +98,6 @@   {- $setup->>> import qualified DocTest.Data.Array.Comfort.Boxed.Unchecked->>>                                              as TestBoxedArray->>> import qualified Data.Array.Comfort.Boxed as BoxedArray >>> import qualified Data.Array.Comfort.Storable as Array >>> import qualified Data.Array.Comfort.Shape as Shape >>> import Data.Array.Comfort.Storable (Array, (!))@@ -106,18 +105,12 @@ >>> import qualified Test.QuickCheck as QC >>> import Test.ChasingBottoms.IsBottom (isBottom) >>>->>> import Control.Monad (replicateM)->>> import Control.Applicative ((<$>), (<*>))+>>> import Control.Applicative ((<$>)) >>>->>> import qualified Data.Map as Map+>>> import qualified Data.IntSet as IntSet >>> import qualified Data.Set as Set->>> import Data.Map (Map)->>> import Data.Function.HT (Id) >>> import Data.Complex (Complex((:+)))->>> import Data.Tuple.HT (swap)->>> import Data.Word (Word16)->>>->>> import Foreign.Storable (Storable)+>>> import Data.Word (Word8, Word16) >>> >>> type ShapeInt = Shape.ZeroBased Int >>> type X = Shape.Element@@ -128,27 +121,6 @@ >>> genArray :: QC.Gen (Array ShapeInt Word16) >>> genArray = Array.vectorFromList <$> QC.arbitrary >>>->>> genArray2 :: QC.Gen (Array (ShapeInt,ShapeInt) Word16)->>> genArray2 = do->>>    xs <- QC.arbitrary->>>    let n = length xs->>>    (k,m) <-->>>       if n == 0->>>          then QC.elements [(,) 0, flip (,) 0] <*> QC.choose (1,20)->>>          else fmap (\m -> (div n m, m)) $ QC.choose (1,n)->>>    return $ Array.fromList (Shape.ZeroBased k, Shape.ZeroBased m) xs->>>->>> genArrayForShape :: (Shape.C shape) => shape -> QC.Gen (Array shape Word16)->>> genArrayForShape sh =->>>    Array.fromList sh <$> replicateM (Shape.size sh) QC.arbitrary->>>->>> genNonEmptyArray2 :: QC.Gen (Array (ShapeInt,ShapeInt) Word16)->>> genNonEmptyArray2 = do->>>    xs <- QC.getNonEmpty <$> QC.arbitrary->>>    let n = length xs->>>    m <- QC.choose (1,n)->>>    return $ Array.fromList (Shape.ZeroBased (div n m), Shape.ZeroBased m) xs->>> >>> infix 4 ==? >>> (==?) :: a -> a -> (a,a) >>> (==?) = (,)@@ -161,12 +133,6 @@ >>>          if Array.shape xs == Shape.ZeroBased 0 >>>             then isBottom resultArray >>>             else resultArray == resultList->>>->>>->>> transpose ::->>>    (Shape.Indexed sh0, Shape.Indexed sh1, Storable a) =>->>>    Array (sh0,sh1) a -> Array (sh1,sh0) a->>> transpose a = Array.sample (swap $ Array.shape a) (\(i,j) -> a!(j,i)) -}  @@ -264,9 +230,7 @@    (Shape.Indexed sh, Storable a) => sh -> (Shape.Index sh -> a) -> Array sh a sample sh f = Array.fromList sh $ List.map f $ Shape.indices sh -replicate ::-   (Shape.Indexed sh, Storable a) =>-   sh -> a -> Array sh a+replicate :: (Shape.C sh, Storable a) => sh -> a -> Array sh a replicate sh a = runST (MutArrayNC.unsafeFreeze =<< MutArray.new sh a)  @@ -277,147 +241,27 @@ toBoxed arr = BoxedArray.fromList (Array.shape arr) $ Array.toList arr  -fromStorableVector ::-   (Storable a) => SVB.Vector a -> Array (Shape.ZeroBased Int) a-fromStorableVector xs =-   case SVB.toForeignPtr xs of-      (fptr,0,n) -> Array (Shape.ZeroBased n) fptr-      (fptr,s,n) ->-         Array.takeRight $-         Array (Shape.ZeroBased s ::+ Shape.ZeroBased n) fptr--toStorableVector :: (Shape.C sh, Storable a) => Array sh a -> SVB.Vector a-toStorableVector (Array sh fptr) =-   SVB.fromForeignPtr fptr $ Shape.size sh---{- |->>> :{-   Array.fromBlockArray1 $ BoxedArray.fromList Set.empty [] :: Array (Map Char ShapeInt) Word16-:}-StorableArray.fromList (fromList []) []-->>> :{-   let block n a = Array.replicate (shapeInt n) (a::Word16) in-   Array.fromBlockArray1 $-   BoxedArray.fromList (Set.fromList "ABC") [block 2 0, block 3 1, block 5 2]-:}-StorableArray.fromList (fromList [('A',ZeroBased {... 2}),('B',ZeroBased {... 3}),('C',ZeroBased {... 5})]) [0,0,1,1,1,2,2,2,2,2]--}-fromBlockArray1 ::+{-# DEPRECATED fromBlockArray1 "Use fromBlockArray instead." #-}+fromBlockArray, fromBlockArray1 ::    (Ord k, Shape.C shape, Storable a) =>    BoxedArray.Array (Set k) (Array shape a) -> Array (Map k shape) a-fromBlockArray1 a =+fromBlockArray1 = fromBlockArray+fromBlockArray a =    reshape (BoxedArray.toMap $ fmap Array.shape a) $-   fromStorableVector $ SV.concat $-   List.map toStorableVector $ BoxedArray.toList a--{- |-Only the outer @BoxedArray@ need to be non-empty.-->>> :{-   let shapeR0 = shapeInt 2; shapeR1 = shapeInt 3 in-   let shapeC0 = shapeInt 3; shapeC1 = shapeInt 2 in-   let block sh a = Array.replicate sh (a::Word16) in-   Array.fromBlockArray2-      (Map.singleton 'A' shapeR0 <> Map.singleton 'B' shapeR1)-      (Map.singleton '1' shapeC0 <> Map.singleton '2' shapeC1) $-   BoxedArray.fromList (Set.fromList "AB", Set.fromList "12")-      [block (shapeR0,shapeC0) 0, block (shapeR0,shapeC1) 1,-       block (shapeR1,shapeC0) 2, block (shapeR1,shapeC1) 3]-:}-StorableArray.fromList (fromList [('A',ZeroBased {... 2}),('B',ZeroBased {... 3})],fromList [('1',ZeroBased {... 3}),('2',ZeroBased {... 2})]) [0,0,0,1,1,0,0,0,1,1,2,2,2,3,3,2,2,2,3,3,2,2,2,3,3]--prop> :{-   QC.forAll genArray2 $ \blockA1 ->-   QC.forAll genArray2 $ \blockB2 ->-   let shapeR0 = fst $ Array.shape blockA1 in-   let shapeC0 = snd $ Array.shape blockA1 in-   let shapeR1 = fst $ Array.shape blockB2 in-   let shapeC1 = snd $ Array.shape blockB2 in-   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->-   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->-   let blocked =-         BoxedArray.fromList (Set.fromList "AB", Set.fromList "12")-            [blockA1, blockA2, blockB1, blockB2] in--   transpose (Array.fromNonEmptyBlockArray2 blocked)-   QC.===-   Array.fromNonEmptyBlockArray2-      (TestBoxedArray.transpose (fmap transpose blocked))-:}--prop> :{-   QC.forAll genArray2 $ \blockA1 ->-   QC.forAll genArray2 $ \blockB2 ->-   QC.forAll genArray2 $ \blockC3 ->-   let shapeR0 = fst $ Array.shape blockA1 in-   let shapeC0 = snd $ Array.shape blockA1 in-   let shapeR1 = fst $ Array.shape blockB2 in-   let shapeC1 = snd $ Array.shape blockB2 in-   let shapeR2 = fst $ Array.shape blockC3 in-   let shapeC2 = snd $ Array.shape blockC3 in-   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->-   QC.forAll (genArrayForShape (shapeR0, shapeC2)) $ \blockA3 ->-   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->-   QC.forAll (genArrayForShape (shapeR1, shapeC2)) $ \blockB3 ->-   QC.forAll (genArrayForShape (shapeR2, shapeC0)) $ \blockC1 ->-   QC.forAll (genArrayForShape (shapeR2, shapeC1)) $ \blockC2 ->-   let blocked =-         BoxedArray.fromList (Set.fromList "ABC", Set.fromList "123")-            [blockA1, blockA2, blockA3,-             blockB1, blockB2, blockB3,-             blockC1, blockC2, blockC3] in+   Array.fromStorableVector $ SV.concat $+   List.map Array.toStorableVector $ BoxedArray.toList a -   transpose (Array.fromNonEmptyBlockArray2 blocked)-   QC.===-   Array.fromNonEmptyBlockArray2-      (TestBoxedArray.transpose (fmap transpose blocked))-:}--}+{-# DEPRECATED fromNonEmptyBlockArray2+      "Use Storable.Dim2.fromNonEmptyBlockArray instead." #-} fromNonEmptyBlockArray2 ::    (Ord row,    Shape.C height, Eq height) =>    (Ord column, Shape.C width,  Eq width) =>    (Storable a) =>    BoxedArray.Array (Set row, Set column) (Array (height, width) a) ->    Array (Map row height, Map column width) a-fromNonEmptyBlockArray2 arr =-   let shapes = List.map Array.shape $ BoxedArray.toList arr in-   let width = Set.size $ snd $ BoxedArray.shape arr in-   let (rowIxs, columnIxs) =-         mapPair (Set.toAscList, Set.toAscList) $ BoxedArray.shape arr in-   case (ListHT.sieve width shapes, take width shapes) of-      (leftColumn@(_:_), topRow@(_:_)) ->-         fromBlockArray2-            (Map.fromList $ List.zip rowIxs $ List.map fst leftColumn)-            (Map.fromList $ List.zip columnIxs $ List.map snd topRow)-            arr-      _ -> errorArray "fromNonEmptyBlockArray2" "empty array"--{- |-Explicit parameters for the shape of the result matrix-allow for working with arrays of zero rows or columns.-->>> :{-   (id :: Id (array (height, Map Char ShapeInt) Word16)) $-   Array.fromBlockArray2-      (Map.singleton 'A' (shapeInt 2) <> Map.singleton 'B' (shapeInt 3))-      Map.empty $-   BoxedArray.fromList (Set.fromList "AB", Set.empty) []-:}-StorableArray.fromList (fromList [('A',ZeroBased {... 2}),('B',ZeroBased {... 3})],fromList []) []--prop> :{-   QC.forAll genArray2 $ \block ->-   let height = Map.singleton 'A' $ fst $ Array.shape block in-   let width  = Map.singleton '1' $ snd $ Array.shape block in+fromNonEmptyBlockArray2 = Array2.fromNonEmptyBlockArray -   Array.reshape (height,width) block-   QC.===-   Array.fromBlockArray2 height width-      (BoxedArray.replicate (Set.singleton 'A', Set.singleton '1') block)-:}--}+{-# DEPRECATED fromBlockArray2 "Use Storable.Dim2.fromBlockArray instead." #-} fromBlockArray2 ::    (Ord row,    Shape.C height, Eq height) =>    (Ord column, Shape.C width,  Eq width) =>@@ -425,29 +269,7 @@    Map row height -> Map column width ->    BoxedArray.Array (Set row, Set column) (Array (height, width) a) ->    Array (Map row height, Map column width) a-fromBlockArray2 height width =-   Array.reshape (height, width) . fromStorableVector .-   SV.concat . List.concat . List.concatMap List.transpose .-   ListHT.sliceVertical (Map.size width) . BoxedArray.toList .-   BoxedArray.zipWith-      (\(h,w) block ->-         if (h,w) == Array.shape block-            then toRowSlices block-            else errorArray "fromBlockArray2" "block shapes mismatch")-      (BoxedArray.cartesian-         (BoxedArray.fromMap height) (BoxedArray.fromMap width))-{--[[[111,111],[222,222]],[[333,333],[444,444]]]-  |-  v-[111,222,111,222,333,444,333,444]--}--toRowSlices ::-   (Shape.C sh0, Shape.C sh1, Storable a) =>-   Array (sh0, sh1) a -> [SV.Vector a]-toRowSlices arr =-   SV.sliceVertical (Shape.size $ snd $ shape arr) $ toStorableVector arr+fromBlockArray2 = Array2.fromBlockArray   toAssociations ::@@ -513,36 +335,56 @@   {- |-prop> QC.forAll genNonEmptyArray2 $ \xs -> QC.forAll (QC.elements $ Shape.indices $ Array.shape xs) $ \(ix0,ix1) -> Array.pick xs ix0 ! ix1 == xs!(ix0,ix1)+>>> Array.takeSet (Set.fromList [0,2,4,7,13]) (Array.vectorFromList [3,1,4,1,5,9,2,6,5,3,5,8,9,7,9,3::Word8])+StorableArray... (... [0,2,4,7,13]) [3,4,5,6,7] -}+{-# INLINE takeSet #-}+takeSet ::+   (Shape.Indexed sh, Shape.Index sh ~ ix, Ord ix, Storable a) =>+   Set ix -> Array sh a -> Array (Set ix) a+takeSet = takeSetGen Set.toAscList++{- |+>>> Array.takeIntSet (IntSet.fromList [0,2,4,7,13]) (Array.vectorFromList [3,1,4,1,5,9,2,6,5,3,5,8,9,7,9,3::Word8])+StorableArray... (... [0,2,4,7,13]) [3,4,5,6,7]+-}+{-# INLINE takeIntSet #-}+takeIntSet ::+   (Shape.Indexed sh, Shape.Index sh ~ Int, Storable a) =>+   IntSet -> Array sh a -> Array IntSet a+takeIntSet = takeSetGen IntSet.toAscList++{-# INLINE takeSetGen #-}+takeSetGen ::+   (Shape.Indexed sh, Shape.Index sh ~ ix, Shape.C set, Storable a) =>+   (set -> [ix]) -> set -> Array sh a -> Array set a+takeSetGen listFromSet ixs (Array sh a) =+   Array.unsafeCreate ixs $ \dstPtr ->+   withForeignPtr a $ \srcPtr ->+   sequence_ $+      List.zipWith+         (\src dst -> poke dst =<< peekElemOff srcPtr src)+         (List.map (Shape.offset sh) $ listFromSet ixs)+         (iterate (flip advancePtr 1) dstPtr)+++{-# DEPRECATED pick "Use Storable.Dim2.takeRow instead." #-} pick ::    (Shape.Indexed sh0, Shape.C sh1, Storable a) =>    Array (sh0,sh1) a -> Shape.Index sh0 -> Array sh1 a-pick (Array (sh0,sh1) x) ix0 =-   Array.unsafeCreateWithSize sh1 $ \k yPtr ->-   withForeignPtr x $ \xPtr ->-      copyArray yPtr (advancePtr xPtr (Shape.offset sh0 ix0 * k)) k+pick = Array2.takeRow +{-# DEPRECATED toRowArray "Use Storable.Dim2.toRowArray instead." #-} toRowArray ::    (Shape.Indexed sh0, Shape.C sh1, Storable a) =>    Array (sh0,sh1) a -> BoxedArray.Array sh0 (Array sh1 a)-toRowArray x = fmap (pick x) $ BoxedArray.indices $ fst $ Array.shape x--{- |-It is a checked error if a row width differs from the result array width.+toRowArray = Array2.toRowArray -prop> QC.forAll genArray2 $ \xs -> xs == Array.fromRowArray (snd $ Array.shape xs) (Array.toRowArray xs)--}+{-# DEPRECATED fromRowArray "Use Storable.Dim2.fromRowArray instead." #-} fromRowArray ::    (Shape.C sh0, Shape.C sh1, Eq sh1, Storable a) =>    sh1 -> BoxedArray.Array sh0 (Array sh1 a) -> Array (sh0,sh1) a-fromRowArray sh1 x =-   Array.unsafeCreate (BoxedArray.shape x, sh1) $ \yPtr ->-   let k = Shape.size sh1 in-   forM_ (zip [0,k..] (BoxedArray.toList x)) $ \(j, Array sh1i row) ->-   if sh1 == sh1i-      then withForeignPtr row $ \xPtr -> copyArray (advancePtr yPtr j) xPtr k-      else errorArray "fromRowArray" "mismatching row width"+fromRowArray = Array2.fromRowArray   {- |

@@ -0,0 +1,697 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE UndecidableInstances #-}+module Data.Array.Comfort.Storable.Dim2 (+   Array2,+   singleRow, flattenRow,+   singleColumn, flattenColumn,+   takeRow,+   toRowArray,+   fromRowArray,+   above, beside,+   takeTop, takeBottom,+   takeLeft, takeRight,++   fromNonEmptyBlockArray,+   fromBlockArray,+   fromBlocks, BlockFunction, RowFunction,+   ShapeSequence(switchSequence),++   BlockArray, BlockMatrix, Block,+   fromBlockMatrix, block, blockAbove, blockBeside, (&===), (&|||),+   ) where++import qualified Data.Array.Comfort.Boxed as BoxedArray+import qualified Data.Array.Comfort.Storable.Unchecked as Array+import qualified Data.Array.Comfort.Shape.SubSize as SubSize+import qualified Data.Array.Comfort.Shape as Shape+import Data.Array.Comfort.Storable.Unchecked (Array(Array))+import Data.Array.Comfort.Shape ((::+)((::+)))++import Foreign.Marshal.Array (copyArray, advancePtr)+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Storable (Storable)++import qualified Data.StorableVector as SV++import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified Data.List.HT as ListHT+import qualified Data.List as List+import Data.Map (Map)+import Data.Set (Set)+import Data.Foldable (forM_)+import Data.Tuple.HT (mapPair, mapFst)+import Data.Proxy (Proxy(Proxy))+++{- $setup+>>> import qualified DocTest.Data.Array.Comfort.Boxed.Unchecked+>>>                                              as TestBoxedArray+>>> import DocTest.Data.Array.Comfort.Storable (ShapeInt, shapeInt)+>>>+>>> import qualified Data.Array.Comfort.Boxed as BoxedArray+>>> import qualified Data.Array.Comfort.Storable.Dim2 as Array2+>>> import qualified Data.Array.Comfort.Storable as Array+>>> import qualified Data.Array.Comfort.Shape as Shape+>>> import Data.Array.Comfort.Storable.Dim2 (Array2, (&===), (&|||))+>>> import Data.Array.Comfort.Storable (Array, (!))+>>> import Data.Array.Comfort.Shape ((::+)((::+)))+>>>+>>> import qualified Test.QuickCheck as QC+>>>+>>> import Control.Monad (replicateM)+>>> import Control.Applicative (liftA2, (<$>), (<*>))+>>>+>>> import qualified Data.Map as Map+>>> import qualified Data.Set as Set+>>> import Data.Map (Map)+>>> import Data.Function.HT (Id)+>>> import Data.Tuple.HT (swap)+>>> import Data.Word (Word16)+>>> import Data.Proxy (Proxy(Proxy))+>>>+>>> import Foreign.Storable (Storable)+>>>+>>> genArray2 :: QC.Gen (Array2 ShapeInt ShapeInt Word16)+>>> genArray2 = do+>>>    xs <- QC.arbitrary+>>>    let n = length xs+>>>    (k,m) <-+>>>       if n == 0+>>>          then QC.elements [(,) 0, flip (,) 0] <*> QC.choose (1,20)+>>>          else fmap (\m -> (div n m, m)) $ QC.choose (1,n)+>>>    return $ Array.fromList (Shape.ZeroBased k, Shape.ZeroBased m) xs+>>>+>>> genArrayForShape :: (Shape.C shape) => shape -> QC.Gen (Array shape Word16)+>>> genArrayForShape sh =+>>>    Array.fromList sh <$> replicateM (Shape.size sh) QC.arbitrary+>>>+>>> genNonEmptyArray2 :: QC.Gen (Array2 ShapeInt ShapeInt Word16)+>>> genNonEmptyArray2 = do+>>>    xs <- QC.getNonEmpty <$> QC.arbitrary+>>>    let n = length xs+>>>    m <- QC.choose (1,n)+>>>    return $ Array.fromList (Shape.ZeroBased (div n m), Shape.ZeroBased m) xs+>>>+>>>+>>> transpose ::+>>>    (Shape.Indexed sh0, Shape.Indexed sh1, Storable a) =>+>>>    Array2 sh0 sh1 a -> Array2 sh1 sh0 a+>>> transpose a = Array.sample (swap $ Array.shape a) (\(i,j) -> a!(j,i))+-}+++type Array2 sh0 sh1 = Array (sh0,sh1)++singleRow :: Array width a -> Array2 () width a+singleRow = Array.mapShape ((,) ())++singleColumn :: Array height a -> Array2 height () a+singleColumn = Array.mapShape (flip (,) ())++flattenRow :: Array2 () width a -> Array width a+flattenRow = Array.mapShape snd++flattenColumn :: Array2 height () a -> Array height a+flattenColumn = Array.mapShape fst+++{- |+prop> :{+   QC.forAll genNonEmptyArray2 $ \xs ->+   QC.forAll (QC.elements $ Shape.indices $ Array.shape xs) $ \(ix0,ix1) ->+      Array2.takeRow xs ix0 ! ix1 == xs!(ix0,ix1)+:}+-}+takeRow ::+   (Shape.Indexed sh0, Shape.C sh1, Storable a) =>+   Array2 sh0 sh1 a -> Shape.Index sh0 -> Array sh1 a+takeRow (Array (sh0,sh1) x) ix0 =+   Array.unsafeCreateWithSize sh1 $ \k yPtr ->+   withForeignPtr x $ \xPtr ->+      copyArray yPtr (advancePtr xPtr (Shape.offset sh0 ix0 * k)) k++toRowArray ::+   (Shape.C sh0, Shape.C sh1, Storable a) =>+   Array2 sh0 sh1 a -> BoxedArray.Array sh0 (Array sh1 a)+toRowArray x =+   let y = Array.mapShape (mapFst Shape.Deferred) x in+   BoxedArray.mapShape (\(Shape.Deferred sh0) -> sh0) $+   fmap (takeRow y) $ BoxedArray.indices $ fst $ Array.shape y++{- |+It is a checked error if a row width differs from the result array width.++prop> :{+   QC.forAll genArray2 $ \xs ->+      xs == Array2.fromRowArray (snd $ Array.shape xs) (Array2.toRowArray xs)+:}+-}+fromRowArray ::+   (Shape.C sh0, Shape.C sh1, Eq sh1, Storable a) =>+   sh1 -> BoxedArray.Array sh0 (Array sh1 a) -> Array2 sh0 sh1 a+fromRowArray sh1 x =+   Array.unsafeCreateWithAutoSizes (BoxedArray.shape x, sh1) $+      \(SubSize.Atom _, SubSize.Atom k) yPtr ->+   forM_ (zip [0,k..] (BoxedArray.toList x)) $ \(j, Array sh1i row) ->+   if sh1 == sh1i+      then withForeignPtr row $ \xPtr -> copyArray (advancePtr yPtr j) xPtr k+      else errorArray "fromRowArray" "mismatching row width"+++infixr 2 `above`+infixr 3 `beside`++{- |+prop> :{+   QC.forAll genArray2 $ \xs ->+   let (Shape.ZeroBased m, width) = Array.shape xs in+   QC.forAll (QC.choose (0, m)) $ \k ->+      let ys = Array.reshape+                  (Shape.ZeroBased k ::+ Shape.ZeroBased (m-k), width) xs in+      ys == Array2.above (Array2.takeTop ys) (Array2.takeBottom ys)+:}+-}+above ::+   (Shape.C heightA, Shape.C heightB) =>+   (Shape.C width, Eq width) =>+   (Storable a) =>+   Array2 heightA width a ->+   Array2 heightB width a ->+   Array2 (heightA::+heightB) width a+above a b =+   Array.mapShape+      (\((heightA,widthA)::+(heightB,widthB)) ->+         if widthA == widthB+            then (heightA::+heightB, widthA)+            else error "Array.Dim2.above: widths mismatch") $+   Array.append a b++{- |+prop> :{+   QC.forAll genArray2 $ \xs ->+   let (height, Shape.ZeroBased n) = Array.shape xs in+   QC.forAll (QC.choose (0, n)) $ \k ->+      let ys = Array.reshape+                  (height, Shape.ZeroBased k ::+ Shape.ZeroBased (n-k)) xs in+      ys == Array2.beside (Array2.takeLeft ys) (Array2.takeRight ys)+:}+-}+beside ::+   (Shape.C height, Eq height) =>+   (Shape.C widthA, Shape.C widthB) =>+   (Storable a) =>+   Array2 height widthA a ->+   Array2 height widthB a ->+   Array2 height (widthA::+widthB) a+beside a b =+   case (Array.shape a, Array.shape b) of+      ((heightA, widthA), (heightB, widthB)) ->+         if heightA == heightB+            then+               Array.reshape (heightA, widthA::+widthB) .+               Array.fromStorableVector .+               SV.concat . concat . take (Shape.size heightA) $+               zipWith+                  (\arow brow -> [arow, brow])+                  (toRowSlicesInf a)+                  (toRowSlicesInf b)+            else error "Array.Dim2.beside: heights mismatch"+++takeTop ::+   (Shape.C heightA, Shape.C heightB, Shape.C width, Storable a) =>+   Array2 (heightA::+heightB) width a ->+   Array2 heightA width a+takeTop = Array.takeLeft . splitVertically++takeBottom ::+   (Shape.C heightA, Shape.C heightB, Shape.C width, Storable a) =>+   Array2 (heightA::+heightB) width a ->+   Array2 heightB width a+takeBottom = Array.takeRight . splitVertically++splitVertically ::+   (Shape.C heightA, Shape.C heightB, Shape.C width) =>+   Array2 (heightA::+heightB) width a ->+   Array ((heightA,width)::+(heightB,width)) a+splitVertically =+   Array.mapShape+      (\(heightA::+heightB, width) -> (heightA,width)::+(heightB,width))+++takeLeft ::+   (Shape.C height, Shape.C widthA, Shape.C widthB, Storable a) =>+   Array2 height (widthA::+widthB) a ->+   Array2 height widthA a+takeLeft a =+   case Array.shape a of+      (height, widthA::+widthB) ->+         let m = Shape.size height+             na = Shape.size widthA+             nb = Shape.size widthB+         in Array.reshape (height, widthA) . Array.fromStorableVector .+            SV.concat . take m . map (SV.take na) .+            iterate (SV.drop (na+nb)) .+            Array.toStorableVector $ a++takeRight ::+   (Shape.C height, Shape.C widthA, Shape.C widthB, Storable a) =>+   Array2 height (widthA::+widthB) a ->+   Array2 height widthB a+takeRight a =+   case Array.shape a of+      (height, widthA::+widthB) ->+         let m = Shape.size height+             na = Shape.size widthA+             nb = Shape.size widthB+         in Array.reshape (height, widthB) . Array.fromStorableVector .+            SV.concat . take m . map (SV.take nb) .+            iterate (SV.drop (na+nb)) . SV.drop na .+            Array.toStorableVector $ a+++{- |+Only the outer @BoxedArray@ need to be non-empty.++>>> :{+   let shapeR0 = shapeInt 2; shapeR1 = shapeInt 3 in+   let shapeC0 = shapeInt 3; shapeC1 = shapeInt 2 in+   let block sh a = Array.replicate sh (a::Word16) in+   Array2.fromBlockArray+      (Map.singleton 'A' shapeR0 <> Map.singleton 'B' shapeR1)+      (Map.singleton '1' shapeC0 <> Map.singleton '2' shapeC1) $+   BoxedArray.fromList (Set.fromList "AB", Set.fromList "12")+      [block (shapeR0,shapeC0) 0, block (shapeR0,shapeC1) 1,+       block (shapeR1,shapeC0) 2, block (shapeR1,shapeC1) 3]+:}+StorableArray.fromList (fromList [('A',ZeroBased {... 2}),('B',ZeroBased {... 3})],fromList [('1',ZeroBased {... 3}),('2',ZeroBased {... 2})]) [0,0,0,1,1,0,0,0,1,1,2,2,2,3,3,2,2,2,3,3,2,2,2,3,3]++prop> :{+   QC.forAll genArray2 $ \blockA1 ->+   QC.forAll genArray2 $ \blockB2 ->+   let shapeR0 = fst $ Array.shape blockA1 in+   let shapeC0 = snd $ Array.shape blockA1 in+   let shapeR1 = fst $ Array.shape blockB2 in+   let shapeC1 = snd $ Array.shape blockB2 in+   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->+   let blocked =+         BoxedArray.fromList (Set.fromList "AB", Set.fromList "12")+            [blockA1, blockA2, blockB1, blockB2] in++   transpose (Array2.fromNonEmptyBlockArray blocked)+   QC.===+   Array2.fromNonEmptyBlockArray+      (TestBoxedArray.transpose (fmap transpose blocked))+:}++prop> :{+   QC.forAll genArray2 $ \blockA1 ->+   QC.forAll genArray2 $ \blockB2 ->+   QC.forAll genArray2 $ \blockC3 ->+   let shapeR0 = fst $ Array.shape blockA1 in+   let shapeC0 = snd $ Array.shape blockA1 in+   let shapeR1 = fst $ Array.shape blockB2 in+   let shapeC1 = snd $ Array.shape blockB2 in+   let shapeR2 = fst $ Array.shape blockC3 in+   let shapeC2 = snd $ Array.shape blockC3 in+   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->+   QC.forAll (genArrayForShape (shapeR0, shapeC2)) $ \blockA3 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC2)) $ \blockB3 ->+   QC.forAll (genArrayForShape (shapeR2, shapeC0)) $ \blockC1 ->+   QC.forAll (genArrayForShape (shapeR2, shapeC1)) $ \blockC2 ->+   let blocked =+         BoxedArray.fromList (Set.fromList "ABC", Set.fromList "123")+            [blockA1, blockA2, blockA3,+             blockB1, blockB2, blockB3,+             blockC1, blockC2, blockC3] in++   transpose (Array2.fromNonEmptyBlockArray blocked)+   QC.===+   Array2.fromNonEmptyBlockArray+      (TestBoxedArray.transpose (fmap transpose blocked))+:}+-}+fromNonEmptyBlockArray ::+   (Ord row,    Shape.C height, Eq height) =>+   (Ord column, Shape.C width,  Eq width) =>+   (Storable a) =>+   BoxedArray.Array (Set row, Set column) (Array2 height width a) ->+   Array2 (Map row height) (Map column width) a+fromNonEmptyBlockArray arr =+   let shapes = List.map Array.shape $ BoxedArray.toList arr in+   let width = Set.size $ snd $ BoxedArray.shape arr in+   let (rowIxs, columnIxs) =+         mapPair (Set.toAscList, Set.toAscList) $ BoxedArray.shape arr in+   case (ListHT.sieve width shapes, take width shapes) of+      (leftColumn@(_:_), topRow@(_:_)) ->+         fromBlockArray+            (Map.fromList $ List.zip rowIxs $ List.map fst leftColumn)+            (Map.fromList $ List.zip columnIxs $ List.map snd topRow)+            arr+      _ -> errorArray "fromNonEmptyBlockArray" "empty array"++{- |+Explicit parameters for the shape of the result matrix+allow for working with arrays of zero rows or columns.++>>> :{+   (id :: Id (array (height, Map Char ShapeInt) Word16)) $+   Array2.fromBlockArray+      (Map.singleton 'A' (shapeInt 2) <> Map.singleton 'B' (shapeInt 3))+      Map.empty $+   BoxedArray.fromList (Set.fromList "AB", Set.empty) []+:}+StorableArray.fromList (fromList [('A',ZeroBased {... 2}),('B',ZeroBased {... 3})],fromList []) []++prop> :{+   QC.forAll genArray2 $ \block ->+   let height = Map.singleton 'A' $ fst $ Array.shape block in+   let width  = Map.singleton '1' $ snd $ Array.shape block in++   Array.reshape (height,width) block+   QC.===+   Array2.fromBlockArray height width+      (BoxedArray.replicate (Set.singleton 'A', Set.singleton '1') block)+:}+-}+fromBlockArray ::+   (Ord row,    Shape.C height, Eq height) =>+   (Ord column, Shape.C width,  Eq width) =>+   (Storable a) =>+   Map row height -> Map column width ->+   BoxedArray.Array (Set row, Set column) (Array2 height width a) ->+   Array2 (Map row height) (Map column width) a+fromBlockArray height width =+   Array.reshape (height, width) . Array.fromStorableVector .+   SV.concat . List.concat . List.concatMap List.transpose .+   ListHT.sliceVertical (Map.size width) . BoxedArray.toList .+   BoxedArray.zipWith checkSliceBlock+      (BoxedArray.cartesian+         (BoxedArray.fromMap height) (BoxedArray.fromMap width))+{-+[[[111,111],[222,222]],[[333,333],[444,444]]]+  |+  v+[111,222,111,222,333,444,333,444]+-}++++class (Shape.C sh) => ShapeSequence sh where+   switchSequence ::+      f Shape.Zero ->+      (forall sh0 shs. (Shape.C sh0, Eq sh0, ShapeSequence shs) =>+         f (sh0::+shs)) ->+      f sh++instance ShapeSequence Shape.Zero where+   switchSequence f _ = f++instance+   (Shape.C sh, Eq sh, ShapeSequence shs) =>+      ShapeSequence (sh::+shs) where+   switchSequence _ f = f+++type family BlockFunction heights widths a r+type instance BlockFunction Shape.Zero widths a r = r+type instance BlockFunction (height::+heights) widths a r =+       RowFunction height widths a (BlockFunction heights widths a r)++newtype CreateBig widths a r heights =+   CreateBig {+      getCreateBig ::+         heights -> widths ->+         ([[SV.Vector a]] -> r) ->+         BlockFunction heights widths a r+   }++createBig ::+   (ShapeSequence heights, ShapeSequence widths, Storable a) =>+   heights -> widths ->+   ([[SV.Vector a]] -> r) ->+   BlockFunction heights widths a r+createBig =+   getCreateBig $+   switchSequence+      (CreateBig $ \Shape.Zero _widths cons -> cons [])+      (CreateBig $ \(height::+heights) widths cons ->+         createBlockRow heights widths cons height widths id)+++type family RowFunction height widths a r+type instance RowFunction height Shape.Zero a r = r+type instance RowFunction height (width::+widths) a r =+       Array2 height width a -> RowFunction height widths a r++newtype CreateBlockRow heightsRem widthsRem height a r widths =+   CreateBlockRow {+      getCreateBlockRow ::+         heightsRem -> widthsRem -> ([[SV.Vector a]] -> r) ->+         height ->     widths ->    ([[SV.Vector a]] -> [[SV.Vector a]]) ->+         RowFunction height widths a+            (BlockFunction heightsRem widthsRem a r)+   }++createBlockRow ::+   (ShapeSequence heightsRem, ShapeSequence widthsRem) =>+   (Shape.C height, Eq height, ShapeSequence widths, Storable a) =>+   heightsRem -> widthsRem -> ([[SV.Vector a]] -> r) ->+   height ->     widths ->    ([[SV.Vector a]] -> [[SV.Vector a]]) ->+   RowFunction height widths a+      (BlockFunction heightsRem widthsRem a r)+createBlockRow =+   getCreateBlockRow $+   switchSequence+      (CreateBlockRow $+         \heightsRem widthsRem consBig _height Shape.Zero consRow ->+            createBig heightsRem widthsRem+               (consBig . (List.transpose (consRow []) ++)))+      (CreateBlockRow $+         \heightsRem widthsRem consBig height (width::+widths) consRow blk ->+            createBlockRow+               heightsRem widthsRem consBig+               height widths+                  (consRow . (checkSliceBlock (height,width) blk :)))+++{- |+prop> :{+   QC.forAll genArray2 $ \blockA1 ->+   QC.forAll genArray2 $ \blockB2 ->+   let shapeR0 = fst $ Array.shape blockA1 in+   let shapeC0 = snd $ Array.shape blockA1 in+   let shapeR1 = fst $ Array.shape blockB2 in+   let shapeC1 = snd $ Array.shape blockB2 in+   let shapeR = shapeR0::+shapeR1::+Shape.Zero in+   let shapeC = shapeC0::+shapeC1::+Shape.Zero in+   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->+   let blocked =+         BoxedArray.fromList (Set.fromList "AB", Set.fromList "12")+            [blockA1, blockA2, blockB1, blockB2] in++   Array.reshape (shapeR, shapeC)+      (Array2.fromNonEmptyBlockArray blocked)+   QC.===+   Array2.fromBlocks shapeR shapeC Proxy+      blockA1 blockA2+      blockB1 blockB2+:}+-}+fromBlocks ::+   (ShapeSequence height, ShapeSequence width, Storable a) =>+   height -> width -> Proxy a ->+   BlockFunction height width a (Array2 height width a)+fromBlocks height width proxy =+   createBig height width+      (Array.reshape (height, width) . Array.fromStorableVector .+       idSV proxy . SV.concat . List.concat)++idSV :: Proxy a -> SV.Vector a -> SV.Vector a+idSV Proxy = id++++data BlockArray shape a = BlockArray shape [[SV.Vector a]]+type BlockMatrix height width = BlockArray (height, width)++block ::+   (Block block, Shape.C height, Shape.C width, Storable a) =>+   block (height, width) a -> BlockMatrix height width a+block = blockPrivate++class Block block where+   blockPrivate ::+      (Shape.C height, Shape.C width, Storable a) =>+      block (height, width) a -> BlockMatrix height width a++instance Block BlockArray where+   blockPrivate = id++instance Block Array where+   blockPrivate arr =+      BlockArray (Array.shape arr)+         (map (:[]) $ take (Shape.size $ fst $ Array.shape arr) $+         toRowSlicesInf arr)++blockAbove ::+   (Eq width) =>+   BlockMatrix heightA width a -> BlockMatrix heightB width a ->+   BlockMatrix (heightA::+heightB) width a+blockAbove (BlockArray (heightA,widthA) a) (BlockArray (heightB,widthB) b) =+   BlockArray+      (if widthA == widthB+         then (heightA::+heightB, widthA)+         else error "Array.Dim2.blockAbove: widths mismatch")+      (a ++ b)++blockBeside ::+   (Eq height) =>+   BlockMatrix height widthA a -> BlockMatrix height widthB a ->+   BlockMatrix height (widthA::+widthB) a+blockBeside (BlockArray (heightA,widthA) a) (BlockArray (heightB,widthB) b) =+   BlockArray+      (if heightA == heightB+         then (heightA, widthA::+widthB)+         else error "Array.Dim2.beside: heights mismatch")+      (zipWith (++) a b)++infixr 2 &===+infixr 3 &|||++(&===) ::+   (Block blockA, Block blockB) =>+   (Shape.C heightA, Shape.C heightB) =>+   (Shape.C width, Eq width) =>+   (Storable a) =>+   blockA (heightA,width) a -> blockB (heightB,width) a ->+   BlockMatrix (heightA::+heightB) width a+(&===) a b = blockAbove (block a) (block b)++(&|||) ::+   (Block blockA, Block blockB) =>+   (Shape.C height, Eq height) =>+   (Shape.C widthA, Shape.C widthB) =>+   (Storable a) =>+   blockA (height,widthA) a -> blockB (height,widthB) a ->+   BlockMatrix height (widthA::+widthB) a+(&|||) a b = blockBeside (block a) (block b)++++{- |+prop> :{+   QC.forAll genArray2 $ \blockA1 ->+   QC.forAll genArray2 $ \blockB3 ->+   QC.forAll+      (liftA2+         (\char0 char1 -> Shape.Range (min char0 char1) (max char0 char1))+         (QC.choose ('a','k')) (QC.choose ('a','k'))) $+      \shapeC1 ->+   let shapeR0 = fst $ Array.shape blockA1 in+   let shapeC0 = snd $ Array.shape blockA1 in+   let shapeR1 = fst $ Array.shape blockB3 in+   let shapeC2 = snd $ Array.shape blockB3 in+   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->+   QC.forAll (genArrayForShape (shapeR0, shapeC2)) $ \blockA3 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC1)) $ \blockB2 ->++   Array2.fromBlockMatrix+      (blockA1 &||| Array2.beside blockA2 blockA3+       &===+       blockB1 &||| blockB2 &||| blockB3)+   QC.===+   Array.reshape+      (shapeR0::+shapeR1, shapeC0::+shapeC1::+shapeC2)+      (Array2.fromBlocks+         (shapeR0::+shapeR1::+Shape.Zero)+         (shapeC0::+shapeC1::+shapeC2::+Shape.Zero)+         Proxy+         blockA1 blockA2 blockA3+         blockB1 blockB2 blockB3)+:}++prop> :{+   QC.forAll+      (liftA2+         (\char0 char1 -> Shape.Range (min char0 char1) (max char0 char1))+         (QC.choose ('a','k')) (QC.choose ('a','k'))) $+      \shapeR0 ->+   QC.forAll+         (liftA2 Shape.Shifted (QC.choose (-10,10)) (QC.choose (0,10::Int))) $+      \shapeR1 ->+   let shapeR2 = () in+   QC.forAll (fmap Shape.ZeroBased (QC.choose (0,10::Int))) $+      \shapeC0 ->+   QC.forAll (fmap Shape.OneBased (QC.choose (0,10::Int))) $+      \shapeC1 ->+   let shapeC2 :: Shape.Enumeration Ordering+       shapeC2 = Shape.Enumeration in++   QC.forAll (genArrayForShape (shapeR0, shapeC0)) $ \blockA1 ->+   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->+   QC.forAll (genArrayForShape (shapeR0, shapeC2)) $ \blockA3 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC1)) $ \blockB2 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC2)) $ \blockB3 ->+   QC.forAll (genArrayForShape (shapeR2, shapeC0)) $ \blockC1 ->+   QC.forAll (genArrayForShape (shapeR2, shapeC1)) $ \blockC2 ->+   QC.forAll (genArrayForShape (shapeR2, shapeC2)) $ \blockC3 ->++   Array2.fromBlockMatrix+      (blockA1 &||| blockA2 &||| blockA3+       &===+       blockB1 &||| blockB2 &||| blockB3+       &===+       blockC1 &||| blockC2 &||| blockC3)+   QC.===+   Array2.beside+      (Array2.above blockA1 $ Array2.above blockB1 blockC1)+      (Array2.above+         (Array2.beside blockA2 blockA3)+         (Array2.beside+            (Array2.above blockB2 blockC2)+            (Array2.above blockB3 blockC3)))+:}+-}+fromBlockMatrix ::+   (Shape.C height, Shape.C width, Storable a) =>+   BlockMatrix height width a -> Array2 height width a+fromBlockMatrix (BlockArray (height, width) rows) =+   Array.reshape (height, width) .+   Array.fromStorableVector . SV.concat . List.concat $ rows+++checkSliceBlock ::+   (Shape.C sh0, Eq sh0, Shape.C sh1, Eq sh1, Storable a) =>+   (sh0, sh1) -> Array (sh0, sh1) a -> [SV.Vector a]+checkSliceBlock sh blk =+   if sh == Array.shape blk+      then toRowSlices blk+      else errorArray "fromBlockArray" "block shapes mismatch"++toRowSlices ::+   (Shape.C sh0, Shape.C sh1, Storable a) =>+   Array2 sh0 sh1 a -> [SV.Vector a]+toRowSlices arr =+   SV.sliceVertical (Shape.size $ snd $ Array.shape arr) $+   Array.toStorableVector arr++toRowSlicesInf ::+   (Shape.C sh0, Shape.C sh1, Storable a) =>+   Array2 sh0 sh1 a -> [SV.Vector a]+toRowSlicesInf arr =+   let n = Shape.size $ snd $ Array.shape arr in+   map (SV.take n) . iterate (SV.drop n) . Array.toStorableVector $ arr+++errorArray :: String -> String -> a+errorArray name msg =+   error ("Array.Comfort.Storable.Dim2." ++ name ++ ": " ++ msg)

@@ -11,10 +11,14 @@    (Priv.!),    unsafeCreate,    unsafeCreateWithSize,+   unsafeCreateWithSizes,+   unsafeCreateWithAutoSizes,    unsafeCreateWithSizeAndResult,    Priv.toList,    Priv.fromList,    Priv.vectorFromList,+   fromStorableVector,+   toStorableVector,     map,    mapWithIndex,@@ -36,10 +40,13 @@ import qualified Data.Array.Comfort.Storable.Unchecked.Monadic as Monadic import qualified Data.Array.Comfort.Storable.Private as Priv import qualified Data.Array.Comfort.Storable.Memory as Memory+import qualified Data.Array.Comfort.Shape.SubSize as SubSize import qualified Data.Array.Comfort.Shape as Shape import Data.Array.Comfort.Storable.Private (Array(Array), mapShape) import Data.Array.Comfort.Shape ((::+)((::+))) +import qualified Data.StorableVector.Base as SVB+ import System.IO.Unsafe (unsafePerformIO) import Foreign.Marshal.Array (copyArray, advancePtr) import Foreign.Storable (Storable, poke, peek)@@ -83,6 +90,18 @@    sh -> (Int -> Ptr a -> IO ()) -> Array sh a unsafeCreateWithSize sh arr = runST (Monadic.unsafeCreateWithSize sh arr) +unsafeCreateWithSizes ::+   (Shape.C sh, Storable a) =>+   SubSize.T sh nsize -> sh -> (nsize -> Ptr a -> IO ()) -> Array sh a+unsafeCreateWithSizes sub sh arr =+   runST (Monadic.unsafeCreateWithSizes sub sh arr)++unsafeCreateWithAutoSizes ::+   (Shape.C sh, sh ~ SubSize.ToShape nsize, SubSize.C nsize,+    Storable a) =>+   sh -> (nsize -> Ptr a -> IO ()) -> Array sh a+unsafeCreateWithAutoSizes = unsafeCreateWithSizes SubSize.auto+ unsafeCreateWithSizeAndResult ::    (Shape.C sh, Storable a) =>    sh -> (Int -> Ptr a -> IO b) -> (Array sh a, b)@@ -90,13 +109,26 @@    runST (Monadic.unsafeCreateWithSizeAndResult sh arr)  +fromStorableVector ::+   (Storable a) => SVB.Vector a -> Array (Shape.ZeroBased Int) a+fromStorableVector xs =+   case SVB.toForeignPtr xs of+      (fptr,0,n) -> Array (Shape.ZeroBased n) fptr+      (fptr,s,n) ->+         takeRight $ Array (Shape.ZeroBased s ::+ Shape.ZeroBased n) fptr++toStorableVector :: (Shape.C sh, Storable a) => Array sh a -> SVB.Vector a+toStorableVector (Array sh fptr) =+   SVB.fromForeignPtr fptr $ Shape.size sh++ map ::    (Shape.C sh, Storable a, Storable b) =>    (a -> b) -> Array sh a -> Array sh b map f (Array sh a) =-   unsafeCreate sh $ \dstPtr ->+   unsafeCreateWithSize sh $ \n dstPtr ->    withForeignPtr a $ \srcPtr ->-   sequence_ $ List.take (Shape.size sh) $+   sequence_ $ List.take n $       List.zipWith          (\src dst -> poke dst . f =<< peek src)          (iterate (flip advancePtr 1) srcPtr)@@ -119,10 +151,10 @@    (Shape.C sh, Storable a, Storable b, Storable c) =>    (a -> b -> c) -> Array sh a -> Array sh b -> Array sh c zipWith f (Array _sh a) (Array sh b) =-   unsafeCreate sh $ \dstPtr ->+   unsafeCreateWithSize sh $ \n dstPtr ->    withForeignPtr a $ \srcAPtr ->    withForeignPtr b $ \srcBPtr ->-   sequence_ $ List.take (Shape.size sh) $+   sequence_ $ List.take n $       List.zipWith3          (\srcA srcB dst -> poke dst =<< liftA2 f (peek srcA) (peek srcB))          (iterate (flip advancePtr 1) srcAPtr)

@@ -0,0 +1,80 @@+{-# LANGUAGE Rank2Types #-}+module Data.Array.Comfort.Storable.Unchecked.Creator where++import qualified Data.Array.Comfort.Shape.SubSize as SubSize+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 qualified Control.Monad.Trans.Cont as MC+import Control.Monad.Primitive (PrimMonad, unsafeIOToPrim)++import Data.Biapplicative (Biapplicative(bipure, (<<*>>)))+import Data.Bifunctor (Bifunctor(bimap))++import Data.Tuple.HT (mapFst)+++newtype Creator arr ptr = Creator (forall a. (ptr -> IO a) -> IO (arr, a))++liftIO :: IO ptr -> Creator () ptr+liftIO act = Creator $ \f -> fmap ((,) ()) $ f =<< act++liftContT :: (forall a. MC.ContT a IO ptr) -> Creator () ptr+liftContT act = Creator $ \f -> fmap ((,) ()) $ MC.runContT act f++instance Functor (Creator arr) where+   fmap g (Creator act) = Creator $ \f -> act (f . g)+++pair ::+   Creator arr0 ptr0 -> Creator arr1 ptr1 ->+   Creator (arr0,arr1) (ptr0,ptr1)+pair (Creator act0) (Creator act1) =+   Creator $ \f ->+      fmap (\(arr0,(arr1,a)) -> ((arr0,arr1),a)) $+      act0 $ \ptr0 ->+      act1 $ \ptr1 ->+         f (ptr0, ptr1)++instance Bifunctor Creator where+   bimap g h (Creator act) = Creator $ \f -> fmap (mapFst g) $ act (f . h)++instance Biapplicative Creator where+   bipure a b = Creator $ \f -> fmap ((,) a) $ f b+   creator0 <<*>> creator1 =+      bimap (uncurry id) (uncurry id) $ pair creator0 creator1++unsafeRun :: (PrimMonad m) => Creator arr ptr -> (ptr -> IO ()) -> m arr+unsafeRun (Creator act) f = unsafeIOToPrim $ fmap (\(arr,()) -> arr) $ act f++unsafeRunWithResult ::+   (PrimMonad m) => Creator arr ptr -> (ptr -> IO b) -> m (arr, b)+unsafeRunWithResult (Creator act) f = unsafeIOToPrim $ act f++{-# INLINE create #-}+create ::+   (Shape.C sh, Storable a) =>+   sh -> Creator (Array sh a) (Ptr a)+create sh = fmap snd $ createWithSize sh++{-# INLINE createWithSize #-}+createWithSize ::+   (Shape.C sh, Storable a) =>+   sh -> Creator (Array sh a) (Int, Ptr a)+createWithSize sh =+   let size = Shape.size sh+   in Creator $ \f ->+         fmap (mapFst (Array sh)) $ Alloc.create size $ curry f size++{-# INLINE createWithSizes #-}+createWithSizes ::+   (Shape.C sh, Storable a) =>+   SubSize.T sh nsize -> sh -> Creator (Array sh a) (nsize, Ptr a)+createWithSizes (SubSize.Cons subSize) sh =+   let (size, subSizes) = subSize sh+   in Creator $ \f ->+         fmap (mapFst (Array sh)) $ Alloc.create size $ curry f subSizes

@@ -1,5 +1,8 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} module Data.Array.Comfort.Storable.Unchecked.Monadic where +import qualified Data.Array.Comfort.Shape.SubSize as SubSize import qualified Data.Array.Comfort.Shape as Shape import Data.Array.Comfort.Storable.Private (Array(Array)) @@ -23,9 +26,30 @@    sh -> (Int -> Ptr a -> IO ()) -> m (Array sh a) unsafeCreateWithSize sh f = liftM fst $ unsafeCreateWithSizeAndResult sh f +unsafeCreateWithSizes ::+   (PrimMonad m, Shape.C sh, Storable a) =>+   SubSize.T sh nsize -> sh -> (nsize -> Ptr a -> IO ()) -> m (Array sh a)+unsafeCreateWithSizes sub sh f =+   liftM fst $ unsafeCreateWithSizesAndResult sub 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++unsafeCreateWithSizesAndResult ::+   (PrimMonad m, Shape.C sh, Storable a) =>+   SubSize.T sh nsize -> sh -> (nsize -> Ptr a -> IO b) -> m (Array sh a, b)+unsafeCreateWithSizesAndResult (SubSize.Cons subSize) sh f = unsafeIOToPrim $+   let (size, subSizes) = subSize sh+   in fmap (mapFst (Array sh)) $ Alloc.create size $ f subSizes++_unsafeCreateWithSizesAndResult ::+   (PrimMonad m, Storable a,+    SubSize.C nsize, SubSize.ToShape nsize ~ sh, Shape.C sh) =>+   sh -> (Int -> nsize -> Ptr a -> IO b) -> m (Array sh a, b)+_unsafeCreateWithSizesAndResult sh f = unsafeIOToPrim $+   let (size, subSizes) = SubSize.evaluate sh+   in fmap (mapFst (Array sh)) $ Alloc.create size $ f size subSizes

@@ -1,5 +0,0 @@-Data.Array.Comfort.Shape-Data.Array.Comfort.Storable-Data.Array.Comfort.Storable.Unchecked-Data.Array.Comfort.Boxed-Data.Array.Comfort.Boxed.Unchecked

@@ -19,87 +19,87 @@  test :: DocTest.T () test = do- DocTest.printPrefix "Data.Array.Comfort.Shape:344: "-{-# LINE 344 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:345: "+{-# LINE 345 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 344 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 345 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices ()   )   [ExpectedLine [LineChunk "[()]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:367: "-{-# LINE 367 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:368: "+{-# LINE 368 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 367 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 368 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices (Shape.ZeroBased (7::Int))   )   [ExpectedLine [LineChunk "[0,1,2,3,4,5,6]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:425: "-{-# LINE 425 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:426: "+{-# LINE 426 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 425 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 426 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices (Shape.OneBased (7::Int))   )   [ExpectedLine [LineChunk "[1,2,3,4,5,6,7]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:475: "-{-# LINE 475 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:476: "+{-# LINE 476 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 475 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 476 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices (Shape.Range (-5) (5::Int))   )   [ExpectedLine [LineChunk "[-5,-4,-3,-2,-1,0,1,2,3,4,5]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:477: "-{-# LINE 477 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:478: "+{-# LINE 478 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 477 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 478 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices (Shape.Range (-1,-1) (1::Int,1::Int))   )   [ExpectedLine [LineChunk "[(-1,-1),(-1,0),(-1,1),(0,-1),(0,0),(0,1),(1,-1),(1,0),(1,1)]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:527: "-{-# LINE 527 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:528: "+{-# LINE 528 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 527 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 528 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices (Shape.Shifted (-4) (8::Int))   )   [ExpectedLine [LineChunk "[-4,-3,-2,-1,0,1,2,3]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:598: "-{-# LINE 598 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:599: "+{-# LINE 599 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 598 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 599 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices (Shape.Enumeration :: Shape.Enumeration Ordering)   )   [ExpectedLine [LineChunk "[LT,EQ,GT]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:662: "-{-# LINE 662 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:663: "+{-# LINE 663 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 662 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 663 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices (Set.fromList "comfort")   )   [ExpectedLine [LineChunk "\"cfmort\""]]- DocTest.printPrefix "Data.Array.Comfort.Shape:693: "-{-# LINE 693 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:694: "+{-# LINE 694 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 693 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 694 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices (IntSet.fromList [3,1,4,1,5,9,2,6,5,3])   )   [ExpectedLine [LineChunk "[1,2,3,4,5,6,9]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:726: "-{-# LINE 726 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:727: "+{-# LINE 727 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 726 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 727 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices $ fmap Shape.ZeroBased $ Map.fromList [('b', (0::Int)), ('a', 5), ('c', 2)]   )   [ExpectedLine [LineChunk "[('a',0),('a',1),('a',2),('a',3),('a',4),('c',0),('c',1)]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:784: "-{-# LINE 784 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:785: "+{-# LINE 785 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 784 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 785 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices $ IntMap.fromList [(2, Set.fromList "abc"), (0, Set.fromList "a"), (1, Set.fromList "d")]   )   [ExpectedLine [LineChunk "[(0,'a'),(1,'d'),(2,'a'),(2,'b'),(2,'c')]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:850: "-{-# LINE 850 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:851: "+{-# LINE 851 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 850 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 851 "src/Data/Array/Comfort/Shape.hs" #-}           let sh2 = (Shape.ZeroBased (2::Int), Shape.ZeroBased (2::Int)) in    let sh3 = (Shape.ZeroBased (3::Int), Shape.ZeroBased (3::Int)) in@@ -108,156 +108,156 @@       Shape.indexFromOffset (Shape.Deferred sh2) 3)   )   [ExpectedLine [LineChunk "(4,3)"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:954: "-{-# LINE 954 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:955: "+{-# LINE 955 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 954 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 955 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices (Shape.ZeroBased (3::Int), Shape.ZeroBased (3::Int))   )   [ExpectedLine [LineChunk "[(0,0),(0,1),(0,2),(1,0),(1,1),(1,2),(2,0),(2,1),(2,2)]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1076: "-{-# LINE 1076 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1077: "+{-# LINE 1077 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 1076 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1077 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices $ Shape.Square $ Shape.ZeroBased (3::Int)   )   [ExpectedLine [LineChunk "[(0,0),(0,1),(0,2),(1,0),(1,1),(1,2),(2,0),(2,1),(2,2)]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1133: "-{-# LINE 1133 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1134: "+{-# LINE 1134 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 1133 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1134 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices $ Shape.Cube $ Shape.ZeroBased (2::Int)   )   [ExpectedLine [LineChunk "[(0,0,0),(0,0,1),(0,1,0),(0,1,1),(1,0,0),(1,0,1),(1,1,0),(1,1,1)]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1195: "-{-# LINE 1195 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1196: "+{-# LINE 1196 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 1195 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1196 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices $ Shape.Triangular Shape.Upper $ Shape.ZeroBased (3::Int)   )   [ExpectedLine [LineChunk "[(0,0),(0,1),(0,2),(1,1),(1,2),(2,2)]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1197: "-{-# LINE 1197 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1198: "+{-# LINE 1198 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 1197 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1198 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices $ Shape.Triangular Shape.Lower $ Shape.ZeroBased (3::Int)   )   [ExpectedLine [LineChunk "[(0,0),(1,0),(1,1),(2,0),(2,1),(2,2)]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1329: "-{-# LINE 1329 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1330: "+{-# LINE 1330 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 1329 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1330 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices $ Shape.simplexAscending (replicate 3 Shape.AllDistinct) $ Shape.ZeroBased (4::Int)   )   [ExpectedLine [LineChunk "[[0,1,2],[0,1,3],[0,2,3],[1,2,3]]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1331: "-{-# LINE 1331 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1332: "+{-# LINE 1332 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 1331 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1332 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices $ Shape.simplexAscending (replicate 3 Shape.SomeRepetitive) $ Shape.ZeroBased (3::Int)   )   [ExpectedLine [LineChunk "[[0,0,0],[0,0,1],[0,0,2],[0,1,1],[0,1,2],[0,2,2],[1,1,1],[1,1,2],[1,2,2],[2,2,2]]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1333: "-{-# LINE 1333 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1334: "+{-# LINE 1334 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 1333 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1334 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices $ Shape.simplexAscending [Shape.Repetitive,Shape.Distinct,Shape.Repetitive] $ Shape.ZeroBased (4::Int)   )   [ExpectedLine [LineChunk "[[0,0,1],[0,0,2],[0,0,3],[0,1,2],[0,1,3],[0,2,3],[1,1,2],[1,1,3],[1,2,3],[2,2,3]]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1335: "-{-# LINE 1335 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1336: "+{-# LINE 1336 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 1335 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1336 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices $ Shape.simplexAscending [Shape.Repetitive,Shape.Distinct,Shape.Distinct] $ Shape.ZeroBased (4::Int)   )   [ExpectedLine [LineChunk "[[0,0,1],[0,0,2],[0,0,3],[0,1,2],[0,1,3],[0,2,3],[1,1,2],[1,1,3],[1,2,3],[2,2,3]]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1338: "-{-# LINE 1338 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1339: "+{-# LINE 1339 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 1338 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1339 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices $ Shape.simplexDescending (replicate 3 Shape.AllDistinct) $ Shape.ZeroBased (4::Int)   )   [ExpectedLine [LineChunk "[[2,1,0],[3,1,0],[3,2,0],[3,2,1]]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1340: "-{-# LINE 1340 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1341: "+{-# LINE 1341 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 1340 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1341 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices $ Shape.simplexDescending (replicate 3 Shape.SomeRepetitive) $ Shape.ZeroBased (3::Int)   )   [ExpectedLine [LineChunk "[[0,0,0],[1,0,0],[1,1,0],[1,1,1],[2,0,0],[2,1,0],[2,1,1],[2,2,0],[2,2,1],[2,2,2]]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1342: "-{-# LINE 1342 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1343: "+{-# LINE 1343 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 1342 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1343 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices $ Shape.simplexDescending [Shape.Repetitive,Shape.Distinct,Shape.Repetitive] $ Shape.ZeroBased (4::Int)   )   [ExpectedLine [LineChunk "[[1,1,0],[2,1,0],[2,2,0],[2,2,1],[3,1,0],[3,2,0],[3,2,1],[3,3,0],[3,3,1],[3,3,2]]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1344: "-{-# LINE 1344 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1345: "+{-# LINE 1345 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 1344 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1345 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices $ Shape.simplexDescending [Shape.Repetitive,Shape.Distinct,Shape.Distinct] $ Shape.ZeroBased (4::Int)   )   [ExpectedLine [LineChunk "[[1,1,0],[2,1,0],[2,2,0],[2,2,1],[3,1,0],[3,2,0],[3,2,1],[3,3,0],[3,3,1],[3,3,2]]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1578: "-{-# LINE 1578 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1579: "+{-# LINE 1579 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.property(-{-# LINE 1578 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1579 "src/Data/Array/Comfort/Shape.hs" #-}       let shape = Shape.Cyclic (10::Int) in Shape.offset shape (-1) == Shape.offset shape 9   )- DocTest.printPrefix "Data.Array.Comfort.Shape:1583: "-{-# LINE 1583 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1584: "+{-# LINE 1584 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 1583 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1584 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices (Shape.Cyclic (7::Int))   )   [ExpectedLine [LineChunk "[0,1,2,3,4,5,6]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1627: "-{-# LINE 1627 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1628: "+{-# LINE 1628 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 1627 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1628 "src/Data/Array/Comfort/Shape.hs" #-}     Shape.indices (Shape.ZeroBased (3::Int) ::+ Shape.Range 'a' 'c')   )   [ExpectedLine [LineChunk "[Left 0,Left 1,Left 2,Right 'a',Right 'b',Right 'c']"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1714: "-{-# LINE 1714 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1715: "+{-# LINE 1715 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 1714 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1715 "src/Data/Array/Comfort/Shape.hs" #-}     rnf (Shape.NestedTuple (Shape.Element 1, Shape.Element 2))   )   [ExpectedLine [LineChunk "()"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1716: "-{-# LINE 1716 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1717: "+{-# LINE 1717 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 1716 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1717 "src/Data/Array/Comfort/Shape.hs" #-}     rnf (Shape.NestedTuple (Shape.Element 1, (Shape.Element 2, Shape.Element 3)))   )   [ExpectedLine [LineChunk "()"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1718: "-{-# LINE 1718 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1719: "+{-# LINE 1719 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 1718 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1719 "src/Data/Array/Comfort/Shape.hs" #-}     isBottom $ rnf (Shape.NestedTuple (Shape.Element undefined, Shape.Element 2))   )   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1720: "-{-# LINE 1720 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1721: "+{-# LINE 1721 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 1720 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1721 "src/Data/Array/Comfort/Shape.hs" #-}     isBottom $ rnf (Shape.NestedTuple (Shape.Element undefined, (Shape.Element 2, Shape.Element 3)))   )   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1722: "-{-# LINE 1722 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1723: "+{-# LINE 1723 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 1722 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1723 "src/Data/Array/Comfort/Shape.hs" #-}     isBottom $ rnf (Shape.NestedTuple (Shape.Element 1, (Shape.Element undefined, Shape.Element 3)))   )   [ExpectedLine [LineChunk "True"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:1724: "-{-# LINE 1724 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1725: "+{-# LINE 1725 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example(-{-# LINE 1724 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1725 "src/Data/Array/Comfort/Shape.hs" #-}     isBottom $ rnf (Shape.NestedTuple (Shape.Element 1, (Shape.Element 2, Shape.Element undefined)))   )   [ExpectedLine [LineChunk "True"]]

@@ -1,15 +1,12 @@ -- Do not edit! Automatically created with doctest-extract from src/Data/Array/Comfort/Storable.hs-{-# LINE 98 "src/Data/Array/Comfort/Storable.hs" #-}+{-# LINE 100 "src/Data/Array/Comfort/Storable.hs" #-}  module DocTest.Data.Array.Comfort.Storable where  import Test.DocTest.Base import qualified Test.DocTest.Driver as DocTest -{-# LINE 99 "src/Data/Array/Comfort/Storable.hs" #-}-import     qualified DocTest.Data.Array.Comfort.Boxed.Unchecked-                                                 as TestBoxedArray-import     qualified Data.Array.Comfort.Boxed as BoxedArray+{-# LINE 101 "src/Data/Array/Comfort/Storable.hs" #-} import     qualified Data.Array.Comfort.Storable as Array import     qualified Data.Array.Comfort.Shape as Shape import     Data.Array.Comfort.Storable (Array, (!))@@ -17,18 +14,12 @@ import     qualified Test.QuickCheck as QC import     Test.ChasingBottoms.IsBottom (isBottom) -import     Control.Monad (replicateM)-import     Control.Applicative ((<$>), (<*>))+import     Control.Applicative ((<$>)) -import     qualified Data.Map as Map+import     qualified Data.IntSet as IntSet import     qualified Data.Set as Set-import     Data.Map (Map)-import     Data.Function.HT (Id) import     Data.Complex (Complex((:+)))-import     Data.Tuple.HT (swap)-import     Data.Word (Word16)--import     Foreign.Storable (Storable)+import     Data.Word (Word8, Word16)  type     ShapeInt = Shape.ZeroBased Int type     X = Shape.Element@@ -39,27 +30,6 @@ genArray     :: QC.Gen (Array ShapeInt Word16) genArray     = Array.vectorFromList <$> QC.arbitrary -genArray2     :: QC.Gen (Array (ShapeInt,ShapeInt) Word16)-genArray2     = do-       xs <- QC.arbitrary-       let n = length xs-       (k,m) <--          if n == 0-             then QC.elements [(,) 0, flip (,) 0] <*> QC.choose (1,20)-             else fmap (\m -> (div n m, m)) $ QC.choose (1,n)-       return $ Array.fromList (Shape.ZeroBased k, Shape.ZeroBased m) xs--genArrayForShape     :: (Shape.C shape) => shape -> QC.Gen (Array shape Word16)-genArrayForShape     sh =-       Array.fromList sh <$> replicateM (Shape.size sh) QC.arbitrary--genNonEmptyArray2     :: QC.Gen (Array (ShapeInt,ShapeInt) Word16)-genNonEmptyArray2     = do-       xs <- QC.getNonEmpty <$> QC.arbitrary-       let n = length xs-       m <- QC.choose (1,n)-       return $ Array.fromList (Shape.ZeroBased (div n m), Shape.ZeroBased m) xs- infix     4 ==? (==?)     :: a -> a -> (a,a) (==?)     = (,)@@ -73,188 +43,71 @@                 then isBottom resultArray                 else resultArray == resultList --transpose     ::-       (Shape.Indexed sh0, Shape.Indexed sh1, Storable a) =>-       Array (sh0,sh1) a -> Array (sh1,sh0) a-transpose     a = Array.sample (swap $ Array.shape a) (\(i,j) -> a!(j,i))- test :: DocTest.T () test = do- DocTest.printPrefix "Data.Array.Comfort.Storable:185: "-{-# LINE 185 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Storable:151: "+{-# LINE 151 "src/Data/Array/Comfort/Storable.hs" #-}  DocTest.example(-{-# LINE 185 "src/Data/Array/Comfort/Storable.hs" #-}+{-# LINE 151 "src/Data/Array/Comfort/Storable.hs" #-}     Array.fromList (shapeInt 5) ['a'..]   )   [ExpectedLine [LineChunk "StorableArray.fromList (ZeroBased {zeroBasedSize = 5}) \"abcde\""]]- DocTest.printPrefix "Data.Array.Comfort.Storable:204: "-{-# LINE 204 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Storable:170: "+{-# LINE 170 "src/Data/Array/Comfort/Storable.hs" #-}  DocTest.example(-{-# LINE 204 "src/Data/Array/Comfort/Storable.hs" #-}+{-# LINE 170 "src/Data/Array/Comfort/Storable.hs" #-}     Array.fromTuple ('a',('b','c')) :: Array (Shape.NestedTuple Shape.TupleIndex (X,(X,X))) Char   )   [ExpectedLine [LineChunk "StorableArray.fromList (NestedTuple {getNestedTuple = (Element 0,(Element 1,Element 2))}) \"abc\""]]- DocTest.printPrefix "Data.Array.Comfort.Storable:207: "-{-# LINE 207 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Storable:173: "+{-# LINE 173 "src/Data/Array/Comfort/Storable.hs" #-}  DocTest.example(-{-# LINE 207 "src/Data/Array/Comfort/Storable.hs" #-}+{-# LINE 173 "src/Data/Array/Comfort/Storable.hs" #-}           let arr :: Array (Shape.NestedTuple Shape.TupleAccessor (X,(X,X))) Char        arr = Array.fromTuple ('a',('b','c'))    in (arr ! fst, arr ! (fst.snd))   )   [ExpectedLine [LineChunk "('a','b')"]]- DocTest.printPrefix "Data.Array.Comfort.Storable:230: "-{-# LINE 230 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Storable:196: "+{-# LINE 196 "src/Data/Array/Comfort/Storable.hs" #-}  DocTest.example(-{-# LINE 230 "src/Data/Array/Comfort/Storable.hs" #-}+{-# LINE 196 "src/Data/Array/Comfort/Storable.hs" #-}           let arr = Array.fromRecord ('a' :+ 'b') in    let (real:+imag) = Shape.indexRecordFromShape $ Array.shape arr in    (arr ! real, arr ! imag)   )   [ExpectedLine [LineChunk "('a','b')"]]- DocTest.printPrefix "Data.Array.Comfort.Storable:295: "-{-# LINE 295 "src/Data/Array/Comfort/Storable.hs" #-}- DocTest.example(-{-# LINE 295 "src/Data/Array/Comfort/Storable.hs" #-}-      -   Array.fromBlockArray1 $ BoxedArray.fromList Set.empty [] :: Array (Map Char ShapeInt) Word16-  )-  [ExpectedLine [LineChunk "StorableArray.fromList (fromList []) []"]]- DocTest.printPrefix "Data.Array.Comfort.Storable:300: "-{-# LINE 300 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Storable:338: "+{-# LINE 338 "src/Data/Array/Comfort/Storable.hs" #-}  DocTest.example(-{-# LINE 300 "src/Data/Array/Comfort/Storable.hs" #-}-      -   let block n a = Array.replicate (shapeInt n) (a::Word16) in-   Array.fromBlockArray1 $-   BoxedArray.fromList (Set.fromList "ABC") [block 2 0, block 3 1, block 5 2]+{-# LINE 338 "src/Data/Array/Comfort/Storable.hs" #-}+    Array.takeSet (Set.fromList [0,2,4,7,13]) (Array.vectorFromList [3,1,4,1,5,9,2,6,5,3,5,8,9,7,9,3::Word8])   )-  [ExpectedLine [LineChunk "StorableArray.fromList (fromList [('A',ZeroBased {",WildCardChunk,LineChunk " 2}),('B',ZeroBased {",WildCardChunk,LineChunk " 3}),('C',ZeroBased {",WildCardChunk,LineChunk " 5})]) [0,0,1,1,1,2,2,2,2,2]"]]- DocTest.printPrefix "Data.Array.Comfort.Storable:318: "-{-# LINE 318 "src/Data/Array/Comfort/Storable.hs" #-}+  [ExpectedLine [LineChunk "StorableArray",WildCardChunk,LineChunk " (",WildCardChunk,LineChunk " [0,2,4,7,13]) [3,4,5,6,7]"]]+ DocTest.printPrefix "Data.Array.Comfort.Storable:348: "+{-# LINE 348 "src/Data/Array/Comfort/Storable.hs" #-}  DocTest.example(-{-# LINE 318 "src/Data/Array/Comfort/Storable.hs" #-}-      -   let shapeR0 = shapeInt 2; shapeR1 = shapeInt 3 in-   let shapeC0 = shapeInt 3; shapeC1 = shapeInt 2 in-   let block sh a = Array.replicate sh (a::Word16) in-   Array.fromBlockArray2-      (Map.singleton 'A' shapeR0 <> Map.singleton 'B' shapeR1)-      (Map.singleton '1' shapeC0 <> Map.singleton '2' shapeC1) $-   BoxedArray.fromList (Set.fromList "AB", Set.fromList "12")-      [block (shapeR0,shapeC0) 0, block (shapeR0,shapeC1) 1,-       block (shapeR1,shapeC0) 2, block (shapeR1,shapeC1) 3]-  )-  [ExpectedLine [LineChunk "StorableArray.fromList (fromList [('A',ZeroBased {",WildCardChunk,LineChunk " 2}),('B',ZeroBased {",WildCardChunk,LineChunk " 3})],fromList [('1',ZeroBased {",WildCardChunk,LineChunk " 3}),('2',ZeroBased {",WildCardChunk,LineChunk " 2})]) [0,0,0,1,1,0,0,0,1,1,2,2,2,3,3,2,2,2,3,3,2,2,2,3,3]"]]- DocTest.printPrefix "Data.Array.Comfort.Storable:331: "-{-# LINE 331 "src/Data/Array/Comfort/Storable.hs" #-}- DocTest.property(-{-# LINE 331 "src/Data/Array/Comfort/Storable.hs" #-}-        -   QC.forAll genArray2 $ \blockA1 ->-   QC.forAll genArray2 $ \blockB2 ->-   let shapeR0 = fst $ Array.shape blockA1 in-   let shapeC0 = snd $ Array.shape blockA1 in-   let shapeR1 = fst $ Array.shape blockB2 in-   let shapeC1 = snd $ Array.shape blockB2 in-   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->-   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->-   let blocked =-         BoxedArray.fromList (Set.fromList "AB", Set.fromList "12")-            [blockA1, blockA2, blockB1, blockB2] in--   transpose (Array.fromNonEmptyBlockArray2 blocked)-   QC.===-   Array.fromNonEmptyBlockArray2-      (TestBoxedArray.transpose (fmap transpose blocked))+{-# LINE 348 "src/Data/Array/Comfort/Storable.hs" #-}+    Array.takeIntSet (IntSet.fromList [0,2,4,7,13]) (Array.vectorFromList [3,1,4,1,5,9,2,6,5,3,5,8,9,7,9,3::Word8])   )- DocTest.printPrefix "Data.Array.Comfort.Storable:350: "-{-# LINE 350 "src/Data/Array/Comfort/Storable.hs" #-}+  [ExpectedLine [LineChunk "StorableArray",WildCardChunk,LineChunk " (",WildCardChunk,LineChunk " [0,2,4,7,13]) [3,4,5,6,7]"]]+ DocTest.printPrefix "Data.Array.Comfort.Storable:393: "+{-# LINE 393 "src/Data/Array/Comfort/Storable.hs" #-}  DocTest.property(-{-# LINE 350 "src/Data/Array/Comfort/Storable.hs" #-}-        -   QC.forAll genArray2 $ \blockA1 ->-   QC.forAll genArray2 $ \blockB2 ->-   QC.forAll genArray2 $ \blockC3 ->-   let shapeR0 = fst $ Array.shape blockA1 in-   let shapeC0 = snd $ Array.shape blockA1 in-   let shapeR1 = fst $ Array.shape blockB2 in-   let shapeC1 = snd $ Array.shape blockB2 in-   let shapeR2 = fst $ Array.shape blockC3 in-   let shapeC2 = snd $ Array.shape blockC3 in-   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->-   QC.forAll (genArrayForShape (shapeR0, shapeC2)) $ \blockA3 ->-   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->-   QC.forAll (genArrayForShape (shapeR1, shapeC2)) $ \blockB3 ->-   QC.forAll (genArrayForShape (shapeR2, shapeC0)) $ \blockC1 ->-   QC.forAll (genArrayForShape (shapeR2, shapeC1)) $ \blockC2 ->-   let blocked =-         BoxedArray.fromList (Set.fromList "ABC", Set.fromList "123")-            [blockA1, blockA2, blockA3,-             blockB1, blockB2, blockB3,-             blockC1, blockC2, blockC3] in--   transpose (Array.fromNonEmptyBlockArray2 blocked)-   QC.===-   Array.fromNonEmptyBlockArray2-      (TestBoxedArray.transpose (fmap transpose blocked))+{-# LINE 393 "src/Data/Array/Comfort/Storable.hs" #-}+      forAllNonEmpty $ \xs -> Array.minimum xs ==? minimum (Array.toList xs)   )  DocTest.printPrefix "Data.Array.Comfort.Storable:401: " {-# LINE 401 "src/Data/Array/Comfort/Storable.hs" #-}- DocTest.example(-{-# LINE 401 "src/Data/Array/Comfort/Storable.hs" #-}-      -   (id :: Id (array (height, Map Char ShapeInt) Word16)) $-   Array.fromBlockArray2-      (Map.singleton 'A' (shapeInt 2) <> Map.singleton 'B' (shapeInt 3))-      Map.empty $-   BoxedArray.fromList (Set.fromList "AB", Set.empty) []-  )-  [ExpectedLine [LineChunk "StorableArray.fromList (fromList [('A',ZeroBased {",WildCardChunk,LineChunk " 2}),('B',ZeroBased {",WildCardChunk,LineChunk " 3})],fromList []) []"]]- DocTest.printPrefix "Data.Array.Comfort.Storable:410: "-{-# LINE 410 "src/Data/Array/Comfort/Storable.hs" #-}  DocTest.property(-{-# LINE 410 "src/Data/Array/Comfort/Storable.hs" #-}-        -   QC.forAll genArray2 $ \block ->-   let height = Map.singleton 'A' $ fst $ Array.shape block in-   let width  = Map.singleton '1' $ snd $ Array.shape block in--   Array.reshape (height,width) block-   QC.===-   Array.fromBlockArray2 height width-      (BoxedArray.replicate (Set.singleton 'A', Set.singleton '1') block)-  )- DocTest.printPrefix "Data.Array.Comfort.Storable:516: "-{-# LINE 516 "src/Data/Array/Comfort/Storable.hs" #-}- DocTest.property(-{-# LINE 516 "src/Data/Array/Comfort/Storable.hs" #-}-      QC.forAll genNonEmptyArray2 $ \xs -> QC.forAll (QC.elements $ Shape.indices $ Array.shape xs) $ \(ix0,ix1) -> Array.pick xs ix0 ! ix1 == xs!(ix0,ix1)-  )- DocTest.printPrefix "Data.Array.Comfort.Storable:534: "-{-# LINE 534 "src/Data/Array/Comfort/Storable.hs" #-}- DocTest.property(-{-# LINE 534 "src/Data/Array/Comfort/Storable.hs" #-}-      QC.forAll genArray2 $ \xs -> xs == Array.fromRowArray (snd $ Array.shape xs) (Array.toRowArray xs)-  )- DocTest.printPrefix "Data.Array.Comfort.Storable:551: "-{-# LINE 551 "src/Data/Array/Comfort/Storable.hs" #-}- DocTest.property(-{-# LINE 551 "src/Data/Array/Comfort/Storable.hs" #-}-      forAllNonEmpty $ \xs -> Array.minimum xs ==? minimum (Array.toList xs)-  )- DocTest.printPrefix "Data.Array.Comfort.Storable:559: "-{-# LINE 559 "src/Data/Array/Comfort/Storable.hs" #-}- DocTest.property(-{-# LINE 559 "src/Data/Array/Comfort/Storable.hs" #-}+{-# LINE 401 "src/Data/Array/Comfort/Storable.hs" #-}       forAllNonEmpty $ \xs -> Array.maximum xs ==? maximum (Array.toList xs)   )- DocTest.printPrefix "Data.Array.Comfort.Storable:571: "-{-# LINE 571 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Storable:413: "+{-# LINE 413 "src/Data/Array/Comfort/Storable.hs" #-}  DocTest.property(-{-# LINE 571 "src/Data/Array/Comfort/Storable.hs" #-}+{-# LINE 413 "src/Data/Array/Comfort/Storable.hs" #-}       forAllNonEmpty $ \xs -> Array.limits xs ==? (Array.minimum xs, Array.maximum xs)   )

@@ -0,0 +1,308 @@+-- Do not edit! Automatically created with doctest-extract from src/Data/Array/Comfort/Storable/Dim2.hs+{-# LINE 49 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}++module DocTest.Data.Array.Comfort.Storable.Dim2 where++import Test.DocTest.Base+import qualified Test.DocTest.Driver as DocTest++{-# LINE 50 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+import     qualified DocTest.Data.Array.Comfort.Boxed.Unchecked+                                                 as TestBoxedArray+import     DocTest.Data.Array.Comfort.Storable (ShapeInt, shapeInt)++import     qualified Data.Array.Comfort.Boxed as BoxedArray+import     qualified Data.Array.Comfort.Storable.Dim2 as Array2+import     qualified Data.Array.Comfort.Storable as Array+import     qualified Data.Array.Comfort.Shape as Shape+import     Data.Array.Comfort.Storable.Dim2 (Array2, (&===), (&|||))+import     Data.Array.Comfort.Storable (Array, (!))+import     Data.Array.Comfort.Shape ((::+)((::+)))++import     qualified Test.QuickCheck as QC++import     Control.Monad (replicateM)+import     Control.Applicative (liftA2, (<$>), (<*>))++import     qualified Data.Map as Map+import     qualified Data.Set as Set+import     Data.Map (Map)+import     Data.Function.HT (Id)+import     Data.Tuple.HT (swap)+import     Data.Word (Word16)+import     Data.Proxy (Proxy(Proxy))++import     Foreign.Storable (Storable)++genArray2     :: QC.Gen (Array2 ShapeInt ShapeInt Word16)+genArray2     = do+       xs <- QC.arbitrary+       let n = length xs+       (k,m) <-+          if n == 0+             then QC.elements [(,) 0, flip (,) 0] <*> QC.choose (1,20)+             else fmap (\m -> (div n m, m)) $ QC.choose (1,n)+       return $ Array.fromList (Shape.ZeroBased k, Shape.ZeroBased m) xs++genArrayForShape     :: (Shape.C shape) => shape -> QC.Gen (Array shape Word16)+genArrayForShape     sh =+       Array.fromList sh <$> replicateM (Shape.size sh) QC.arbitrary++genNonEmptyArray2     :: QC.Gen (Array2 ShapeInt ShapeInt Word16)+genNonEmptyArray2     = do+       xs <- QC.getNonEmpty <$> QC.arbitrary+       let n = length xs+       m <- QC.choose (1,n)+       return $ Array.fromList (Shape.ZeroBased (div n m), Shape.ZeroBased m) xs+++transpose     ::+       (Shape.Indexed sh0, Shape.Indexed sh1, Storable a) =>+       Array2 sh0 sh1 a -> Array2 sh1 sh0 a+transpose     a = Array.sample (swap $ Array.shape a) (\(i,j) -> a!(j,i))++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Data.Array.Comfort.Storable.Dim2:122: "+{-# LINE 122 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+ DocTest.property(+{-# LINE 122 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+        +   QC.forAll genNonEmptyArray2 $ \xs ->+   QC.forAll (QC.elements $ Shape.indices $ Array.shape xs) $ \(ix0,ix1) ->+      Array2.takeRow xs ix0 ! ix1 == xs!(ix0,ix1)+  )+ DocTest.printPrefix "Data.Array.Comfort.Storable.Dim2:147: "+{-# LINE 147 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+ DocTest.property(+{-# LINE 147 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+        +   QC.forAll genArray2 $ \xs ->+      xs == Array2.fromRowArray (snd $ Array.shape xs) (Array2.toRowArray xs)+  )+ DocTest.printPrefix "Data.Array.Comfort.Storable.Dim2:168: "+{-# LINE 168 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+ DocTest.property(+{-# LINE 168 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+        +   QC.forAll genArray2 $ \xs ->+   let (Shape.ZeroBased m, width) = Array.shape xs in+   QC.forAll (QC.choose (0, m)) $ \k ->+      let ys = Array.reshape+                  (Shape.ZeroBased k ::+ Shape.ZeroBased (m-k), width) xs in+      ys == Array2.above (Array2.takeTop ys) (Array2.takeBottom ys)+  )+ DocTest.printPrefix "Data.Array.Comfort.Storable.Dim2:193: "+{-# LINE 193 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+ DocTest.property(+{-# LINE 193 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+        +   QC.forAll genArray2 $ \xs ->+   let (height, Shape.ZeroBased n) = Array.shape xs in+   QC.forAll (QC.choose (0, n)) $ \k ->+      let ys = Array.reshape+                  (height, Shape.ZeroBased k ::+ Shape.ZeroBased (n-k)) xs in+      ys == Array2.beside (Array2.takeLeft ys) (Array2.takeRight ys)+  )+ DocTest.printPrefix "Data.Array.Comfort.Storable.Dim2:279: "+{-# LINE 279 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+ DocTest.example(+{-# LINE 279 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+      +   let shapeR0 = shapeInt 2; shapeR1 = shapeInt 3 in+   let shapeC0 = shapeInt 3; shapeC1 = shapeInt 2 in+   let block sh a = Array.replicate sh (a::Word16) in+   Array2.fromBlockArray+      (Map.singleton 'A' shapeR0 <> Map.singleton 'B' shapeR1)+      (Map.singleton '1' shapeC0 <> Map.singleton '2' shapeC1) $+   BoxedArray.fromList (Set.fromList "AB", Set.fromList "12")+      [block (shapeR0,shapeC0) 0, block (shapeR0,shapeC1) 1,+       block (shapeR1,shapeC0) 2, block (shapeR1,shapeC1) 3]+  )+  [ExpectedLine [LineChunk "StorableArray.fromList (fromList [('A',ZeroBased {",WildCardChunk,LineChunk " 2}),('B',ZeroBased {",WildCardChunk,LineChunk " 3})],fromList [('1',ZeroBased {",WildCardChunk,LineChunk " 3}),('2',ZeroBased {",WildCardChunk,LineChunk " 2})]) [0,0,0,1,1,0,0,0,1,1,2,2,2,3,3,2,2,2,3,3,2,2,2,3,3]"]]+ DocTest.printPrefix "Data.Array.Comfort.Storable.Dim2:292: "+{-# LINE 292 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+ DocTest.property(+{-# LINE 292 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+        +   QC.forAll genArray2 $ \blockA1 ->+   QC.forAll genArray2 $ \blockB2 ->+   let shapeR0 = fst $ Array.shape blockA1 in+   let shapeC0 = snd $ Array.shape blockA1 in+   let shapeR1 = fst $ Array.shape blockB2 in+   let shapeC1 = snd $ Array.shape blockB2 in+   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->+   let blocked =+         BoxedArray.fromList (Set.fromList "AB", Set.fromList "12")+            [blockA1, blockA2, blockB1, blockB2] in++   transpose (Array2.fromNonEmptyBlockArray blocked)+   QC.===+   Array2.fromNonEmptyBlockArray+      (TestBoxedArray.transpose (fmap transpose blocked))+  )+ DocTest.printPrefix "Data.Array.Comfort.Storable.Dim2:311: "+{-# LINE 311 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+ DocTest.property(+{-# LINE 311 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+        +   QC.forAll genArray2 $ \blockA1 ->+   QC.forAll genArray2 $ \blockB2 ->+   QC.forAll genArray2 $ \blockC3 ->+   let shapeR0 = fst $ Array.shape blockA1 in+   let shapeC0 = snd $ Array.shape blockA1 in+   let shapeR1 = fst $ Array.shape blockB2 in+   let shapeC1 = snd $ Array.shape blockB2 in+   let shapeR2 = fst $ Array.shape blockC3 in+   let shapeC2 = snd $ Array.shape blockC3 in+   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->+   QC.forAll (genArrayForShape (shapeR0, shapeC2)) $ \blockA3 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC2)) $ \blockB3 ->+   QC.forAll (genArrayForShape (shapeR2, shapeC0)) $ \blockC1 ->+   QC.forAll (genArrayForShape (shapeR2, shapeC1)) $ \blockC2 ->+   let blocked =+         BoxedArray.fromList (Set.fromList "ABC", Set.fromList "123")+            [blockA1, blockA2, blockA3,+             blockB1, blockB2, blockB3,+             blockC1, blockC2, blockC3] in++   transpose (Array2.fromNonEmptyBlockArray blocked)+   QC.===+   Array2.fromNonEmptyBlockArray+      (TestBoxedArray.transpose (fmap transpose blocked))+  )+ DocTest.printPrefix "Data.Array.Comfort.Storable.Dim2:362: "+{-# LINE 362 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+ DocTest.example(+{-# LINE 362 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+      +   (id :: Id (array (height, Map Char ShapeInt) Word16)) $+   Array2.fromBlockArray+      (Map.singleton 'A' (shapeInt 2) <> Map.singleton 'B' (shapeInt 3))+      Map.empty $+   BoxedArray.fromList (Set.fromList "AB", Set.empty) []+  )+  [ExpectedLine [LineChunk "StorableArray.fromList (fromList [('A',ZeroBased {",WildCardChunk,LineChunk " 2}),('B',ZeroBased {",WildCardChunk,LineChunk " 3})],fromList []) []"]]+ DocTest.printPrefix "Data.Array.Comfort.Storable.Dim2:371: "+{-# LINE 371 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+ DocTest.property(+{-# LINE 371 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+        +   QC.forAll genArray2 $ \block ->+   let height = Map.singleton 'A' $ fst $ Array.shape block in+   let width  = Map.singleton '1' $ snd $ Array.shape block in++   Array.reshape (height,width) block+   QC.===+   Array2.fromBlockArray height width+      (BoxedArray.replicate (Set.singleton 'A', Set.singleton '1') block)+  )+ DocTest.printPrefix "Data.Array.Comfort.Storable.Dim2:484: "+{-# LINE 484 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+ DocTest.property(+{-# LINE 484 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+        +   QC.forAll genArray2 $ \blockA1 ->+   QC.forAll genArray2 $ \blockB2 ->+   let shapeR0 = fst $ Array.shape blockA1 in+   let shapeC0 = snd $ Array.shape blockA1 in+   let shapeR1 = fst $ Array.shape blockB2 in+   let shapeC1 = snd $ Array.shape blockB2 in+   let shapeR = shapeR0::+shapeR1::+Shape.Zero in+   let shapeC = shapeC0::+shapeC1::+Shape.Zero in+   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->+   let blocked =+         BoxedArray.fromList (Set.fromList "AB", Set.fromList "12")+            [blockA1, blockA2, blockB1, blockB2] in++   Array.reshape (shapeR, shapeC)+      (Array2.fromNonEmptyBlockArray blocked)+   QC.===+   Array2.fromBlocks shapeR shapeC Proxy+      blockA1 blockA2+      blockB1 blockB2+  )+ DocTest.printPrefix "Data.Array.Comfort.Storable.Dim2:589: "+{-# LINE 589 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+ DocTest.property(+{-# LINE 589 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+        +   QC.forAll genArray2 $ \blockA1 ->+   QC.forAll genArray2 $ \blockB3 ->+   QC.forAll+      (liftA2+         (\char0 char1 -> Shape.Range (min char0 char1) (max char0 char1))+         (QC.choose ('a','k')) (QC.choose ('a','k'))) $+      \shapeC1 ->+   let shapeR0 = fst $ Array.shape blockA1 in+   let shapeC0 = snd $ Array.shape blockA1 in+   let shapeR1 = fst $ Array.shape blockB3 in+   let shapeC2 = snd $ Array.shape blockB3 in+   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->+   QC.forAll (genArrayForShape (shapeR0, shapeC2)) $ \blockA3 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC1)) $ \blockB2 ->++   Array2.fromBlockMatrix+      (blockA1 &||| Array2.beside blockA2 blockA3+       &===+       blockB1 &||| blockB2 &||| blockB3)+   QC.===+   Array.reshape+      (shapeR0::+shapeR1, shapeC0::+shapeC1::+shapeC2)+      (Array2.fromBlocks+         (shapeR0::+shapeR1::+Shape.Zero)+         (shapeC0::+shapeC1::+shapeC2::+Shape.Zero)+         Proxy+         blockA1 blockA2 blockA3+         blockB1 blockB2 blockB3)+  )+ DocTest.printPrefix "Data.Array.Comfort.Storable.Dim2:621: "+{-# LINE 621 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+ DocTest.property(+{-# LINE 621 "src/Data/Array/Comfort/Storable/Dim2.hs" #-}+        +   QC.forAll+      (liftA2+         (\char0 char1 -> Shape.Range (min char0 char1) (max char0 char1))+         (QC.choose ('a','k')) (QC.choose ('a','k'))) $+      \shapeR0 ->+   QC.forAll+         (liftA2 Shape.Shifted (QC.choose (-10,10)) (QC.choose (0,10::Int))) $+      \shapeR1 ->+   let shapeR2 = () in+   QC.forAll (fmap Shape.ZeroBased (QC.choose (0,10::Int))) $+      \shapeC0 ->+   QC.forAll (fmap Shape.OneBased (QC.choose (0,10::Int))) $+      \shapeC1 ->+   let shapeC2 :: Shape.Enumeration Ordering+       shapeC2 = Shape.Enumeration in++   QC.forAll (genArrayForShape (shapeR0, shapeC0)) $ \blockA1 ->+   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->+   QC.forAll (genArrayForShape (shapeR0, shapeC2)) $ \blockA3 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC1)) $ \blockB2 ->+   QC.forAll (genArrayForShape (shapeR1, shapeC2)) $ \blockB3 ->+   QC.forAll (genArrayForShape (shapeR2, shapeC0)) $ \blockC1 ->+   QC.forAll (genArrayForShape (shapeR2, shapeC1)) $ \blockC2 ->+   QC.forAll (genArrayForShape (shapeR2, shapeC2)) $ \blockC3 ->++   Array2.fromBlockMatrix+      (blockA1 &||| blockA2 &||| blockA3+       &===+       blockB1 &||| blockB2 &||| blockB3+       &===+       blockC1 &||| blockC2 &||| blockC3)+   QC.===+   Array2.beside+      (Array2.above blockA1 $ Array2.above blockB1 blockC1)+      (Array2.above+         (Array2.beside blockA2 blockA3)+         (Array2.beside+            (Array2.above blockB2 blockC2)+            (Array2.above blockB3 blockC3)))+  )

@@ -1,11 +1,11 @@ -- Do not edit! Automatically created with doctest-extract from src/Data/Array/Comfort/Storable/Unchecked.hs-{-# LINE 57 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+{-# LINE 64 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}  module DocTest.Data.Array.Comfort.Storable.Unchecked where  import qualified Test.DocTest.Driver as DocTest -{-# LINE 58 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+{-# LINE 65 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-} import     DocTest.Data.Array.Comfort.Storable (ShapeInt, genArray)  import     qualified Data.Array.Comfort.Storable as Array@@ -24,39 +24,39 @@  test :: DocTest.T () test = do- DocTest.printPrefix "Data.Array.Comfort.Storable.Unchecked:134: "-{-# LINE 134 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Storable.Unchecked:166: "+{-# LINE 166 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}  DocTest.property(-{-# LINE 134 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+{-# LINE 166 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}       \x  ->  Array.singleton x ! () == (x::Word16)   )- DocTest.printPrefix "Data.Array.Comfort.Storable.Unchecked:148: "-{-# LINE 148 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Storable.Unchecked:180: "+{-# LINE 180 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}  DocTest.property(-{-# LINE 148 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+{-# LINE 180 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}       \(QC.NonNegative n) (Array16 x)  ->  x == Array.mapShape (Shape.ZeroBased . Shape.size) (Array.append (Array.take n x) (Array.drop n x))   )- DocTest.printPrefix "Data.Array.Comfort.Storable.Unchecked:163: "-{-# LINE 163 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Storable.Unchecked:195: "+{-# LINE 195 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}  DocTest.property(-{-# LINE 163 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+{-# LINE 195 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}       \(Array16 x) (Array16 y) -> let xy = Array.append x y in x == Array.takeLeft xy  &&  y == Array.takeRight xy   )- DocTest.printPrefix "Data.Array.Comfort.Storable.Unchecked:183: "-{-# LINE 183 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Storable.Unchecked:215: "+{-# LINE 215 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}  DocTest.property(-{-# LINE 183 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+{-# LINE 215 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}       \(Array16 x) (Array16 y) (Array16 z) -> let xyz = Array.append x $ Array.append y z in y == Array.takeCenter xyz   )- DocTest.printPrefix "Data.Array.Comfort.Storable.Unchecked:196: "-{-# LINE 196 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Storable.Unchecked:228: "+{-# LINE 228 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}  DocTest.property(-{-# LINE 196 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+{-# LINE 228 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}       \(Array16 xs)  ->  Array.sum xs == sum (Array.toList xs)   )- DocTest.printPrefix "Data.Array.Comfort.Storable.Unchecked:202: "-{-# LINE 202 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Storable.Unchecked:234: "+{-# LINE 234 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}  DocTest.property(-{-# LINE 202 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}+{-# LINE 234 "src/Data/Array/Comfort/Storable/Unchecked.hs" #-}       \(Array16 xs)  ->  Array.product xs == product (Array.toList xs)   )

@@ -2,17 +2,19 @@ module DocTest.Main where  import qualified DocTest.Data.Array.Comfort.Shape-import qualified DocTest.Data.Array.Comfort.Storable import qualified DocTest.Data.Array.Comfort.Storable.Unchecked-import qualified DocTest.Data.Array.Comfort.Boxed+import qualified DocTest.Data.Array.Comfort.Storable+import qualified DocTest.Data.Array.Comfort.Storable.Dim2 import qualified DocTest.Data.Array.Comfort.Boxed.Unchecked+import qualified DocTest.Data.Array.Comfort.Boxed  import qualified Test.DocTest.Driver as DocTest  main :: DocTest.T () main = do     DocTest.Data.Array.Comfort.Shape.test-    DocTest.Data.Array.Comfort.Storable.test     DocTest.Data.Array.Comfort.Storable.Unchecked.test-    DocTest.Data.Array.Comfort.Boxed.test+    DocTest.Data.Array.Comfort.Storable.test+    DocTest.Data.Array.Comfort.Storable.Dim2.test     DocTest.Data.Array.Comfort.Boxed.Unchecked.test+    DocTest.Data.Array.Comfort.Boxed.test