dph-test: add more quickcheck framework for nested arrays
authorBen Lippmeier <benl@ouroborus.net>
Fri, 4 Nov 2011 04:28:05 +0000 (15:28 +1100)
committerBen Lippmeier <benl@ouroborus.net>
Fri, 4 Nov 2011 04:28:05 +0000 (15:28 +1100)
12 files changed:
dph-test/framework/DPH/Arbitrary.hs
dph-test/framework/DPH/Arbitrary/Array.hs [new file with mode: 0644]
dph-test/framework/DPH/Arbitrary/ArrayExp.hs [new file with mode: 0644]
dph-test/framework/DPH/Arbitrary/Joint.hs [new file with mode: 0644]
dph-test/framework/DPH/Arbitrary/Perm.hs
dph-test/framework/DPH/Arbitrary/Segd.hs
dph-test/framework/DPH/Arbitrary/Selector.hs
dph-test/framework/DPH/Arbitrary/Vector.hs
dph-test/framework/DPH/War/Job/Compile.hs
dph-test/framework/Util/Array.hs [new file with mode: 0644]
dph-test/framework/Util/Nesting.hs [new file with mode: 0644]
dph-test/test/PArray/PRFuns.hs

index b561721..bda2ec9 100644 (file)
@@ -1,13 +1,21 @@
 
-module DPH.Arbitrary 
+module DPH.Arbitrary
         ( module DPH.Arbitrary.Int
         , module DPH.Arbitrary.Vector
         , module DPH.Arbitrary.Perm
         , module DPH.Arbitrary.Selector
-        , module DPH.Arbitrary.SliceSpec)
+        , module DPH.Arbitrary.SliceSpec
+        , module DPH.Arbitrary.ArrayExp
+        , module DPH.Arbitrary.Array
+        , module DPH.Arbitrary.Joint
+        , module DPH.Arbitrary.Segd)
 where
 import DPH.Arbitrary.Int
 import DPH.Arbitrary.Vector
 import DPH.Arbitrary.Perm
 import DPH.Arbitrary.Selector
 import DPH.Arbitrary.SliceSpec
