Fix DPH make file and test suite
authorAmos Robinson <amos.robinson@gmail.com>
Mon, 27 Aug 2012 06:22:24 +0000 (16:22 +1000)
committerAmos Robinson <amos.robinson@gmail.com>
Mon, 27 Aug 2012 06:23:07 +0000 (16:23 +1000)
13 files changed:
dph-lifted-base/Data/Array/Parallel/PArray.hs [deleted file]
dph-lifted-base/Data/Array/Parallel/PArray/Reference.hs
dph-lifted-base/Data/Array/Parallel/PArray/Reference/Convert.hs [new file with mode: 0644]
dph-lifted-base/dph-lifted-base.cabal
dph-lifted-vseg/Data/Array/Parallel/PArray.hs
dph-lifted-vseg/dph-lifted-vseg.cabal
dph-test/framework/DPH/War/Job/Compile.hs
dph-test/test/PArray/PRFuns.hs
dph-test/test/Unlifted/Basics.hs
dph-test/test/Unlifted/Permutes.hs
make/Makefile
make/config.mk
make/targets/test.mk

diff --git a/dph-lifted-base/Data/Array/Parallel/PArray.hs b/dph-lifted-base/Data/Array/Parallel/PArray.hs
deleted file mode 100644 (file)
index 2fc483d..0000000
+++ /dev/null
@@ -1,400 +0,0 @@
-
--- | 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)
-
--------------------------------------------------------------------------------
-here :: String -> String
-here str   = "Data.Array.Parallel.PArray." ++ str
-
-die :: String -> String -> a
-die fn str = error (here $ 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.sourcesOfSSegd ssegd)
-                (V.convert $ U.startsOfSSegd  ssegd)
-                (V.convert $ U.lengthsOfSSegd 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 _ -> U.index (here "packByTag") tags 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
index 1f6d573..e3cfd54 100644 (file)
-{-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS -fno-warn-missing-signatures #-}
--- | During testing, we compare the output of each invocation of the lifted
---   combinators in "Data.Array.Parallel.PArray" with the reference implementations. 
---
---   This module helps convert the to and from the array representation
---   used by the reference implementation.
 
---   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.
+-- | 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.Reference
-        ( Similar(..), PprPhysical1 (..)
-        , withRef1, withRef2
-        , toRef1,   toRef2,   toRef3)
+        ( 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.Pretty
-import qualified Data.Array.Parallel.Array      as A
-import qualified Data.Vector                    as V
+import Data.Array.Parallel.Base                 (Tag)
 import Data.Vector                              (Vector)
-import Prelude hiding (length)
-import System.IO
-import System.IO.Unsafe
+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)
 
--- Config ---------------------------------------------------------------------
-debugLiftedTrace        :: Bool
-debugLiftedTrace        = False
+-------------------------------------------------------------------------------
+here :: String -> String
+here str   = "Data.Array.Parallel.PArray." ++ str
 
-debugLiftedCompare      :: Bool
-debugLiftedCompare      = False
+die :: String -> String -> a
+die fn str = error (here $ fn ++ " " ++ str)
 
-class Similar a where
- similar :: a -> a -> Bool
+-- 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
 
-class PprPhysical1 a where
- pprp1  :: a -> Doc
 
- pprp1v :: Vector a -> Doc
- pprp1v vec
-        = brackets 
-        $ hcat
-        $ punctuate (text ", ") 
-        $ V.toList $ V.map pprp1 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
 
--- withRef --------------------------------------------------------------------
--- | Compare the result of some array operator against a reference.
-
---  Careful:
---   * We don't want to inline the whole body of this function into
---     every use site, or we'll get code explosion. When debugging is off we
---     want this wrapper to be inlined and eliminated as cheaply as possible.
---   * We also do this with 'unsafePerformIO' instead of trace, because
---     with trace, if the computation contructing the string throws an exception
---     then we get no output. For debugging we want to see what function was
---     entered before we try to print the result (which might be badly formed),
---
-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
-
-{-# INLINE withRef1 #-}
-withRef1 name arrRef arrImpl
- = if debugLiftedCompare || debugLiftedTrace
-        then withRef1' name arrRef arrImpl
-        else arrImpl
+
+-- | 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.sourcesOfSSegd ssegd)
+                (V.convert $ U.startsOfSSegd  ssegd)
+                (V.convert $ U.lengthsOfSSegd 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
         
-{-# NOINLINE withRef1' #-}
-withRef1' name arrRef arrImpl
- = unsafePerformIO
- $ do   when debugLiftedTrace
-         $ do putStrLn  $ "* " ++ name
-              putStrLn  $ render (nest 4 $ pprp1 arrImpl)
-              hFlush stdout
+
+-- 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 _ -> U.index (here "packByTag") tags 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)
         
-        when ( debugLiftedCompare 
-             && or [ not $ A.valid arrImpl
-                   , not $ A.length arrRef == A.length arrImpl
-                   , not $ V.and $ V.zipWith similar
-                                (A.toVectors1 arrRef)
-                                (A.toVectors1 arrImpl)])
-         $ error $ render $ vcat
-                [ text "withRef1: failure " <> text name
-                , nest 4 $ pprp1v $ A.toVectors1 arrRef
-                , nest 4 $ pprp1  $ arrImpl ]
-
-        return arrImpl
-
-
--- | Compare the nested result of some array operator against a reference.
-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)
-
-{-# INLINE withRef2 #-}
-withRef2 name arrRef arrImpl
- = if debugLiftedCompare || debugLiftedTrace
-         then withRef2' name arrRef arrImpl
-         else arrImpl
-
-{-# NOINLINE withRef2' #-}
-withRef2' name arrRef arrImpl
- = unsafePerformIO
- $ do   when debugLiftedTrace
-         $ do putStrLn  $ "* " ++ name
-              putStrLn  $ render (nest 4 $ pprp1 arrImpl)
-              hFlush stdout
-
-        when ( debugLiftedCompare
-             && or [ not $ A.valid arrImpl
-                   , not $ A.length arrRef == A.length arrImpl
-                   , not $ V.and $ V.zipWith 
-                                (\xs ys -> V.and $ V.zipWith similar xs ys)
-                                (A.toVectors2 arrRef)
-                                (A.toVectors2 arrImpl) ])
-         $ error $ render $ vcat
-                [ text "withRef2: failure " <> text name
-                , nest 4 $ pprp1 arrImpl ]
-
-        return arrImpl
-
-
--- toRef ----------------------------------------------------------------------
--- | Convert an array to the reference version.
-toRef1  :: ( A.Array c a
-           , A.Array r a)
-        => c a -> r a
-
-toRef1  = A.fromVectors1 . A.toVectors1
-{-# NOINLINE toRef1 #-}
---  NOINLINE because it's only for debugging.
-
-
--- | Convert a nested array to the reference version.
-toRef2 :: ( A.Array c (c a)
-          , A.Array c a
-          , A.Array r (r a)
-          , A.Array r a)
-       => c (c a)
-       -> r (r a)
-
-toRef2  = A.fromVectors2 . A.toVectors2
-{-# NOINLINE toRef2 #-}
---  NOINLINE because it's only for debugging.
-
-
--- | Convert a doubly nested array to the reference version.
-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 (r (r a))
-
-toRef3  = A.fromVectors3 . A.toVectors3
-{-# NOINLINE toRef3 #-}
---  NOINLINE because it's only for debugging.
+fromUArray2  = V.convert
diff --git a/dph-lifted-base/Data/Array/Parallel/PArray/Reference/Convert.hs b/dph-lifted-base/Data/Array/Parallel/PArray/Reference/Convert.hs
new file mode 100644 (file)
index 0000000..c111c8f
--- /dev/null
@@ -0,0 +1,170 @@
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS -fno-warn-missing-signatures #-}
+-- | During testing, we compare the output of each invocation of the lifted
+--   combinators in "Data.Array.Parallel.PArray" with the reference implementations. 
+--
+--   This module helps convert the to and from the array representation
+--   used by the reference implementation.
+
+--   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.Convert
+        ( Similar(..), PprPhysical1 (..)
+        , withRef1, withRef2
+        , toRef1,   toRef2,   toRef3)
+where
+import Data.Array.Parallel.Pretty
+import qualified Data.Array.Parallel.Array      as A
+import qualified Data.Vector                    as V
+import Data.Vector                              (Vector)
+import Prelude hiding (length)
+import System.IO
+import System.IO.Unsafe
+import Control.Monad
+
+-- Config ---------------------------------------------------------------------
+debugLiftedTrace        :: Bool
+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.
+
+--  Careful:
+--   * We don't want to inline the whole body of this function into
+--     every use site, or we'll get code explosion. When debugging is off we
+--     want this wrapper to be inlined and eliminated as cheaply as possible.
+--   * We also do this with 'unsafePerformIO' instead of trace, because
+--     with trace, if the computation contructing the string throws an exception
+--     then we get no output. For debugging we want to see what function was
+--     entered before we try to print the result (which might be badly formed),
+--
+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
+
+{-# INLINE withRef1 #-}
+withRef1 name arrRef arrImpl
+ = if debugLiftedCompare || debugLiftedTrace
+        then withRef1' name arrRef arrImpl
+        else arrImpl
+        
+{-# NOINLINE withRef1' #-}
+withRef1' name arrRef arrImpl
+ = unsafePerformIO
+ $ do   when debugLiftedTrace
+         $ do putStrLn  $ "* " ++ name
+              putStrLn  $ render (nest 4 $ pprp1 arrImpl)
+              hFlush stdout
+        
+        when ( debugLiftedCompare 
+             && or [ not $ A.valid arrImpl
+                   , not $ A.length arrRef == A.length arrImpl
+                   , not $ V.and $ V.zipWith similar
+                                (A.toVectors1 arrRef)
+                                (A.toVectors1 arrImpl)])
+         $ error $ render $ vcat
+                [ text "withRef1: failure " <> text name
+                , nest 4 $ pprp1v $ A.toVectors1 arrRef
+                , nest 4 $ pprp1  $ arrImpl ]
+
+        return arrImpl
+
+
+-- | Compare the nested result of some array operator against a reference.
+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)
+
+{-# INLINE withRef2 #-}
+withRef2 name arrRef arrImpl
+ = if debugLiftedCompare || debugLiftedTrace
+         then withRef2' name arrRef arrImpl
+         else arrImpl
+
+{-# NOINLINE withRef2' #-}
+withRef2' name arrRef arrImpl
+ = unsafePerformIO
+ $ do   when debugLiftedTrace
+         $ do putStrLn  $ "* " ++ name
+              putStrLn  $ render (nest 4 $ pprp1 arrImpl)
+              hFlush stdout
+
+        when ( debugLiftedCompare
+             && or [ not $ A.valid arrImpl
+                   , not $ A.length arrRef == A.length arrImpl
+                   , not $ V.and $ V.zipWith 
+                                (\xs ys -> V.and $ V.zipWith similar xs ys)
+                                (A.toVectors2 arrRef)
+                                (A.toVectors2 arrImpl) ])
+         $ error $ render $ vcat
+                [ text "withRef2: failure " <> text name
+                , nest 4 $ pprp1 arrImpl ]
+
+        return arrImpl
+
+
+-- toRef ----------------------------------------------------------------------
+-- | Convert an array to the reference version.
+toRef1  :: ( A.Array c a
+           , A.Array r a)
+        => c a -> r a
+
+toRef1  = A.fromVectors1 . A.toVectors1
+{-# NOINLINE toRef1 #-}
+--  NOINLINE because it's only for debugging.
+
+
+-- | Convert a nested array to the reference version.
+toRef2 :: ( A.Array c (c a)
+          , A.Array c a
+          , A.Array r (r a)
+          , A.Array r a)
+       => c (c a)
+       -> r (r a)
+
+toRef2  = A.fromVectors2 . A.toVectors2
+{-# NOINLINE toRef2 #-}
+--  NOINLINE because it's only for debugging.
+
+
+-- | Convert a doubly nested array to the reference version.
+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 (r (r a))
+
+toRef3  = A.fromVectors3 . A.toVectors3
+{-# NOINLINE toRef3 #-}
+--  NOINLINE because it's only for debugging.
index a0c1661..360b521 100644 (file)
@@ -15,7 +15,7 @@ Library
   Exposed-Modules:
         Data.Array.Parallel.PArray.Types
         Data.Array.Parallel.PArray.Reference
-        Data.Array.Parallel.PArray
+        Data.Array.Parallel.PArray.Reference.Convert
         Data.Array.Parallel.PArr
         
   Exposed:
@@ -43,7 +43,6 @@ Library
         ExistentialQuantification,
         ScopedTypeVariables,
         PatternGuards,
-        PackageImports,
         DeriveDataTypeable
 
   GHC-Options:
index 030d328..8e802a0 100644 (file)
@@ -69,19 +69,19 @@ import Data.Array.Parallel.Trace
 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 Data.Array.Parallel.PArray.Reference.Convert
 import GHC.Exts
 import Data.Vector                              (Vector)
 import Data.Array.Parallel.Base                 (Tag)
-import qualified Data.Array.Parallel.Pretty     as T
-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-base" Data.Array.Parallel.PArray           as R
-import qualified "dph-lifted-base" Data.Array.Parallel.PArray.Reference as R
+import qualified Data.Array.Parallel.Pretty                    as T
+import qualified Data.Array.Parallel.Array                     as A
+import qualified Data.Array.Parallel.Unlifted                  as U
+import qualified Data.Vector                                   as V
+import qualified Data.Array.Parallel.PArray.Reference          as R
+import qualified Data.Array.Parallel.PArray.Reference.Convert  as R
 import Data.Typeable
 
-import qualified Prelude                        as P
+import qualified Prelude                                       as P
 import Prelude hiding 
         ( length, replicate, concat
         , enumFromTo
index ef70e95..6e62e32 100644 (file)
@@ -83,7 +83,6 @@ Library
         ExistentialQuantification,
         ScopedTypeVariables,
         PatternGuards,
-        PackageImports,
         DeriveDataTypeable
 
   GHC-Options:
index 38d6fa3..76c957b 100644 (file)
@@ -39,28 +39,10 @@ jobCompile (JobCompile
        (time, (code, strOut, strErr))
          <- runTimedCommand
          $  systemTee False
-               ("ghc " ++ " -XCPP"
-                       ++ " -XBangPatterns"
-                       ++ " -XNoMonomorphismRestriction"
-                        ++ " -XTypeOperators"
-                        ++ " -XExistentialQuantification"
-                       ++ " -XRankNTypes"
-                       ++ " -XTypeFamilies"
-                        ++ " -XMultiParamTypeClasses"
-                       ++ " -XFlexibleInstances"
-                       ++ " -XFlexibleContexts"
-                       ++ " -XMagicHash"
-                       ++ " -XUnboxedTuples"
-                       ++ " -XTemplateHaskell"
-                       ++ " -XStandaloneDeriving"
+               ("ghc " ++ ghc_exts
                        ++ " -Idph-prim-interface/interface"
                        ++ " -Idph-base/include"
-                       ++ " -idph-test/framework"
-                       ++ " -idph-lifted-base"
-                       ++ " -idph-base"
-                       ++ " -idph-prim-par"
-                       ++ " -idph-prim-seq"
-                       ++ " -idph-lifted-vseg"
+                       ++ dph_code_includes
                        ++ " -package ghc"
                        ++ " -Odph -fno-liberate-case"
                        ++ " -outputdir " ++ buildDir 
@@ -83,3 +65,40 @@ jobCompile (JobCompile
        return  $  [ ResultAspect $ Time TotalWall `secs` ftime]
                ++ (if success then [] else [ResultUnexpectedFailure])
 
+
+ghc_exts :: String
+ghc_exts = concat
+       [ "-XBangPatterns "
+       , "-XCPP "
+       , "-XDeriveDataTypeable "
+       , "-XEmptyDataDecls "
+       , "-XExistentialQuantification "
+       , "-XExplicitForAll "
+       , "-XFlexibleContexts "
+       , "-XFlexibleInstances "
+       , "-XGADTs "
+       , "-XMagicHash "
+       , "-XMultiParamTypeClasses "
+       , "-XNoMonomorphismRestriction "
+       , "-XParallelListComp "
+       , "-XPatternGuards "
+       , "-XRankNTypes "
+       , "-XScopedTypeVariables "
+       , "-XStandaloneDeriving "
+       , "-XTemplateHaskell "
+       , "-XTypeFamilies "
+       , "-XTypeOperators "
+       , "-XUnboxedTuples "]
+
+
+dph_code_includes :: String
+dph_code_includes = concat $ map (" -i"++)
+       [ "dph-test/framework"
+       , "dph-base"
+       -- not dph-prim-interface
+       --
+       -- put prim-par before so par's Data.Array.Parallel.Unlifted is used
+       , "dph-prim-par"
+       , "dph-prim-seq"
+       , "dph-lifted-base"
+       , "dph-lifted-vseg" ]
index 0f17c2a..2c9d85a 100644 (file)
@@ -14,7 +14,7 @@ import DPH.Testsuite
 import Data.Array.Parallel.Array
 import Data.Array.Parallel.Base                 (Tag)
 import Data.Array.Parallel.Pretty
-import "dph-lifted-vseg" Data.Array.Parallel.PArray               (PA(..))
+import Data.Array.Parallel.PArray               (PA(..))
 import Data.Array.Parallel.PArray.PData.Base    ()
 import Data.Array.Parallel.PArray.PData
 import Data.Array.Parallel.PArray.PData.Nested
@@ -27,7 +27,7 @@ import Text.PrettyPrint                         as T
 import Prelude                                  as P
 import qualified Data.Vector                    as V
 import qualified Data.Array.Parallel.Unlifted   as U
-import qualified "dph-lifted-vseg" Data.Array.Parallel.PArray     as PA
+import qualified Data.Array.Parallel.PArray     as PA
 import qualified DPH.Operators.List             as L
 import System.IO.Unsafe
 import Debug.Trace
index 1b2c84b..e449e99 100644 (file)
@@ -3,9 +3,11 @@ import DPH.Testsuite
 import DPH.Arbitrary.Int
 import Data.Array.Parallel.Unlifted as U
 import Prelude as P
-
 import System.Random as R ( Random, StdGen, randoms, randomRs )
 
+(!:) = index "test:Basics"
+
+
 $(testcases [ ""        <@ [t| ( Bool, Int ) |]
             , "acc"     <@ [t| ( Int       ) |]
             , "num"     <@ [t| ( Int       ) |]
index dc95f21..2826883 100644 (file)
@@ -5,9 +5,11 @@ import DPH.Arbitrary.Perm
 import Data.Array.Parallel.Unlifted as U
 import qualified Data.Vector        as V
 import Prelude as P
-
 import Data.List ( sort )
 
+(!:) = index "test:Permutes"
+
+
 $(testcases [ ""        <@ [t| ( Bool, Int ) |]
             , "acc"     <@ [t| ( Int       ) |]
             , "num"     <@ [t| ( Int       ) |]
index cdaabb4..d5c3f93 100644 (file)
@@ -55,8 +55,10 @@ lifted-vseg : dph-lifted-vseg/Data/Array/Parallel/PArray.o
 # Dirs that contain real source files that we want to build.
 dph_src_dirs \
  =      dph-base \
+        dph-prim-interface \
         dph-prim-seq \
         dph-prim-par \
+        dph-lifted-base \
         dph-lifted-$(FRONTEND)
 
 # Dirs that contain .h files that we may way to #include
index 1fb4d3c..3ae52c4 100644 (file)
@@ -28,18 +28,34 @@ GHC_OPTS = \
 
 # GHC language extensions that DPH code needs.
 GHC_EXTS = \
-        -XCPP \
+       -XCPP \
+       -XFlexibleInstances \
+       -XGADTs \
+       -XMagicHash \
+       -XRankNTypes \
+       -XTypeFamilies \
+       -XTypeOperators \
+       -XUnboxedTuples \
         -XBangPatterns \
-        -XNoMonomorphismRestriction \
-        -XTypeOperators \
+        -XCPP \
+        -XDeriveDataTypeable \
+        -XEmptyDataDecls \
         -XExistentialQuantification \
-        -XRankNTypes \
-        -XTypeFamilies \
-        -XFlexibleInstances \
+        -XExplicitForAll \
         -XFlexibleContexts \
+        -XFlexibleInstances \
         -XMagicHash \
-        -XUnboxedTuples \
-        -XTemplateHaskell
+        -XMultiParamTypeClasses \
+        -XNoMonomorphismRestriction \
+        -XParallelListComp \
+        -XPatternGuards \
+        -XRankNTypes \
+        -XScopedTypeVariables \
+        -XStandaloneDeriving \
+        -XTemplateHaskell \
+        -XTypeFamilies \
+        -XTypeOperators \
+        -XUnboxedTuples
 
 # External packages that we need
 GHC_PACKAGES = \
index cf361cd..ab410cc 100644 (file)
@@ -1,10 +1,15 @@
 
+WAR_PACKAGES = \
+       stm \
+       parseargs \
+       buildbox
 
 dph-test/bin/war : $(shell find dph-test/framework -name "*.hs")
        @echo "* Build war test driver"
+       @mkdir -p dph-test/bin
        @$(GHC_FRAMEWORK) \
                -threaded \
-               -package stm \
+                $(patsubst %,-package %,$(WAR_PACKAGES)) \
                -idph-test/framework --make dph-test/framework/Main.hs -o dph-test/bin/war -threaded
        @echo
 
@@ -12,4 +17,4 @@ dph-test/bin/war : $(shell find dph-test/framework -name "*.hs")
 test-prims : dph-test/bin/war
        @echo "* Running tests"
        @dph-test/bin/war -d dph-test/test
-       @echo 
\ No newline at end of file
+       @echo