comfort-array 0.5.1.1 → 0.5.2

raw patch · 11 files changed

+876/−119 lines, 11 filesdep ~deepseqPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: deepseq

API changes (from Hackage documentation)

Files

• comfort-array.cabal +9/−2
• src/Data/Array/Comfort/Boxed.hs +56/−0
• src/Data/Array/Comfort/Boxed/Unchecked.hs +95/−5
• src/Data/Array/Comfort/Shape.hs +383/−8
• src/Data/Array/Comfort/Shape/Tuple.hs +62/−0
• src/Data/Array/Comfort/Storable.hs +60/−4
• test-module.list +1/−0
• test/DocTest/Data/Array/Comfort/Boxed/Unchecked.hs +42/−0
• test/DocTest/Data/Array/Comfort/Shape.hs +119/−80
• test/DocTest/Data/Array/Comfort/Storable.hs +47/−20
• test/DocTest/Main.hs +2/−0

@@ -1,5 +1,5 @@ Name:             comfort-array-Version:          0.5.1.1+Version:          0.5.2 License:          BSD3 License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -45,6 +45,10 @@   * @Enumeration@:     Arrays with indices like 'LT', 'EQ', 'GT' and a shape of fixed size.   .+  * @NestedTuple@:+    Arrays with shapes that are compatible to nested tuples+    like @(a,(a,a))@ and indices like @fst@ and @fst.snd@.+  .   * @(::+)@:     The Append type constructor allows to respresent block arrays,     e.g. block matrices.@@ -92,7 +96,7 @@   test-module.list  Source-Repository this-  Tag:         0.5.1.1+  Tag:         0.5.2   Type:        darcs   Location:    https://hub.darcs.net/thielema/comfort-array/ @@ -144,6 +148,7 @@     Data.Array.Comfort.Boxed.Unchecked     Data.Array.Comfort.Container   Other-Modules:+    Data.Array.Comfort.Shape.Tuple     Data.Array.Comfort.Shape.Set     Data.Array.Comfort.Shape.Utility     Data.Array.Comfort.Boxed.Strict.Unchecked@@ -160,6 +165,7 @@     tagged,     containers,     QuickCheck,+    deepseq,     base    GHC-Options:      -Wall@@ -170,6 +176,7 @@     DocTest.Data.Array.Comfort.Shape     DocTest.Data.Array.Comfort.Storable.Unchecked     DocTest.Data.Array.Comfort.Storable+    DocTest.Data.Array.Comfort.Boxed.Unchecked     DocTest.Main     Test.Shape     Test.Utility

