Extend DPH_Header/Interface a little
authorManuel M T Chakravarty <chak@cse.unsw.edu.au>
Tue, 3 Mar 2009 13:04:51 +0000 (13:04 +0000)
committerManuel M T Chakravarty <chak@cse.unsw.edu.au>
Tue, 3 Mar 2009 13:04:51 +0000 (13:04 +0000)
dph-prim-interface/Data/Array/Parallel/Unlifted.hs
dph-prim-interface/interface/DPH_Header.h
dph-prim-interface/interface/DPH_Interface.h
dph-prim-par/Data/Array/Parallel/Unlifted.hs
dph-prim-seq/Data/Array/Parallel/Unlifted.hs
examples/smvm/Makefile
examples/smvm/SMVMVect.hs
examples/smvm/prim.hs [new file with mode: 0644]
examples/smvm/smvm.hs [deleted file]
examples/smvm/vect.hs [new file with mode: 0644]

index 815d8ba..4452f98 100644 (file)
@@ -107,9 +107,19 @@ enumFromThenTo_s = zipWith3 enumFromThenTo
 
 indexed_s = map indexed
 
+lengthsSegd = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.lengthsSegd"
+lengthsToSegd  = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.lengthsToSegd"
 toSegd = unpairS . unzip
+fromSegd = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.fromSegd"
 
 
+class Elt a => IOElt a
+hPut = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.hPut"
+hGet = P.error "Not implemented: dph-prim-interface:Data.Array.Parallel.Unlifted.hGet"
+
 toList x = x
 fromList x = x
 
