dph-lifted-vseg: shift reference implementation harness to its own module and cleanup
authorBen Lippmeier <benl@ouroborus.net>
Tue, 8 Nov 2011 10:29:56 +0000 (21:29 +1100)
committerBen Lippmeier <benl@ouroborus.net>
Wed, 9 Nov 2011 05:29:00 +0000 (16:29 +1100)
dph-base/Data/Array/Parallel/Array.hs
dph-lifted-reference/Data/Array/Parallel/PArray.hs
dph-lifted-vseg/Data/Array/Parallel/PArray.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Nested.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PRepr.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/Reference.hs [new file with mode: 0644]
dph-lifted-vseg/dph-lifted-vseg.cabal

index 3d0431f..86a7a4a 100644 (file)
@@ -1,4 +1,6 @@
--- | Generic array class, used as a compatability layer during testing.
+
+-- | Generic array class.
+--   This is used as a compatability layer during testing and debugging.
 module Data.Array.Parallel.Array 
         ( Array(..)
         , fromList, toList
@@ -13,14 +15,18 @@ import Prelude                  hiding (length)
 
 
 class Array a e where
+ valid      :: a e -> Bool
+ singleton  :: e   -> a e
+ append     :: a e -> a e -> a e
  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
+ valid          = const True
+ singleton x    = [x]
  length         = P.length
  index          = (P.!!)
  append         = (P.++)
@@ -29,6 +35,8 @@ instance Array [] e where
  
 
 instance Array Vector e where
+ valid          = const True
+ singleton      = V.singleton
  length         = V.length
  index          = (V.!)
  append         = (V.++)
index f927b36..fed7652 100644 (file)
@@ -41,6 +41,9 @@ data PArray a
 
 -- Array Instances ------------------------------------------------------------
 instance A.Array PArray a where
+ valid     = const True
+ singleton = A.singleton
+
  length  (PArray _ vec)
         = V.length vec
 
@@ -225,7 +228,7 @@ packByTag (PArray n1# xs) tags tag
 
 -- | Combine two arrays based on a selector.
 combine2 :: U.Sel2 -> PArray a -> PArray a -> PArray a
-combine2 tags (PArray n1# vec1) (PArray n2# vec2)
+combine2 tags (PArray _ vec1) (PArray _ vec2)
  = let  
         go [] [] [] = []
         go (0 : bs) (x : xs) ys       = x : go bs xs ys
index 54ce8ff..fc41c28 100644 (file)
@@ -62,14 +62,16 @@ import qualified Data.Array.Parallel.Pretty     as T
 import Data.Array.Parallel.PArray.PData
 import Data.Array.Parallel.PArray.PRepr
 import Data.Array.Parallel.PArray.Scalar
+import Data.Array.Parallel.PArray.Reference
 import GHC.Exts
 import Data.Maybe
 import Data.Vector                              (Vector)
 import Data.Array.Parallel.Base                 (Tag)
-import qualified "dph-lifted-reference" Data.Array.Parallel.PArray as R
 import qualified Data.Array.Parallel.Array      as A
 import qualified Data.Array.Parallel.Unlifted   as U
 import qualified Data.Vector                    as V
+import qualified "dph-lifted-reference" 
+                 Data.Array.Parallel.PArray     as R
 import qualified Prelude                        as P
 import Prelude hiding 
         ( length, replicate, concat
@@ -78,126 +80,34 @@ import Prelude hiding
         
 import Debug.Trace
 
--- Config ---------------------------------------------------------------------
-debugLiftedTrace        = False
-debugLiftedCompare      = False
-
-
--- Tracing --------------------------------------------------------------------
--- TODO: we could use this to trace the lengths of the vectors being used, 
---       as well as the types that each opeartor is being called at.
-
-instance PA e => A.Array PArray e where
- length arr     = length arr
-
- index (PArray _ pdata) ix
-        = indexPA pdata ix
-
- append         = append
-
- -- The toVector conversion used for testing is built by looking up every index
- --  instead of using the bulk fromVectorPA function.
- --  We need to do this to convert arrays of type (PArray Void) properly, as 
- --  although a (PArray Void) has an intrinsic length, a (PData Void) does not.
- --  Arrays of type PArray Void aren't visible in the user API, but during debugging
- --  we need to be able to print them out with the correct length.
- toVector arr
-        = V.map (A.index arr) $ V.enumFromTo 0 (A.length arr - 1)
-
- fromVector
-        = fromVector
 
+-- Pretty ---------------------------------------------------------------------
 instance PA a => PprPhysical (PArray a) where
  pprp (PArray n# pdata)
         =     ( T.text "PArray " T.<+> T.int (I# n#))
         T.$+$ ( T.nest 4 
               $ pprpDataPA pdata)
 
-instance PA a => PprPhysical (Vector a) where
- pprp vec
-        = T.brackets 
-        $ T.hcat
-        $ T.punctuate (T.text ", ") 
-        $ V.toList $ V.map pprpPA vec
-
--- TODO: shift this stuff to the reference implementation module.
---       make the PArray constructor polymorphic
--- | Compare a flat array against a reference
-withRef1 :: PA a 
-         => String
-         -> R.PArray a
-         -> PArray a
-         -> PArray a
-
-withRef1 name arrRef arrImpl
- = let  trace'
-         = if debugLiftedTrace  
-            then trace (T.render $ T.text " " 
-                        T.$$ T.text name 
-                        T.$$ (T.nest 8 $ pprpPA arrImpl))
-            else id    
-
-        resultOk
-         = valid arrImpl
-             && A.length arrRef == A.length arrImpl
-             && (V.and $ V.zipWith
-                  similarPA
-                  (A.toVectors1 arrRef) (A.toVectors1 arrImpl))
-              
-        resultFail
-         = error $ T.render $ T.vcat
-                [ T.text "withRef1: failure " T.<> T.text name
-                , T.nest 4 $ pprp  $ A.toVectors1 arrRef
-                , T.nest 4 $ pprpPA arrImpl ]
-
-   in   trace' (if debugLiftedCompare
-                 then (if resultOk then arrImpl else resultFail)
-                 else arrImpl)
-{-# INLINE withRef1 #-}
-
-
-withRef2 :: PA a 
-         => String 
-         -> R.PArray (R.PArray a)
-         -> PArray (PArray a)
-         -> PArray (PArray a)
-
-withRef2 name arrRef arrImpl
- = let  trace'
-         = if debugLiftedTrace  
-            then trace (T.render $ T.text " " 
-                        T.$$ T.text name 
-                        T.$$ (T.nest 8 $ pprpPA arrImpl))
-            else id
-
-        resultOK
-         = valid arrImpl
-           && A.length arrRef == A.length arrImpl
-           && (V.and $ V.zipWith 
-                (\xs ys -> V.and $ V.zipWith similarPA xs ys)
-                (A.toVectors2 arrRef) (A.toVectors2 arrImpl))
-        
-        resultFail
-         = error $ T.render $ T.vcat
-                [ T.text "withRef2: failure " T.<> T.text name
-                , T.nest 4 $ pprpPA arrImpl ]
-
-   in   trace' (if debugLiftedCompare
-                 then (if resultOK then arrImpl else resultFail)
-                 else arrImpl)
-{-# INLINE withRef2 #-}
-
-
--- TODO: shift this stuff to the reference implementation module.
---       make the parray constructor polymorphic.
-toRef1 :: PA a => PArray a -> R.PArray a
-toRef1  = A.fromVectors1 . A.toVectors1
+-- Array -----------------------------------------------------------------------
+-- | Generic interface to PArrays.
+--
+-- NOTE: 
+--  The toVector conversion is defined by looking up every index instead of
+--  using the bulk fromVectorPA function.
+--  We need to do this to convert arrays of type (PArray Void) properly, as 
+--  although a (PArray Void) has an intrinsic length, a (PData Void) does not.
+--  Arrays of type PArray Void aren't visible in the user API, but during
+--  debugging we need to be able to print them out with the correct length.
+--
+instance PA e => A.Array PArray e where
+ length arr     = length arr
 
-toRef2 :: PA a => PArray (PArray a) -> R.PArray (R.PArray a)
-toRef2  = A.fromVectors2 . A.toVectors2
+ index (PArray _ pdata) ix
+        = indexPA pdata ix
 
-toRef3 :: PA a => PArray (PArray (PArray a)) -> R.PArray (R.PArray (R.PArray a))
-toRef3  = A.fromVectors3 . A.toVectors3
+ append         = append
+ toVector arr   = V.map (A.index arr) $ V.enumFromTo 0 (A.length arr - 1)
+ fromVector     = fromVector
 
 
 -- Basics ---------------------------------------------------------------------
index 06960a8..a8d0ae4 100644 (file)
@@ -717,9 +717,4 @@ validBool str b
 deriving instance Show (PDatas a) => Show (PDatas (PArray a))
 deriving instance Show (PDatas a) => Show (PData  (PArray a))
 
-     
-
-
-
-
 
index 45c7ace..645f0fc 100644 (file)
@@ -17,6 +17,7 @@ import Data.Array.Parallel.PArray.PRepr.Nested
 import Data.Array.Parallel.PArray.PRepr.Tuple
 import Data.Array.Parallel.PArray.PData
 import Data.Array.Parallel.Pretty
+import Data.Vector                              (Vector)
 import Data.Array.Parallel.Base                 (Tag)
 import qualified Data.Array.Parallel.Unlifted   as U
 import qualified Data.Vector                    as V
@@ -27,7 +28,7 @@ import GHC.Exts
 instance (Show a, PA a)
         => Show (PArray a) where
  show (PArray _ pdata)
-   render 
+        = render 
         $ brackets 
         $ text "|"
                 <> (hcat $ punctuate comma $ map (text . show) $ V.toList $ toVectorPA pdata)
@@ -38,40 +39,19 @@ instance (Show a, PA a)
 instance  (PprVirtual a, PA a)
         => PprVirtual (PArray a) where
  pprv (PArray _ pdata)
-  =     brackets 
+        = brackets 
         $ text "|"
                 <> (hcat $ punctuate comma $ map pprv $ V.toList $ toVectorPA pdata)
                 <> text "|"
 
 
--- | To pretty print a physical PArray we need to print the elements in their
---   generic representations.
-{-instance  (PprPhysical (PData (PRepr a)), PA a)
-        => PprPhysical (PArray a) where
- pprp (PArray n# dat)
-  =   (text "PArray " <+> int (I# n#))
-  $+$ ( nest 4 
-      $ pprp $ toArrPRepr dat)
--}
-{-
--- | Pretty print the physical representation of a nested array
-instance (PprPhysical (PData a), PR a) 
-       => PprPhysical (PData (PArray a)) where
- pprp (PNested uvsegd pdatas)
-  =   text "PNested"
-  $+$ (nest 4 $ pprp uvsegd $$ (pprp $ pdatas))
--}
-{-
--- | Pretty print a virtual nested array.
-instance ( PprVirtual (PData a), PR a) 
-        => PprVirtual (PData (PArray a)) where
- pprv arr
-  =   lbrack 
-        <> hcat (punctuate comma 
-                        $ map pprv 
-                        $ V.toList $ toVectorPR arr)
-   <> rbrack
--}
+instance PA a => PprPhysical (Vector a) where
+ pprp vec
+        = brackets 
+        $ hcat
+        $ punctuate (text ", ") 
+        $ V.toList $ V.map pprpPA vec
+
 
 -- Unpack ----------------------------------------------------------------------
 -- | Unpack an array to reveal its representation.
diff --git a/dph-lifted-vseg/Data/Array/Parallel/PArray/Reference.hs b/dph-lifted-vseg/Data/Array/Parallel/PArray/Reference.hs
new file mode 100644 (file)
index 0000000..a096541
--- /dev/null
@@ -0,0 +1,117 @@
+
+-- TODO: we could use this to trace the lengths of the vectors being used, 
+--       as well as the types that each opeartor is being called at.
+
+module Data.Array.Parallel.PArray.Reference
+        ( withRef1, withRef2
+        , toRef1,   toRef2,   toRef3)
+where
+import Data.Array.Parallel.PArray.PData
+import Data.Array.Parallel.PArray.PRepr
+import Debug.Trace
+import qualified Data.Array.Parallel.Array      as A
+import qualified Data.Array.Parallel.Pretty     as T
+import qualified Data.Vector                    as V
+import qualified "dph-lifted-reference" 
+                 Data.Array.Parallel.PArray     as R
+import Prelude hiding (length)
+
+-- Config ---------------------------------------------------------------------
+debugLiftedTrace        = False
+debugLiftedCompare      = False
+
+
+-- withRef --------------------------------------------------------------------
+-- | Compare the result of some array operator against a reference.
+withRef1 :: (PA a, PA (c a), A.Array c a)
+         => String                 -- name of operator
+         -> R.PArray a             -- result using reference implementation
+         -> c a                    -- result using vseg implementation
+         -> c a
+
+withRef1 name arrRef arrImpl
+ = let  trace'
+         = if debugLiftedTrace  
+            then trace (T.render $ T.text " " 
+                        T.$$ T.text name 
+                        T.$$ (T.nest 8 $ pprpPA arrImpl))
+            else id    
+
+        resultOk
+         = A.valid arrImpl
+             && A.length arrRef == A.length arrImpl
+             && (V.and $ V.zipWith
+                  similarPA
+                  (A.toVectors1 arrRef) (A.toVectors1 arrImpl))
+              
+        resultFail
+         = error $ T.render $ T.vcat
+                [ T.text "withRef1: failure " T.<> T.text name
+                , T.nest 4 $ pprp  $ A.toVectors1 arrRef
+                , T.nest 4 $ pprpPA arrImpl ]
+
+   in   trace' (if debugLiftedCompare
+                 then (if resultOk then arrImpl else resultFail)
+                 else arrImpl)
+{-# INLINE withRef1 #-}
+
+
+-- | Compare the nested result of some array operator against a reference.
+withRef2 :: ( A.Array c (c a), PA (c (c a))
+            , A.Array c a,     PA (c a)
+            , PA a)
+         => String                 -- name of operator.
+         -> R.PArray (R.PArray a)  -- result using reference implementaiton.
+         -> c (c a)                -- result using vseg implementation.
+         -> c (c a)
+
+withRef2 name arrRef arrImpl
+ = let  trace'
+         = if debugLiftedTrace  
+            then trace (T.render $ T.text " " 
+                        T.$$ T.text name 
+                        T.$$ (T.nest 8 $ pprpPA arrImpl))
+            else id
+
+        resultOK
+         = A.valid arrImpl
+           && A.length arrRef == A.length arrImpl
+           && (V.and $ V.zipWith 
+                (\xs ys -> V.and $ V.zipWith similarPA xs ys)
+                (A.toVectors2 arrRef) (A.toVectors2 arrImpl))
+        
+        resultFail
+         = error $ T.render $ T.vcat
+                [ T.text "withRef2: failure " T.<> T.text name
+                , T.nest 4 $ pprpPA arrImpl ]
+
+   in   trace' (if debugLiftedCompare
+                 then (if resultOK then arrImpl else resultFail)
+                 else arrImpl)
+{-# INLINE withRef2 #-}
+
+
+-- toRef ----------------------------------------------------------------------
+-- | Convert an array to the reference version.
+toRef1  :: (A.Array c a, PA (c a))
+        => c a -> R.PArray a
+
+toRef1  = A.fromVectors1 . A.toVectors1
+
+-- | Convert a nested array to the reference version.
+toRef2 :: ( A.Array c (c a), PA (c a)
+          , A.Array c a) 
+       => c (c a)
+       -> R.PArray (R.PArray a)
+
+toRef2  = A.fromVectors2 . A.toVectors2
+
+-- | Convert a doubly nested array to the reference version.
+toRef3 :: ( A.Array c (c (c a)), PA (c (c a))
+          , A.Array c (c a),     PA (c a)
+          , A.Array c a)
+       => c (c (c a))
+       -> R.PArray (R.PArray (R.PArray a))
+
+toRef3  = A.fromVectors3 . A.toVectors3
+
index 766edfa..6ada18a 100644 (file)
@@ -22,12 +22,13 @@ Library
         Data.Array.Parallel.Lifted.Combinators
         Data.Array.Parallel.Lifted
         Data.Array.Parallel.PArray.PData.Base
-        Data.Array.Parallel.PArray.PData.Bool
         Data.Array.Parallel.PArray.PData.Double
         Data.Array.Parallel.PArray.PData.Int
         Data.Array.Parallel.PArray.PData.Nested
+        Data.Array.Parallel.PArray.PData.Sum2
         Data.Array.Parallel.PArray.PData.Tuple
         Data.Array.Parallel.PArray.PData.Unit
+        Data.Array.Parallel.PArray.PData.Void
         Data.Array.Parallel.PArray.PData.Wrap
         Data.Array.Parallel.PArray.PData
         Data.Array.Parallel.PArray.PRepr.Base
@@ -37,11 +38,16 @@ Library
         Data.Array.Parallel.PArray.PRepr
         Data.Array.Parallel.PArray.Scalar
         Data.Array.Parallel.PArray.Types
+        Data.Array.Parallel.PArray.Reference
         Data.Array.Parallel.PArray
+        Data.Array.Parallel.Prelude.Bool
         Data.Array.Parallel.Prelude.Double
         Data.Array.Parallel.Prelude.Int
+        Data.Array.Parallel.Prelude.Tuple
+        Data.Array.Parallel.Prelude
         Data.Array.Parallel
         Data.Array.Parallel.Prim
+        Data.Array.Parallel.PArr
 
   Include-Dirs:
         include