@@ -10,6 +10,10 @@    toAssociations,    fromMap,    toMap,+   fromTuple,+   toTuple,+   fromRecord,+   toRecord,    fromContainer,    toContainer,    indices,@@ -20,17 +24,25 @@    (//),    accumulate,    fromAssociations,++   pick,+   Array.append,+   Array.take, Array.drop,+   Array.takeLeft, Array.takeRight, Array.split,+   Array.takeCenter,    ) where  import qualified Data.Array.Comfort.Boxed.Unchecked as Array import qualified Data.Array.Comfort.Container as Container import qualified Data.Array.Comfort.Check as Check+import qualified Data.Array.Comfort.Shape.Tuple as TupleShape import qualified Data.Array.Comfort.Shape as Shape import Data.Array.Comfort.Boxed.Unchecked (Array(Array))  import qualified Data.Primitive.Array as Prim  import qualified Control.Monad.Primitive as PrimM+import qualified Control.Monad.Trans.State as MS import Control.Monad.ST (runST) import Control.Applicative ((<$>)) @@ -39,6 +51,7 @@ import qualified Data.Set as Set import Data.Map (Map) import Data.Set (Set)+import Data.Traversable (Traversable, traverse) import Data.Foldable (forM_) import Data.Either.HT (maybeRight) import Data.Maybe (fromMaybe)@@ -66,6 +79,39 @@ toMap :: (Ord k) => Array (Set k) a -> Map k a toMap arr = Map.fromAscList $ zip (Set.toAscList $ shape arr) (Array.toList arr) +fromTuple ::+   (TupleShape.NestedTuple tuple) =>+   Shape.DataTuple tuple a -> Array (Shape.NestedTuple ixtype tuple) a+fromTuple tuple =+   case MS.evalState (TupleShape.decons tuple) (Shape.Element 0) of+      (sh, xs) -> Array.fromList (Shape.NestedTuple sh) xs++toTuple ::+   (TupleShape.NestedTuple tuple) =>+   Array (Shape.NestedTuple ixtype tuple) a -> Shape.DataTuple tuple a+toTuple arr =+   MS.evalState+      (TupleShape.cons $ Shape.getNestedTuple $ shape arr)+      (Array.toList arr)++fromRecord ::+   (Traversable f) =>+   f a -> Array (Shape.Record f) a+fromRecord xs =+   Array.fromList+      (Shape.Record $ flip MS.evalState (Shape.Element 0) $+       traverse (const TupleShape.next) xs)+      (Fold.toList xs)++toRecord ::+   (Traversable f) =>+   Array (Shape.Record f) a -> f a+toRecord arr =+   MS.evalState+      (traverse (const TupleShape.get) $+       (\(Shape.Record record) -> record) $ shape arr)+      (Array.toList arr)+ fromContainer :: (Container.C f) => f a -> Array (Container.Shape f) a fromContainer xs = Array.fromList (Container.toShape xs) (Fold.toList xs) @@ -124,3 +170,13 @@    marr <- Prim.newArray (Shape.size sh) a    forM_ xs $ \(ix,x) -> Prim.writeArray marr (Shape.offset sh ix) x    Array sh <$> Prim.unsafeFreezeArray marr)++++pick ::+   (Shape.Indexed sh0, Shape.C sh1) =>+   Array (sh0,sh1) a -> Shape.Index sh0 -> Array sh1 a+pick (Array (sh0,sh1) x) ix0 =+   Array sh1 $+   let k = Shape.size sh1+   in Prim.cloneArray x (Shape.offset sh0 ix0 * k) k

@@ -1,4 +1,5 @@ {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} module Data.Array.Comfort.Boxed.Unchecked (    Array(..),    reshape,@@ -10,10 +11,16 @@    replicate,    map,    zipWith,++   append,+   take, drop,+   takeLeft, takeRight, split,+   takeCenter,    ) where  import qualified Data.Array.Comfort.Shape as Shape import qualified Data.Primitive.Array as Prim+import Data.Array.Comfort.Shape ((::+)((::+)))  -- FixMe: In GHC-7.4.2 there is no instance PrimMonad (Lazy.ST s) -- import qualified Control.Monad.ST.Lazy as ST@@ -25,14 +32,34 @@ import qualified Data.Traversable as Trav import qualified Data.Foldable as Fold import qualified Data.List as List-import Prelude hiding (map, zipWith, replicate)+import Prelude hiding (map, zipWith, replicate, take, drop)  +{- $setup+>>> import qualified Data.Array.Comfort.Boxed as Array+>>> import qualified Data.Array.Comfort.Shape as Shape+>>> import Data.Array.Comfort.Boxed (Array)+>>>+>>> import qualified Test.QuickCheck as QC+>>>+>>> type ShapeInt = Shape.ZeroBased Int+>>>+>>> genArray :: QC.Gen (Array ShapeInt Char)+>>> genArray = Array.vectorFromList <$> QC.arbitrary+>>>+>>> newtype ArrayChar = ArrayChar (Array ShapeInt Char)+>>>    deriving (Show)+>>>+>>> instance QC.Arbitrary ArrayChar where+>>>    arbitrary = fmap ArrayChar genArray+-}++ data Array sh a =    Array {       shape :: sh,       buffer :: Prim.Array a-   }+   } deriving (Eq)  instance (Shape.C sh, Show sh, Show a) => Show (Array sh a) where    showsPrec p arr =@@ -86,7 +113,7 @@  toList :: (Shape.C sh) => Array sh a -> [a] toList (Array sh arr) =-   List.map (Prim.indexArray arr) $ take (Shape.size sh) [0..]+   List.map (Prim.indexArray arr) $ List.take (Shape.size sh) [0..]  fromList :: (Shape.C sh) => sh -> [a] -> Array sh a fromList sh xs = Array sh $ Prim.fromListN (Shape.size sh) xs@@ -104,7 +131,7 @@ map :: (Shape.C sh) => (a -> b) -> Array sh a -> Array sh b map f (Array sh arr) = Array sh $    let n = Shape.size sh-   in Prim.fromListN n $ List.map (f . Prim.indexArray arr) $ take n [0..]+   in Prim.fromListN n $ List.map (f . Prim.indexArray arr) $ List.take n [0..]  zipWith ::    (Shape.C sh) => (a -> b -> c) -> Array sh a -> Array sh b -> Array sh c@@ -112,4 +139,67 @@    let n = Shape.size sha    in Prim.fromListN n $       List.map (\k -> f (Prim.indexArray arra k) (Prim.indexArray arrb k)) $-      take n [0..]+      List.take n [0..]++++infixr 5 `append`++append ::+   (Shape.C shx, Shape.C shy) =>+   Array shx a -> Array shy a -> Array (shx::+shy) a+append (Array shX x) (Array shY y) =+   let sizeX = Shape.size shX in+   let sizeY = Shape.size shY in+   Array (shX::+shY) $+   ST.runST (do+      arr <-+         Prim.newArray (sizeX+sizeY)+            (error "Boxed.append: uninitialized element")+      Prim.copyArray arr 0 x 0 sizeX+      Prim.copyArray arr sizeX y 0 sizeY+      Prim.unsafeFreezeArray arr)++{- |+prop> \(QC.NonNegative n) (ArrayChar x)  ->  x == Array.mapShape (Shape.ZeroBased . Shape.size) (Array.append (Array.take n x) (Array.drop n x))+-}+take, drop ::+   (Integral n) =>+   n -> Array (Shape.ZeroBased n) a -> Array (Shape.ZeroBased n) a+take n = takeLeft . splitN n+drop n = takeRight . splitN n++splitN ::+   (Integral n) =>+   n -> Array (Shape.ZeroBased n) a ->+   Array (Shape.ZeroBased n ::+ Shape.ZeroBased n) a+splitN n = mapShape (Shape.zeroBasedSplit n)++{- |+prop> \(ArrayChar x) (ArrayChar y) -> let xy = Array.append x y in x == Array.takeLeft xy  &&  y == Array.takeRight xy+-}+takeLeft ::+   (Shape.C sh0, Shape.C sh1) =>+   Array (sh0::+sh1) a -> Array sh0 a+takeLeft =+   takeCenter . mapShape (\(sh0 ::+ sh1) -> (Shape.Zero ::+ sh0 ::+ sh1))++takeRight ::+   (Shape.C sh0, Shape.C sh1) =>+   Array (sh0::+sh1) a -> Array sh1 a+takeRight =+   takeCenter . mapShape (\(sh0 ::+ sh1) -> (sh0 ::+ sh1 ::+ Shape.Zero))++split ::+   (Shape.C sh0, Shape.C sh1) =>+   Array (sh0::+sh1) a -> (Array sh0 a, Array sh1 a)+split x = (takeLeft x, takeRight x)++{- |+prop> \(ArrayChar x) (ArrayChar y) (ArrayChar z) -> let xyz = Array.append x $ Array.append y z in y == Array.takeCenter xyz+-}+takeCenter ::+   (Shape.C sh0, Shape.C sh1, Shape.C sh2) =>+   Array (sh0::+sh1::+sh2) a -> Array sh1 a+takeCenter (Array (sh0::+sh1::+_sh2) x) =+   Array sh1 $ Prim.cloneArray x (Shape.size sh0) (Shape.size sh1)