+toList_s x = x
+fromList_s x = x
+
index af588b8..dd7dc70 100644 (file)
@@ -1,5 +1,5 @@
 module Data.Array.Parallel.Unlifted (
-  Elt, Array, SArray, Segd,
+  (:*:)(..), Elt, Array, SArray, Segd,
 
   length,
   empty, replicate, replicateEach, repeat, (+:+),
@@ -13,21 +13,22 @@ module Data.Array.Parallel.Unlifted (
 
   fold, fold1, and, sum, scan,
 
-  randoms, randomRs,
-
   (>:), concat, (^+:+^), length_s, lengths_s, replicate_s, indices_s,
   fst_s, snd_s, zip_s,
   bpermute_s', map_s, filter_s, pack_c, combine_c, zipWith_s,
   indexed_s,
   fold_s, fold1_s, sum_s,
   enumFromThenTo_s, replicate_s,
-  toSegd,
+  lengthsSegd, lengthsToSegd, toSegd, fromSegd,
+
+  randoms, randomRs, IOElt, hGet, hPut,
 
-  toList, fromList
+  toList, fromList, toList_s, fromList_s
 ) where
 
-import Data.Array.Parallel.Base   ( (:*:) )
+import Data.Array.Parallel.Base   ( (:*:)(..) )
 import Prelude                    (Num, Int, Bool, Double)
+import System.IO                  (IO, Handle)
 import Data.Word                  (Word8)
 import qualified System.Random
 
index 8c8a621..b076eb5 100644 (file)
@@ -110,15 +110,6 @@ enumFromToEach :: Int -> Array (Int :*: Int) -> Array Int
 {-# INLINE enumFromToEach #-}
 
 
-randoms :: (Elt a, System.Random.Random a, System.Random.RandomGen g)
-        => Int -> g -> Array a
-{-# INLINE randoms #-}
-
-randomRs :: (Elt a, System.Random.Random a, System.Random.RandomGen g)
-          => Int -> (a,a) -> g -> Array a
-{-# INLINE randomRs #-}
-
-
 concat :: Elt a => SArray a -> Array a
 {-# INLINE concat #-}
 
@@ -191,9 +182,37 @@ indexed_s :: Elt a => SArray a -> SArray (Int :*: a)
 {-# INLINE indexed_s #-}
 
 
+lengthsSegd :: Segd -> Array Int
+{-# INLINE lengthsSegd #-}
+
+lengthsToSegd :: Array Int -> Segd
+{-# INLINE lengthsToSegd #-}
+
 toSegd :: Array (Int :*: Int) -> Segd
 {-# INLINE toSegd #-}
 
+fromSegd :: Segd -> Array (Int :*: Int)
+{-# INLINE fromSegd #-}
+
+
+randoms :: (Elt a, System.Random.Random a, System.Random.RandomGen g)
+        => Int -> g -> Array a
+{-# INLINE randoms #-}
+
+randomRs :: (Elt a, System.Random.Random a, System.Random.RandomGen g)
+          => Int -> (a,a) -> g -> Array a
+{-# INLINE randomRs #-}
+
+
+instance IOElt Int
+instance IOElt Double
+instance (IOElt a, IOElt b) => IOElt (a :*: b)
+
+hPut :: IOElt a => Handle -> Array a -> IO ()
+{-# INLINE hPut #-}
+
+hGet :: IOElt a => Handle -> IO (Array a)
+{-# INLINE hGet #-}
 
 toList :: Elt a => Array a -> [a]
 {-# INLINE toList #-}
@@ -201,3 +220,9 @@ toList :: Elt a => Array a -> [a]
 fromList :: Elt a => [a] -> Array a
 {-# INLINE fromList #-}
 
+toList_s :: Elt a => SArray a -> [[a]]
+{-# INLINE toList_s #-}
+
+fromList_s :: Elt a => [[a]] -> SArray a
+{-# INLINE fromList_s #-}
+
index 87c0f8b..45959c3 100644 (file)
@@ -5,7 +5,7 @@
 import Data.Array.Parallel.Unlifted.Parallel
 import Data.Array.Parallel.Unlifted.Distributed ( DT )
 import Data.Array.Parallel.Unlifted.Sequential
-  hiding ((!:), (+:+), (>:), (^+:+^), toUSegd)
+  hiding ((!:), (+:+), (>:), (^+:+^))
 import qualified Data.Array.Parallel.Unlifted.Sequential
   as U
 
@@ -47,8 +47,6 @@ indexed = indexedUP
 enumFromTo = enumFromToUP
 enumFromThenTo = enumFromThenToUP
 enumFromToEach = enumFromToEachU
-randoms = randomU
-randomRs = randomRU
 concat = concatSU
 (>:) = (U.>:)
 (^+:+^) = (U.^+:+^)
@@ -70,6 +68,16 @@ fold1_s = fold1SU
 sum_s = sumSUP
 enumFromThenTo_s = enumFromThenToSUP
 indexed_s = indexedSUP
-toSegd = U.toUSegd
+lengthsSegd = lengthsUSegd
+lengthsToSegd  = lengthsToUSegd
+toSegd = toUSegd
+fromSegd = fromUSegd
+randoms = randomU
+randomRs = randomRU
+class UIO a => IOElt a
+hPut = hPutU
+hGet = hGetU
 toList = fromU
 fromList = toU
+toList_s = fromSU
+fromList_s = toSU
index b3708e2..b37cd8b 100644 (file)
@@ -3,7 +3,7 @@
 #include "DPH_Header.h"
 
 import Data.Array.Parallel.Unlifted.Sequential
-  hiding ((!:), (+:+), (>:), (^+:+^), toUSegd)
+  hiding ((!:), (+:+), (>:), (^+:+^))
 import qualified Data.Array.Parallel.Unlifted.Sequential
   as U
 
@@ -45,8 +45,6 @@ indexed = indexedU
 enumFromTo = enumFromToU
 enumFromThenTo = enumFromThenToU
 enumFromToEach = enumFromToEachU
-randoms = randomU
-randomRs = randomRU
 concat = concatSU
 (>:) = (U.>:)
 (^+:+^) = (U.^+:+^)
@@ -68,7 +66,17 @@ fold1_s = fold1SU
 sum_s = sumSU
 enumFromThenTo_s = enumFromThenToSU
 indexed_s = indexedSU
-toSegd = U.toUSegd
+lengthsSegd = lengthsUSegd
+lengthsToSegd  = lengthsToUSegd
+toSegd = toUSegd
+fromSegd = fromUSegd
+randoms = randomU
+randomRs = randomRU
+class UIO a => IOElt a
+hPut = hPutU
+hGet = hGetU
 toList = fromU
 fromList = toU
+toList_s = fromSU
+fromList_s = toSU
 
index 47a01bd..83346f9 100644 (file)
@@ -1,12 +1,16 @@
 TOPDIR = ..
-BINARIES = mksm smvm-c smvm prim
+BINARIES = smvm prim mksm smvm-c
 
 HCCFLAGS = -optc-O3
 
 smvm_DPH = smvm
-smvm_SOURCES = smvm.hs SMVMVect.hs
+smvm_SOURCES = vect.hs SMVMVect.hs
 
 prim_DPH = prim
 prim_SOURCES = prim.hs SMVMPrim.hs
 
-include $(TESTDIR)/mk/test.mk
+smvm-c_CSOURCES = smvm-c.c
+
+mksm_CSOURCES = mksm.c
+
+include $(TOPDIR)/mk/test.mk
index 1fe7744..bc0c045 100644 (file)
@@ -3,8 +3,8 @@
 module SMVMVect (smvm) where
 
 import Data.Array.Parallel.Prelude
-import Data.Array.Parallel.Prelude.Double
-import Data.Array.Parallel.Prelude.Int (Int)
+import Data.Array.Parallel.Prelude.Double as D
+import Data.Array.Parallel.Prelude.Int    as I
 
 import qualified Prelude
 
@@ -13,5 +13,5 @@ smvm :: PArray (PArray (Int, Double)) -> PArray Double -> PArray Double
 smvm m v = toPArrayP (smvm' (fromNestedPArrayP m) (fromPArrayP v))
 
 smvm' :: [:[: (Int, Double) :]:] -> [:Double:] -> [:Double:]
-smvm' m v = [: doubleSumP [: x * (v !: i) | (i,x) <- row :] | row <- m :]
-
+smvm' m v = [: D.sumP [: x D.* (v !: i) | (i,x) <- row :] | row <- m :]
+--smvm' m v = mapP (\row -> D.sumP (mapP (\(i, x) -> x D.* (v !: i)) row)) m
diff --git a/examples/smvm/prim.hs b/examples/smvm/prim.hs
new file mode 100644 (file)
index 0000000..55c7fab
--- /dev/null
@@ -0,0 +1,49 @@
+import SMVMPrim (smvm)
+
+import Control.Exception (evaluate)
+
+import Data.Array.Parallel.Unlifted
+import Data.Array.Parallel.Unlifted.Distributed
+import Data.Array.Parallel.Prelude
+
+import Bench.Benchmark
+import Bench.Options
+
+
+main = ndpMain "Sparse matrix/vector multiplication (primitives)"
+               "[OPTION] ... FILES ..."
+               run [] ()
+
+run opts () files
+  = do
+      benchmark opts smvm
+                (map loadSM files)
+                showRes
+      return ()
+  where
+    showRes arr = "sum = " ++ show (sumU arr)
+
+loadSM :: String -> IO (Point (SUArr (Int :*: Double), UArr Double))
+loadSM s@('(' : _) =
+  case reads s of
+    [((lm,lv), "")] -> return $ mkPoint "input" (toSU lm, toU lv)
+    _         -> failWith ["Invalid data " ++ s]
+loadSM fname =
+  do
+    h <- openBinaryFile fname ReadMode
+    lengths <- hGetU h
+    indices <- hGetU h
+    values  <- hGetU h
+    dv      <- hGetU h
+    let sm = lengthsToUSegd lengths >: zipU indices values
+    return (sm, values)
+    evaluate lengths
+    evaluate indices
+    evaluate values
+    evaluate dv
+    -- print (sumU values)
+    -- print (sumU dv)
+    return $ mkPoint (  "cols=" ++ show (lengthU dv) ++ ", "
+                     ++ "rows=" ++ show (lengthSU sm) ++ ", "
+                     ++ "elems=" ++ show (lengthU (concatSU sm)))
+              (sm,dv)
diff --git a/examples/smvm/smvm.hs b/examples/smvm/smvm.hs
deleted file mode 100644 (file)
index 17e3a09..0000000
+++ /dev/null
@@ -1,84 +0,0 @@
-import Data.Array.Parallel.Unlifted
-import Data.Array.Parallel.Unlifted.Distributed
-import Data.Array.Parallel.Prelude
-import qualified SMVMPar
-import qualified SMVMSeq
-import qualified SMVMVect
---import Timing
-
-import System.Console.GetOpt
-import System.IO
-{-
-import System.Exit
-import System.Environment  (getArgs)
--}
-import Control.Exception   (evaluate)
-{-
-import System.Mem          (performGC)
--}
-
-import Bench.Benchmark
-import Bench.Options
-
-type Alg = SUArr (Int :*: Double) -> UArr Double -> UArr Double
-
-algs = [("smvmp",  SMVMPar.smvm)
-       ,("smvms",  SMVMSeq.smvm)
-       ,("smvmv",  smvm_vect)
-       ]
-
-smvm_vect m v = toUArrPA (SMVMVect.smvm (fromSUArrPA_2' m) (fromUArrPA' v))
-
-main = ndpMain "Sparse matrix/vector multiplication"
-               "[OPTION] ... FILE ..."
-               run [Option ['a'] ["algo"] (ReqArg const "ALGORITHM")
-                      "use the specified algorithm"]
-                   "smvmp"
-
-run opts alg files =
-  case lookup alg algs of
-    Just f  -> procFiles opts f files
-    Nothing -> failWith ["Unknown algorithm " ++ alg]
-
-procFiles :: Options -> Alg -> [String] -> IO ()
-procFiles opts alg fs =
-  do
-    benchmark opts
-              (uncurry alg)
-              (map loadSM fs)
-              showRes
-    return ()
-  where
-    arg s = (cols, rows, ratio)
-      where
-        ((cols,('x':s')):_)  = reads s
-        ((rows,('@':s'')):_) = reads s'
-        ratio                = read s''
-
-    showRes arr = "sum=" ++ show (sumU arr)
-
-loadSM :: String -> IO (Point (SUArr (Int :*: Double), UArr Double))
-loadSM s@('(' : _) =
-  case reads s of
-    [((lm,lv), "")] -> return $ mkPoint "input" (toSU lm, toU lv)
-    _         -> failWith ["Invalid data " ++ s]
-loadSM fname =
-  do
-    h <- openBinaryFile fname ReadMode
-    lengths <- hGetU h
-    indices <- hGetU h
-    values  <- hGetU h
-    dv      <- hGetU h
-    let sm = lengthsToUSegd lengths >: zipU indices values
-    return (sm, values)
-    evaluate lengths
-    evaluate indices
-    evaluate values
-    evaluate dv
-    -- print (sumU values)
-    -- print (sumU dv)
-    return $ mkPoint (  "cols=" ++ show (lengthU dv) ++ ", "
-                     ++ "rows=" ++ show (lengthSU sm) ++ ", "
-                     ++ "elems=" ++ show (lengthU (concatSU sm)))
-              (sm,dv)
-
diff --git a/examples/smvm/vect.hs b/examples/smvm/vect.hs
new file mode 100644 (file)
index 0000000..344456a
--- /dev/null
@@ -0,0 +1,51 @@
+{-# LANGUAGE TypeOperators #-}
+
+import SMVMVect (smvm)
+
+import Control.Exception (evaluate)
+import System.IO
+
+import qualified Data.Array.Parallel.Unlifted as U
+import Data.Array.Parallel.Prelude
+
+import Bench.Benchmark
+import Bench.Options
+
+
+main = ndpMain "Sparse matrix/vector multiplication (vectorised)"
+               "[OPTION] ... FILES ..."
+               run [] ()
+
+run opts () files
+  = do
+      benchmark opts smvm
+                (map loadSM files)
+                showRes
+      return ()
+  where
+    showRes arr = "sum = " ++ show (U.sum arr)
+
+loadSM :: String -> IO (Point (U.SArray (Int U.:*: Double), U.Array Double))
+loadSM s@('(' : _) =
+  case reads s of
+    [((lm,lv), "")] -> return $ mkPoint "input" (U.fromList_s lm, U.fromList lv)
+    _         -> failWith ["Invalid data " ++ s]
+loadSM fname =
+  do
+    h <- openBinaryFile fname ReadMode
+    lengths <- U.hGet h
+    indices <- U.hGet h
+    values  <- U.hGet h
+    dv      <- U.hGet h
+    let sm = U.lengthsToSegd lengths U.>: U.zip indices values
+    return (sm, values)
+    evaluate lengths
+    evaluate indices
+    evaluate values
+    evaluate dv
+    -- print (sumU values)
+    -- print (sumU dv)
+    return $ mkPoint (  "cols=" ++ show (U.length dv) ++ ", "
+                     ++ "rows=" ++ show (U.length_s sm) ++ ", "
+                     ++ "elems=" ++ show (U.length (U.concat sm)))
+              (sm,dv)