+import DPH.Arbitrary.ArrayExp
+import DPH.Arbitrary.Array
+import DPH.Arbitrary.Joint
+import DPH.Arbitrary.Segd
\ No newline at end of file
diff --git a/dph-test/framework/DPH/Arbitrary/Array.hs b/dph-test/framework/DPH/Arbitrary/Array.hs
new file mode 100644 (file)
index 0000000..a9403c4
--- /dev/null
@@ -0,0 +1,70 @@
+
+-- | Generation of arbitrary nested arrays.
+module DPH.Arbitrary.Array
+        ( arbitraryArrayFromExp
+        , AArray(..)
+        , AAArray(..))
+where
+import Test.QuickCheck        
+import Control.Monad
+import DPH.Arbitrary.ArrayExp
+import Util.Array               (Array)
+import qualified Util.Array     as A
+
+
+-------------------------------------------------------------------------------
+-- | Generate an array using the given plan.
+--   By using the same plan to generate two different arrays, we can ensure
+--   that their internal structure is identical.
+arbitraryArrayFromExp 
+        :: (Array c a, Arbitrary a)
+        => ArrayExp -> Gen (c a)
+
+arbitraryArrayFromExp xx
+ = case xx of
+        XArbitrary n
+         -> liftM A.fromList $ vector n
+         
+        XAppend x1 x2
+         -> do  arr1    <- arbitraryArrayFromExp x1
+                arr2    <- arbitraryArrayFromExp x2
+                return  $ A.append arr1 arr2
+
+
+-- AArray ---------------------------------------------------------------------
+-- | Constrain a doubly nested array so the total number of elements contained
+--   is proportional to the size parameter.
+data AArray a
+        = AArray a
+        deriving Show
+
+
+instance ( Array c1 (c2 a)
+         , Arbitrary (c2 a))
+        => Arbitrary (AArray (c1 (c2 a))) where
+
+ arbitrary
+  = sized $ \s -> 
+  do    let s'  = truncate $ sqrt $ fromIntegral s
+        xs      <- liftM A.fromList $ listOf $ resize s' $ arbitrary
+        return  $ AArray xs
+
+
+-- AAArray --------------------------------------------------------------------
+-- | Constrain a triply nested array so the total number of elements contained
+--   is proportional to the size parameter.
+data AAArray a
+        = AAArray a
+        deriving Show
+
+instance ( Array c1 (c2 a)
+         , Arbitrary (AArray (c2 a)))
+        => Arbitrary (AAArray (c1 (c2 a))) where
+
+ arbitrary
+  = sized $ \s -> 
+  do    let s'  = truncate $ sqrt $ fromIntegral s
+        xs      <- liftM (A.fromList . map (\(AArray a) -> a)) 
+                $  listOf $ resize s' $ arbitrary
+        return  $ AAArray xs
+                
\ No newline at end of file
diff --git a/dph-test/framework/DPH/Arbitrary/ArrayExp.hs b/dph-test/framework/DPH/Arbitrary/ArrayExp.hs
new file mode 100644 (file)
index 0000000..b055784
--- /dev/null
@@ -0,0 +1,61 @@
+{-# LANGUAGE UndecidableInstances #-}
+
+-- | Planning the generation of arbitrary nested arrays.
+module DPH.Arbitrary.ArrayExp
+        (ArrayExp(..), ArbitraryLen(..))
+where
+import Test.QuickCheck        
+import Control.Monad
+import Util.Array               (Array)
+import qualified Util.Array     as A
+
+-- ArbitraryLen -------------------------------------------------------------------
+-- | Generate an arbitrary thing of a specific size.
+class ArbitraryLen a where
+ arbitraryLen :: Int -> Gen a
+
+
+-- ArrayExp ------------------------------------------------------------------------
+-- | Generate a plan for building an arbitrary array.
+--
+--   If we create an array directly from a list, then the internal structure 
+--   is simpler than if it had been constructed by appending or concatenating
+--   several other arrays. In our tests, we want to use arrays with complicated
+--   internal structure, as these have more change of showing up bugs.
+--
+--   We split the plan generation from the actual array, so we can check
+--   that the plan is covering the cases we want. We can also use the plan to 
+--   generate multiple arrays with identical structure.
+--   
+data ArrayExp
+        -- Generate a flat array of the given size.
+        = XArbitrary Int
+
+        -- Append two arbitrary arrays.
+        | XAppend    ArrayExp ArrayExp
+        deriving Show
+
+
+-- | Generate a plan to build an array of a particular size.
+instance ArbitraryLen ArrayExp where
+ arbitraryLen s
+  = let aFlat
+         = do   return  $ XArbitrary s
+         
+        aAppend
+         = do   split   <- choose (0, s)
+                liftM2 XAppend
+                        (arbitraryLen split)
+                        (arbitraryLen (s - split))
+                        
+    in  choose (0, 10) >>= \(n :: Int) -> 
+        if (s == 0
+         || n < 5)
+                then aFlat
+                else aAppend
+
+
+instance ArbitraryLen ArrayExp => Arbitrary ArrayExp where
+ arbitrary      = sized arbitraryLen
+
+
diff --git a/dph-test/framework/DPH/Arbitrary/Joint.hs b/dph-test/framework/DPH/Arbitrary/Joint.hs
new file mode 100644 (file)
index 0000000..33b6bfc
--- /dev/null
@@ -0,0 +1,54 @@
+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
+
+-- | Generation of nested arrays with identical structure.
+module DPH.Arbitrary.Joint where
+import Test.QuickCheck                  hiding (NonEmpty)
+import Util.Array
+import qualified Util.Array             as A
+import qualified Data.Vector.Unboxed    as U
+import qualified Data.Vector            as V
+import Control.Monad
+
+
+-- Joint21 ---------------------------------------------------------------------
+-- | Generate two arrays with the same length.
+data Joint21 a b
+        = Joint21 a b
+        deriving Show
+        
+instance ( Array c1 a, Arbitrary a
+         , Array c2 b, Arbitrary b)
+        => Arbitrary (Joint21 (c1 a) (c2 b)) where
+
+ arbitrary
+  = sized $ \s ->
+  do    NonNegative n   <- arbitrary
+        xs      <- vector n
+        ys      <- vector n
+        return  $ Joint21 (fromList xs) (fromList ys)
+
+
+-- Joint2 ---------------------------------------------------------------------
+-- | Generate two nested arrays with the same lengths at the two outermost
+--   levels. Also adjust the length of the inner elements, so the the total
+--   number of elements is proportional to the size parameter.
+data Joint22 a b
+        = Joint22 a b
+        deriving Show
+
+instance ( Array c11 (c12 a), Array c12 a, Arbitrary a
+         , Array c21 (c22 b), Array c22 b, Arbitrary b)
+        => Arbitrary (Joint22 (c11 (c12 a)) (c21 (c22 b))) where
+
+ arbitrary
+  = sized $ \s ->
+  do    let s'   =  truncate $ sqrt $ fromIntegral s
+
+        lens     <- liftM (map (\(NonNegative n) -> n)) 
+                 $  listOf $ resize s' arbitrary
+
+        xs      <- liftM (fromList . map fromList) $ mapM vector lens
+        ys      <- liftM (fromList . map fromList) $ mapM vector lens
+        return  $ Joint22 xs ys
+
+
index cf48649..1a5ff18 100644 (file)
@@ -1,5 +1,5 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
+-- | Generation of arbitrary permutations.
 module DPH.Arbitrary.Perm
         (Perm (..))
 where
@@ -8,8 +8,9 @@ import qualified Data.Vector    as V
 import Data.Vector              (Vector)
 import Data.List
 
+
 -- | Permutation of [0..n-1] with all values appearing exactly once.
-newtype Perm 
+data Perm 
         = Perm (Vector Int)
         deriving (Eq, Show)
 
index e74a495..ab95a71 100644 (file)
@@ -1,4 +1,3 @@
-{-# LANGUAGE TypeSynonymInstances #-}
 
 -- | Generation of arbitrary segment descriptors.
 module DPH.Arbitrary.Segd
index f621611..99e8b41 100644 (file)
@@ -1,5 +1,5 @@
 
--- | Generation arbitrary selector for the combine opeartors.
+-- | Generation of arbitrary selectors for the combine opeartor.
 module DPH.Arbitrary.Selector
         (Selector (..))
 where
index 73d8d18..a372322 100644 (file)
@@ -1,59 +1,22 @@
 
+-- | Generation of arbitrary vectors.
 module DPH.Arbitrary.Vector where
 import Test.QuickCheck
 import qualified Data.Vector.Unboxed    as U
 import qualified Data.Vector            as V
-import Control.Monad
 
 
--- Vector ---------------------------------------------------------------------
-instance Arbitrary a
-        => Arbitrary (V.Vector a) where
+-- U.Vector ------------------------------------------------------------------
+instance (Arbitrary a, U.Unbox a)
+        => Arbitrary (U.Vector a) where
  arbitrary
   = do  xs      <- arbitrary
-        return  $ V.fromList xs
-
+        return  $ U.fromList xs
 
--- VVector --------------------------------------------------------------------
--- | Generate some nested vectors, but adjust the size of the inner vectors
---   so the whole structure contains the number of elements proportinal
---   to the outer size parameter.
---  
---   If we generate an arbitrary (V.Vector (V.Vector a)) using the builtin 
---   instances then the total number of elements will be (size * size) instead
---   of just size.
-data VVector a 
-        = VVector (V.Vector (V.Vector a))
-        deriving Show
-        
-instance Arbitrary a
-        => Arbitrary (VVector a) where
- arbitrary 
-  = sized $ \s -> 
-  do    let s'  = truncate $ sqrt $ fromIntegral s
-        xs      <- liftM V.fromList $ listOf $ resize s' $ arbitrary
-        return  $ VVector xs
 
--- VVVector -------------------------------------------------------------------
--- | Like `VVector`, but with an additional layer of nesting.
-data VVVector a 
-        = VVVector (V.Vector (V.Vector (V.Vector a)))
-        deriving Show
-        
+-- V.Vector -------------------------------------------------------------------
 instance Arbitrary a
-        => Arbitrary (VVVector a) where
- arbitrary 
-  = sized $ \s -> 
-  do    let s'  = truncate $ sqrt $ fromIntegral s
-        xs      <- liftM V.fromList $ listOf $ resize s' $ arbitrary
-        return  $ VVVector xs
-
-
--- UVector --------------------------------------------------------------------
-instance (U.Unbox a, Arbitrary a)
-        => Arbitrary (U.Vector a) where
+        => Arbitrary (V.Vector a) where
  arbitrary
   = do  xs      <- arbitrary
-        return  $ U.fromList xs
-
-
+        return  $ V.fromList xs
index 5394e21..727c385 100644 (file)
@@ -46,6 +46,7 @@ jobCompile (JobCompile
                         ++ " -XExistentialQuantification"
                        ++ " -XRankNTypes"
                        ++ " -XTypeFamilies"
+                        ++ " -XMultiParamTypeClasses"
                        ++ " -XFlexibleInstances"
                        ++ " -XFlexibleContexts"
                        ++ " -XMagicHash"
diff --git a/dph-test/framework/Util/Array.hs b/dph-test/framework/Util/Array.hs
new file mode 100644 (file)
index 0000000..4733b54
--- /dev/null
@@ -0,0 +1,63 @@
+
+module Util.Array where
+import Data.Vector              (Vector)
+import qualified Data.Vector    as V
+import qualified Prelude        as P
+import Prelude                  hiding (length)
+
+
+class Array a e where
+ length     :: a e -> Int
+ index      :: a e -> Int -> e
+ append     :: a e -> a e -> a e
+ toVector   :: a e -> Vector e
+ fromVector :: Vector e -> a e
+
+instance Array [] e where
+ length         = P.length
+ index          = (P.!!)
+ append         = (P.++)
+ toVector       = V.fromList
+ fromVector     = V.toList
+
+instance Array Vector e where
+ length         = V.length
+ index          = (V.!)
+ append         = (V.++)
+ toVector       = id
+ fromVector     = id
+
+
+fromList :: Array a e => [e] -> a e
+fromList = fromVector . V.fromList
+
+toList   :: Array a e => a e -> [e]
+toList   = V.toList . toVector
+
+
+-- | Convert the outer level of an array to vectors.
+toVectors1 
+        :: Array a e
+        => a e -> Vector e
+
+toVectors1 arr
+        = toVector arr
+        
+        
+-- | Convert the outer two levels of an array to vectors.
+toVectors2 
+        :: (Array a1 (a2 e), Array a2 e)
+        => a1 (a2 e) -> Vector (Vector e)
+
+toVectors2 = V.map toVector . toVector
+        
+
+-- | Convert the outer three levels of an array to vectors.
+toVectors3
+        :: (Array a1 (a2 (a3 e)), Array a2 (a3 e), Array a3 e)
+        => a1 (a2 (a3 e)) -> Vector (Vector (Vector e))
+
+toVectors3 = V.map (V.map toVector) . V.map toVector . toVector 
+        
diff --git a/dph-test/framework/Util/Nesting.hs b/dph-test/framework/Util/Nesting.hs
new file mode 100644 (file)
index 0000000..70d4ede
--- /dev/null
@@ -0,0 +1,59 @@
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE UndecidableInstances, FlexibleInstances #-}
+module Util.Nesting where
+import Control.Monad
+import Util.Array               (Array)
+import Data.Vector              (Vector)
+import qualified Util.Array     as A
+import qualified Data.Vector    as V
+
+
+-- | Class of nested structures.
+class Nested c a e i | c a -> e, c a -> i where
+ rank     :: c a -> Int
+ nesting  :: c a -> i
+ flatten  :: c a -> Vector e
+
+
+instance ( Array c1 (c2 a)
+         , Array c2 a
+         , Nested c2 a e i)
+ =>      Nested c1 (c2 a) e (Vector i) where
+         
+ rank xs  = 1 + rank (A.index xs 0)
+ nesting  = V.map nesting . A.toVector
+ flatten  = join . V.map flatten . A.toVector
+
+
+-- | Instances for atomic types need to be written out manually. If GHC had
+--   backtracking constraint resolution then we could make an Atom class for
+--   this, but it doesn't. 
+instance Array a Int => Nested a Int Int Int where
+ rank _      = 1
+ nesting     = A.length . A.toVector
+ flatten xs  = A.toVector xs
+
+instance Array a Float => Nested a Float Float Int where
+ rank _      = 1
+ nesting     = A.length . A.toVector
+ flatten xs  = A.toVector xs
+
+instance Array a Bool => Nested a Bool Bool Int where
+ rank _      = 1
+ nesting     = A.length . A.toVector
+ flatten xs  = A.toVector xs
+
+
+-- | Compare two nested structures for equality, not caring exactly what
+--   data structure defines the nesting. Provided the elements are equal,
+--   and the two structures are congruent, then we'll call them equal.
+(~=) :: ( Eq i, Eq e
+        , Nested c1 a1 e i
+        , Nested c2 a2 e i)
+     => c1 a1 -> c2 a2 -> Bool
+   
+(~=) xs ys
+        =   nesting xs == nesting ys
+        &&  flatten xs == flatten ys
+
\ No newline at end of file
index bd69665..158953a 100644 (file)
@@ -1,7 +1,15 @@
 {-# LANGUAGE UndecidableInstances #-}
 
+-- | Tests for PR functions.
+--   These are the ones that take a PR dictionary, and work on PData arrays.
+--
+--   TODO: Most of the tests don't use the Exp builder becasuse they take Vectors
+--         instead of PArray / PData.
+-- 
 import DPH.Arbitrary
 import DPH.Testsuite
+import Util.Array
+import Util.Nesting
 
 import Data.Array.Parallel.Base                 (Tag)
 import Data.Array.Parallel.Pretty
@@ -24,6 +32,7 @@ import qualified Data.Vector                    as V
 import qualified Data.Array.Parallel.Unlifted   as U
 import qualified Data.Array.Parallel.PArray     as PA
 import qualified DPH.Operators.List             as L
+import Debug.Trace
 
 -- NOTE:
 -- The 'b' element type contains one less level of nesting compared with the
@@ -59,8 +68,7 @@ $(testcases [ ""        <@ [t|  PArray Int |]
   prop_toFromVector :: (PR a, Eq a) => Vector a -> Bool
   prop_toFromVector vec
    =  let arr    = fromVectorPR vec
-      in  validPR arr 
-       && vec == toVectorPR arr
+      in  validPR arr  && vec == toVectorPR arr
 
 
   -- | Check that the arbitrary arrays we're getting are valid.
@@ -70,28 +78,27 @@ $(testcases [ ""        <@ [t|  PArray Int |]
   prop_valid pdata      
         = validPR pdata
 
-{-
+
   -- | Define an array that maps all indices to the same element.
   --   The array size must be > 0.
   prop_replicate :: (PR a, Eq a) => a -> Property
   prop_replicate x
    =  forAll (choose (1, 100)) $ \n
-   -> let arr = replicatePR n x
-      in  validPR arr 
-       && V.replicate n x ==  toVectorPR arr
+   -> let pdata = replicatePR n x
+          vec   = V.replicate n x
+      in  validPR pdata  && vec == toVectors1 pdata
 
 
   -- | Segmented replicate.
-  prop_replicates :: (PR a, Eq a) => Vector a -> Property
-  prop_replicates vec
-   =  forAll (liftM V.fromList $ vectorOf (V.length vec) (choose (0, 10))) $ \repCounts
-   -> let vec'  = V.concat $ V.toList
-                $ V.zipWith V.replicate repCounts vec
-                
-          segd  = U.lengthsToSegd $ U.fromList $ V.toList repCounts
-          arr'  = replicatesPR segd (fromVectorPR vec)
-      in  validPR arr'
-       && vec' == toVectorPR arr'
+  prop_replicates :: (PR a, Eq a) => PData a -> Int -> Property
+  prop_replicates pdata i
+   =  forAll (vectorOf (lengthPR pdata) (choose (0, 10 `asTypeOf` i))) $ \reps
+   -> let vec'    = join $ V.zipWith V.replicate (toVector reps) (toVectors1 pdata)
+
+          segd    = U.lengthsToSegd (U.fromList reps)
+          pdata'  = replicatesPR segd pdata
+
+      in  validPR pdata' && vec' == toVectors1 pdata'
 
 
   -- | Take a single element from an array.
@@ -109,23 +116,13 @@ $(testcases [ ""        <@ [t|  PArray Int |]
 
 
   -- | Extract a single slice from a single array.
-  prop_extract :: (PR a, Eq a) => Vector a -> Property
-  prop_extract vec
-    =  forAll (arbitrarySliceSpec (V.length vec)) $ \(SliceSpec ixStart lenSlice)  
-    -> let vec'  = V.slice ixStart lenSlice vec
-           arr'  = extractPR (fromVectorPR vec) ixStart lenSlice
-
-       in  validPR arr'
-        && vec' == toVectorPR arr'
-
-  prop_extract' :: (PR a, Eq a) => PData a -> Property
-  prop_extract' pdata
+  prop_extract :: (PR a, Eq a) => PData a -> Property
+  prop_extract pdata
     =  forAll (arbitrarySliceSpec (lengthPR pdata)) $ \(SliceSpec ixStart lenSlice)  
-    -> let vec'    = V.slice ixStart lenSlice (toVectorPR pdata)
-           pdata'  = extractPR pdata ixStart lenSlice
+    -> let vec'   = V.slice ixStart lenSlice (toVector pdata)
+           pdata' = extractPR pdata ixStart lenSlice
 
-       in  validPR pdata'
-        && vec' == toVectorPR pdata'
+       in  validPR pdata' && vec' == toVector pdata'
 
 
   -- | Extract many slices from a single array.
@@ -149,8 +146,7 @@ $(testcases [ ""        <@ [t|  PArray Int |]
             ssegd       = U.mkSSegd  (V.convert starts) (V.convert sources) segd
             pdata'      = extractsPR (singletondPR pdata) ssegd
 
-        in  validPR pdata' 
-         && vec' == toVectorPR pdata'
+        in  validPR pdata' && vec' == toVector pdata'
 
 
   ---------------------------------------------------------
@@ -159,13 +155,12 @@ $(testcases [ ""        <@ [t|  PArray Int |]
 
 
   -- | Append two arrays.  
-  prop_append :: (PR a, Eq a) => Vector a -> Vector a -> Bool
+  prop_append :: (PR a, Eq a) => PData a -> PData a -> Bool
   prop_append xs ys
-    = let vec'   = xs V.++ ys
-          pdata' = fromVectorPR xs `appendPR` fromVectorPR ys
+    = let vec'   = toVector xs V.++ toVector ys
+          pdata' = xs `appendPR` ys
 
-      in  validPR pdata'
-       && vec' == toVectorPR pdata'
+      in  validPR pdata'  && vec' == toVectorPR pdata'
 
 
   ---------------------------------------------------------
@@ -176,27 +171,27 @@ $(testcases [ ""        <@ [t|  PArray Int |]
   -- | Filter an array based on some tags.
   prop_packByTag
     :: (PR a, Eq a, Arbitrary a, Show a)
-    => Len -> Vector a -> Property
-  prop_packByTag (Len n) zz
-   =   forAll (liftM V.fromList $ vectorOf n (choose (0, 1))) $ \tags
-    -> forAll (liftM V.fromList $ vectorOf n arbitrary)       $ \vec1
-    -> forAll (choose (0, 1))                                 $ \tag
+    => PData a -> Property
+  prop_packByTag pdata
+   =   forAll (liftM V.fromList $ vectorOf (lengthPR pdata) (choose (0, 1))) $ \tags
+    -> forAll (choose (0, 1))                                                $ \tag
     -> let vec'    = V.fromList
-                   $ L.packByTag  (V.toList $ vec1 `asTypeOf` zz)
-                                  (V.toList $ (tags :: Vector Tag))
+                   $ L.packByTag  (V.toList $ toVector pdata)
+                                  (V.toList tags)
                                   tag
 
-           pdata'  = packByTagPR  (fromVectorPR vec1)
+           pdata'  = packByTagPR  pdata
                                   (U.fromList $ V.toList tags)
                                   tag
-       in  validPR pdata'
-        && vec' == toVectorPR pdata'
+
+       in  validPR pdata' && vec' == toVector pdata'
 
 
+  -- TODO: more interesting input data.
   -- | Combine two arrays based on a selector.
   prop_combine2 
      :: (PR a, Eq a, Arbitrary a, Show a) 
-     => Selector -> Vector a-> Property
+     => Selector -> Vector a -> Property
   prop_combine2 (Selector vecTags) zz
    =    V.length vecTags >= 2
     ==> even (V.length vecTags)
@@ -214,6 +209,8 @@ $(testcases [ ""        <@ [t|  PArray Int |]
          && vec' == toVectorPR pdata'
 
 
+  -- TODO: more interesting input data.
+  -- TODO: use sanely sized nested vector
   -- | Concatenate arrays that have been produced via combine.
   --   When an nested array has been produced with combine, it's guaranteed to contain
   --   multiple flat data arrays in its psegdata field. By concatenating it we test
@@ -242,6 +239,7 @@ $(testcases [ ""        <@ [t|  PArray Int |]
          && vec'' == toVectorPR pdata''
 
 
+  -- TODO: more interesting input data
   -- | Packing an array then immediately combining it should yield the original array.
   prop_combine2_packByTag
    :: (PR a, Eq a, Arbitrary a, Show a)
@@ -259,87 +257,61 @@ $(testcases [ ""        <@ [t|  PArray Int |]
                                 (packByTagPR pdata uarrTags 0)
                                 (packByTagPR pdata uarrTags 1)
 
-        in  validPR pdata'
-         && toVectorPR pdata == toVectorPR pdata'
+        in  validPR pdata' && pdata == pdata'
 
 
   -- Derived Functions --------------------------------------------------------
   -- These are PR functions that are not in the PR dictionary.
-  --
--}  
   -- | Concatenate arrays
   prop_concat
         :: (PR b, PA b, Eq b)
-        => VVector b -> Bool
-  prop_concat (VVector vec)
-   = let  vec'   = V.concat (V.toList vec)
-
-          pdata  = fromVectorPR (V.map PA.fromVector vec)
+        => AArray (PData (PArray b)) -> Bool
+  prop_concat (AArray pdata)
+   = let  vec'   = join $ toVectors2 pdata
           pdata' = concatPR pdata
           
-     in   validPR pdata'
-      &&  vec' == toVectorPR pdata'
+     in   validPR pdata' &&  vec' == toVector pdata'
 
 
   -- | Lifted concat
   prop_concatl
         :: (PR c, PA c, Eq c)
-        => VVVector c  -> Property
-  prop_concatl (VVVector vec)
-   =  V.length vec >= 1
-    ==> let vec'   = V.map join vec
-         
-            pdata   = fromVectorPR 
-                    $ V.map PA.fromVector
-                    $ V.map (V.map PA.fromVector) vec
-
+        => AAArray (PData (PArray (PArray c))) -> Property
+  prop_concatl (AAArray pdata)
+   =  lengthPR pdata >= 1
+    ==> let vec'   = V.map join $ toVectors3 pdata
             pdata' = concatlPR pdata
-         
-        in  validPR pdata'
-         && (V.map PA.fromVector vec') == toVectorPR pdata'
+
+        in  validPR pdata' && vec' == toVectors2 pdata'
 
 
   -- | Concat then unconcat
   prop_concat_unconcat 
         :: (PR b, PA b, Eq b)
-        => VVector b -> Bool
-  prop_concat_unconcat (VVector vec)
-   = let  pdata   = fromVectorPR $ V.map PA.fromVector vec
-          pdata'  = concatPR pdata
-          
+        => AArray (PData (PArray b)) -> Bool
+  prop_concat_unconcat (AArray pdata)
+   = let  pdata'  = concatPR   pdata  
           pdata'' = unconcatPR pdata pdata'
-     in   validPR pdata''
-      &&  toVectorPR pdata == toVectorPR pdata''
 
+     in   validPR pdata'' && pdata == pdata''
 
+
+  -- TODO: Joint22 requires second level lengths to be the same, but this isn't nessesary.
+  --       Want to allow this to vary, while still constraining level size.
   -- | Lifted append
   prop_appendl
         :: (PR b, PA b, Eq b)
-        => VVector b -> VVector b -> Bool
-  prop_appendl (VVector vec1) (VVector vec2)
-   = let  -- Ensure both input vectors have the same length, 
-          --   which will be the lifting context.
-          len   = min (V.length vec1) (V.length vec2)
-          vec1' = V.take len vec1
-          vec2' = V.take len vec2
-          
-          -- Lifted append directly on the vectors.
-          vec'   = V.map PA.fromVector $ V.zipWith (V.++) vec1' vec2'
+        => Joint22 (PData (PArray b)) (PData (PArray b)) ->  Bool
+  prop_appendl (Joint22 pdata1 pdata2)
+   = let vec'   = V.zipWith (V.++) (toVectors2 pdata1) (toVectors2 pdata2)
+         pdata' = appendlPR pdata1 pdata2 
 
-          -- Lifted append via a nested array.
-          pdata1 = fromVectorPR (V.map PA.fromVector vec1')
-          pdata2 = fromVectorPR (V.map PA.fromVector vec2')
-          pdata' = appendlPR pdata1 pdata2
-          
-     in  validPR pdata'
-      && vec' == toVectorPR pdata'
+     in  validPR pdata'  && vec' == toVectors2 pdata'
 
 
   ---------------------------------------------------------
   -- TODO: slicelPD
   ---------------------------------------------------------
-
-  
   |])
 
 
@@ -352,107 +324,52 @@ instance (PprPhysical a, PprPhysical b)
         , T.nest 4 $ pprp x
         , T.nest 4 $ pprp y]
 
+instance (PR a, Eq a) => Eq (PData a) where
+ xs == ys
+        = toVectorPR xs == toVectorPR ys
+
+
+-- Nesting --------------------------------------------------------------------
+instance PR a => Array PData a where
+ length       = lengthPR
+ index        = indexPR
+ append       = appendPR
+ toVector     = toVectorPR
+ fromVector   = fromVectorPR
+
+
+instance PA a => Array PArray a where
+ length       = PA.length
+ index        = PA.index
+ append       = PA.append
+ toVector     = PA.toVector
+ fromVector   = PA.fromVector
+
+
 -- Arbitrary PArrays ----------------------------------------------------------
 instance (PprPhysical (PArray a), Arbitrary a, PR a) 
-       => Arbitrary (PArray a) where
- arbitrary 
-  = do  plan    <- arbitrary
-        pdata   <- arbitraryPDataFromExp plan
+       => ArbitraryLen (PArray a) where
+ arbitraryLen n
+  = do  plan    <- arbitraryLen n
+        pdata   <- arbitraryArrayFromExp plan
         return  $ wrapPDataAsPArray pdata
 
+instance ArbitraryLen (PArray a) => Arbitrary (PArray a) where
+ arbitrary = sized arbitraryLen
+
+wrapPDataAsPArray :: PR a => PData a -> PArray a
+wrapPDataAsPArray pdata
+ = let  !(I# n#)        = lengthPR pdata
+   in   PArray n# pdata
+
 
 -- Arbitrary PData ------------------------------------------------------------
 instance (PprPhysical (PData a), Arbitrary a, PR a) 
-       => Arbitrary (PData a) where
- arbitrary 
-  = do  plan    <- arbitrary
-        arbitraryPDataFromExp plan
-        
-
--- Exp ------------------------------------------------------------------------
--- | Generate a plan for building an arbitrary array.
---    If we create an array directly from a list, then the internal structure 
---    is simpler than if it had been constructed by appending or concatenating
---    several other arrays. In our tests, we want to use arrays with complicated
---    internal structure, as these have more change of showing up bugs.
---
---   We split the plan generation from the actual array, so we can check
---   that the plan is covering the cases we want. We want arrays to be build
---   from a good mixture of different operators.
---   
-data Exp a
-        -- Generate a flat array of the given size.
-        = XArbitrary Int
-
-        -- Append two arbitrary arrays.
-        | XAppend    (Exp a) (Exp a)
-
-        -- Concatenate a list of arbitrary arrays.
-        | XConcat    [Exp a]
-
-deriving instance 
-        (Show a, Show (PData a), Show (PDatas a)) 
-        => Show (Exp a)
-
-instance Arbitrary (Exp a) where
- arbitrary
-  = sized $ \s -> 
-    let aFlat   
-         = do   n       <- choose (0, s)
-                return (XArbitrary n)
-
-        aAppend
-         = do   liftM2 XAppend 
-                         (resize (s `div` 2) arbitrary)
-                         (resize (s `div` 2) arbitrary)
-
-        aConcat
-         = do   n       <- choose (1, min 5 s)
-                liftM XConcat
-                        (vectorOf n $ resize (s `div` n) arbitrary)
-                        
-   in   -- If the size is small then just use a flat arary without invoking a
-        -- more complex operator. This allows our properties to test those 
-        -- operators in isolation, before the array structure gets too
-        -- complicated.
-        if s <= 10
-           then aFlat
-           else oneof [aFlat, aAppend, aConcat]
-  
-
--- | Generate some PData by using the operators described by the given plan.
-arbitraryPDataFromExp :: (Arbitrary a, PR a) => Exp a -> Gen (PData a)
-arbitraryPDataFromExp xx
- = sized $ \s -> 
-   case xx of
-        XArbitrary n
-         ->     arbitraryFlatPData 
-
-        XAppend exp1 exp2
-         -> do  pdata1  <- arbitraryPDataFromExp exp1
-                pdata2  <- arbitraryPDataFromExp exp2
-                return  $ appendPR pdata1 pdata2
-
-        XConcat exps
-         -> do  pdatas  <- mapM arbitraryPDataFromExp exps
-
-                return  $ concatPR 
-                        $ fromVectorPR $ V.fromList
-                        $ map wrapPDataAsPArray pdatas
-
-
--- | Generate an arbitrary PData just by converting a list.
---   The internal representation will only contain a single physical vector.
-arbitraryFlatPData :: (Arbitrary a, PR a) => Gen (PData a)
-arbitraryFlatPData
-  =  sized $ \s
-  -> do xs      <- resize (truncate $ (\x -> sqrt x * 2 ) $ fromIntegral s) 
-                $ arbitrary 
-
-        return  $ fromVectorPR xs
+       => ArbitraryLen (PData a) where
+ arbitraryLen n 
+  = do  plan    <- arbitraryLen n
+        arbitraryArrayFromExp plan
 
+instance ArbitraryLen (PData a) => Arbitrary (PData a) where
+ arbitrary = sized arbitraryLen
 
-wrapPDataAsPArray :: PR a => PData a -> PArray a
-wrapPDataAsPArray pdata
- = let  !(I# n#)        = lengthPR pdata
-   in   PArray n# pdata
\ No newline at end of file