scan-vector-machine 0.0.1 → 0.2
raw patch · 10 files changed
+358/−3 lines, 10 filesdep +HUnitdep +acceleratedep +arraysetup-changed
Dependencies added: HUnit, accelerate, array, dph-par, haskell2010
Files
- AccelerateSVM.hs +22/−0
- DataParallelHaskellSVM.hs +24/−0
- NestedVectors.hs +45/−0
- ScanVectorMachine.hs +82/−1
- SegmentedScanVectorMachine.hs +59/−0
- SerialScanVectorMachine.hs +46/−0
- Setup.hs +0/−0
- Setup.lhs +0/−0
- Tests.hs +67/−0
- scan-vector-machine.cabal +13/−2
+ AccelerateSVM.hs view
@@ -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 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"
+ DataParallelHaskellSVM.hs view
@@ -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 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"
+ NestedVectors.hs view
@@ -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 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
ScanVectorMachine.hs view
@@ -1,2 +1,83 @@--- Placeholder+{-# 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 +
+ SegmentedScanVectorMachine.hs view
@@ -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 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
+ SerialScanVectorMachine.hs view
@@ -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 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')
+ Setup.hs view
− Setup.lhs
+ Tests.hs view
@@ -0,0 +1,67 @@+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
scan-vector-machine.cabal view
@@ -1,6 +1,6 @@ name: scan-vector-machine-version: 0.0.1-Cabal-Version: >= 1.2+version: 0.2+Cabal-Version: >= 1.8 build-type: Simple synopsis: An implementation of the Scan Vector Machine instruction set in Haskell license: BSD3@@ -11,3 +11,14 @@ library exposed-modules: ScanVectorMachine+ , SerialScanVectorMachine+ , SegmentedScanVectorMachine+ , NestedVectors+ , DataParallelHaskellSVM+ , AccelerateSVM+ build-depends: haskell2010, HUnit >=1.0, array, dph-par, accelerate++Test-Suite Test+ type: exitcode-stdio-1.0+ main-is: Tests.hs+ build-depends: haskell2010, HUnit >=1.0, array