diff --git a/examples/spec-constr/Makefile b/examples/spec-constr/Makefile new file mode 100644 index 0000000000000000000000000000000000000000..a78fb85802ae16e22e14c3995122b8ffa2ee7b1e --- /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 0000000000000000000000000000000000000000..fbc4058bafaded1131c94b34ef0960402052198e --- /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 0000000000000000000000000000000000000000..a3b889640580f9306d22514118e2d4dcc975881f --- /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 +