@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE EmptyDataDecls #-}@@ -7,6 +8,7 @@    Indexed(..),    InvIndexed(..), messageIndexFromOffset, assertIndexFromOffset,    Static(..),+   Pattern(..),     requireCheck,    CheckSingleton(..),@@ -49,6 +51,27 @@    CollisionC,     Cyclic(..),++   NestedTuple(..),+   AccessorTuple(..),+   StaticTuple(..),+   Element(..),+   TupleAccessor,+   TupleIndex,++   ElementIndex,+   ElementTuple(..),+   indexTupleFromShape,++   Record(..),+   FieldIndex,+   indexRecordFromShape,++   Constructed,+   ConsIndex,+   Construction,+   construct,+   consIndex,    ) where  import qualified Data.Array.Comfort.Shape.Set as ShapeSet@@ -61,13 +84,14 @@  import qualified GHC.Arr as Ix +import qualified Control.Monad.Trans.Writer as MW import qualified Control.Monad.Trans.State as MS import qualified Control.Monad.HT as Monad-import qualified Control.Applicative.HT as AppHT+import qualified Control.Applicative.HT as App import qualified Control.Applicative.Backwards as Back import Control.DeepSeq (NFData, rnf) import Control.Monad (liftM)-import Control.Applicative (Applicative, pure, liftA2, liftA3, (<*>), (<$>))+import Control.Applicative (Applicative, pure, (<*>), (<$>)) import Control.Applicative (Const(Const, getConst)) import Control.Functor.HT (void) @@ -83,20 +107,27 @@ import Data.Traversable (Traversable) import Data.Foldable (Foldable) import Data.Functor.Identity (Identity(Identity), runIdentity)+import Data.Monoid (Sum(Sum, getSum)) import Data.Function.HT (compose2) import Data.Tagged (Tagged(Tagged, unTagged))+import Data.Complex (Complex((:+)), realPart, imagPart) import Data.Map (Map) import Data.Set (Set) import Data.List.HT (tails) import Data.Tuple.HT (mapFst, mapSnd, swap, fst3, snd3, thd3) import Data.Eq.HT (equating) +import Text.Printf (printf) + {- $setup >>> import qualified Data.Array.Comfort.Shape as Shape >>> import qualified Data.Map as Map >>> import qualified Data.Set as Set >>> import Data.Array.Comfort.Shape ((::+)((::+)))+>>>+>>> import Test.ChasingBottoms.IsBottom (isBottom)+>>> import Control.DeepSeq (rnf) -}  @@ -246,7 +277,15 @@ class (C sh, Eq sh) => Static sh where    static :: sh +{-+We need superclass Indexed for Index type function.+But this disables the sensible instance Pattern Zero.+-}+class (Indexed sh) => Pattern sh where+   type DataPattern sh x+   indexPattern :: (Index sh -> x) -> sh -> DataPattern sh x + data Zero = Zero    deriving (Eq, Ord, Show) @@ -256,7 +295,15 @@ instance Static Zero where    static = Zero +{-+missing superclass Indexed +instance Pattern Zero where+   type DataPattern Zero x = ()+   indexPattern _ Zero = ()+-}++ instance C () where    size () = 1 @@ -276,7 +323,11 @@ instance Static () where    static = () +instance Pattern () where+   type DataPattern () x = x+   indexPattern extend = extend + {- | 'ZeroBased' denotes a range starting at zero and has a certain length. @@ -324,6 +375,11 @@       else let k = min n m in ZeroBased k ::+ ZeroBased (m-k)  +instance (Integral n) => Pattern (ZeroBased n) where+   type DataPattern (ZeroBased n) x = n -> x+   indexPattern extend (ZeroBased _n) = extend++ {- | 'OneBased' denotes a range starting at one and has a certain length. @@ -447,9 +503,9 @@          (iterate (subtract 1) len)          (iterate (1+) offs)    unifiedOffset (Shifted offs len) ix = do-      assert "Shape.Shifted: array index too small" $ ix>=offs+      assert (printf "Shape.Shifted: array index too small (%d vs %d)" (toInteger offs) (toInteger ix)) $ ix>=offs       let k = ix-offs-      assert "Shape.Shifted: array index too big" $ k<len+      assert (printf "Shape.Shifted: array index too big (%d vs %d)" (toInteger k) (toInteger len)) $ k<len       return $ fromIntegral k    inBounds (Shifted offs len) ix = offs <= ix && ix < offs+len @@ -745,8 +801,12 @@ instance (Static sh) => Static (Tagged s sh) where    static = Tagged static +instance (Pattern sh) => Pattern (Tagged s sh) where+   type DataPattern (Tagged s sh) x = DataPattern sh x+   indexPattern extend (Tagged sh) = indexPattern (extend . Tagged) sh  + instance (C sh0, C sh1) => C (sh0,sh1) where    size (sh0,sh1) = size sh0 * size sh1 @@ -772,14 +832,20 @@ instance (InvIndexed sh0, InvIndexed sh1) => InvIndexed (sh0,sh1) where    unifiedIndexFromOffset (sh0,sh1) k = do       let (rix0,ix1) =-            runInvIndex k $ liftA2 (,) (pickLastIndex sh0) (pickIndex sh1)+            runInvIndex k $ App.lift2 (,) (pickLastIndex sh0) (pickIndex sh1)       ix0 <- rix0       return (ix0,ix1)  instance (Static sh0, Static sh1) => Static (sh0,sh1) where    static = (static, static) +instance (Pattern sh0, Pattern sh1) => Pattern (sh0,sh1) where+   type DataPattern (sh0,sh1) x = PatternRecord sh0 (DataPattern sh1 x)+   indexPattern extend (sh0,sh1) =+      PatternRecord $+         indexPattern (\i -> indexPattern (\j -> extend (i,j)) sh1) sh0 + instance (C sh0, C sh1, C sh2) => C (sh0,sh1,sh2) where    size (sh0,sh1,sh2) = size sh0 * size sh1 * size sh2 @@ -808,7 +874,7 @@    unifiedIndexFromOffset (sh0,sh1,sh2) k = do       let (rix0,ix1,ix2) =             runInvIndex k $-            liftA3 (,,) (pickLastIndex sh0) (pickIndex sh1) (pickIndex sh2)+            App.lift3 (,,) (pickLastIndex sh0) (pickIndex sh1) (pickIndex sh2)       ix0 <- rix0       return (ix0,ix1,ix2) @@ -890,8 +956,19 @@    unifiedIndexFromOffset (Square sh) =       unifiedIndexFromOffset (sh,sh) +newtype PatternRecord sh a = PatternRecord (DataPattern sh a) +instance (Pattern sh) => Pattern (Square sh) where+   -- Would require UndecidableInstances+   -- type DataPattern (Square sh) x = DataPattern sh (DataPattern sh x) +   type DataPattern (Square sh) x = PatternRecord sh (DataPattern sh x)+   indexPattern extend (Square sh) =+      PatternRecord $+         indexPattern (\i -> indexPattern (\j -> extend (i,j)) sh) sh+++ {- | 'Cube' is like a Cartesian product, but it is statically asserted that both dimension shapes match.@@ -1040,7 +1117,7 @@     unifiedIndexFromOffset (Triangular part sz) k =       let n = size sz in-      AppHT.mapPair (unifiedIndexFromOffset sz, unifiedIndexFromOffset sz) $+      App.mapPair (unifiedIndexFromOffset sz, unifiedIndexFromOffset sz) $        caseTriangularPart part          (let r = floor (triangleRootDouble k)           in (r, k - triangleSize r))@@ -1426,7 +1503,12 @@ instance (Static sh0, Static sh1) => Static (sh0::+sh1) where    static = static::+static +instance (Pattern sh0, Pattern sh1) => Pattern (sh0::+sh1) where+   type DataPattern (sh0::+sh1) x = DataPattern sh0 x ::+ DataPattern sh1 x+   indexPattern extend (sh0::+sh1) =+      indexPattern (extend . Left) sh0 ::+ indexPattern (extend . Right) sh1 + infixl 7 |* infixl 6 |+| @@ -1434,4 +1516,297 @@ f|*a = fmap (*a) f  (|+|) :: (Applicative f, Num a) => f a -> f a -> f a-(|+|) = liftA2 (+)+(|+|) = App.lift2 (+)++++{- |+Shape for arrays that hold elements+that can alternatively be stored in nested tuples.+-}+newtype NestedTuple ixtype tuple = NestedTuple {getNestedTuple :: tuple}+   deriving (Eq, Show)++data TupleAccessor+data TupleIndex++newtype Element = Element Int+   deriving (Eq, Show)++instance NFData Element where+   rnf (Element k) = rnf k+++class ElementTuple tuple where+   type DataTuple tuple x+   indexTupleA ::+      (Applicative f) => (Element -> f a) -> tuple -> f (DataTuple tuple a)++tupleSize :: (ElementTuple tuple) => tuple -> Int+tupleSize =+   getSum . MW.execWriter . indexTupleA (\x -> MW.tell (Sum 1) >> return x)++indexTuple ::+   (ElementTuple tuple) => (Element -> a) -> tuple -> DataTuple tuple a+indexTuple extend = runIdentity . indexTupleA (Identity . extend)++{- |+>>> rnf (Shape.NestedTuple (Shape.Element 1, Shape.Element 2))+()+>>> rnf (Shape.NestedTuple (Shape.Element 1, (Shape.Element 2, Shape.Element 3)))+()+>>> isBottom $ rnf (Shape.NestedTuple (Shape.Element undefined, Shape.Element 2))+True+>>> isBottom $ rnf (Shape.NestedTuple (Shape.Element undefined, (Shape.Element 2, Shape.Element 3)))+True+>>> isBottom $ rnf (Shape.NestedTuple (Shape.Element 1, (Shape.Element undefined, Shape.Element 3)))+True+>>> isBottom $ rnf (Shape.NestedTuple (Shape.Element 1, (Shape.Element 2, Shape.Element undefined)))+True+-}+instance (ElementTuple tuple) => NFData (NestedTuple ixtype tuple) where+   rnf (NestedTuple tuple) =+      execStrictUnitWriter $ indexTupleA ((StrictUnitWriter$!) . rnf) tuple++data StrictUnitWriter a = StrictUnitWriter a++execStrictUnitWriter :: StrictUnitWriter a -> ()+execStrictUnitWriter (StrictUnitWriter _) = ()++instance Functor StrictUnitWriter where+   fmap f (StrictUnitWriter a) = StrictUnitWriter $ f a++instance Applicative StrictUnitWriter where+   pure = StrictUnitWriter+   StrictUnitWriter f <*> StrictUnitWriter a = StrictUnitWriter $ f a++instance Monad StrictUnitWriter where+   return = pure+   StrictUnitWriter a >>= k = k a++++class (ElementTuple tuple) => AccessorTuple tuple where+   tupleAccessors :: tuple -> [tuple -> Element]++class (ElementTuple tuple, Eq tuple) => StaticTuple tuple where+   staticTuple :: MS.State Element tuple+++instance ElementTuple () where+   type DataTuple () x = ()+   indexTupleA _ () = pure ()++instance AccessorTuple () where+   tupleAccessors () = []++instance StaticTuple () where+   staticTuple = return ()+++instance ElementTuple Element where+   type DataTuple Element x = x+   indexTupleA extend = extend++instance AccessorTuple Element where+   tupleAccessors _ = [id]++instance StaticTuple Element where+   staticTuple = do+      ix <- MS.get+      MS.modify (\(Element k) -> Element (k+1))+      return ix+++instance (ElementTuple a, ElementTuple b) => ElementTuple (a,b) where+   type DataTuple (a,b) x = (DataTuple a x, DataTuple b x)+   indexTupleA extend (a,b) =+      App.lift2 (,) (indexTupleA extend a) (indexTupleA extend b)++instance (AccessorTuple a, AccessorTuple b) => AccessorTuple (a,b) where+   tupleAccessors (a,b) =+      map (.fst) (tupleAccessors a) ++ map (.snd) (tupleAccessors b)++instance (StaticTuple a, StaticTuple b) => StaticTuple (a,b) where+   staticTuple = App.lift2 (,) staticTuple staticTuple+++instance+   (ElementTuple a, ElementTuple b, ElementTuple c) =>+      ElementTuple (a,b,c) where+   type DataTuple (a,b,c) x = (DataTuple a x, DataTuple b x, DataTuple c x)+   indexTupleA extend (a,b,c) =+      App.lift3 (,,)+         (indexTupleA extend a) (indexTupleA extend b) (indexTupleA extend c)++instance+   (AccessorTuple a, AccessorTuple b, AccessorTuple c) =>+      AccessorTuple (a,b,c) where+   tupleAccessors (a,b,c) =+      map (.fst3) (tupleAccessors a) +++      map (.snd3) (tupleAccessors b) +++      map (.thd3) (tupleAccessors c)++instance+   (StaticTuple a, StaticTuple b, StaticTuple c) =>+      StaticTuple (a,b,c) where+   staticTuple = App.lift3 (,,) staticTuple staticTuple staticTuple+++instance+   (ElementTuple a, ElementTuple b, ElementTuple c, ElementTuple d) =>+      ElementTuple (a,b,c,d) where+   type DataTuple (a,b,c,d) x =+         (DataTuple a x, DataTuple b x, DataTuple c x, DataTuple d x)+   indexTupleA extend (a,b,c,d) =+      App.lift4 (,,,)+         (indexTupleA extend a) (indexTupleA extend b)+         (indexTupleA extend c) (indexTupleA extend d)++instance+   (AccessorTuple a, AccessorTuple b, AccessorTuple c, AccessorTuple d) =>+      AccessorTuple (a,b,c,d) where+   tupleAccessors (a,b,c,d) =+      map (.(\(i,_,_,_) -> i)) (tupleAccessors a) +++      map (.(\(_,i,_,_) -> i)) (tupleAccessors b) +++      map (.(\(_,_,i,_) -> i)) (tupleAccessors c) +++      map (.(\(_,_,_,i) -> i)) (tupleAccessors d)++instance+   (StaticTuple a, StaticTuple b, StaticTuple c, StaticTuple d) =>+      StaticTuple (a,b,c,d) where+   staticTuple = App.lift4 (,,,) staticTuple staticTuple staticTuple staticTuple+++instance (ElementTuple a) => ElementTuple (Complex a) where+   type DataTuple (Complex a) x = Complex (DataTuple a x)+   indexTupleA extend (a:+b) =+      App.lift2 (:+) (indexTupleA extend a) (indexTupleA extend b)++instance (AccessorTuple a) => AccessorTuple (Complex a) where+   tupleAccessors (a:+b) =+      map (.realPart) (tupleAccessors a) ++ map (.imagPart) (tupleAccessors b)++instance (StaticTuple a) => StaticTuple (Complex a) where+   staticTuple = App.lift2 (:+) staticTuple staticTuple+++instance (ElementTuple tuple) => C (NestedTuple ixtype tuple) where+   size (NestedTuple tuple) = tupleSize tuple++instance (StaticTuple tuple) => Static (NestedTuple ixtype tuple) where+   static = NestedTuple $ MS.evalState staticTuple $ Element 0++-- requires FlexibleInstances+instance (AccessorTuple tuple) => Indexed (NestedTuple TupleAccessor tuple) where+   type Index (NestedTuple TupleAccessor tuple) = tuple -> Element+   indices (NestedTuple tuple) = tupleAccessors tuple+   unifiedOffset (NestedTuple tuple) ix =+      case ix tuple of Element k -> return k++++newtype ElementIndex tuple = ElementIndex Int+   deriving (Eq, Ord, Show)++instance (ElementTuple tuple) => Indexed (NestedTuple TupleIndex tuple) where+   type Index (NestedTuple TupleIndex tuple) = ElementIndex tuple+   indices (NestedTuple tuple) =+      map ElementIndex $ take (tupleSize tuple) [0..]+   unifiedOffset (NestedTuple _tuple) (ElementIndex k) = return k++instance (ElementTuple tuple) => Pattern (NestedTuple TupleIndex tuple) where+   type DataPattern (NestedTuple TupleIndex tuple) x = DataTuple tuple x+   indexPattern extend (NestedTuple tuple) =+      let elemIx :: tuple -> Element -> ElementIndex tuple+          elemIx _ (Element k) = ElementIndex k+      in indexTuple (extend . elemIx tuple) tuple++indexTupleFromShape ::+   (ElementTuple tuple) =>+   NestedTuple TupleIndex tuple -> DataTuple tuple (ElementIndex tuple)+indexTupleFromShape = indexPattern id+++++nextCounter :: MS.State Int Int+nextCounter = do k <- MS.get; MS.put (k+1); return k++{- |+Shape for arrays that hold elements+that can alternatively be stored in a 'Traversable' record.+-}+newtype Record f = Record {getRecord :: f Element}++instance (Foldable f) => Eq (Record f) where+   Record sh0 == Record sh1  =  Fold.toList sh0 == Fold.toList sh1+{-+instance (Eq (f Element)) => Eq (Record f) where+   Record sh0 == Record sh1  =  sh0 == sh1+-}++newtype FieldIndex (f :: * -> *) = FieldIndex Int+   deriving (Eq, Show)++instance (Foldable f) => C (Record f) where+   size = foldLength . getRecord++instance (Applicative f, Traversable f) => Static (Record f) where+   static =+      Record $ flip MS.evalState 0 $ Trav.sequence $+      pure (fmap Element nextCounter)++instance (Foldable f) => Indexed (Record f) where+   type Index (Record f) = FieldIndex f+   indices (Record xs) = map FieldIndex $ Match.take (Fold.toList xs) [0..]+   unifiedOffset (Record _xs) (FieldIndex k) = return k++indexRecordFromShape ::+   (Traversable f) =>+   Record f -> f (FieldIndex f)+indexRecordFromShape (Record xs) = fmap (\(Element k) -> FieldIndex k) xs++++newtype Constructed tag = Constructed {constructedSize :: Int}+   deriving (Eq, Show)++newtype ConsIndex tag = ConsIndex Int+   deriving (Eq, Show)++newtype Construction tag a = Construction (MS.State Int a)++instance Functor (Construction tag) where+   fmap f (Construction m) = Construction $ fmap f m++instance Applicative (Construction tag) where+   pure = Construction . pure+   Construction f  <*>  Construction a = Construction $ f<*>a++instance Monad (Construction tag) where+   return = pure+   Construction am  >>=  k  =+      Construction $ am >>= \a -> case k a of Construction bm -> bm++construct :: Construction tag a -> (Constructed tag, a)+construct (Construction m) =+   case MS.runState m 0 of (a, sz) -> (Constructed sz, a)++consIndex :: Construction tag (ConsIndex tag)+consIndex = Construction $ fmap ConsIndex nextCounter+++instance C (Constructed tag) where+   size = constructedSize++instance Indexed (Constructed tag) where+   type Index (Constructed tag) = ConsIndex tag+   indices (Constructed len) = map ConsIndex $ take len [0..]+   unifiedOffset (Constructed len) =+      let f = unifiedOffset (ZeroBased len) in \(ConsIndex k) -> f k+   inBounds (Constructed len) (ConsIndex ix) = inBounds (ZeroBased len) ix++instance InvIndexed (Constructed tag) where+   unifiedIndexFromOffset (Constructed len) =+      fmap ConsIndex . unifiedIndexFromOffset (ZeroBased len)

