From b6eb31f590dfeca14f33553b9abf3e2844e45bb6 Mon Sep 17 00:00:00 2001
From: Roman Leshchinskiy <rl@cse.unsw.edu.au>
Date: Tue, 27 Mar 2007 13:55:47 +0000
Subject: [PATCH] Add SpecConstr examples
---
examples/spec-constr/Makefile | 8 ++++
examples/spec-constr/Pipelines.hs | 20 +++++++++
examples/spec-constr/spec-constr.hs | 68 +++++++++++++++++++++++++++++
3 files changed, 96 insertions(+)
create mode 100644 examples/spec-constr/Makefile
create mode 100644 examples/spec-constr/Pipelines.hs
create mode 100644 examples/spec-constr/spec-constr.hs
diff --git a/examples/spec-constr/Makefile b/examples/spec-constr/Makefile
new file mode 100644
index 00000000..a78fb858
--- /dev/null
+++ b/examples/spec-constr/Makefile
@@ -0,0 +1,8 @@
+TESTDIR = ..
+PROGS = spec-constr
+include $(TESTDIR)/mk/test.mk
+
+spec-constr.o: Pipelines.hi
+
+spec-constr: Pipelines.o $(BENCHLIB)
+
diff --git a/examples/spec-constr/Pipelines.hs b/examples/spec-constr/Pipelines.hs
new file mode 100644
index 00000000..fbc4058b
--- /dev/null
+++ b/examples/spec-constr/Pipelines.hs
@@ -0,0 +1,20 @@
+module Pipelines where
+
+import Data.Array.Parallel.Unlifted
+
+pipe1 :: UArr Int -> UArr Int -> UArr Int
+pipe1 xs ys = mapU (+1) (xs +:+ ys)
+{-# NOINLINE pipe1 #-}
+
+pipe2 :: UArr Int -> UArr Int
+pipe2 = mapU (+1) . tailU
+{-# NOINLINE pipe2 #-}
+
+pipe3 :: UArr Int -> Int
+pipe3 = maximumU . scan1U (+)
+{-# NOINLINE pipe3 #-}
+
+pipe4 :: SUArr Int -> Int
+pipe4 = maximumU . sumSU
+{-# NOINLINE pipe4 #-}
+
diff --git a/examples/spec-constr/spec-constr.hs b/examples/spec-constr/spec-constr.hs
new file mode 100644
index 00000000..a3b88964
--- /dev/null
+++ b/examples/spec-constr/spec-constr.hs
@@ -0,0 +1,68 @@
+import Data.Array.Parallel.Unlifted
+
+import Bench.Benchmark
+import Bench.Options
+
+import System.Random
+import System.Console.GetOpt
+
+import Pipelines as P
+
+type Gen a = forall g. RandomGen g => Int -> g -> IO a
+
+data Algo = forall a b. Algo (a -> b) (Gen a)
+
+algs :: [(String, Algo)]
+algs = [("pipe1", Algo (uncurry pipe1) (uarr >< uarr))
+ ,("pipe2", Algo pipe2 uarr)
+ ,("pipe3", Algo pipe3 uarr)
+ ,("pipe4", Algo pipe4 suarr)
+ ]
+
+uarr :: (UA a, Random a) => Gen (UArr a)
+uarr n g = return $! randomU n g
+
+suarr :: (UA a, Random a) => Gen (SUArr a)
+suarr n g =
+ do let lens = replicateU (n `div` 10) (10 :: Int)
+ segd = lengthsToUSegd lens
+ n' = (n `div` 10) * 10
+ arr = randomU n' g
+ segd `seq` arr `seq` return (segd >: arr)
+
+(><) :: Gen a -> Gen b -> Gen (a,b)
+(h1 >< h2) n g = let (g1,g2) = split g
+ in
+ do x <- h1 n g1
+ y <- h2 n g2
+ return (x,y)
+
+randomGens :: RandomGen g => Int -> g -> [g]
+randomGens 0 g = []
+randomGens n g = let (g1,g2) = split g
+ in g1 : randomGens (n-1) g2
+
+main = ndpMain "SpecConstr test"
+ "[OPTION] ... SIZE"
+ run [Option ['a'] ["algo"] (ReqArg const "ALGORITHM")
+ "use the selected algorithm"]
+ "<none>"
+
+run opts alg sizes =
+ case lookup alg algs of
+ Nothing -> failWith ["Unknown algorithm"]
+ Just (Algo f gen) ->
+ case map read sizes of
+ [] -> failWith ["No sizes specified"]
+ szs -> do
+ g <- getStdGen
+ let gs = randomGens (length szs) g
+ benchmark opts f
+ (zipWith (mk gen) szs gs)
+ (const "")
+ return ()
+ where
+ mk gen n g = do
+ x <- gen n g
+ return $ ("N = " ++ show n) `mkPoint` x
+
--
GitLab