diff --git a/AccelerateSVM.hs b/AccelerateSVM.hs deleted file mode 100644 --- a/AccelerateSVM.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-# LANGUAGE TypeFamilies, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-} - --- --- | An instance demonstrating that the @Data.Array.Accelerate@ --- library for GPU computation is able to support the SVM operations --- - -module AccelerateSVM where -import qualified Data.Array.Accelerate as Accelerate -import ScanVectorMachine as SVM - -instance Accelerate.IsScalar s => SVM.ScanVectorMachine (Accelerate.Array Accelerate.DIM1) s where - neg a = error "FIXME: not implemented" - leq a b = error "FIXME: not implemented" - op o a b = error "FIXME: not implemented" - select b x y = error "FIXME: not implemented" - permute a i = error "FIXME: not implemented" - insert a pos s = error "FIXME: not implemented" - extract a pos = error "FIXME: not implemented" - distribute s len = error "FIXME: not implemented" - length a = error "FIXME: not implemented" - scan o a = error "FIXME: not implemented" diff --git a/Control/Parallel/AccelerateSVM.hs b/Control/Parallel/AccelerateSVM.hs new file mode 100644 --- /dev/null +++ b/Control/Parallel/AccelerateSVM.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE TypeFamilies, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-} + +-- +-- | An instance demonstrating that the @Data.Array.Accelerate@ +-- library for GPU computation is able to support the SVM operations +-- + +module Control.Parallel.AccelerateSVM where +import qualified Data.Array.Accelerate as Accelerate +import Control.Parallel.ScanVectorMachine as SVM + +instance Accelerate.IsScalar s => SVM.ScanVectorMachine (Accelerate.Array Accelerate.DIM1) s where + neg a = error "FIXME: not implemented" + leq a b = error "FIXME: not implemented" + op o a b = error "FIXME: not implemented" + select b x y = error "FIXME: not implemented" + permute a i = error "FIXME: not implemented" + insert a pos s = error "FIXME: not implemented" + extract a pos = error "FIXME: not implemented" + distribute s len = error "FIXME: not implemented" + length a = error "FIXME: not implemented" + scan o a = error "FIXME: not implemented" diff --git a/Control/Parallel/DataParallelHaskellSVM.hs b/Control/Parallel/DataParallelHaskellSVM.hs new file mode 100644 --- /dev/null +++ b/Control/Parallel/DataParallelHaskellSVM.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE TypeFamilies, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, ParallelArrays #-} + +-- +-- | An instance demonstrating that the parallel arrays @[:s:]@ of +-- Data Parallel Haskell support the SVM operations. In truth this +-- is a bit backward: DPH is a high-level nested data parallel +-- language which ought to /compile down to/ something like SVM. +-- Unfortunately DPH's @mapP@ allows closures and uncontained +-- recursion into the parallel context, so this isn't possible. +-- +module Control.Parallel.DataParallelHaskellSVM where +import Control.Parallel.ScanVectorMachine as SVM + +instance Num s => SVM.ScanVectorMachine ([::]) s where + neg a = error "FIXME: not implemented" + leq a b = error "FIXME: not implemented" + op o a b = error "FIXME: not implemented" + select b x y = error "FIXME: not implemented" + permute a i = error "FIXME: not implemented" + insert a pos s = error "FIXME: not implemented" + extract a pos = error "FIXME: not implemented" + distribute s len = error "FIXME: not implemented" + length a = error "FIXME: not implemented" + scan o a = error "FIXME: not implemented" diff --git a/Control/Parallel/NestedVectors.hs b/Control/Parallel/NestedVectors.hs new file mode 100644 --- /dev/null +++ b/Control/Parallel/NestedVectors.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE TypeFamilies, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-} + +-- +-- | Given an instance of @ScanVectorMachine V' (V S)@, we can produce +-- a type @V''@ and instance @ScanVectorMachine V'' (V' (V S))@. In +-- other words, given an implementation of vectors with some nonzero +-- nesting depth, this will produce an implementation with nesting +-- depth /one level deeper/. +-- +-- This is different from @SegmentedVectors@, which uses flat +-- vectors (0-deep nesting) to emulate segmented vectors (1-deep +-- nesting) by cutting the size of the scalars in half. Here, there +-- is no need to assume that the flat-vector scalars are twice as +-- wide (in terms of bits) as the segmented scalars, so arbitrarily +-- deep nesting may be achieved without sacrificing any additional +-- bit-width. In addition, @NestedVectors@ introduces less overhead +-- than @SegmentedVectors@. For this reason, many hardware/platform +-- providers choose to implement @ScanVectorMachine V' (V S)@ +-- instead of @ScanVectorMachine (V S)@; this requires more work +-- (more methods to implement), but eliminates the overhead of +-- @SegmentedVectors@. +-- + +module Control.Parallel.NestedVectors where +import Control.Parallel.ScanVectorMachine as SVM + +-- private; isomorphic to (,) +data VecPair v = VecPair v v + +-- sanity check that the two vectors have identical segment descriptors; if not, raise an error +check_eq a b = a -- FIXME: implement; for now we just trust the user + +instance (SVM.ScanVectorMachine v s, + SVM.ScanVectorMachine v' (v s)) => + SVM.ScanVectorMachine VecPair (v' (v s)) where + neg (VecPair a alens) = undefined + leq (VecPair a alens) (VecPair b blens) = undefined + op o (VecPair a alens) (VecPair b blens) = undefined + select (VecPair b blens) (VecPair x xlens) (VecPair y ylens) = undefined + permute (VecPair a alens) (VecPair i ilens) = undefined + insert (VecPair a alens) pos v = undefined + extract (VecPair a alens) pos = undefined + distribute v len = undefined + length (VecPair a alens) = undefined + scan o (VecPair a alens) = undefined diff --git a/Control/Parallel/ScanVectorMachine.hs b/Control/Parallel/ScanVectorMachine.hs new file mode 100644 --- /dev/null +++ b/Control/Parallel/ScanVectorMachine.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-} +module Control.Parallel.ScanVectorMachine where + +-- | Scalar operations which may be performed on the elements of a +-- vector, either elementwise or in prefix-scan form. +data Op = And | Or | Min | Max | Plus | Times + +-- +-- | An instance of @ScanVectorMachine@ provides a scalar type @s@, +-- vectors of type @v s@ over that scalar of type, and the full +-- suite of Scan Vector Machine (SVM) operations (Blelloch'90, +-- page 60) on those vectors. The SVM instruction set is sometimes +-- referred to as /VCODE/ (CMU tech report CMU-CS-90-146-R). +-- +-- Only two changes have been made: (1) booleans are encoded as +-- scalars (zero is false, nonzero is true) and (2) Belloch's +-- elementwise subtraction has been replaced with a unary @neg@ +-- operation; this way the set of elementwise and scan operations are +-- the same (subtraction is not associative). +-- +-- Many of the names below overlap with those in the Prelude; we +-- recommend @import qualified ScanVectorMachine as SVM@ so that these +-- may be referred to as, for example, @SVM.length@. +-- +-- Notice that there is no @map :: (s -> s) -> v s -> v s@; this is +-- essential to keeping /closures/ and /uncontained recursion/ out of the +-- parallel context. See Blelloch 10.6.2 for the definition of +-- contained recursion. +-- +-- Also notice that only three operations involve communication +-- between different parts of the paralell context: @distribute@, +-- @scan@, and @permute@. The @distribute@ operation performs +-- broadcast communication from the serial context to the parallel +-- context. The @scan@ operation performs prefix scans, which have +-- very efficient communication patterns (do a local scan, then a +-- global tree reduction, then a local distribution, then an +-- elementwise operation). Only the @permute@ operation involves +-- complicated communication patterns. This is mitigated to some +-- extent by the requirement that @permute@ must be a /permutation/ of +-- the vector; it is an error to send two elements to the same +-- destination index, or to have a destination index to which no +-- element is sent. +-- +class ScanVectorMachine v s where + + -- | Scalar negation all of the elements of the vector. + neg :: v s -> v s + + -- | Elementwise less-than-or-equal-to comparison. Both vectors must be the same length. + leq :: v s -> v s -> v s + + -- | Elementwise operations (see @Op@). Both vectors must be the same length. + op :: Op -> v s -> v s -> v s + + -- | Prefix scan operations (see @Op@). + scan :: Op -> v s -> v s + + -- | If-then-else; @select b x y@ returns a vector whose @i@^th element is @if b[i] then x[i] else y[i]@. + -- All three vectors must be the same length. + select :: v s -> v s -> v s -> v s + + -- | Permutation: @permute v1 v2@ returns a vector @v3@ where @v3[v2[i]] = v1[i]@ for all @i@. Both vectors + -- must be the same length and the elements of @v2@ must all be distinct, non-negative, and + -- less than the lengths of the vectors. + permute :: v s -> v s -> v s + + -- | Replaces an element of a vector; @insert v s i e@ sets @i@^th element of the vector to @s@. The scalar @i@ must be + -- nonnegative and less than the length of the vector. This instruction implements unicast communication from the + -- serial context to the parallel context. + insert :: v s -> s -> s -> v s + + -- | Extracts an element of a vector; @extract v i@ yields @v[i]@. The scalar @i@ must be nonnegative and less than + -- the length of the vector. This instruction implements communication from the parallel context to the serial context. + extract :: v s -> s -> s + + -- | Creates a new vector; @distribute s n@ creates a vector of length @n@ whose elements are all @s@. + -- This instruction implements communication from the parallel context to the serial context. + distribute :: s -> s -> v s + + -- | Returns the length of a parallel vector. These can be cached in the serial context since the length of a vector + -- never depends on data from the paralell context; as a result @length@ does not actually involve communication. + length :: v s -> s + diff --git a/Control/Parallel/SegmentedScanVectorMachine.hs b/Control/Parallel/SegmentedScanVectorMachine.hs new file mode 100644 --- /dev/null +++ b/Control/Parallel/SegmentedScanVectorMachine.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE TypeFamilies, FlexibleInstances, MultiParamTypeClasses #-} + +-- | An instance of @SegmentedScanVectorMachine@ provides a scalar +-- type @s@, a vector type @v@, and a segmented vector +-- (vector-of-vectors) type @v'@ such that @v@ implements the SVM +-- operations over @s@ /and/ @v'@ implements the SVM operations over +-- @v s@. +-- +-- This file contains a default instance for @ScanVectorMachine V' (V S)@, +-- given an instance @ScanVectorMachine V S@. In other words, given an +-- implementation of vectors-of-scalars, this will produce an +-- implementation of vectors-of-vectors-of-scalars. +-- +-- This new type @V'@ provides SVM operations over +-- vectors-of-vectors-of-scalars; from the perspective of @V'@, the +-- vectors-of-scalars are called /segments/. Notice that @V'@ uses +-- vectors-of-scalars wherever ordinary scalars were previously +-- used. For example, when the /length/ operation is applied to a +-- vector-of-vectors the result is not a scalar, but rather a +-- vector-of-scalars giving the lengths of each of the segments. +-- This phenomenon is crucial to the replication theorem and +-- flattening transformation. +-- +-- It turns out that @V'@ is basically @(,)@ -- but this is not +-- exposed to the user. Blelloch outlines three encodings (figure +-- 4.2): head-flags, length, and head-pointer. The implementation +-- below uses the /length/ style since it can represent zero-length +-- vectors efficiently. +-- +-- It is sometimes advantageous for hardware/platform providers to +-- implement vectors-of-vectors-of-scalars directly (see +-- @NestedVectors.hs@ for the reasoning). To do this, implement the +-- class @SegmentedScanVectorMachine@ below. + +module Control.Parallel.SegmentedScanVectorMachine(SegmentedScanVectorMachine) where +import Control.Parallel.ScanVectorMachine as SVM + +-- sanity check that the two vectors have identical segment descriptors; if not, raise an error +check_eq a b = a -- FIXME: implement; for now we just trust the user + +class (SVM.ScanVectorMachine v s, + SVM.ScanVectorMachine v' (v' (v s))) => + SegmentedScanVectorMachine v' v s + +-- private; isomorphic to (,) +data SegVec v = SegVec v v + +-- | Default implementation of segments using an auxiliary segment-length vector +instance SVM.ScanVectorMachine v s => SVM.ScanVectorMachine SegVec (v s) where + neg (SegVec a alens) = SegVec (neg a) alens + leq (SegVec a alens) (SegVec b blens) = SegVec (leq a b) (check_eq alens blens) + op o (SegVec a alens) (SegVec b blens) = SegVec (op o a b) (check_eq alens blens) + select (SegVec b blens) (SegVec x xlens) (SegVec y ylens) = SegVec (select b x y) (check_eq blens (check_eq xlens ylens)) + permute (SegVec a alens) (SegVec i ilens) = undefined + insert (SegVec a alens) pos v = undefined + extract (SegVec a alens) pos = undefined + distribute v len = undefined + length (SegVec a alens) = undefined + scan o (SegVec a alens) = undefined diff --git a/Control/Parallel/SerialScanVectorMachine.hs b/Control/Parallel/SerialScanVectorMachine.hs new file mode 100644 --- /dev/null +++ b/Control/Parallel/SerialScanVectorMachine.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE TypeFamilies, FlexibleInstances, MultiParamTypeClasses #-} + +-- | A crude implementation of the ScanVectorMachine class using +-- Data.Array.IArray; no parallelism. Warning: outrageously +-- inefficient code ahead! + +module Control.Parallel.SerialScanVectorMachine(SSVM) where +import Data.Array.IArray +import Control.Parallel.ScanVectorMachine as SVM + +newtype SSVM e = SSVM { unSSVM :: Array e e } + +-- Array zip +azip :: Ix idx => Array idx e1 -> Array idx e2 -> Array idx (e1,e2) +azip x y = array (start, end) $ map (\i -> (i,((x!i),(y!i)))) (range (start,end)) + where + (xmin,xmax) = bounds x + (ymin,ymax) = bounds y + start = max xmin ymin + end = min xmax ymax + +op2func :: (Ix e, Ord e, Num e) => SVM.Op -> (e -> e -> e) +op2func And x y = if x/=0 && y/=0 then 1 else 0 +op2func Or x y = if x/=0 || y/=0 then 1 else 0 +op2func Min x y = if x < y then x else y +op2func Max x y = if x > y then x else y +op2func Plus x y = x+y +op2func Times x y = x*y + +instance (Ix e, Show e) => Show (SSVM e) where + show (SSVM a) = show $ elems a + +instance (Enum e, Ix e, Ord e, Num e) => SVM.ScanVectorMachine SSVM e where + neg (SSVM a) = SSVM $ amap (\x -> if x==0 then 1 else 0) a + leq (SSVM a) (SSVM b) = SSVM $ amap (\(x,y) -> if x <= y then 1 else 0) $ azip a b + op op (SSVM a) (SSVM b) = SSVM $ amap (uncurry $ op2func op) $ azip a b + select (SSVM b) (SSVM x) (SSVM y) = SSVM $ amap (\(b,(x,y)) -> if b/=0 then x else y) $ azip b (azip x y) + permute (SSVM a) (SSVM i) = SSVM $ array (bounds a) $ zip (elems i) (elems a) + insert (SSVM a) pos v = SSVM $ a // [(pos,v)] + extract (SSVM a) pos = a ! pos + distribute v len = SSVM $ array (0,(len-1)) [ (i,v) | i <- [0..(len-1)] ] + length (SSVM a) = max 0 (end-start+fromInteger 1) where (start,end) = bounds a + scan op (SSVM a) = SSVM $ array (bounds a) $ (0,0):(drop 1 result) + where + result = fst $ foldl mapfunc ([],0) (assocs a) + mapfunc (ret,acc) (i,e) = let acc' = op2func op e acc in (((i+1,acc'):ret),acc') diff --git a/Control/Parallel/Tests.hs b/Control/Parallel/Tests.hs new file mode 100644 --- /dev/null +++ b/Control/Parallel/Tests.hs @@ -0,0 +1,67 @@ +module Main(main) where +import Test.HUnit +import qualified Control.Parallel.ScanVectorMachine as SVM +import Control.Parallel.SerialScanVectorMachine +import System.Exit + +ones :: SSVM Int +ones = SVM.distribute 1 20 + +count :: SSVM Int +count = SVM.scan SVM.Plus ones + +mkLiteral :: [Int] -> SSVM Int +mkLiteral vals = let zeroes = SVM.distribute 0 (length vals) + in foldl (\vec -> \(i,e) -> SVM.insert vec i e) zeroes $ zip [0..(length vals-1)] vals + + +example_a = mkLiteral [5,1,3,4,3,9,2,6] +example_b = mkLiteral [2,5,3,8,1,3,6,2] +example_f = mkLiteral [1,0,0,0,1,1,0,1] +example_i = mkLiteral [2,5,4,3,1,6,0,7] + +main = do result <- + runTestTT $ TestList + -- section 4.1.2 of Blelloch's book + [ TestCase $ assertEqual "Ble90 4.1.2: A+B" + "[7,6,6,12,4,12,8,8]" + $ show $ SVM.op SVM.Plus example_a example_b + , TestCase $ assertEqual "Ble90 4.1.2: A*B" + "[10,5,9,32,3,27,12,12]" + $ show $ SVM.op SVM.Times example_a example_b + , TestCase $ assertEqual "Ble90 4.1.2: select(F,A,B)" + "[5,5,3,8,3,9,6,6]" + $ show $ SVM.select example_f example_a example_b + + -- section 4.1.3 of Blelloch's book + , TestCase $ assertEqual "Ble90 4.1.3: permute(A,I)" + "[-6,-4,0,-3,-2,-1,-5,-7]" + $ show $ SVM.permute (mkLiteral [0,-1,-2,-3,-4,-5,-6,-7]) example_i + + -- section 4.1.4 of Blelloch's book + , TestCase $ assertEqual "Ble90 4.1.4: A" + "[5,1,3,4,3,9,2,6]" + $ show example_a + , TestCase $ assertEqual "Ble90 4.1.4: +-scan(A)" + "[0,5,6,9,13,16,25,27]" + $ show $ SVM.scan SVM.Plus example_a + , TestCase $ assertEqual "Ble90 4.1.4: max-scan(A)" + "[0,5,5,5,5,5,9,9]" + $ show $ SVM.scan SVM.Max example_a + + -- section 4.1.5 of Blelloch's book + , TestCase $ assertEqual "Ble90 4.1.5: insert(A,3,999)" + "[5,1,3,999,3,9,2,6]" + $ show $ SVM.insert example_a 3 999 + , TestCase $ assertEqual "Ble90 4.1.5: extract(A,3)" + "4" + $ show $ SVM.extract example_a 3 + , TestCase $ assertEqual "Ble90 4.1.5: distribute(999,5)" + "[999,999,999,999,999]" + $ show $ (SVM.distribute 999 5 :: SSVM Int) + , TestCase $ assertEqual "Ble90 4.1.5: length(A)" + "8" + $ show $ SVM.length example_a + ] + let bad = errors result + failures result + System.Exit.exitWith $ if bad == 0 then ExitSuccess else ExitFailure bad diff --git a/DataParallelHaskellSVM.hs b/DataParallelHaskellSVM.hs deleted file mode 100644 --- a/DataParallelHaskellSVM.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# LANGUAGE TypeFamilies, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, ParallelArrays #-} - --- --- | An instance demonstrating that the parallel arrays @[:s:]@ of --- Data Parallel Haskell support the SVM operations. In truth this --- is a bit backward: DPH is a high-level nested data parallel --- language which ought to /compile down to/ something like SVM. --- Unfortunately DPH's @mapP@ allows closures and uncontained --- recursion into the parallel context, so this isn't possible. --- -module DataParallelHaskellSVM where -import ScanVectorMachine as SVM - -instance Num s => SVM.ScanVectorMachine ([::]) s where - neg a = error "FIXME: not implemented" - leq a b = error "FIXME: not implemented" - op o a b = error "FIXME: not implemented" - select b x y = error "FIXME: not implemented" - permute a i = error "FIXME: not implemented" - insert a pos s = error "FIXME: not implemented" - extract a pos = error "FIXME: not implemented" - distribute s len = error "FIXME: not implemented" - length a = error "FIXME: not implemented" - scan o a = error "FIXME: not implemented" diff --git a/NestedVectors.hs b/NestedVectors.hs deleted file mode 100644 --- a/NestedVectors.hs +++ /dev/null @@ -1,45 +0,0 @@ -{-# LANGUAGE TypeFamilies, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-} - --- --- | Given an instance of @ScanVectorMachine V' (V S)@, we can produce --- a type @V''@ and instance @ScanVectorMachine V'' (V' (V S))@. In --- other words, given an implementation of vectors with some nonzero --- nesting depth, this will produce an implementation with nesting --- depth /one level deeper/. --- --- This is different from @SegmentedVectors@, which uses flat --- vectors (0-deep nesting) to emulate segmented vectors (1-deep --- nesting) by cutting the size of the scalars in half. Here, there --- is no need to assume that the flat-vector scalars are twice as --- wide (in terms of bits) as the segmented scalars, so arbitrarily --- deep nesting may be achieved without sacrificing any additional --- bit-width. In addition, @NestedVectors@ introduces less overhead --- than @SegmentedVectors@. For this reason, many hardware/platform --- providers choose to implement @ScanVectorMachine V' (V S)@ --- instead of @ScanVectorMachine (V S)@; this requires more work --- (more methods to implement), but eliminates the overhead of --- @SegmentedVectors@. --- - -module NestedVectors where -import ScanVectorMachine as SVM - --- private; isomorphic to (,) -data VecPair v = VecPair v v - --- sanity check that the two vectors have identical segment descriptors; if not, raise an error -check_eq a b = a -- FIXME: implement; for now we just trust the user - -instance (SVM.ScanVectorMachine v s, - SVM.ScanVectorMachine v' (v s)) => - SVM.ScanVectorMachine VecPair (v' (v s)) where - neg (VecPair a alens) = undefined - leq (VecPair a alens) (VecPair b blens) = undefined - op o (VecPair a alens) (VecPair b blens) = undefined - select (VecPair b blens) (VecPair x xlens) (VecPair y ylens) = undefined - permute (VecPair a alens) (VecPair i ilens) = undefined - insert (VecPair a alens) pos v = undefined - extract (VecPair a alens) pos = undefined - distribute v len = undefined - length (VecPair a alens) = undefined - scan o (VecPair a alens) = undefined diff --git a/ScanVectorMachine.hs b/ScanVectorMachine.hs deleted file mode 100644 --- a/ScanVectorMachine.hs +++ /dev/null @@ -1,83 +0,0 @@ -{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-} -module ScanVectorMachine where - --- | Scalar operations which may be performed on the elements of a --- vector, either elementwise or in prefix-scan form. -data Op = And | Or | Min | Max | Plus | Times - --- --- | An instance of @ScanVectorMachine@ provides a scalar type @s@, --- vectors of type @v s@ over that scalar of type, and the full --- suite of Scan Vector Machine (SVM) operations (Blelloch'90, --- page 60) on those vectors. The SVM instruction set is sometimes --- referred to as /VCODE/ (CMU tech report CMU-CS-90-146-R). --- --- Only two changes have been made: (1) booleans are encoded as --- scalars (zero is false, nonzero is true) and (2) Belloch's --- elementwise subtraction has been replaced with a unary @neg@ --- operation; this way the set of elementwise and scan operations are --- the same (subtraction is not associative). --- --- Many of the names below overlap with those in the Prelude; we --- recommend @import qualified ScanVectorMachine as SVM@ so that these --- may be referred to as, for example, @SVM.length@. --- --- Notice that there is no @map :: (s -> s) -> v s -> v s@; this is --- essential to keeping /closures/ and /uncontained recursion/ out of the --- parallel context. See Blelloch 10.6.2 for the definition of --- contained recursion. --- --- Also notice that only three operations involve communication --- between different parts of the paralell context: @distribute@, --- @scan@, and @permute@. The @distribute@ operation performs --- broadcast communication from the serial context to the parallel --- context. The @scan@ operation performs prefix scans, which have --- very efficient communication patterns (do a local scan, then a --- global tree reduction, then a local distribution, then an --- elementwise operation). Only the @permute@ operation involves --- complicated communication patterns. This is mitigated to some --- extent by the requirement that @permute@ must be a /permutation/ of --- the vector; it is an error to send two elements to the same --- destination index, or to have a destination index to which no --- element is sent. --- -class ScanVectorMachine v s where - - -- | Scalar negation all of the elements of the vector. - neg :: v s -> v s - - -- | Elementwise less-than-or-equal-to comparison. Both vectors must be the same length. - leq :: v s -> v s -> v s - - -- | Elementwise operations (see @Op@). Both vectors must be the same length. - op :: Op -> v s -> v s -> v s - - -- | Prefix scan operations (see @Op@). - scan :: Op -> v s -> v s - - -- | If-then-else; @select b x y@ returns a vector whose @i@^th element is @if b[i] then x[i] else y[i]@. - -- All three vectors must be the same length. - select :: v s -> v s -> v s -> v s - - -- | Permutation: @permute v1 v2@ returns a vector @v3@ where @v3[v2[i]] = v1[i]@ for all @i@. Both vectors - -- must be the same length and the elements of @v2@ must all be distinct, non-negative, and - -- less than the lengths of the vectors. - permute :: v s -> v s -> v s - - -- | Replaces an element of a vector; @insert v s i e@ sets @i@^th element of the vector to @s@. The scalar @i@ must be - -- nonnegative and less than the length of the vector. This instruction implements unicast communication from the - -- serial context to the parallel context. - insert :: v s -> s -> s -> v s - - -- | Extracts an element of a vector; @extract v i@ yields @v[i]@. The scalar @i@ must be nonnegative and less than - -- the length of the vector. This instruction implements communication from the parallel context to the serial context. - extract :: v s -> s -> s - - -- | Creates a new vector; @distribute s n@ creates a vector of length @n@ whose elements are all @s@. - -- This instruction implements communication from the parallel context to the serial context. - distribute :: s -> s -> v s - - -- | Returns the length of a parallel vector. These can be cached in the serial context since the length of a vector - -- never depends on data from the paralell context; as a result @length@ does not actually involve communication. - length :: v s -> s - diff --git a/SegmentedScanVectorMachine.hs b/SegmentedScanVectorMachine.hs deleted file mode 100644 --- a/SegmentedScanVectorMachine.hs +++ /dev/null @@ -1,59 +0,0 @@ -{-# LANGUAGE TypeFamilies, FlexibleInstances, MultiParamTypeClasses #-} - --- | An instance of @SegmentedScanVectorMachine@ provides a scalar --- type @s@, a vector type @v@, and a segmented vector --- (vector-of-vectors) type @v'@ such that @v@ implements the SVM --- operations over @s@ /and/ @v'@ implements the SVM operations over --- @v s@. --- --- This file contains a default instance for @ScanVectorMachine V' (V S)@, --- given an instance @ScanVectorMachine V S@. In other words, given an --- implementation of vectors-of-scalars, this will produce an --- implementation of vectors-of-vectors-of-scalars. --- --- This new type @V'@ provides SVM operations over --- vectors-of-vectors-of-scalars; from the perspective of @V'@, the --- vectors-of-scalars are called /segments/. Notice that @V'@ uses --- vectors-of-scalars wherever ordinary scalars were previously --- used. For example, when the /length/ operation is applied to a --- vector-of-vectors the result is not a scalar, but rather a --- vector-of-scalars giving the lengths of each of the segments. --- This phenomenon is crucial to the replication theorem and --- flattening transformation. --- --- It turns out that @V'@ is basically @(,)@ -- but this is not --- exposed to the user. Blelloch outlines three encodings (figure --- 4.2): head-flags, length, and head-pointer. The implementation --- below uses the /length/ style since it can represent zero-length --- vectors efficiently. --- --- It is sometimes advantageous for hardware/platform providers to --- implement vectors-of-vectors-of-scalars directly (see --- @NestedVectors.hs@ for the reasoning). To do this, implement the --- class @SegmentedScanVectorMachine@ below. - -module SegmentedScanVectorMachine(SegmentedScanVectorMachine) where -import ScanVectorMachine as SVM - --- sanity check that the two vectors have identical segment descriptors; if not, raise an error -check_eq a b = a -- FIXME: implement; for now we just trust the user - -class (SVM.ScanVectorMachine v s, - SVM.ScanVectorMachine v' (v' (v s))) => - SegmentedScanVectorMachine v' v s - --- private; isomorphic to (,) -data SegVec v = SegVec v v - --- | Default implementation of segments using an auxiliary segment-length vector -instance SVM.ScanVectorMachine v s => SVM.ScanVectorMachine SegVec (v s) where - neg (SegVec a alens) = SegVec (neg a) alens - leq (SegVec a alens) (SegVec b blens) = SegVec (leq a b) (check_eq alens blens) - op o (SegVec a alens) (SegVec b blens) = SegVec (op o a b) (check_eq alens blens) - select (SegVec b blens) (SegVec x xlens) (SegVec y ylens) = SegVec (select b x y) (check_eq blens (check_eq xlens ylens)) - permute (SegVec a alens) (SegVec i ilens) = undefined - insert (SegVec a alens) pos v = undefined - extract (SegVec a alens) pos = undefined - distribute v len = undefined - length (SegVec a alens) = undefined - scan o (SegVec a alens) = undefined diff --git a/SerialScanVectorMachine.hs b/SerialScanVectorMachine.hs deleted file mode 100644 --- a/SerialScanVectorMachine.hs +++ /dev/null @@ -1,46 +0,0 @@ -{-# LANGUAGE TypeFamilies, FlexibleInstances, MultiParamTypeClasses #-} - --- | A crude implementation of the ScanVectorMachine class using --- Data.Array.IArray; no parallelism. Warning: outrageously --- inefficient code ahead! - -module SerialScanVectorMachine(SSVM) where -import Data.Array.IArray -import ScanVectorMachine as SVM - -newtype SSVM e = SSVM { unSSVM :: Array e e } - --- Array zip -azip :: Ix idx => Array idx e1 -> Array idx e2 -> Array idx (e1,e2) -azip x y = array (start, end) $ map (\i -> (i,((x!i),(y!i)))) (range (start,end)) - where - (xmin,xmax) = bounds x - (ymin,ymax) = bounds y - start = max xmin ymin - end = min xmax ymax - -op2func :: (Ix e, Ord e, Num e) => SVM.Op -> (e -> e -> e) -op2func And x y = if x/=0 && y/=0 then 1 else 0 -op2func Or x y = if x/=0 || y/=0 then 1 else 0 -op2func Min x y = if x < y then x else y -op2func Max x y = if x > y then x else y -op2func Plus x y = x+y -op2func Times x y = x*y - -instance (Ix e, Show e) => Show (SSVM e) where - show (SSVM a) = show $ elems a - -instance (Enum e, Ix e, Ord e, Num e) => SVM.ScanVectorMachine SSVM e where - neg (SSVM a) = SSVM $ amap (\x -> if x==0 then 1 else 0) a - leq (SSVM a) (SSVM b) = SSVM $ amap (\(x,y) -> if x <= y then 1 else 0) $ azip a b - op op (SSVM a) (SSVM b) = SSVM $ amap (uncurry $ op2func op) $ azip a b - select (SSVM b) (SSVM x) (SSVM y) = SSVM $ amap (\(b,(x,y)) -> if b/=0 then x else y) $ azip b (azip x y) - permute (SSVM a) (SSVM i) = SSVM $ array (bounds a) $ zip (elems i) (elems a) - insert (SSVM a) pos v = SSVM $ a // [(pos,v)] - extract (SSVM a) pos = a ! pos - distribute v len = SSVM $ array (0,(len-1)) [ (i,v) | i <- [0..(len-1)] ] - length (SSVM a) = max 0 (end-start+fromInteger 1) where (start,end) = bounds a - scan op (SSVM a) = SSVM $ array (bounds a) $ (0,0):(drop 1 result) - where - result = fst $ foldl mapfunc ([],0) (assocs a) - mapfunc (ret,acc) (i,e) = let acc' = op2func op e acc in (((i+1,acc'):ret),acc') diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs diff --git a/Tests.hs b/Tests.hs deleted file mode 100644 --- a/Tests.hs +++ /dev/null @@ -1,67 +0,0 @@ -module Main(main) where -import Test.HUnit -import qualified ScanVectorMachine as SVM -import SerialScanVectorMachine -import System.Exit - -ones :: SSVM Int -ones = SVM.distribute 1 20 - -count :: SSVM Int -count = SVM.scan SVM.Plus ones - -mkLiteral :: [Int] -> SSVM Int -mkLiteral vals = let zeroes = SVM.distribute 0 (length vals) - in foldl (\vec -> \(i,e) -> SVM.insert vec i e) zeroes $ zip [0..(length vals-1)] vals - - -example_a = mkLiteral [5,1,3,4,3,9,2,6] -example_b = mkLiteral [2,5,3,8,1,3,6,2] -example_f = mkLiteral [1,0,0,0,1,1,0,1] -example_i = mkLiteral [2,5,4,3,1,6,0,7] - -main = do result <- - runTestTT $ TestList - -- section 4.1.2 of Blelloch's book - [ TestCase $ assertEqual "Ble90 4.1.2: A+B" - "[7,6,6,12,4,12,8,8]" - $ show $ SVM.op SVM.Plus example_a example_b - , TestCase $ assertEqual "Ble90 4.1.2: A*B" - "[10,5,9,32,3,27,12,12]" - $ show $ SVM.op SVM.Times example_a example_b - , TestCase $ assertEqual "Ble90 4.1.2: select(F,A,B)" - "[5,5,3,8,3,9,6,6]" - $ show $ SVM.select example_f example_a example_b - - -- section 4.1.3 of Blelloch's book - , TestCase $ assertEqual "Ble90 4.1.3: permute(A,I)" - "[-6,-4,0,-3,-2,-1,-5,-7]" - $ show $ SVM.permute (mkLiteral [0,-1,-2,-3,-4,-5,-6,-7]) example_i - - -- section 4.1.4 of Blelloch's book - , TestCase $ assertEqual "Ble90 4.1.4: A" - "[5,1,3,4,3,9,2,6]" - $ show example_a - , TestCase $ assertEqual "Ble90 4.1.4: +-scan(A)" - "[0,5,6,9,13,16,25,27]" - $ show $ SVM.scan SVM.Plus example_a - , TestCase $ assertEqual "Ble90 4.1.4: max-scan(A)" - "[0,5,5,5,5,5,9,9]" - $ show $ SVM.scan SVM.Max example_a - - -- section 4.1.5 of Blelloch's book - , TestCase $ assertEqual "Ble90 4.1.5: insert(A,3,999)" - "[5,1,3,999,3,9,2,6]" - $ show $ SVM.insert example_a 3 999 - , TestCase $ assertEqual "Ble90 4.1.5: extract(A,3)" - "4" - $ show $ SVM.extract example_a 3 - , TestCase $ assertEqual "Ble90 4.1.5: distribute(999,5)" - "[999,999,999,999,999]" - $ show $ (SVM.distribute 999 5 :: SSVM Int) - , TestCase $ assertEqual "Ble90 4.1.5: length(A)" - "8" - $ show $ SVM.length example_a - ] - let bad = errors result + failures result - System.Exit.exitWith $ if bad == 0 then ExitSuccess else ExitFailure bad diff --git a/scan-vector-machine.cabal b/scan-vector-machine.cabal --- a/scan-vector-machine.cabal +++ b/scan-vector-machine.cabal @@ -1,5 +1,5 @@ name: scan-vector-machine -version: 0.2 +version: 0.2.1 Cabal-Version: >= 1.8 build-type: Simple synopsis: An implementation of the Scan Vector Machine instruction set in Haskell @@ -10,15 +10,15 @@ license-file: LICENSE library - exposed-modules: ScanVectorMachine - , SerialScanVectorMachine - , SegmentedScanVectorMachine - , NestedVectors - , DataParallelHaskellSVM - , AccelerateSVM + exposed-modules: Control.Parallel.ScanVectorMachine + , Control.Parallel.SerialScanVectorMachine + , Control.Parallel.SegmentedScanVectorMachine + , Control.Parallel.NestedVectors + , Control.Parallel.DataParallelHaskellSVM + , Control.Parallel.AccelerateSVM build-depends: haskell2010, HUnit >=1.0, array, dph-par, accelerate Test-Suite Test type: exitcode-stdio-1.0 - main-is: Tests.hs + main-is: Control/Parallel/Tests.hs build-depends: haskell2010, HUnit >=1.0, array