Reorganise the way the lifted reference implementation works
authorBen Lippmeier <benl@ouroborus.net>
Fri, 11 Nov 2011 10:38:44 +0000 (21:38 +1100)
committerBen Lippmeier <benl@ouroborus.net>
Fri, 11 Nov 2011 10:38:44 +0000 (21:38 +1100)
The lifted reference implementation is now in dph-lifted-base. The PArray functions there have no PA dictionaries. We need this for comparing against other PArray functions, but it means this module can't be used with the vectoriser by itself. The dph-lifted-boxed package will contain the functions that take PA dictionaries, and can be used with the vectoriser.

21 files changed:
dph-base/Data/Array/Parallel/Pretty.hs
dph-lifted-base/Data/Array/Parallel/PArr.hs [new file with mode: 0644]
dph-lifted-base/Data/Array/Parallel/PArray.hs [new file with mode: 0644]
dph-lifted-base/Data/Array/Parallel/PArray/Reference.hs [moved from dph-lifted-vseg/Data/Array/Parallel/PArray/Reference.hs with 50% similarity]
dph-lifted-base/Data/Array/Parallel/PArray/Types.hs [moved from dph-lifted-vseg/Data/Array/Parallel/PArray/Types.hs with 100% similarity]
dph-lifted-base/LICENSE [new file with mode: 0644]
dph-lifted-base/Setup.hs [new file with mode: 0644]
dph-lifted-base/dph-lifted-vseg.cabal [new file with mode: 0644]
dph-lifted-base/ghc-stage [new file with mode: 0644]
dph-lifted-boxed/Data/Array/Parallel/Lifted/Closure.hs [new file with mode: 0644]
dph-lifted-boxed/Data/Array/Parallel/Lifted/Combinators.hs [new file with mode: 0644]
dph-lifted-boxed/Data/Array/Parallel/PArr.hs [moved from dph-lifted-vseg/Data/Array/Parallel/PArr.hs with 100% similarity]
dph-lifted-boxed/Data/Array/Parallel/PArray.hs
dph-lifted-boxed/Data/Array/Parallel/PArray/PData.hs [new file with mode: 0644]
dph-lifted-boxed/Data/Array/Parallel/PArray/PRepr.hs [new file with mode: 0644]
dph-lifted-boxed/Data/Array/Parallel/PArray/Types.hs [new file with mode: 0644]
dph-lifted-boxed/dph-lifted-boxed.cabal
dph-lifted-vseg/Data/Array/Parallel/Lifted/Combinators.hs
dph-lifted-vseg/Data/Array/Parallel/PArray.hs
dph-lifted-vseg/Data/Array/Parallel/PArray/PRepr.hs
dph-lifted-vseg/dph-lifted-vseg.cabal

index aa54056..a3934b7 100644 (file)
@@ -6,6 +6,8 @@ module Data.Array.Parallel.Pretty
         , PprVirtual (..))
 where
 import Text.PrettyPrint
+import qualified Data.Vector            as V
+import Data.Vector                      (Vector)
 
 
 -- | Pretty print physical structure of data.
@@ -45,3 +47,11 @@ instance (PprPhysical a, PprPhysical b)
         , nest 4 $ pprp x
         , nest 4 $ pprp y]
 