@@ -0,0 +1,62 @@+{-# LANGUAGE TypeFamilies #-}+module Data.Array.Comfort.Shape.Tuple where++import qualified Data.Array.Comfort.Shape as Shape+import Data.Complex (Complex((:+)))++import qualified Control.Monad.Trans.State as MS+import qualified Control.Applicative.HT as App+++get :: MS.State [a] a+get =+   MS.state $ \at ->+      case at of+         a:as -> (a,as)+         [] -> error "Shape.Tuple.get: no element left"++cons ::+   (Shape.ElementTuple shape) =>+   shape -> MS.State [a] (Shape.DataTuple shape a)+cons = Shape.indexTupleA (const get)+++next :: MS.State Shape.Element Shape.Element+next = do+   ix <- MS.get+   MS.modify (\(Shape.Element k) -> Shape.Element (k+1))+   return ix+++class (Shape.ElementTuple shape) => NestedTuple shape where+   decons :: Shape.DataTuple shape a -> MS.State Shape.Element (shape, [a])++instance NestedTuple () where+   decons () = return ((),[])++instance NestedTuple Shape.Element where+   decons a = flip (,) [a] <$> next++instance (NestedTuple a, NestedTuple b) => NestedTuple (a,b) where+   decons (a,b) =+      App.lift2 (\(ta,as) (tb,bs) -> ((ta,tb), as++bs)) (decons a) (decons b)++instance+   (NestedTuple a, NestedTuple b, NestedTuple c) =>+      NestedTuple (a,b,c) where+   decons (a,b,c) =+      App.lift3+         (\(ta,as) (tb,bs) (tc,cs) -> ((ta,tb,tc), as++bs++cs))+         (decons a) (decons b) (decons c)++instance+   (NestedTuple a, NestedTuple b, NestedTuple c, NestedTuple d) =>+      NestedTuple (a,b,c,d) where+   decons (a,b,c,d) =+      App.lift4+         (\(ta,as) (tb,bs) (tc,cs) (td,ds) -> ((ta,tb,tc,td), as++bs++cs++ds))+         (decons a) (decons b) (decons c) (decons d)++instance (NestedTuple a) => NestedTuple (Complex a) where+   decons (a:+b) =+      App.lift2 (\(ta,as) (tb,bs) -> ((ta:+tb), as++bs)) (decons a) (decons b)

@@ -1,4 +1,3 @@-{-# LANGUAGE TypeFamilies #-} module Data.Array.Comfort.Storable (    Array,    shape,@@ -11,6 +10,8 @@    toAssociations,    fromList,    fromMap, toMap,+   fromTuple, toTuple,+   fromRecord, toRecord,    fromContainer,    toContainer,    sample,@@ -51,6 +52,7 @@ import qualified Data.Array.Comfort.Container as Container import qualified Data.Array.Comfort.Boxed as BoxedArray import qualified Data.Array.Comfort.Check as Check+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 ((::+)((::+)))@@ -60,6 +62,7 @@ import Foreign.Storable (Storable) import Foreign.ForeignPtr (withForeignPtr) +import qualified Control.Monad.Trans.State as MS import Control.Monad.ST (runST)  import qualified Data.StorableVector.Base as SVB@@ -90,6 +93,7 @@ >>> >>> import Control.Applicative ((<$>), (<*>)) >>>+>>> import Data.Complex (Complex((:+))) >>> import Data.Word (Word16) >>> >>> type ShapeInt = Shape.ZeroBased Int@@ -126,6 +130,9 @@ >>>          if Array.shape xs == Shape.ZeroBased 0 >>>             then isBottom resultArray >>>             else resultArray == resultList+>>>+>>>+>>> type X = Shape.Element -}  @@ -153,6 +160,55 @@ toMap :: (Ord k, Storable a) => Array (Set k) a -> Map k a toMap arr = Map.fromAscList $ zip (Set.toAscList $ shape arr) (Array.toList arr) +{- |+>>> Array.fromTuple ('a',('b','c')) :: Array.Array (Shape.NestedTuple Shape.TupleIndex (X,(X,X))) Char+StorableArray.fromList (NestedTuple {getNestedTuple = (Element 0,(Element 1,Element 2))}) "abc"++>>> :{ let arr = Array.fromTuple ('a',('b','c')) :: Array.Array (Shape.NestedTuple Shape.TupleAccessor (X,(X,X))) Char+in (arr ! fst, arr ! (fst.snd))+:}+('a','b')+-}+fromTuple ::+   (TupleShape.NestedTuple tuple, Storable a) =>+   Shape.DataTuple tuple a -> Array (Shape.NestedTuple ixtype tuple) a+fromTuple tuple =+   case MS.evalState (TupleShape.decons tuple) (Shape.Element 0) of+      (sh, xs) -> fromList (Shape.NestedTuple sh) xs++toTuple ::+   (TupleShape.NestedTuple tuple, Storable a) =>+   Array (Shape.NestedTuple ixtype tuple) a -> Shape.DataTuple tuple a+toTuple arr =+   MS.evalState+      (TupleShape.cons $ Shape.getNestedTuple $ shape arr)+      (Array.toList arr)++{- |+>>> :{ let arr = Array.fromRecord ('a' :+ 'b') in+let (real:+imag) = Shape.indexRecordFromShape $ Array.shape arr in+(arr ! real, arr ! imag)+:}+('a','b')+-}+fromRecord ::+   (Trav.Traversable f, Storable a) =>+   f a -> Array (Shape.Record f) a+fromRecord xs =+   fromList+      (Shape.Record $ flip MS.evalState (Shape.Element 0) $+       Trav.traverse (const TupleShape.next) xs)+      (Fold.toList xs)++toRecord ::+   (Trav.Traversable f, Storable a) =>+   Array (Shape.Record f) a -> f a+toRecord arr =+   MS.evalState+      (Trav.traverse (const TupleShape.get) $+       (\(Shape.Record record) -> record) $ shape arr)+      (Array.toList arr)+ fromContainer ::    (Container.C f, Storable a) => f a -> Array (Container.Shape f) a fromContainer xs = fromList (Container.toShape xs) (Fold.toList xs)@@ -252,7 +308,7 @@ pick (Array (sh0,sh1) x) ix0 =    Array.unsafeCreateWithSize sh1 $ \k yPtr ->    withForeignPtr x $ \xPtr ->-      copyArray yPtr (advancePtr xPtr (Shape.offset sh0 ix0 * Shape.size sh1)) k+      copyArray yPtr (advancePtr xPtr (Shape.offset sh0 ix0 * k)) k  toRowArray ::    (Shape.Indexed sh0, Shape.C sh1, Storable a) =>@@ -313,8 +369,8 @@   argMinimum, argMaximum ::-   (Shape.InvIndexed sh, Shape.Index sh ~ ix, Storable a, Ord a) =>-   Array sh a -> (ix,a)+   (Shape.InvIndexed sh, Storable a, Ord a) =>+   Array sh a -> (Shape.Index sh, a) argMinimum xs = unArg xs $ getMin $ foldMapWithIndex (\k x -> Min (Arg x k)) xs argMaximum xs = unArg xs $ getMax $ foldMapWithIndex (\k x -> Max (Arg x k)) xs 

@@ -1,3 +1,4 @@ Data.Array.Comfort.Shape Data.Array.Comfort.Storable Data.Array.Comfort.Storable.Unchecked+Data.Array.Comfort.Boxed.Unchecked

@@ -0,0 +1,42 @@+-- Do not edit! Automatically created with doctest-extract from src/Data/Array/Comfort/Boxed/Unchecked.hs+{-# LINE 38 "src/Data/Array/Comfort/Boxed/Unchecked.hs" #-}++module DocTest.Data.Array.Comfort.Boxed.Unchecked where++import qualified Test.DocTest.Driver as DocTest++{-# LINE 39 "src/Data/Array/Comfort/Boxed/Unchecked.hs" #-}+import     qualified Data.Array.Comfort.Boxed as Array+import     qualified Data.Array.Comfort.Shape as Shape+import     Data.Array.Comfort.Boxed (Array)++import     qualified Test.QuickCheck as QC++type     ShapeInt = Shape.ZeroBased Int++genArray     :: QC.Gen (Array ShapeInt Char)+genArray     = Array.vectorFromList <$> QC.arbitrary++newtype     ArrayChar = ArrayChar (Array ShapeInt Char)+       deriving (Show)++instance     QC.Arbitrary ArrayChar where+       arbitrary = fmap ArrayChar genArray++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Data.Array.Comfort.Boxed.Unchecked:164: "+{-# LINE 164 "src/Data/Array/Comfort/Boxed/Unchecked.hs" #-}+ DocTest.property+{-# LINE 164 "src/Data/Array/Comfort/Boxed/Unchecked.hs" #-}+     (\(QC.NonNegative n) (ArrayChar x)  ->  x == Array.mapShape (Shape.ZeroBased . Shape.size) (Array.append (Array.take n x) (Array.drop n x)))+ DocTest.printPrefix "Data.Array.Comfort.Boxed.Unchecked:179: "+{-# LINE 179 "src/Data/Array/Comfort/Boxed/Unchecked.hs" #-}+ DocTest.property+{-# LINE 179 "src/Data/Array/Comfort/Boxed/Unchecked.hs" #-}+     (\(ArrayChar x) (ArrayChar y) -> let xy = Array.append x y in x == Array.takeLeft xy  &&  y == Array.takeRight xy)+ DocTest.printPrefix "Data.Array.Comfort.Boxed.Unchecked:199: "+{-# LINE 199 "src/Data/Array/Comfort/Boxed/Unchecked.hs" #-}+ DocTest.property+{-# LINE 199 "src/Data/Array/Comfort/Boxed/Unchecked.hs" #-}+     (\(ArrayChar x) (ArrayChar y) (ArrayChar z) -> let xyz = Array.append x $ Array.append y z in y == Array.takeCenter xyz)

@@ -1,77 +1,80 @@ -- Do not edit! Automatically created with doctest-extract from src/Data/Array/Comfort/Shape.hs-{-# LINE 95 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 123 "src/Data/Array/Comfort/Shape.hs" #-}  module DocTest.Data.Array.Comfort.Shape where  import Test.DocTest.Base import qualified Test.DocTest.Driver as DocTest -{-# LINE 96 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 124 "src/Data/Array/Comfort/Shape.hs" #-} import     qualified Data.Array.Comfort.Shape as Shape import     qualified Data.Map as Map import     qualified Data.Set as Set import     Data.Array.Comfort.Shape ((::+)((::+))) +import     Test.ChasingBottoms.IsBottom (isBottom)+import     Control.DeepSeq (rnf)+ test :: DocTest.T () test = do- DocTest.printPrefix "Data.Array.Comfort.Shape:264: "-{-# LINE 264 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:311: "+{-# LINE 311 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 264 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 311 "src/Data/Array/Comfort/Shape.hs" #-}    (Shape.indices ())   [ExpectedLine [LineChunk "[()]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:283: "-{-# LINE 283 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:334: "+{-# LINE 334 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 283 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 334 "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:330: "-{-# LINE 330 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:386: "+{-# LINE 386 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 330 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 386 "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:374: "-{-# LINE 374 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:430: "+{-# LINE 430 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 374 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 430 "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:376: "-{-# LINE 376 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:432: "+{-# LINE 432 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 376 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 432 "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:426: "-{-# LINE 426 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:482: "+{-# LINE 482 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 426 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 482 "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:491: "-{-# LINE 491 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:547: "+{-# LINE 547 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 491 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 547 "src/Data/Array/Comfort/Shape.hs" #-}    (Shape.indices (Shape.Enumeration :: Shape.Enumeration Ordering))   [ExpectedLine [LineChunk "[LT,EQ,GT]"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:555: "-{-# LINE 555 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:611: "+{-# LINE 611 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 555 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 611 "src/Data/Array/Comfort/Shape.hs" #-}    (Shape.indices (Set.fromList "comfort"))   [ExpectedLine [LineChunk "\"cfmort\""]]- DocTest.printPrefix "Data.Array.Comfort.Shape:591: "-{-# LINE 591 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:647: "+{-# LINE 647 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 591 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 647 "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:656: "-{-# LINE 656 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:712: "+{-# LINE 712 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 656 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 712 "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@@ -80,98 +83,134 @@   Shape.indexFromOffset (Shape.Deferred sh2) 3)   )   [ExpectedLine [LineChunk "(4,3)"]]- DocTest.printPrefix "Data.Array.Comfort.Shape:756: "-{-# LINE 756 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:816: "+{-# LINE 816 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 756 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 816 "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:856: "-{-# LINE 856 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:922: "+{-# LINE 922 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 856 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 922 "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:899: "-{-# LINE 899 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:976: "+{-# LINE 976 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 899 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 976 "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:958: "-{-# LINE 958 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1035: "+{-# LINE 1035 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 958 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1035 "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:960: "-{-# LINE 960 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1037: "+{-# LINE 1037 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 960 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1037 "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:1092: "-{-# LINE 1092 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1169: "+{-# LINE 1169 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 1092 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1169 "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:1094: "-{-# LINE 1094 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1171: "+{-# LINE 1171 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 1094 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1171 "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:1096: "-{-# LINE 1096 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1173: "+{-# LINE 1173 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 1096 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1173 "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:1098: "-{-# LINE 1098 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1175: "+{-# LINE 1175 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 1098 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1175 "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:1101: "-{-# LINE 1101 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1178: "+{-# LINE 1178 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 1101 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1178 "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:1103: "-{-# LINE 1103 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1180: "+{-# LINE 1180 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 1103 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1180 "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:1105: "-{-# LINE 1105 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1182: "+{-# LINE 1182 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 1105 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1182 "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:1107: "-{-# LINE 1107 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1184: "+{-# LINE 1184 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 1107 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1184 "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:1341: "-{-# LINE 1341 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1418: "+{-# LINE 1418 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.property-{-# LINE 1341 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1418 "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:1346: "-{-# LINE 1346 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1423: "+{-# LINE 1423 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 1346 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1423 "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:1390: "-{-# LINE 1390 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Shape:1467: "+{-# LINE 1467 "src/Data/Array/Comfort/Shape.hs" #-}  DocTest.example-{-# LINE 1390 "src/Data/Array/Comfort/Shape.hs" #-}+{-# LINE 1467 "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:1554: "+{-# LINE 1554 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 1554 "src/Data/Array/Comfort/Shape.hs" #-}+   (rnf (Shape.NestedTuple (Shape.Element 1, Shape.Element 2)))+  [ExpectedLine [LineChunk "()"]]+ DocTest.printPrefix "Data.Array.Comfort.Shape:1556: "+{-# LINE 1556 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 1556 "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:1558: "+{-# LINE 1558 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 1558 "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:1560: "+{-# LINE 1560 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 1560 "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:1562: "+{-# LINE 1562 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 1562 "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:1564: "+{-# LINE 1564 "src/Data/Array/Comfort/Shape.hs" #-}+ DocTest.example+{-# LINE 1564 "src/Data/Array/Comfort/Shape.hs" #-}+   (isBottom $ rnf (Shape.NestedTuple (Shape.Element 1, (Shape.Element 2, Shape.Element undefined))))+  [ExpectedLine [LineChunk "True"]]

@@ -1,12 +1,12 @@ -- Do not edit! Automatically created with doctest-extract from src/Data/Array/Comfort/Storable.hs-{-# LINE 83 "src/Data/Array/Comfort/Storable.hs" #-}+{-# LINE 86 "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 84 "src/Data/Array/Comfort/Storable.hs" #-}+{-# LINE 87 "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, (!))@@ -16,6 +16,7 @@  import     Control.Applicative ((<$>), (<*>)) +import     Data.Complex (Complex((:+))) import     Data.Word (Word16)  type     ShapeInt = Shape.ZeroBased Int@@ -53,36 +54,62 @@                 then isBottom resultArray                 else resultArray == resultList ++type     X = Shape.Element+ test :: DocTest.T () test = do- DocTest.printPrefix "Data.Array.Comfort.Storable:144: "-{-# LINE 144 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Storable:151: "+{-# LINE 151 "src/Data/Array/Comfort/Storable.hs" #-}  DocTest.example-{-# LINE 144 "src/Data/Array/Comfort/Storable.hs" #-}+{-# LINE 151 "src/Data/Array/Comfort/Storable.hs" #-}    (Array.fromList (Shape.ZeroBased (5::Int)) ['a'..])   [ExpectedLine [LineChunk "StorableArray.fromList (ZeroBased {zeroBasedSize = 5}) \"abcde\""]]- DocTest.printPrefix "Data.Array.Comfort.Storable:247: "-{-# LINE 247 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Storable:164: "+{-# LINE 164 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.example+{-# LINE 164 "src/Data/Array/Comfort/Storable.hs" #-}+   (Array.fromTuple ('a',('b','c')) :: Array.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:167: "+{-# LINE 167 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.example+{-# LINE 167 "src/Data/Array/Comfort/Storable.hs" #-}+   ( let arr = Array.fromTuple ('a',('b','c')) :: Array.Array (Shape.NestedTuple Shape.TupleAccessor (X,(X,X))) Char+  in (arr ! fst, arr ! (fst.snd))+  )+  [ExpectedLine [LineChunk "('a','b')"]]+ DocTest.printPrefix "Data.Array.Comfort.Storable:188: "+{-# LINE 188 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.example+{-# LINE 188 "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:303: "+{-# LINE 303 "src/Data/Array/Comfort/Storable.hs" #-}  DocTest.property-{-# LINE 247 "src/Data/Array/Comfort/Storable.hs" #-}+{-# LINE 303 "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:265: "-{-# LINE 265 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Storable:321: "+{-# LINE 321 "src/Data/Array/Comfort/Storable.hs" #-}  DocTest.property-{-# LINE 265 "src/Data/Array/Comfort/Storable.hs" #-}+{-# LINE 321 "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:282: "-{-# LINE 282 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Storable:338: "+{-# LINE 338 "src/Data/Array/Comfort/Storable.hs" #-}  DocTest.property-{-# LINE 282 "src/Data/Array/Comfort/Storable.hs" #-}+{-# LINE 338 "src/Data/Array/Comfort/Storable.hs" #-}      (forAllNonEmpty $ \xs -> Array.minimum xs ==? minimum (Array.toList xs))- DocTest.printPrefix "Data.Array.Comfort.Storable:290: "-{-# LINE 290 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Storable:346: "+{-# LINE 346 "src/Data/Array/Comfort/Storable.hs" #-}  DocTest.property-{-# LINE 290 "src/Data/Array/Comfort/Storable.hs" #-}+{-# LINE 346 "src/Data/Array/Comfort/Storable.hs" #-}      (forAllNonEmpty $ \xs -> Array.maximum xs ==? maximum (Array.toList xs))- DocTest.printPrefix "Data.Array.Comfort.Storable:302: "-{-# LINE 302 "src/Data/Array/Comfort/Storable.hs" #-}+ DocTest.printPrefix "Data.Array.Comfort.Storable:358: "+{-# LINE 358 "src/Data/Array/Comfort/Storable.hs" #-}  DocTest.property-{-# LINE 302 "src/Data/Array/Comfort/Storable.hs" #-}+{-# LINE 358 "src/Data/Array/Comfort/Storable.hs" #-}      (forAllNonEmpty $ \xs -> Array.limits xs ==? (Array.minimum xs, Array.maximum xs))

@@ -4,6 +4,7 @@ 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.Unchecked  import qualified Test.DocTest.Driver as DocTest @@ -12,3 +13,4 @@     DocTest.Data.Array.Comfort.Shape.test     DocTest.Data.Array.Comfort.Storable.test     DocTest.Data.Array.Comfort.Storable.Unchecked.test+    DocTest.Data.Array.Comfort.Boxed.Unchecked.test