+instance PprPhysical a
+        => PprPhysical (Vector a) where
+ pprp vec
+        = brackets 
+        $ hcat
+        $ punctuate (text ", ") 
+        $ V.toList $ V.map pprp vec
+
diff --git a/dph-lifted-base/Data/Array/Parallel/PArr.hs b/dph-lifted-base/Data/Array/Parallel/PArr.hs
new file mode 100644 (file)
index 0000000..8c51af2
--- /dev/null
@@ -0,0 +1,89 @@
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+--   NOTE NOTE NOTE
+--   This file is IDENTICAL to the one in dph-lifted-boxed.
+--   If you update one then update the other as well.
+
+-- | Unvectorised functions that work directly on parallel arrays of [::] type.
+--   These are used internally in the DPH library, but the user never sees them.
+--   Only vectorised functions are visible in the DPH client programs.
+--
+module Data.Array.Parallel.PArr 
+        ( PArr
+        , emptyPArr
+        , replicatePArr
+        , singletonPArr
+        , indexPArr
+        , headPArr
+        , lengthPArr)
+where
+import GHC.ST
+import GHC.Base
+import GHC.PArr
+
+-- | Construct an empty array, with no elements.
+emptyPArr :: PArr a
+{-# NOINLINE emptyPArr #-}
+emptyPArr = replicatePArr 0 undefined
+
+
+-- | Construct an array with a single element.
+singletonPArr :: a -> PArr a
+{-# NOINLINE singletonPArr #-}
+singletonPArr e = replicatePArr 1 e
+
+
+-- | Construct an array by replicating the given element some number of times.
+replicatePArr :: Int -> a -> PArr a
+{-# NOINLINE replicatePArr #-}
+replicatePArr n e  
+ = runST (do
+         marr# <- newArray n e
+         mkPArr n marr#)
+
+
+-- | Take the length of an array.
+lengthPArr :: PArr a -> Int
+{-# NOINLINE lengthPArr #-}
+lengthPArr (PArr n _) = n
+
+
+-- | Lookup a single element from the source array.
+indexPArr :: PArr e -> Int -> e
+{-# NOINLINE indexPArr #-}
+indexPArr (PArr n arr#) i@(I# i#)
+  | i >= 0 && i < n 
+  = case indexArray# arr# i# of (# e #) -> e
+
+  | otherwise
+  = error $  "indexPArr: out of bounds parallel array index; " 
+          ++ "idx = " ++ show i ++ ", arr len = "
+          ++ show n
+
+-- | Take the first element of the source array, 
+--   or `error` if there isn't one.
+headPArr :: PArr a -> a
+headPArr arr = indexPArr arr 0
+
+
+-------------------------------------------------------------------------------
+-- | Internally used mutable boxed arrays
+data MPArr s e = MPArr !Int (MutableArray# s e)
+
+
+-- | Allocate a new mutable array that is pre-initialised with a given value
+newArray :: Int -> e -> ST s (MPArr s e)
+{-# INLINE newArray #-}
+newArray n@(I# n#) e  = ST $ \s1# ->
+  case newArray# n# e s1# of { (# s2#, marr# #) ->
+  (# s2#, MPArr n marr# #)}
+
+
+-- | Convert a mutable array into the external parallel array representation
+mkPArr :: Int -> MPArr s e -> ST s (PArr e)
+{-# INLINE mkPArr #-}
+mkPArr n (MPArr _ marr#)  = ST $ \s1# ->
+  case unsafeFreezeArray# marr# s1#   of { (# s2#, arr# #) ->
+  (# s2#, PArr n arr# #) }
+
diff --git a/dph-lifted-base/Data/Array/Parallel/PArray.hs b/dph-lifted-base/Data/Array/Parallel/PArray.hs
new file mode 100644 (file)
index 0000000..314efaf
--- /dev/null
@@ -0,0 +1,398 @@
+
+-- | Reference implementation of operators on unvectorised parallel arrays.
+--
+--   * In this module we just used boxed vectors as the array representation. 
+--     This won't be fast, but it means we can write the operators without
+--     needing type class dictionaries such as PA. This makes them
+--     much easier to use as reference code.
+--
+--   * The operators should also all do bounds checks, sanity checks, and 
+--     give nice error messages if something is wrong. The ideas is that
+--     this code can be run side-by-side production code during debugging.
+--
+--   TODO: check lengths properly in functions like zip, extracts
+--
+module Data.Array.Parallel.PArray
+        ( PArray
+        , valid
+        , nf
+        
+        -- * Constructors
+        , empty
+        , singleton,    singletonl
+        , replicate,    replicatel,     replicates,     replicates'
+        , append,       appendl
+        , concat,       concatl
+        , unconcat
+        , nestUSegd
+        
+        -- * Projections
+        , length,       lengthl
+        , index,        indexl
+        , extract,      extracts,       extracts'
+        , slice,        slicel
+        , takeUSegd
+        
+        -- * Pack and Combine
+        , pack,         packl
+        , packByTag
+        , combine2
+        
+        -- * Enumerations
+        , enumFromTo,   enumFromTol
+        
+        -- * Tuples
+        , zip,          zipl
+        , unzip,        unzipl
+        
+        -- * Conversions
+        , fromVector,   toVector
+        , fromList,     toList
+        , fromUArray,   toUArray
+        , fromUArray2)
+where
+import Data.Array.Parallel.Base                 (Tag)
+import Data.Vector                              (Vector)
+import qualified Data.Array.Parallel.Unlifted   as U
+import qualified Data.Vector                    as V
+import qualified Prelude                        as P
+import Control.Monad
+import GHC.Exts
+import Prelude hiding
+        ( replicate, length, concat
+        , enumFromTo
+        , zip, unzip)
+
+-------------------------------------------------------------------------------
+die :: String -> String -> a
+die fn str = error $ "Data.Array.Parallel.PArray: " ++ fn ++ " " ++ str
+
+
+-- Array Type -----------------------------------------------------------------
+type PArray a
+        = Vector a
+        
+-- | Lift a unary array operator.
+lift1   :: (a -> b) -> PArray a -> PArray b
+lift1 f vec
+        = V.map f vec
+
+
+-- | Lift a binary array operator.
+lift2   :: (a -> b -> c) -> PArray a -> PArray b -> PArray c
+lift2 f vec1 vec2
+        | V.length vec1 /= V.length vec2
+        = die "lift2" "length mismatch"
+        | otherwise
+        = V.zipWith f vec1 vec2
+
+
+-- | Lift a trinary array operator
+lift3   :: (a -> b -> c -> d) -> PArray a -> PArray b -> PArray c -> PArray d
+lift3 f vec1 vec2 vec3
+        |   V.length vec1 /= V.length vec2
+         || V.length vec1 /= V.length vec3
+        = die "lift3" "length mismatch"
+        | otherwise
+        = V.zipWith3 f vec1 vec2 vec3
+
+
+-- Basics ---------------------------------------------------------------------
+-- | Check that an array has a valid internal representation.
+valid :: PArray a -> Bool
+valid _ = True
+
+-- | Force an array to normal form.
+nf :: PArray a -> ()
+nf _    = ()
+
+
+-- Constructors ----------------------------------------------------------------
+-- | O(1). An empty array.
+empty :: PArray a
+empty           = V.empty
+
+
+-- | O(1). Produce an array containing a single element.
+singleton :: a -> PArray a
+singleton       = V.singleton
+
+
+-- | O(n). Produce an array of singleton arrays.
+singletonl :: PArray a -> PArray (PArray a)
+singletonl      = lift1 singleton
+
+
+-- | O(n). Define an array of the given size, that maps all elements to the same value.
+replicate :: Int -> a -> PArray a
+replicate       = V.replicate
+
+
+-- | O(sum lengths). Lifted replicate.
+replicatel :: PArray Int -> PArray a -> PArray (PArray a)
+replicatel      = lift2 replicate
+
+
+-- | O(sum lengths). Segmented replicate.
+replicates :: U.Segd -> PArray a -> PArray a
+replicates segd vec
+        | V.length vec /= U.lengthSegd segd
+        = die "replicates" $ unlines
+                [ "segd length mismatch"
+                , "  segd length  = " ++ (show $ U.lengthSegd segd)
+                , "  array length = " ++ (show $ V.length vec)]
+
+        | otherwise
+        = join 
+        $ V.zipWith V.replicate
+                (V.convert $ U.lengthsSegd segd)
+                vec
+
+
+-- | O(sum lengths). Wrapper for segmented replicate that takes replication counts
+--  and uses them to build the `U.Segd`.
+replicates' :: PArray Int -> PArray a -> PArray a
+replicates' reps arr
+        = replicates (U.lengthsToSegd $ V.convert $ reps) arr
+
+
+-- | Append two arrays.
+append :: PArray a -> PArray a -> PArray a
+append          = (V.++)
+
+
+-- | Lifted append.
+appendl :: PArray (PArray a) -> PArray (PArray a) -> PArray (PArray a)
+appendl         = lift2 append
+
+
+-- | Concatenation
+concat :: PArray (PArray a) -> PArray a
+concat          = join
+
+
+-- | Lifted concatenation.
+concatl :: PArray (PArray (PArray a)) -> PArray (PArray a)
+concatl         = lift1 concat
+
+
+-- | Impose a nesting structure on a flat array
+unconcat :: PArray (PArray a) -> PArray b -> PArray (PArray b)
+unconcat arr1 arr2
+        = nestUSegd (takeUSegd arr1) arr2
+
+
+-- | Create a nested array from a segment descriptor and some flat data.
+--   The segment descriptor must represent as many elements as present
+--   in the flat data array, else `error`
+nestUSegd :: U.Segd -> PArray a -> PArray (PArray a)
+nestUSegd segd vec
+        | U.elementsSegd segd     == V.length vec 
+        = V.zipWith
+                (\start len -> V.slice start len vec)
+                (V.convert $ U.indicesSegd segd)
+                (V.convert $ U.lengthsSegd segd)
+
+        | otherwise
+        = error $ unlines
+                [ "Data.Array.Parallel.PArray.nestSegd: number of elements defined by "
+                        ++ "segment descriptor and data array do not match"
+                , " length of segment desciptor = " ++ (show $ U.elementsSegd segd)
+                , " length of data array        = " ++ (show $ V.length vec)]
+{-# NOINLINE nestUSegd #-}
+
+
+-- Projections ----------------------------------------------------------------
+-- | Take the length of an array
+length :: PArray a -> Int
+length          = V.length
+
+
+-- | Take the length of some arrays.
+lengthl :: PArray (PArray a) -> PArray Int
+lengthl         = lift1 length
+
+
+-- | Lookup a single element from the source array.
+index :: PArray a -> Int -> a
+index           = (V.!)
+
+
+-- | Lookup a several elements from several source arrays.
+indexl :: PArray (PArray a) -> PArray Int -> PArray a
+indexl          = lift2 index
+
+
+-- | Extract a range of elements from an array.
+extract :: PArray a -> Int -> Int -> PArray a
+extract vec start len
+        = V.slice start len vec
+
+
+-- | Segmented extract.
+extracts :: Vector (PArray a) -> U.SSegd -> PArray a
+extracts arrs ssegd
+        = join
+        $ V.zipWith3
+                (\src start len -> extract (arrs V.! src) start len)
+                (V.convert $ U.sourcesSSegd ssegd)
+                (V.convert $ U.startsSSegd  ssegd)
+                (V.convert $ U.lengthsSSegd ssegd)
+
+
+-- | Wrapper for `extracts` that takes arrays of sources, starts and lengths of
+--   the segments, and uses these to build the `U.SSegd`.
+extracts' 
+        :: Vector (PArray a) 
+        -> PArray Int           -- ^ id of source array for each segment.
+        -> PArray Int           -- ^ starting index of each segment in its source array.
+        -> PArray Int           -- ^ length of each segment.
+        -> PArray a
+extracts' arrs sources starts lengths
+ = let  segd    = U.lengthsToSegd $ V.convert lengths
+        ssegd   = U.mkSSegd 
+                        (V.convert $ starts)
+                        (V.convert $ sources)
+                        segd
+   in   extracts arrs ssegd
+
+
+-- | Extract a range of elements from an arrary.
+--   Like `extract` but with the parameters in a different order.
+slice :: Int -> Int -> PArray a -> PArray a
+slice start len arr
+        = extract arr start len
+
+
+-- | Extract some slices from some arrays.
+--   The arrays of starting indices and lengths must themselves
+--   have the same length.
+slicel :: PArray Int -> PArray Int -> PArray (PArray a) -> PArray (PArray a)
+slicel  = lift3 slice
+
+
+-- | Take the segment descriptor from a nested array. This can cause index space
+--   overflow if the number of elements in the result does not can not be
+--   represented by a single machine word.
+takeUSegd :: PArray (PArray a) -> U.Segd
+takeUSegd vec
+        = U.lengthsToSegd 
+        $ V.convert
+        $ V.map length vec
+        
+
+-- Pack and Combine -----------------------------------------------------------
+-- | Select the elements of an array that have their tag set to True.
+pack    :: PArray a -> PArray Bool -> PArray a
+pack xs bs
+        | V.length xs /= V.length bs
+        = die "pack" $ unlines
+                [ "array length mismatch"
+                , "  data  length = " ++ (show $ V.length xs)
+                , "  flags length = " ++ (show $ V.length bs) ]
+
+        | otherwise
+        = V.ifilter (\i _ -> bs V.! i) xs
+
+
+-- | Lifted pack.
+packl :: PArray (PArray a) -> PArray (PArray Bool) -> PArray (PArray a)
+packl   = lift2 pack
+
+
+-- | Filter an array based on some tags.
+packByTag :: PArray a -> U.Array Tag -> Tag -> PArray a
+packByTag xs tags tag
+        | V.length xs /= U.length tags
+        = die "packByTag" $ unlines
+                [ "array length mismatch"
+                , "  data  length = " ++ (show $ V.length xs)
+                , "  flags length = " ++ (show $ U.length tags) ]
+
+        | otherwise
+        = V.ifilter (\i _ -> tags U.!: i == tag) xs
+
+
+-- | Combine two arrays based on a selector.
+combine2 :: U.Sel2 -> PArray a -> PArray a -> PArray a
+combine2 tags vec1 vec2
+ = let  go [] [] []                     = []
+        go (0 : bs) (x : xs) ys         = x : go bs xs ys
+        go (1 : bs) xs       (y : ys)   = y : go bs xs ys
+        go _ _ _ = error "Data.Array.Parallel.PArray.combine: length mismatch"
+   in   V.fromList
+                $ go    (V.toList $ V.convert $ U.tagsSel2 tags)
+                        (V.toList vec1)
+                        (V.toList vec2)
+
+
+-- Enumerations ---------------------------------------------------------------
+-- | Construct a range of integers
+enumFromTo :: Int -> Int -> PArray Int
+enumFromTo      = V.enumFromTo
+
+
+-- | Lifted enumeration
+enumFromTol :: PArray Int -> PArray Int -> PArray (PArray Int)
+enumFromTol     = lift2 enumFromTo
+
+
+-- Tuples ---------------------------------------------------------------------
+-- | O(n). Zip a pair of arrays into an array of pairs.
+zip     :: PArray a -> PArray b -> PArray (a, b)
+zip     = V.zip
+
+
+-- | Lifted zip
+zipl    :: PArray (PArray a) -> PArray (PArray b) -> PArray (PArray (a, b))
+zipl    = lift2 zip
+
+
+-- | O(n). Unzip an array of pairs into a pair of arrays.
+unzip   :: PArray (a, b) -> (PArray a, PArray b)
+unzip   = V.unzip
+
+
+-- | Lifted unzip
+unzipl  :: PArray (PArray (a, b)) -> PArray (PArray a, PArray b)
+unzipl  = lift1 unzip
+
+
+-- Conversions ----------------------------------------------------------------
+-- | Convert a `Vector` to a `PArray`
+fromVector :: Vector a -> PArray a
+fromVector = id
+
+
+-- | Convert a `PArray` to a `Vector`        
+toVector   :: PArray a -> Vector a
+toVector   = id
+
+-- | Convert a list to a `PArray`.
+fromList   :: [a] -> PArray a
+fromList   = V.fromList
+
+-- | Convert a `PArray` to a list.
+toList     :: PArray a -> [a]
+toList     = V.toList
+
+
+-- | Convert a `U.Array` to a `PArray`
+fromUArray :: U.Elt a => U.Array a -> PArray a
+fromUArray  = V.convert
+
+
+-- | Convert a `PArray` to a `U.Array`
+toUArray   :: U.Elt a => PArray a -> U.Array a
+toUArray    = V.convert
+
+
+-- | Convert a `U.Array` of tuples to a `PArray`
+fromUArray2
+        :: (U.Elt a, U.Elt b)
+        => U.Array (a, b) -> PArray (a, b)
+        
+fromUArray2  = V.convert
\ No newline at end of file
@@ -1,4 +1,4 @@
-
+{-# LANGUAGE UndecidableInstances #-}
 -- | During testing, we compare the output of each invocation of the lifted
 --   combinators in "Data.Array.Parallel.PArray" with the reference implementations. 
 --
@@ -9,16 +9,15 @@
 --         as well as the types that each opeartor is being called at.
 --
 module Data.Array.Parallel.PArray.Reference
-        ( withRef1, withRef2
+        ( Similar(..), PprPhysical1 (..)
+        , withRef1, withRef2
         , toRef1,   toRef2,   toRef3)
 where
-import Data.Array.Parallel.PArray.PRepr
 import Debug.Trace
+import Data.Array.Parallel.Pretty
 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-boxed" 
-                 Data.Array.Parallel.PArray     as R
+import Data.Vector                              (Vector)
 import Prelude hiding (length)
 
 -- Config ---------------------------------------------------------------------
@@ -28,35 +27,52 @@ debugLiftedTrace        = False
 debugLiftedCompare      :: Bool
 debugLiftedCompare      = False
 
+class Similar a where
+ similar :: a -> a -> Bool
+
+class PprPhysical1 a where
+ pprp1  :: a -> Doc
+
+ pprp1v :: Vector a -> Doc
+ pprp1v vec
+        = brackets 
+        $ hcat
+        $ punctuate (text ", ") 
+        $ V.toList $ V.map pprp1 vec
+        
 
 -- 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
+withRef1 :: ( A.Array r a
+            , A.Array c a, PprPhysical1 (c a)
+            , Similar a,   PprPhysical1 a)
+         => String              -- name of operator
+         -> r 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))
+            then trace (render $ text " " 
+                        $$ text name 
+                        $$ (nest 8 $ pprp1 arrImpl))
             else id    
 
         resultOk
          = A.valid arrImpl
              && A.length arrRef == A.length arrImpl
-             && (V.and $ V.zipWith
-                  similarPA
-                  (A.toVectors1 arrRef) (A.toVectors1 arrImpl))
+             && (V.and 
+                  $ V.zipWith
+                        similar
+                        (A.toVectors1 arrRef)
+                        (A.toVectors1 arrImpl))
               
         resultFail
-         = error $ T.render $ T.vcat
-                [ T.text "withRef1: failure " T.<> T.text name
-                , T.nest 4 $ T.pprp  $ A.toVectors1 arrRef
-                , T.nest 4 $ pprpPA arrImpl ]
+         = error $ render $ vcat
+                [ text "withRef1: failure " <> text name
+                , nest 4 $ pprp1v $ A.toVectors1 arrRef
+                , nest 4 $ pprp1  $ arrImpl ]
 
    in   trace' (if debugLiftedCompare
                  then (if resultOk then arrImpl else resultFail)
@@ -65,33 +81,35 @@ withRef1 name arrRef arrImpl
 
 
 -- | 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.
+withRef2 :: ( A.Array r (r a)
+            , A.Array r a
+            , A.Array c (c a), PprPhysical1 (c (c a))
+            , A.Array c a,     PprPhysical1 (c a)
+            , Similar a,       PprPhysical1 a)
+         => String      -- name of operator.
+         -> r (r 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))
+            then trace (render $ text " " 
+                        $$ text name 
+                        $$ (nest 8 $ pprp1 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)
+                (\xs ys -> V.and $ V.zipWith similar 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 ]
+         = error $ render $ vcat
+                [ text "withRef2: failure " <> text name
+                , nest 4 $ pprp1 arrImpl ]
 
    in   trace' (if debugLiftedCompare
                  then (if resultOK then arrImpl else resultFail)
@@ -101,25 +119,33 @@ withRef2 name arrRef arrImpl
 
 -- toRef ----------------------------------------------------------------------
 -- | Convert an array to the reference version.
-toRef1  :: (A.Array c a, PA (c a))
-        => c a -> R.PArray a
+toRef1  :: ( A.Array c a
+           , A.Array r a)
+        => c a -> r 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) 
+toRef2 :: ( A.Array c (c a)
+          , A.Array c a
+          , A.Array r (r a)
+          , A.Array r a)
        => c (c a)
-       -> R.PArray (R.PArray a)
+       -> r (r 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)
+toRef3 :: ( A.Array c (c (c a))
+          , A.Array c (c a)
+          , A.Array c a
+          , A.Array r (r (r a))
+          , A.Array r (r a)
+          , A.Array r a)
        => c (c (c a))
-       -> R.PArray (R.PArray (R.PArray a))
+       -> r (r (r a))
 
 toRef3  = A.fromVectors3 . A.toVectors3
 
diff --git a/dph-lifted-base/LICENSE b/dph-lifted-base/LICENSE
new file mode 100644 (file)
index 0000000..235f8f1
--- /dev/null
@@ -0,0 +1,37 @@
+Copyright (c) 2001-2011, The DPH Team
+All rights reserved.
+
+The DPH Team is:
+  Manuel M T Chakravarty
+  Gabriele Keller
+  Roman Leshchinskiy
+  Ben Lippmeier
+  George Roldugin
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+- Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+- Neither name of the University nor the names of its contributors may be
+used to endorse or promote products derived from this software without
+specific prior written permission. 
+
+THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.
+
diff --git a/dph-lifted-base/Setup.hs b/dph-lifted-base/Setup.hs
new file mode 100644 (file)
index 0000000..200a2e5
--- /dev/null
@@ -0,0 +1,3 @@
+import Distribution.Simple
+main = defaultMain
+
diff --git a/dph-lifted-base/dph-lifted-vseg.cabal b/dph-lifted-base/dph-lifted-vseg.cabal
new file mode 100644 (file)
index 0000000..038db06
--- /dev/null
@@ -0,0 +1,66 @@
+Name:           dph-lifted-base
+Version:        0.5.2.0
+License:        BSD3
+License-File:   LICENSE
+Author:         The DPH Team
+Maintainer:     Ben Lippmeier <benl@cse.unsw.edu.au>
+Homepage:       http://www.haskell.org/haskellwiki/GHC/Data_Parallel_Haskell
+Category:       Data Structures
+Synopsis:       Data structures for the Data Parallel Haskell vectoriser.
+
+Cabal-Version:  >= 1.6
+Build-Type:     Simple
+
+Library
+  Exposed-Modules:
+        Data.Array.Parallel.PArray.Types
+        Data.Array.Parallel.PArray.Reference
+        Data.Array.Parallel.PArray
+        Data.Array.Parallel.PArr
+        
+  Exposed:
+        False
+
+  Extensions:
+        CPP,
+        BangPatterns,
+        PatternGuards
+        TypeFamilies,
+        TypeOperators,
+        RankNTypes,
+        BangPatterns,
+        MagicHash,
+        UnboxedTuples,
+        TypeOperators,
+        FlexibleContexts,
+        FlexibleInstances,
+        EmptyDataDecls,
+        NoMonomorphismRestriction,
+        MultiParamTypeClasses,
+        EmptyDataDecls,
+        StandaloneDeriving,
+        ExplicitForAll,
+        ParallelListComp,
+        ExistentialQuantification,
+        ScopedTypeVariables,
+        PatternGuards,
+        PackageImports
+
+  GHC-Options:
+        -Odph 
+        -fcpr-off -fno-liberate-case -fno-spec-constr
+        -Wall
+        -fno-warn-missing-methods
+        -fno-warn-orphans
+
+  Build-Depends:  
+        base                    == 4.4.*,
+        ghc                     == 7.*,
+        array                   == 0.3.*,
+        random                  == 1.0.*,
+        template-haskell        == 2.6.*,
+        dph-base                == 0.5.*,
+        dph-prim-par            == 0.5.*,
+        vector                  == 0.9.*,
+        pretty                  == 1.1.*,
+        containers              == 0.4.*
diff --git a/dph-lifted-base/ghc-stage b/dph-lifted-base/ghc-stage
new file mode 100644 (file)
index 0000000..0cfbf08
--- /dev/null
@@ -0,0 +1 @@
+2
diff --git a/dph-lifted-boxed/Data/Array/Parallel/Lifted/Closure.hs b/dph-lifted-boxed/Data/Array/Parallel/Lifted/Closure.hs
new file mode 100644 (file)
index 0000000..82419ef
--- /dev/null
@@ -0,0 +1,233 @@
+#include "fusion-phases.h"
+
+-- | Closures.
+--   Used when closure converting the source program during vectorisation.
+module Data.Array.Parallel.Lifted.Closure 
+        ( -- * Closures.
+          (:->)(..)
+        , ($:)
+
+        -- * Array Closures.
+        , PData(..), PDatas(..)
+        , ($:^), liftedApply
+
+        -- * Closure Construction.
+        , closure1,  closure2,  closure3
+        , closure1', closure2', closure3')
+where
+import Data.Array.Parallel.PArray.PData
+import Data.Array.Parallel.PArray.PRepr
+import qualified Data.Vector            as V
+import GHC.Exts
+
+
+-- Closures -------------------------------------------------------------------
+-- | Define the fixity of the closure type constructor.
+infixr 0 :->
+infixl 1 $:, $:^
+
+-- | The type of closures.
+--   This bundles up:
+---   1) the 'vectorised' version of the function that takes an explicit environment
+--    2) the 'lifted' version, that works on arrays.
+--       The first parameter of the lifted version is the 'lifting context'
+--       that gives the length of the arrays being operated on.
+--    3) the environment of the closure.
+-- 
+--   The vectoriser closure-converts the source program so that all functions
+--   are expressed in this form.
+data (a :-> b)
+        = forall env. PA env
+        => Clo  (env -> a -> b)
+                (Int -> PData env -> PData a -> PData b)
+                env
+
+-- | Closure application.
+($:) :: (a :-> b) -> a -> b
+($:) (Clo fv _fl env) x  = fv env x
+{-# INLINE_CLOSURE ($:) #-}
+
+
+-- Array Closures -------------------------------------------------------------
+-- | Arrays of closures (aka array closures)
+--   We need to represent arrays of closures when vectorising partial applications.
+--
+--   For example, consider:
+--     @mapP (+) xs   ::  [: Int -> Int :]@
+--
+--   Representing this an array of thunks doesn't work because we can't evaluate
+--   it in a data parallel manner. Instead, we want *one* function applied to many
+--   array elements.
+-- 
+--   Instead, such an array of closures is represented as the vectorised  and
+--   lifted versions of (+), along with an environment array xs that contains the
+--   partially applied arguments.
+--
+--     @mapP (+) xs  ==>  AClo plus_v plus_l xs@
+--
+data instance PData (a :-> b)
+        =  forall env. PA env
+        => AClo  (env -> a -> b)
+                 (Int -> PData env -> PData a -> PData b)
+                 (PData env)
+
+data instance PDatas (a :-> b)
+        =  forall env. PA env
+        => AClos (env -> a -> b)
+                 (Int -> PData env -> PData a -> PData b)
+                 (PDatas env)
+
+
+-- | Lifted closure application.
+($:^) :: PArray (a :-> b) -> PArray a -> PArray b
+PArray n# (AClo _ f es) $:^ PArray _ as 
+        = PArray n# (f (I# n#) es as)
+{-# INLINE ($:^) #-}
+
+
+-- | Lifted closure application, taking an explicit lifting context.
+liftedApply :: Int -> PData (a :-> b) -> PData a -> PData b
+liftedApply n (AClo _ fl envs) as
+        = fl n envs as
+{-# INLINE_CLOSURE liftedApply #-}
+
+
+-- Closure Construction -------------------------------------------------------
+-- These functions are used for building closure representations of primitive
+-- functions. They're used in D.A.P.Lifted.Combinators where we define the 
+-- closure converted lifted array combinators that vectorised code uses.
+
+-- | Construct an arity-1 closure,
+--   from unlifted and lifted versions of a primitive function.
+closure1 
+        :: (a -> b)
+        -> (Int -> PData a -> PData b)
+        -> (a :-> b)
+
+closure1 fv fl  
+        = Clo   (\_env -> fv)
+                (\n _env -> fl n)
+                ()
+{-# INLINE_CLOSURE closure1 #-}
+
+
+-- | Construct an arity-2 closure,
+--   from lifted and unlifted versions of a primitive function.
+closure2 
+        :: forall a b c. PA a
+        => (a -> b -> c)
+        -> (Int -> PData a -> PData b -> PData c)
+        -> (a :-> b :-> c)
+
+closure2 fv fl
+ = let  fv_1 _ xa   = Clo fv fl xa
+        fl_1 _ _ xs = AClo fv fl xs
+        
+   in   Clo fv_1 fl_1 ()
+{-# INLINE_CLOSURE closure2 #-}
+
+
+-- | Construct an arity-3 closure
+--   from lifted and unlifted versions of a primitive function.
+closure3 
+        :: forall a b c d. (PA a, PA b)
+        => (a -> b -> c -> d)
+        -> (Int -> PData a -> PData b -> PData c -> PData d)
+        -> (a :-> b :-> c :-> d)
+        
+closure3 fv fl
+ = let  fv_1   _ xa = Clo   fv_2 fl_2 xa
+        fl_1 _ _ xs = AClo  fv_2 fl_2 xs
+
+        -----
+        fv_2 xa yb   = Clo  fv_3 fl_3 (xa, yb)
+        fl_2 _ xs ys = AClo fv_3 fl_3 (PTuple2 xs ys)
+
+        -----
+        fv_3 (xa, yb) zc           = fv xa yb zc
+        fl_3 n (PTuple2 xs ys) zs  = fl n xs ys zs
+
+   in   Clo fv_1 fl_1 ()
+{-# INLINE_CLOSURE closure3 #-}
+
+
+-- Closure constructors that take PArrays -------------------------------------
+-- These versions are useful when defining prelude functions such as in 
+-- D.A.P.Prelude.Int. They let us promote functions that work on PArrays 
+-- to closures, while inferring the lifting context from the first argument.
+
+-- | Construct an arity-1 closure.
+closure1'
+        :: forall a b
+        .  (a -> b)
+        -> (PArray a -> PArray b)
+        -> (a :-> b)
+
+closure1' fv fl 
+ = let  {-# INLINE fl' #-}
+        fl' (I# n#) pdata
+         = case fl (PArray n# pdata) of
+                 PArray _ pdata' -> pdata'
+   in   closure1 fv fl'
+{-# INLINE_CLOSURE closure1' #-}
+
+
+-- | Construct an arity-2 closure.
+closure2'
+        :: forall a b c. PA a
+        => (a -> b -> c)
+        -> (PArray a -> PArray b -> PArray c)
+        -> (a :-> b :-> c)
+
+closure2' fv fl 
+ = let  {-# INLINE fl' #-}
+        fl' (I# n#) pdata1 pdata2
+         = case fl (PArray n# pdata1) (PArray n# pdata2) of
+                 PArray _ pdata' -> pdata'
+   in   closure2 fv fl'
+{-# INLINE_CLOSURE closure2' #-}
+
+
+-- | Construct an arity-3 closure.
+closure3'
+        :: forall a b c d. (PA a, PA b) 
+        => (a -> b -> c -> d)
+        -> (PArray a -> PArray b -> PArray c -> PArray d)
+        -> (a :-> b :-> c :-> d) 
+
+closure3' fv fl 
+ = let  {-# INLINE fl' #-}
+        fl' (I# n#) pdata1 pdata2 pdata3
+         = case fl (PArray n# pdata1) (PArray n# pdata2) (PArray n# pdata3) of
+                 PArray _ pdata' -> pdata'
+   in   closure3 fv fl'
+{-# INLINE_CLOSURE closure3' #-}
+
+
+-- PData instance for closures ------------------------------------------------
+-- This needs to be here instead of in a module D.A.P.PArray.PData.Closure
+-- to break an import loop.
+--
+instance PR (a :-> b) where
+ toVectorPR (AClo fv fl envs)
+        = V.map (Clo fv fl) $ toVectorPA envs
+
+ fromVectorPR 
+        = error $ unlines
+        [ "Data.Array.Parallel.Lifted.Closure.fromVector"
+        , "  can't create closure array of unknown vector of functions" ]
+
+-- PRepr Instance -------------------------------------------------------------
+-- This needs to be here instead of in D.A.P.PRepr.Instances 
+-- to break an import loop.
+--
+type instance PRepr (a :-> b) 
+        = a :-> b
+
+instance (PA a, PA b) => PA (a :-> b) where
+  toPRepr       = id
+  fromPRepr     = id
+  toArrPRepr    = id
+  fromArrPRepr  = id
+  toArrPReprs   = id
+  fromArrPReprs = id
diff --git a/dph-lifted-boxed/Data/Array/Parallel/Lifted/Combinators.hs b/dph-lifted-boxed/Data/Array/Parallel/Lifted/Combinators.hs
new file mode 100644 (file)
index 0000000..e110459
--- /dev/null
@@ -0,0 +1,226 @@
+{-# OPTIONS -fno-spec-constr #-}
+#include "fusion-phases.h"
+
+-- | Closure converted lifted array combinators.
+--   The vectoriser produces code that uses these combinators directly.
+-- 
+--   All of the combinators in this module are polymorphic, work on `PArray`, and
+--   take `PA` dictionaries. Combinators that are specific to a certain element type,
+--   like `Int`, are defined in the corresponding prelude module, 
+--   eg "Data.Array.Parallel.Prelude.Int".
+--
+module Data.Array.Parallel.Lifted.Combinators 
+        ( -- * Conversions
+          fromPArrayPP
+        , toPArrayPP
+        , fromNestedPArrayPP
+        
+        -- * Constructors
+        , emptyPP
+        , singletonPP
+        , replicatePP
+        , appendPP
+
+        -- * Projections
+        , lengthPP
+        , indexPP
+        , slicePP
+
+        -- * Traversals
+        , mapPP
+        , zipWithPP
+        , crossMapPP
+
+        -- * Filtering
+        , filterPP
+
+        -- * Concatenation
+        , concatPP
+
+        -- * Tuple functions
+        , zipPP
+        , unzipPP)
+where
+import Data.Array.Parallel.Lifted.Closure
+import Data.Array.Parallel.PArray.PData         as PA
+import Data.Array.Parallel.PArray.PRepr         as PA
+import Data.Array.Parallel.PArray               as PA
+
+
+-- Conversions ================================================================
+-- The following identity functions are used as the vectorised versions of the
+-- functions that convert between the source level array type [:a:] and the 
+-- PArray type which is used in the library. 
+
+-- | Identity function, used as the vectorised version of fromPArrayP.
+fromPArrayPP :: PA a => PArray a :-> PArray a
+fromPArrayPP         = closure1 (\x -> x) (\_ xs -> xs)
+{-# INLINE fromPArrayPP #-}
+
+
+-- | Identity function, used as the vectorised version of toPArrayP.
+toPArrayPP :: PA a => PArray a :-> PArray a
+toPArrayPP         = closure1 (\x -> x) (\_ xs -> xs)
+{-# INLINE toPArrayPP #-}
+
+
+-- | Identity function, used as the vectorised version of fromNestedPArrayP
+fromNestedPArrayPP :: PA a => (PArray (PArray a) :-> PArray (PArray a))
+fromNestedPArrayPP = closure1 (\xs -> xs) (\_ xss -> xss)
+{-# INLINE fromNestedPArrayPP #-}
+
+
+-- Combinators ================================================================
+--   For each combinator:
+--    The *PP_v version is the "vectorised" version that has had its parameters
+--    closure converted. For first-order functions, the *PP_v version is
+--    identical to the standard *PA version from D.A.P.PArray, so we can 
+--    just use that directly.
+--
+--    The *PP_l version is the "lifted" version that works on arrays of arrays.
+--    Each of these functions also takes an integer as its first argument. 
+--    This is the "lifting context" that says now many element to expect in 
+--    each of the argument arrays. 
+--
+--    The *PP version contains both the vectorised and lifted versions wrapped
+--    up in a closure. The code produced by the vectoriser uses the *PP
+--    versions directly.
+
+
+-- Constructors ---------------------------------------------------------------
+-- | O(1). Construct an empty array.
+emptyPP :: PA a => PArray a
+emptyPP         = PA.empty
+{-# INLINE_PA emptyPP #-}
+
+
+-- | O(1). Construct an array containing a single element.
+singletonPP :: PA a => a :-> PArray a
+singletonPP     = closure1' PA.singleton PA.singletonl
+{-# INLINE_PA singletonPP #-}
+
+
+-- | O(n). Construct an array of the given size, that maps all elements to the same value.
+replicatePP     :: PA a => Int :-> a :-> PArray a
+replicatePP     = closure2' PA.replicate PA.replicatel
+{-# INLINE_PA replicatePP #-}
+
+
+-- | O(len result). Append two arrays.
+appendPP :: PA a => PArray a :-> PArray a :-> PArray a
+appendPP        = closure2' PA.append PA.appendl
+{-# INLINE_PA appendPP #-}
+
+
+-- | O(len result). Concatenate a nested array.
+concatPP :: PA a => PArray (PArray a) :-> PArray a
+concatPP        = closure1' PA.concat PA.concatl
+{-# INLINE_PA concatPP #-}
+
+
+-- Projections ----------------------------------------------------------------
+-- | O(1). Take the number of elements in an array.
+lengthPP   :: PA a => PArray a :-> Int
+lengthPP        = closure1' PA.length PA.lengthl
+{-# INLINE_PA lengthPP #-}
+
+
+-- | O(1). Lookup a single element from the source array.
+indexPP :: PA a => PArray a :-> Int :-> a
+indexPP         = closure2' PA.index PA.indexl
+{-# INLINE_PA indexPP #-}
+
+
+-- | O(len slice). Extract a range of elements from an array.
+slicePP :: PA a => Int :-> Int :-> PArray a :-> PArray a
+slicePP         = closure3' PA.slice PA.slicel
+{-# INLINE_PA slicePP #-}
+
+
+-- Traversals -----------------------------------------------------------------
+-- | Apply a worker function to every element of an array.
+mapPP   :: (PA a, PA b) 
+        => (a :-> b) :-> PArray a :-> PArray b
+
+mapPP   = closure2' mapPP_v mapPP_l
+{-# INLINE_PA mapPP #-}
+
+
+mapPP_v :: (PA a, PA b)
+        => (a :-> b) -> PArray a -> PArray b
+mapPP_v f as
+        =   PA.replicate (PA.length as) f $:^ as
+{-# INLINE mapPP_v #-}
+
+
+mapPP_l :: (PA a, PA b)
+        => (PArray (a :-> b)) -> PArray (PArray a) -> PArray (PArray b)
+mapPP_l fs ass
+        =   PA.unconcat ass 
+        $   PA.replicates (PA.takeUSegd ass) fs
+        $:^ PA.concat ass
+{-# INLINE mapPP_l #-}
+
+
+-- | Apply a worker function to every pair of two arrays.
+zipWithPP 
+        :: (PA a, PA b, PA c)
+        => (a :-> b :-> c) :-> PArray a :-> PArray b :-> PArray c
+
+zipWithPP = closure3' zipWithPP_v zipWithPP_l
+ where
+        {-# INLINE zipWithPP_v #-}
+        zipWithPP_v f as bs
+                = PA.replicate (PA.length as) f $:^ as $:^ bs
+
+        {-# INLINE zipWithPP_l #-}
+        zipWithPP_l fs ass bss
+                =   PA.unconcat ass
+                $   PA.replicates (PA.takeUSegd ass) fs
+                $:^ PA.concat ass
+                $:^ PA.concat bss
+{-# INLINE_PA zipWithPP #-}
+
+
+-- | 
+crossMapPP
+        :: (PA a, PA b)
+        => PArray a :-> (a :-> PArray b) :-> PArray (a, b)
+
+crossMapPP = closure2' crossMapPP_v crossMapPP_l
+ where
+        {-# INLINE crossMapPP_v #-}
+        crossMapPP_v _ _
+                = error "crossMapP: not implemented"
+
+        {-# INLINE crossMapPP_l #-}
+        crossMapPP_l _ _
+                = error "crossMapP: not implemented"
+
+{-# INLINE_PA crossMapPP #-}
+
+-- Filtering ------------------------------------------------------------------
+-- | Extract the elements from an array that match the given predicate.
+filterPP :: PA a => (a :-> Bool) :-> PArray a :-> PArray a
+{-# INLINE filterPP #-}
+filterPP = closure2' filterPP_v filterPP_l
+ where
+        {-# INLINE filterPP_v #-}
+        filterPP_v p xs    = PA.pack xs   (mapPP_v p xs)
+        
+        {-# INLINE filterPP_l #-}
+        filterPP_l ps xss  = PA.packl xss (mapPP_l ps xss)
+
+
+-- Tuple Functions ------------------------------------------------------------
+-- | Zip a pair of arrays into an array of pairs.
+zipPP :: (PA a, PA b) => PArray a :-> PArray b :-> PArray (a, b)
+zipPP           = closure2' PA.zip PA.zipl
+{-# INLINE_PA zipPP #-}
+
+
+-- | Unzip an array of pairs into a pair of arrays.
+unzipPP :: (PA a, PA b) => PArray (a, b) :-> (PArray a, PArray b)
+unzipPP         = closure1' PA.unzip PA.unzipl
+{-# INLINE_PA unzipPP #-}
+
index e6d6239..b0778b7 100644 (file)
@@ -14,7 +14,7 @@
 --   TODO: check lengths properly in functions like zip, extracts
 --
 module Data.Array.Parallel.PArray
-        ( PArray(..)
+        ( PArray(..), PA
         , valid
         , nf
         
@@ -52,6 +52,8 @@ module Data.Array.Parallel.PArray
         , fromUArray,   toUArray
         , fromUArray2)
 where
+import Data.Array.Parallel.PArray.PData
+import Data.Array.Parallel.PArray.PRepr
 import Data.Array.Parallel.Base                 (Tag)
 import Data.Vector                              (Vector)
 import qualified Data.Array.Parallel.Unlifted   as U
@@ -67,59 +69,69 @@ import Prelude hiding
 
 die fn str = error $ "Data.Array.Parallel.PArray: " ++ fn ++ " " ++ str
 
--- | Parallel Ararys.
-data PArray a
-        = PArray Int# (Vector a)
-        deriving (Eq, Show)
-
 
 -- Array Instances ------------------------------------------------------------
-instance A.Array PArray a where
+instance PA a => A.Array PArray a where
  valid     = const True
  singleton = A.singleton
 
  length  (PArray _ vec)
-        = V.length vec
+        = V.length $ toVectorPA vec
 
  index (PArray _ vec) ix
-        = vec V.! ix
+        = (toVectorPA vec) V.! ix
 
  append (PArray n1# xs) (PArray n2# ys)
-        = PArray (n1# +# n2#) (xs V.++ ys)
+        = PArray (n1# +# n2#) 
+        $ fromVectorPA (toVectorPA xs V.++ toVectorPA ys)
 
  toVector (PArray _ vec)
-        = vec
+        = toVectorPA vec
 
  fromVector vec
   = case V.length vec of
-        I# n# -> PArray n# vec
+        I# n# -> PArray n# (fromVectorPA vec)
 
 
 -- | Lift a unary array operator.
-lift1 :: (a -> b) -> PArray a -> PArray b
+lift1   :: (PA a, PA b)
+        => (a -> b) -> PArray a -> PArray b
 lift1 f (PArray n# vec)
-        = PArray n# $ V.map f vec
+        = PArray n# 
+        $ fromVectorPA
+        $ V.map f (toVectorPA vec)
 
 
 -- | Lift a binary array operator.
-lift2 :: (a -> b -> c) -> PArray a -> PArray b -> PArray c
+lift2   :: (PA a, PA b, PA c) 
+        => (a -> b -> c) -> PArray a -> PArray b -> PArray c
 lift2 f (PArray n1# vec1) (PArray n2# vec2)
- | I# n1# /= I# n2# 
- = die "lift2" "length mismatch"
       | I# n1# /= I# n2# 
       = die "lift2" "length mismatch"
  
- | otherwise
- = PArray n1# $ V.zipWith f vec1 vec2
+        | otherwise
+        = PArray n1# 
+        $ fromVectorPA 
+        $ V.zipWith f 
+                (toVectorPA vec1)
+                (toVectorPA vec2)
 
 
 -- | Lift a trinary array operator
-lift3 :: (a -> b -> c -> d) -> PArray a -> PArray b -> PArray c -> PArray d
+lift3   :: (PA a, PA b, PA c, PA d)
+        => (a -> b -> c -> d) -> PArray a -> PArray b -> PArray c -> PArray d
 lift3 f (PArray n1# vec1) (PArray n2# vec2) (PArray n3# vec3)
- |   I# n1# /= I# n2# 
-  || I# n1# /= I# n3#
- = die "lift3" "length mismatch"
       |   I# n1# /= I# n2# 
+         || I# n1# /= I# n3#
       = die "lift3" "length mismatch"
  
- | otherwise
- = PArray n1# $ V.zipWith3 f vec1 vec2 vec3
+        | otherwise
+        = PArray n1# 
+        $ fromVectorPA
+        $ V.zipWith3 f 
+                (toVectorPA vec1)
+                (toVectorPA vec2)
+                (toVectorPA vec3)
 
 
 -- Basics ---------------------------------------------------------------------
@@ -134,34 +146,34 @@ nf _    = ()
 
 -- Constructors ----------------------------------------------------------------
 -- | O(1). An empty array.
-empty :: PArray a
-empty           = PArray 0# V.empty
+empty :: PA a => PArray a
+empty           = PArray 0# $ fromVectorPA V.empty
 
 
 -- | O(1). Produce an array containing a single element.
-singleton :: a -> PArray a
-singleton x     = PArray 1# (V.singleton x)
+singleton :: PA a => a -> PArray a
+singleton x     = PArray 1# $ fromVectorPA $ V.singleton x
 
 
 -- | O(n). Produce an array of singleton arrays.
-singletonl :: PArray a -> PArray (PArray a)
+singletonl :: PA a => PArray a -> PArray (PArray a)
 singletonl = lift1 singleton
 
 
 -- | O(n). Define an array of the given size, that maps all elements to the same value.
-replicate :: Int -> a -> PArray a
+replicate :: PA a => Int -> a -> PArray a
 replicate n@(I# n#) x
-        = PArray n# (V.replicate n x)
+        = PArray n# $ fromVectorPA $ V.replicate n x
 
 
 -- | O(sum lengths). Lifted replicate.
-replicatel :: PArray Int -> PArray a -> PArray (PArray a)
+replicatel :: PA a => PArray Int -> PArray a -> PArray (PArray a)
 replicatel = lift2 replicate
 
 
 -- | O(sum lengths). Segmented replicate.
-replicates :: U.Segd -> PArray a -> PArray a
-replicates segd (PArray n# vec)
+replicates :: PA a => U.Segd -> PArray a -> PArray a
+replicates segd (PArray n# pdata)
  | I# n# /= U.lengthSegd segd
  = die "replicates" $ unlines
         [ "segd length mismatch"
@@ -171,44 +183,46 @@ replicates segd (PArray n# vec)
  | otherwise
  = let  !(I# n2#) = U.elementsSegd segd
    in   PArray n2# 
+         $ fromVectorPA
          $ join $ V.zipWith V.replicate
                         (V.convert $ U.lengthsSegd segd)
-                        vec
+                        (toVectorPA pdata)
 
 
 -- | O(sum lengths). Wrapper for segmented replicate that takes replication counts
 --  and uses them to build the `U.Segd`.
-replicates' :: PArray Int -> PArray a -> PArray a
+replicates' :: PA a => PArray Int -> PArray a -> PArray a
 replicates' (PArray _ reps) arr
- = replicates (U.lengthsToSegd $ V.convert reps) arr
+ = replicates (U.lengthsToSegd $ V.convert $ toVectorPA reps) arr
 
 
 -- | Append two arrays.
-append :: PArray a -> PArray a -> PArray a
+append :: PA a => PArray a -> PArray a -> PArray a
 append (PArray n1# xs) (PArray n2# ys)
-        = PArray (n1# +# n2#) (xs V.++ ys)
+        = PArray (n1# +# n2#) 
+        $ fromVectorPA (toVectorPA xs V.++ toVectorPA ys)
 
 
 -- | Lifted append.
-appendl :: PArray (PArray a) -> PArray (PArray a) -> PArray (PArray a)
+appendl :: PA a => PArray (PArray a) -> PArray (PArray a) -> PArray (PArray a)
 appendl = lift2 append
 
 
 -- | Concatenation
-concat :: PArray (PArray a) -> PArray a
+concat :: PA a => PArray (PArray a) -> PArray a
 concat (PArray _ xss)
- = let  xs       = join $ V.map A.toVector xss
+ = let  xs       = join $ V.map A.toVector $ toVectorPA xss
         !(I# n') = V.length xs
-   in   PArray n' xs
+   in   PArray n' $ fromVectorPA xs
 
 
 -- | Lifted concatenation
-concatl :: PArray (PArray (PArray a)) -> PArray (PArray a)
+concatl :: PA a => PArray (PArray (PArray a)) -> PArray (PArray a)
 concatl = lift1 concat
 
 
 -- | Impose a nesting structure on a flat array
-unconcat ::  PArray (PArray a) -> PArray b -> PArray (PArray b)
+unconcat :: (PA a, PA b) => PArray (PArray a) -> PArray b -> PArray (PArray b)
 unconcat arr1 arr2
         = nestUSegd (takeUSegd arr1) arr2
 
@@ -216,13 +230,14 @@ unconcat arr1 arr2
 -- | Create a nested array from a segment descriptor and some flat data.
 --   The segment descriptor must represent as many elements as present
 --   in the flat data array, else `error`
-nestUSegd :: U.Segd -> PArray a -> PArray (PArray a)
-nestUSegd segd (PArray n# vec)
+nestUSegd :: PA a => U.Segd -> PArray a -> PArray (PArray a)
+nestUSegd segd (PArray n# pdata)
         | U.elementsSegd segd     == I# n#
         , I# n2#                <- U.lengthSegd segd
         = PArray n2#
+        $ fromVectorPA 
         $ V.zipWith
-                (\start len@(I# len#) -> PArray len# $ V.slice start len vec)
+                (\start len@(I# len#) -> PArray len# $ fromVectorPA $ V.slice start len (toVectorPA pdata))
                 (V.convert $ U.indicesSegd segd)
                 (V.convert $ U.lengthsSegd segd)
 
@@ -237,34 +252,36 @@ nestUSegd segd (PArray n# vec)
 
 -- Projections ----------------------------------------------------------------
 -- | Take the length of an array
-length :: PArray a -> Int
+length :: PA a => PArray a -> Int
 length (PArray n# _)    = I# n#
 
 
 -- | Take the length of some arrays.
-lengthl :: PArray (PArray a) -> PArray Int
+lengthl :: PA a => PArray (PArray a) -> PArray Int
 lengthl = lift1 length
 
 
 -- | Lookup a single element from the source array.
-index :: PArray a -> Int -> a
+index :: PA a => PArray a -> Int -> a
 index (PArray _ arr) ix
-        = arr V.! ix
+        = (toVectorPA arr) V.! ix
 
 
 -- | Lookup a several elements from several source arrays.
-indexl :: PArray (PArray a) -> PArray Int -> PArray a
+indexl :: PA a => PArray (PArray a) -> PArray Int -> PArray a
 indexl  = lift2 index
 
 
 -- | Extract a range of elements from an array.
-extract :: PArray a -> Int -> Int -> PArray a
+extract :: PA a => PArray a -> Int -> Int -> PArray a
 extract (PArray _ vec) start len@(I# len#)
-        = PArray len# $ V.slice start len vec
+        = PArray len# 
+        $ fromVectorPA
+        $ V.slice start len (toVectorPA vec)
 
 
 -- | Segmented extract.
-extracts :: Vector (PArray a) -> U.SSegd -> PArray a
+extracts :: PA a => Vector (PArray a) -> U.SSegd -> PArray a
 extracts arrs ssegd
         = concat
         $ fromVector
@@ -278,23 +295,23 @@ extracts arrs ssegd
 -- | Wrapper for `extracts` that takes arrays of sources, starts and lengths of
 --   the segments, and uses these to build the `U.SSegd`.
 extracts' 
-        :: Vector (PArray a) 
+        :: PA a => Vector (PArray a) 
         -> PArray Int           -- ^ id of source array for each segment.
         -> PArray Int           -- ^ starting index of each segment in its source array.
         -> PArray Int           -- ^ length of each segment.
         -> PArray a
 extracts' arrs (PArray _ sources) (PArray _ starts) (PArray _ lengths)
- = let  segd    = U.lengthsToSegd $ V.convert lengths
+ = let  segd    = U.lengthsToSegd $ V.convert $ toVectorPA lengths
         ssegd   = U.mkSSegd 
-                        (V.convert starts)
-                        (V.convert sources)
+                        (V.convert $ toVectorPA starts)
+                        (V.convert $ toVectorPA sources)
                         segd
    in   extracts arrs ssegd
 
 
 -- | Extract a range of elements from an arrary.
 --   Like `extract` but with the parameters in a different order.
-slice :: Int -> Int -> PArray a -> PArray a
+slice :: PA a => Int -> Int -> PArray a -> PArray a
 slice start len arr
  = extract arr start len
 
@@ -302,23 +319,24 @@ slice start len arr
 -- | Extract some slices from some arrays.
 --   The arrays of starting indices and lengths must themselves
 --   have the same length.
-slicel :: PArray Int -> PArray Int -> PArray (PArray a) -> PArray (PArray a)
+slicel :: PA a => PArray Int -> PArray Int -> PArray (PArray a) -> PArray (PArray a)
 slicel  = lift3 slice
 
 
 -- | Take the segment descriptor from a nested array. This can cause index space
 --   overflow if the number of elements in the result does not can not be
 --   represented by a single machine word.
-takeUSegd :: (PArray (PArray a)) -> U.Segd
-takeUSegd (PArray _ vec)
+takeUSegd :: PA a => (PArray (PArray a)) -> U.Segd
+takeUSegd (PArray _ pdata)
         = U.lengthsToSegd 
         $ V.convert
-        $ V.map length vec
+        $ V.map length 
+        $ toVectorPA pdata
         
 
 -- Pack and Combine -----------------------------------------------------------
 -- | Select the elements of an array that have their tag set to True.
-pack    :: PArray a -> PArray Bool -> PArray a
+pack    :: PA a => PArray a -> PArray Bool -> PArray a
 pack (PArray n1# xs) (PArray n2# bs)
  | I# n1# /= I# n2#
  = die "pack" $ unlines
@@ -327,17 +345,17 @@ pack (PArray n1# xs) (PArray n2# bs)
         , "  flags length = " ++ show (I# n2#) ]
 
  | otherwise
- = let  xs'      = V.ifilter (\i _ -> bs V.! i) xs
+ = let  xs'      = V.ifilter (\i _ -> (toVectorPA bs) V.! i) $ toVectorPA xs
         !(I# n') = V.length xs'
-   in   PArray n' xs'
+   in   PArray n' $ fromVectorPA xs'
 
 -- | Lifted pack.
-packl :: PArray (PArray a) -> PArray (PArray Bool) -> PArray (PArray a)
+packl :: PA a => PArray (PArray a) -> PArray (PArray Bool) -> PArray (PArray a)
 packl   = lift2 pack
 
 
 -- | Filter an array based on some tags.
-packByTag :: PArray a -> U.Array Tag -> Tag -> PArray a
+packByTag :: PA a => PArray a -> U.Array Tag -> Tag -> PArray a
 packByTag (PArray n1# xs) tags tag
  | I# n1# /= U.length tags
  = die "packByTag" $ unlines
@@ -346,14 +364,14 @@ packByTag (PArray n1# xs) tags tag
         , "  flags length = " ++ (show $ U.length tags) ]
 
  | otherwise
- = let  xs'      = V.ifilter (\i _ -> tags U.!: i == tag) xs
+ = let  xs'      = V.ifilter (\i _ -> tags U.!: i == tag) $ toVectorPA xs
         !(I# n') = V.length xs'
-   in   PArray n' xs'
+   in   PArray n' $ fromVectorPA xs'
 
 
 -- | Combine two arrays based on a selector.
-combine2 :: U.Sel2 -> PArray a -> PArray a -> PArray a
-combine2 tags (PArray _ vec1) (PArray _ vec2)
+combine2 :: PA a => U.Sel2 -> PArray a -> PArray a -> PArray a
+combine2 tags (PArray _ pdata1) (PArray _ pdata2)
  = let  
         go [] [] []                     = []
         go (0 : bs) (x : xs) ys         = x : go bs xs ys
@@ -362,11 +380,11 @@ combine2 tags (PArray _ vec1) (PArray _ vec2)
  
         vec3    = V.fromList
                 $ go    (V.toList $ V.convert $ U.tagsSel2 tags)
-                        (V.toList vec1)
-                        (V.toList vec2)
+                        (V.toList $ toVectorPA pdata1)
+                        (V.toList $ toVectorPA pdata2)
         !(I# n') = V.length vec3
    
-    in  PArray n' vec3
+    in  PArray n' $ fromVectorPA vec3
 
 
 -- Enumerations ---------------------------------------------------------------
@@ -383,73 +401,76 @@ enumFromTol = lift2 enumFromTo
 
 -- Tuples ---------------------------------------------------------------------
 -- | O(n). Zip a pair of arrays into an array of pairs.
-zip :: PArray a -> PArray b -> PArray (a, b)
-zip (PArray n1# vec1) (PArray _ vec2)
-        = PArray n1# (V.zip vec1 vec2)
+zip     :: (PA a, PA b) => PArray a -> PArray b -> PArray (a, b)
+zip (PArray n1# pdata1) (PArray _ pdata2)
+        = PArray n1# 
+        $ fromVectorPA
+        $ V.zip (toVectorPA pdata1) (toVectorPA pdata2)
 
 
 -- | Lifted zip
-zipl    :: PArray (PArray a) -> PArray (PArray b) -> PArray (PArray (a, b))
+zipl    :: (PA a, PA b) => PArray (PArray a) -> PArray (PArray b) -> PArray (PArray (a, b))
 zipl    = lift2 zip
 
 
 -- | O(n). Unzip an array of pairs into a pair of arrays.
-unzip   :: PArray (a, b) -> (PArray a, PArray b)
-unzip (PArray n# vec)
- = let  (xs, ys)        = V.unzip vec
-   in   (PArray n# xs, PArray n# ys)
+unzip   :: (PA a, PA b) => PArray (a, b) -> (PArray a, PArray b)
+unzip (PArray n# pdata)
+ = let  (xs, ys)        = V.unzip $ toVectorPA pdata
+   in   ( PArray n# $ fromVectorPA xs
+        , PArray n# $ fromVectorPA ys)
 
 
 -- | Lifted unzip
-unzipl  :: PArray (PArray (a, b)) -> PArray (PArray a, PArray b)
+unzipl  :: (PA a, PA b) => PArray (PArray (a, b)) -> PArray (PArray a, PArray b)
 unzipl  = lift1 unzip
 
 
 -- Conversions ----------------------------------------------------------------
 -- | Convert a `Vector` to a `PArray`
-fromVector :: Vector a -> PArray a
+fromVector :: PA a => Vector a -> PArray a
 fromVector vec
  = let  !(I# n#) = V.length vec
-   in   PArray n# vec
+   in   PArray n# $ fromVectorPA vec
 
 
 -- | Convert a `PArray` to a `Vector`        
-toVector   :: PArray a -> Vector a
+toVector   :: PA a => PArray a -> Vector a
 toVector (PArray _ vec)
-        = vec
+        = toVectorPA vec
 
 
 -- | Convert a list to a `PArray`.
-fromList :: [a] -> PArray a
+fromList :: PA a => [a] -> PArray a
 fromList xx
  = let  !(I# n#) = P.length xx
-   in   PArray n# (V.fromList xx)
+   in   PArray n# (fromVectorPA $ V.fromList xx)
 
 
 -- | Convert a `PArray` to a list.
-toList     :: PArray a -> [a]
+toList     :: PA a => PArray a -> [a]
 toList (PArray _ vec)
-        = V.toList vec
+        = V.toList $ toVectorPA vec
 
 
 -- | Convert a `U.Array` to a `PArray`
-fromUArray :: U.Elt a => U.Array a -> PArray a
+fromUArray :: (PA a, U.Elt a) => U.Array a -> PArray a
 fromUArray uarr
  = let  !(I# n#) = U.length uarr
-   in   PArray n# (V.convert uarr)
+   in   PArray n# (fromVectorPA $ V.convert uarr)
 
 
 -- | Convert a `PArray` to a `U.Array`
-toUArray :: U.Elt a => PArray a -> U.Array a
+toUArray :: (PA a, U.Elt a) => PArray a -> U.Array a
 toUArray (PArray _ vec)
-        = V.convert vec
+        = V.convert $ toVectorPA vec
 
 
 -- | Convert a `U.Array` of tuples to a `PArray`
 fromUArray2
-        :: (U.Elt a, U.Elt b)
+        :: (PA a, U.Elt a, PA b, U.Elt b)
         => U.Array (a, b) -> PArray (a, b)
         
 fromUArray2 uarr
  = let  !(I# n#) = U.length uarr
-   in   PArray n# $ V.convert uarr
+   in   PArray n# $ fromVectorPA $ V.convert uarr
diff --git a/dph-lifted-boxed/Data/Array/Parallel/PArray/PData.hs b/dph-lifted-boxed/Data/Array/Parallel/PArray/PData.hs
new file mode 100644 (file)
index 0000000..30191d5
--- /dev/null
@@ -0,0 +1,101 @@
+
+module Data.Array.Parallel.PArray.PData
+        ( PArray (..), PData (..), PDatas (..)
+        , PR(..))
+where
+import Data.Array.Parallel.PArray.Types
+import Data.Vector                              (Vector)
+import qualified Data.Vector                    as V
+import GHC.Exts
+import Data.Word
+
+-------------------------------------------------------------------------------
+-- | Parallel Ararys.
+data PArray a
+        = PArray Int# (PData a)
+
+
+data family PData a
+data family PDatas a
+
+class PR a where
+  fromVectorPR :: Vector a -> PData  a
+  toVectorPR   :: PData a  -> Vector a
+
+
+-- Void
+data instance PData  Void       = PVoid   (Vector Void)
+data instance PDatas Void       = PVoids  (Vector (PData Void))
+
+instance PR Void where
+  fromVectorPR vec              = PVoid vec
+  toVectorPR   (PVoid vec)      = vec
+
+
+-- Unit
+data instance PData ()          = PUnit   (Vector ())
+data instance PDatas ()         = PUnits  (Vector (PData ()))
+
+instance PR () where
+  fromVectorPR vec              = PUnit vec
+  toVectorPR   (PUnit vec)      = vec
+
+
+-- Int
+data instance PData  Int        = PInt    (Vector Int)
+data instance PDatas Int        = PInts   (Vector (PData Int))
+
+instance PR Int where
+  fromVectorPR vec              = PInt vec
+  toVectorPR   (PInt vec)       = vec
+
+
+-- Double
+data instance PData  Double     = PDouble  (Vector Double)
+data instance PDatas Double     = PDoubles (Vector (PData Double))
+
+instance PR Double where
+  fromVectorPR vec              = PDouble vec
+  toVectorPR   (PDouble vec)    = vec
+
+
+-- Word8
+data instance PData  Word8      = PWord8  (Vector Word8)
+data instance PDatas Word8      = PWord8s (Vector (PData Word8))
+
+instance PR Word8 where
+  fromVectorPR vec              = PWord8 vec
+  toVectorPR   (PWord8 vec)     = vec
+
+-- Bool
+data instance PData  Bool       = PBool  (Vector Bool)
+data instance PDatas Bool       = PBools (Vector (PData Bool))
+
+instance PR Bool where
+  fromVectorPR vec              = PBool vec
+  toVectorPR   (PBool vec)      = vec
+
+
+-- PArray
+data instance PData  (PArray a) = PNested  (Vector (PArray a))
+data instance PDatas (PArray a) = PNesteds (Vector (PData (PArray a)))
+
+instance PR a => PR (PArray a) where
+  fromVectorPR vec              = PNested vec
+  toVectorPR   (PNested vec)    = vec
+
+
+-- Tuple2
+data instance PData  (a, b)     = PTuple2  (PData a)  (PData b)
+data instance PDatas (a, b)     = PTuple2s (PDatas a) (PDatas b)
+
+instance (PR a, PR b) => PR (a, b) where
+  fromVectorPR vec      
+   = let (as, bs)       = V.unzip vec
+     in  PTuple2 (fromVectorPR as) (fromVectorPR bs)
+
+  toVectorPR   (PTuple2 as bs)  
+   = V.zip (toVectorPR as) (toVectorPR bs)
+
+
+
diff --git a/dph-lifted-boxed/Data/Array/Parallel/PArray/PRepr.hs b/dph-lifted-boxed/Data/Array/Parallel/PArray/PRepr.hs
new file mode 100644 (file)
index 0000000..a3dc0c0
--- /dev/null
@@ -0,0 +1,179 @@
+
+module Data.Array.Parallel.PArray.PRepr
+        ( PRepr
+        , PA (..)
+        , toVectorPA
+        , fromVectorPA)
+where
+import Data.Array.Parallel.PArray.PData
+import Data.Array.Parallel.PArray.Types
+import qualified Data.Vector            as V
+import Data.Vector                      (Vector)
+import Data.Word
+
+
+-- Wrap
+newtype instance PData  (Wrap a)   = PWrap  (PData  a)
+newtype instance PDatas (Wrap a)   = PWraps (PDatas a)
+
+instance PA a => PR (Wrap a) where
+  fromVectorPR vec
+        = PWrap $ fromVectorPA $ V.map unWrap vec
+
+  toVectorPR (PWrap pdata)
+        = V.map Wrap $ toVectorPA pdata
+
+
+------------------------------------------------------------------------
+-- | Fake PRepr and PA classes.
+--   The vectoriser wants to build PA instances involving these types, 
+--   but we don't need that support for this library.
+type family PRepr a
+
+class PR (PRepr a) => PA a where
+  toPRepr       :: a                -> PRepr a
+  fromPRepr     :: PRepr a          -> a
+
+  toArrPRepr    :: PData a          -> PData (PRepr a)
+  fromArrPRepr  :: PData (PRepr a)  -> PData a
+
+  toArrPReprs   :: PDatas a         -> PDatas (PRepr a)
+  fromArrPReprs :: PDatas (PRepr a) -> PDatas a
+
+
+-- PA Functions ------------------------------------------
+fromVectorPA    :: PA a => Vector a -> PData a
+fromVectorPA vec
+        = fromArrPRepr
+        $ fromVectorPR (V.map toPRepr vec)
+
+
+toVectorPA      :: PA a => PData a -> Vector a
+toVectorPA pdata
+        = V.map fromPRepr
+        $ toVectorPR (toArrPRepr pdata)
+
+-----------------------------------------------------------
+
+-- Void
+type instance PRepr Void
+        = Void
+
+instance PA Void where
+  toPRepr               = id
+  fromPRepr             = id
+  toArrPRepr            = id
+  fromArrPRepr          = id
+  toArrPReprs           = id
+  fromArrPReprs         = id
+
+
+-- ()
+type instance PRepr ()
+        = ()
+
+instance PA () where
+  toPRepr               = id
+  fromPRepr             = id
+  toArrPRepr            = id
+  fromArrPRepr          = id
+  toArrPReprs           = id
+  fromArrPReprs         = id
+
+-- Int
+type instance PRepr Int
+        = Int
+
+instance PA Int where
+  toPRepr               = id
+  fromPRepr             = id
+  toArrPRepr            = id
+  fromArrPRepr          = id
+  toArrPReprs           = id
+  fromArrPReprs         = id
+
+-- Double
+type instance PRepr Double
+        = Double
+
+instance PA Double where
+  toPRepr               = id
+  fromPRepr             = id
+  toArrPRepr            = id
+  fromArrPRepr          = id
+  toArrPReprs           = id
+  fromArrPReprs         = id
+
+-- Word8
+type instance PRepr Word8
+        = Word8
+
+instance PA Word8 where
+  toPRepr               = id
+  fromPRepr             = id
+  toArrPRepr            = id
+  fromArrPRepr          = id
+  toArrPReprs           = id
+  fromArrPReprs         = id
+
+-- Tuple2
+type instance PRepr (a, b)      
+        = (Wrap a, Wrap b)
+
+instance (PA a, PA b) => PA (a, b) where
+  toPRepr (a, b)
+        = (Wrap a, Wrap b)
+
+  fromPRepr (Wrap a, Wrap b)
+        = (a, b)
+
+  toArrPRepr (PTuple2 as bs)
+        = PTuple2 (PWrap as) (PWrap bs)
+
+  fromArrPRepr (PTuple2 (PWrap as) (PWrap bs))
+        = PTuple2 as bs
+
+  toArrPReprs (PTuple2s as bs)
+        = PTuple2s (PWraps as) (PWraps bs)
+
+  fromArrPReprs (PTuple2s (PWraps as) (PWraps bs))
+        = PTuple2s as bs
+
+-- PArray
+type instance PRepr (PArray a)
+        = PArray (PRepr a)
+
+instance PA a => PA (PArray a) where
+  toPRepr (PArray n xs) 
+        = PArray n $ toArrPRepr xs
+
+  fromPRepr (PArray n xs)
+        = PArray n $ fromArrPRepr xs
+
+  toArrPRepr   (PNested xs)
+        = PNested  $ V.map toPRepr xs
+
+  fromArrPRepr (PNested xs)
+        = PNested  $ V.map fromPRepr xs
+
+  toArrPReprs (PNesteds vec)
+        = PNesteds $ V.map toArrPRepr vec
+
+  fromArrPReprs (PNesteds vec)
+        = PNesteds $ V.map fromArrPRepr vec
+
+
+-- Bool
+type instance PRepr Bool
+        = Bool
+
+instance PA Bool where
+  toPRepr               = id
+  fromPRepr             = id
+  toArrPRepr            = id
+  fromArrPRepr          = id
+  toArrPReprs           = id
+  fromArrPReprs         = id
+
+
+
diff --git a/dph-lifted-boxed/Data/Array/Parallel/PArray/Types.hs b/dph-lifted-boxed/Data/Array/Parallel/PArray/Types.hs
new file mode 100644 (file)
index 0000000..31ccc31
--- /dev/null
@@ -0,0 +1,118 @@
+#include "fusion-phases.h"
+
+-- | Defines the extra types we use when representing algebraic data in parallel arrays.
+--   We don't store values of user defined algebraic type directly in PArrays. Instead,
+--   we convert these to a generic representation and store that representation.
+--
+--   Conversion to and from the generic representation is handled by the methods
+--   of the PA class defined in "Data.Array.Parallel.PArray.PRepr".
+--
+---  For further information see:
+--     "Instant Generics: Fast and Easy", Chakravarty, Ditu and Keller, 2009
+-- 
+module Data.Array.Parallel.PArray.Types (
+  -- * The Void type
+  Void,
+  void,
+  fromVoid,     
+
+  -- * Generic sums
+  Sum2(..), tagOfSum2,
+  Sum3(..), tagOfSum3,
+
+  -- * The Wrap type
+  Wrap (..)
+)
+where
+import Data.Array.Parallel.Base (Tag)
+import Data.Array.Parallel.Pretty
+
+
+-- Void -----------------------------------------------------------------------
+-- | The `Void` type is used when representing enumerations. 
+-- 
+--   A type like Bool is represented as @Sum2 Void Void@, meaning that we only
+--   only care about the tag of the data constructor and not its argumnent.
+-- 
+data Void
+
+-- | A 'value' with the void type. Used as a placholder like `undefined`.
+--   Forcing this yields `error`. 
+void    :: Void
+void     = error $ unlines
+         [ "Data.Array.Parallel.PArray.Types.void"
+         , "  With the DPH generic array representation, values of type void"
+         , "  should never be forced. Something has gone badly wrong." ]
+
+
+-- | Coerce a `Void` to a different type. Used as a placeholder like `undefined`.
+--   Forcing the result yields `error`.
+fromVoid :: a
+fromVoid = error $ unlines
+         [ "Data.Array.Parallel.PArray.Types.fromVoid"
+         , "  With the DPH generic array representation, values of type void"
+         , "  should never be forced. Something has gone badly wrong." ]
+
+
+-- Sum2 -----------------------------------------------------------------------
+-- | Sum types used for the generic representation of algebraic data.
+data Sum2 a b
+        = Alt2_1 a | Alt2_2 b
+
+tagOfSum2 :: Sum2 a b -> Tag
+tagOfSum2 ss
+ = case ss of
+        Alt2_1 _        -> 0
+        Alt2_2 _        -> 1
+{-# INLINE tagOfSum2 #-}
+
+
+instance (PprPhysical a, PprPhysical b)
+        => PprPhysical (Sum2 a b) where
+ pprp ss
+  = case ss of
+        Alt2_1 x        -> text "Alt2_1" <+> pprp x
+        Alt2_2 y        -> text "Alt2_2" <+> pprp y
+
+
+
+-- Sum3 -----------------------------------------------------------------------
+data Sum3 a b c
+        = Alt3_1 a | Alt3_2 b | Alt3_3 c
+
+tagOfSum3 :: Sum3 a b c -> Tag
+tagOfSum3 ss
+ = case ss of
+        Alt3_1 _        -> 0
+        Alt3_2 _        -> 1
+        Alt3_3 _        -> 2
+{-# INLINE tagOfSum3 #-}
+
+
+-- Wrap -----------------------------------------------------------------------
+-- | When converting a data type to its generic representation, we use
+--   `Wrap` to help us convert only one layer at a time. For example:
+--
+--   @
+--   data Foo a = Foo Int a
+--
+--   instance PA a => PA (Foo a) where
+--    type PRepr (Foo a) = (Int, Wrap a)  -- define how (Foo a) is represented
+--   @
+--
+--   Here we've converted the @Foo@ data constructor to a pair, and Int
+--   is its own representation type. We have PData/PR instances for pairs and
+--   Ints, so we can work with arrays of these types. However, we can't just
+--   use (Int, a) as the representation of (Foo a) because 'a' might
+--   be user defined and we won't have PData/PR instances for it.
+--
+--   Instead, we wrap the second element with the Wrap constructor, which tells
+--   us that if we want to process this element we still need to convert it
+--   to the generic representation (and back). This last part is done by
+--   the PR instance of Wrap, who's methods are defined by calls to the *PD 
+--   functions from "Data.Array.Parallel.PArray.PRepr".
+--
+newtype Wrap a = Wrap { unWrap :: a }
+
+
+
index 271eeac..43b9e40 100644 (file)
@@ -14,6 +14,11 @@ Build-Type:     Simple
 Library
   Exposed-Modules:
         Data.Array.Parallel.PArray
+        Data.Array.Parallel.PArray.Types
+        Data.Array.Parallel.PArray.PData
+        Data.Array.Parallel.PArray.PRepr
+        Data.Array.Parallel.Lifted.Closure
+        Data.Array.Parallel.Lifted.Combinators
 
   Extensions:
         CPP,
index e110459..651936e 100644 (file)
@@ -1,6 +1,10 @@
 {-# OPTIONS -fno-spec-constr #-}
 #include "fusion-phases.h"
 
+--   NOTE NOTE NOTE
+--   This file is IDENTICAL to the one in dph-lifted-boxed.
+--   If you update one then update the other as well.
+
 -- | Closure converted lifted array combinators.
 --   The vectoriser produces code that uses these combinators directly.
 -- 
index 66f8c6a..61d0300 100644 (file)
@@ -1,4 +1,5 @@
 {-# OPTIONS -fno-spec-constr #-}
+{-# LANGUAGE UndecidableInstances #-}
 #include "fusion-phases.h"
 
 -- | Unvectorised parallel arrays.
@@ -71,8 +72,9 @@ import Data.Array.Parallel.Base                 (Tag)
 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-boxed" 
-                 Data.Array.Parallel.PArray     as R
+import qualified "dph-lifted-base" Data.Array.Parallel.PArray           as R
+import qualified "dph-lifted-base" Data.Array.Parallel.PArray.Reference as R
+
 import qualified Prelude                        as P
 import Prelude hiding 
         ( length, replicate, concat
@@ -87,6 +89,12 @@ instance PA a => T.PprPhysical (PArray a) where
         T.$+$ ( T.nest 4 
               $ pprpDataPA pdata)
 
+instance PA a => Similar a where
+ similar        = similarPA
+
+instance PA a => R.PprPhysical1 a where
+ pprp1          = pprpPA
+
 
 -- Array -----------------------------------------------------------------------
 --  Generic interface to PArrays.
index 97fba96..cb081f8 100644 (file)
@@ -23,7 +23,6 @@ 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 qualified Data.Vector                    as V
 
 
@@ -47,14 +46,6 @@ instance  (PprVirtual a, PA a)
                 <> text "|"
 
 
-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.
 unpackPA :: PA a => PArray a -> PData (PRepr a)
index 5244fff..c4cf210 100644 (file)
@@ -33,8 +33,6 @@ Library
         Data.Array.Parallel.PArray.PRepr.Tuple
         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
@@ -44,7 +42,6 @@ Library
         Data.Array.Parallel.Prelude
         Data.Array.Parallel
         Data.Array.Parallel.Prim
-        Data.Array.Parallel.PArr
         
   Exposed:
         False
@@ -89,7 +86,7 @@ Library
         template-haskell        == 2.6.*,
         dph-base                == 0.5.*,
         dph-prim-par            == 0.5.*,
-        dph-lifted-boxed        == 0.5.*,
+        dph-lifted-base         == 0.5.*,
         vector                  == 0.9.*,
         pretty                  == 1.1.*,
         containers              == 0.4.*