[commit: ghc] ghc-lwc2: Refactoring tests (fa74214)
Sivaramakrishnan Krishnamoorthy Chandrasekaran
t-sichan at microsoft.com
Wed May 8 07:50:41 CEST 2013
Repository : http://darcs.haskell.org/ghc.git/
On branch : ghc-lwc2
https://github.com/ghc/ghc/commit/fa74214b0870791c55e82fd5aa2e78c7785a2d43
>---------------------------------------------------------------
commit fa74214b0870791c55e82fd5aa2e78c7785a2d43
Author: KC Sivaramakrishnan <chandras at cs.purdue.edu>
Date: Wed May 8 01:50:04 2013 -0400
Refactoring tests
>---------------------------------------------------------------
tests/Benchmarks/KNucleotide/k-nucleotide-lwc.hs | 2 +-
tests/Benchmarks/Mandelbrot/mandelbrot-lwc.hs | 2 +-
tests/Benchmarks/SpectralNorm/spectral-norm-lwc.hs | 2 +-
tests/Benchmarks/{RegexDNA => Systolic}/Makefile | 2 +-
tests/Benchmarks/Systolic/systolic-lwc.hs | 55 ++++++++++++++++++++++
tests/Benchmarks/Systolic/systolic-vanilla.hs | 47 ++++++++++++++++++
tests/aexp-test.hs | 2 +-
tests/blackhole-test.hs | 2 +-
tests/indefinite-blocking-test.hs | 2 +-
tests/indefinite-blocking-test2.hs | 2 +-
tests/retry-test.hs | 2 +-
tests/spawn-test.hs | 2 +-
12 files changed, 112 insertions(+), 10 deletions(-)
diff --git a/tests/Benchmarks/KNucleotide/k-nucleotide-lwc.hs b/tests/Benchmarks/KNucleotide/k-nucleotide-lwc.hs
index 7073206..a86b4f8 100644
--- a/tests/Benchmarks/KNucleotide/k-nucleotide-lwc.hs
+++ b/tests/Benchmarks/KNucleotide/k-nucleotide-lwc.hs
@@ -11,7 +11,7 @@ import qualified Data.ByteString.Char8 as S
import Control.Applicative
import Control.Monad
import LwConc.Substrate
-import LwConc.ConcurrentList
+import LwConc.RunQueue
import LwConc.MVar
import Foreign.Storable
import Foreign.Marshal.Alloc
diff --git a/tests/Benchmarks/Mandelbrot/mandelbrot-lwc.hs b/tests/Benchmarks/Mandelbrot/mandelbrot-lwc.hs
index 4518940..cfba513 100644
--- a/tests/Benchmarks/Mandelbrot/mandelbrot-lwc.hs
+++ b/tests/Benchmarks/Mandelbrot/mandelbrot-lwc.hs
@@ -2,7 +2,7 @@ import System.Environment
import System.IO
import Foreign
import Foreign.Marshal.Array
-import LwConc.Concurrent
+import LwConc.RunQueue
import LwConc.Substrate
import LwConc.MVar
import Control.Monad
diff --git a/tests/Benchmarks/SpectralNorm/spectral-norm-lwc.hs b/tests/Benchmarks/SpectralNorm/spectral-norm-lwc.hs
index 608e689..d6d69a0 100644
--- a/tests/Benchmarks/SpectralNorm/spectral-norm-lwc.hs
+++ b/tests/Benchmarks/SpectralNorm/spectral-norm-lwc.hs
@@ -19,7 +19,7 @@ import Foreign.Marshal.Array
import Foreign
import Text.Printf
import LwConc.Substrate
-import LwConc.ConcurrentList
+import LwConc.RunQueue
import LwConc.MVar
import Control.Monad
import GHC.Base
diff --git a/tests/Benchmarks/RegexDNA/Makefile b/tests/Benchmarks/Systolic/Makefile
similarity index 67%
copy from tests/Benchmarks/RegexDNA/Makefile
copy to tests/Benchmarks/Systolic/Makefile
index e593b8d..8c8a8fe 100644
--- a/tests/Benchmarks/RegexDNA/Makefile
+++ b/tests/Benchmarks/Systolic/Makefile
@@ -1,4 +1,4 @@
-TARGET := regex-dna-vanilla.bin regex-dna-lwc.bin
+TARGET := systolic-vanilla.bin systolic-lwc.bin
include ../../config.mk
diff --git a/tests/Benchmarks/Systolic/systolic-lwc.hs b/tests/Benchmarks/Systolic/systolic-lwc.hs
new file mode 100644
index 0000000..96b2e50
--- /dev/null
+++ b/tests/Benchmarks/Systolic/systolic-lwc.hs
@@ -0,0 +1,55 @@
+-------------------------------------------------------------------------------
+--- $Id: Bench1.hs#4 2005/06/14 01:10:17 REDMOND\\satnams $
+-------------------------------------------------------------------------------
+
+module Main
+where
+import System.Time
+import System.Random
+import System.Environment
+import Control.Monad
+import LwConc.Substrate
+import LwConc.RunQueue
+import LwConc.MVar
+
+systolicFilter :: [Double] -> [Double] -> [Double]
+systolicFilter weights inputStream
+ = [sum [a*x | (a,x) <- zip weights xs]
+ | xs <- staggerBy (length weights) inputStream]
+
+staggerBy n list | length list <= n = []
+staggerBy n list
+ = take n list : staggerBy n (tail list)
+
+applyFilter rgen resultMV
+ = do let weights = take 10 (randomRs (0.0, 10.0) rgen)
+ let inputStream = take 2000 (randomRs (0.0, 100.0) rgen)
+ let result = last (systolicFilter weights inputStream)
+ putMVar resultMV result
+
+rgens 0 _ = []
+rgens n rgen
+ = nextGen : rgens (n-1) nextGen
+ where
+ (_, nextGen) = split rgen
+
+initSched = do
+ newSched
+ n <- getNumCapabilities
+ replicateM_ (n-1) newCapability
+
+
+main
+ = do initSched
+ instances <- getArgs >>= readIO . head
+ putStrLn "SMP Systolic Filter Benchmarks"
+ dones <- sequence (replicate instances newEmptyMVar)
+ rgen1 <- getStdGen
+ let gens = rgens instances rgen1
+ t1 <- getClockTime
+ sequence [forkIO (applyFilter (gens!!i) (dones!!i)) |
+ i <- [0..instances-1]]
+ rs <- sequence [takeMVar (dones!!i) | i <- [0..instances-1]]
+ sequence [putStrLn (show (rs!!i)) | i <- [0..instances-1]]
+ t2 <- getClockTime
+ putStrLn ("Time: " ++ (timeDiffToString (diffClockTimes t2 t1)))
diff --git a/tests/Benchmarks/Systolic/systolic-vanilla.hs b/tests/Benchmarks/Systolic/systolic-vanilla.hs
new file mode 100644
index 0000000..587a54d
--- /dev/null
+++ b/tests/Benchmarks/Systolic/systolic-vanilla.hs
@@ -0,0 +1,47 @@
+-------------------------------------------------------------------------------
+--- $Id: Bench1.hs#4 2005/06/14 01:10:17 REDMOND\\satnams $
+-------------------------------------------------------------------------------
+
+module Main
+where
+import System.Time
+import System.Random
+import System.IO
+import System.Environment
+import Control.Monad
+import Control.Concurrent
+
+systolicFilter :: [Double] -> [Double] -> [Double]
+systolicFilter weights inputStream
+ = [sum [a*x | (a,x) <- zip weights xs]
+ | xs <- staggerBy (length weights) inputStream]
+
+staggerBy n list | length list <= n = []
+staggerBy n list
+ = take n list : staggerBy n (tail list)
+
+applyFilter rgen resultMV
+ = do let weights = take 10 (randomRs (0.0, 10.0) rgen)
+ let inputStream = take 2000 (randomRs (0.0, 100.0) rgen)
+ let result = last (systolicFilter weights inputStream)
+ putMVar resultMV result
+
+rgens 0 _ = []
+rgens n rgen
+ = nextGen : rgens (n-1) nextGen
+ where
+ (_, nextGen) = split rgen
+
+main
+ = do instances <- getArgs >>= readIO . head
+ putStrLn "SMP Systolic Filter Benchmarks"
+ dones <- sequence (replicate instances newEmptyMVar)
+ rgen1 <- getStdGen
+ let gens = rgens instances rgen1
+ t1 <- getClockTime
+ sequence [forkIO (applyFilter (gens!!i) (dones!!i)) |
+ i <- [0..instances-1]]
+ rs <- sequence [takeMVar (dones!!i) | i <- [0..instances-1]]
+ sequence [putStrLn (show (rs!!i)) | i <- [0..instances-1]]
+ t2 <- getClockTime
+ putStrLn ("Time: " ++ (timeDiffToString (diffClockTimes t2 t1)))
diff --git a/tests/aexp-test.hs b/tests/aexp-test.hs
index 5b1a28b..e933f0f 100644
--- a/tests/aexp-test.hs
+++ b/tests/aexp-test.hs
@@ -1,6 +1,6 @@
{-# LANGUAGE DeriveDataTypeable #-}
-import LwConc.Concurrent
+import LwConc.RunQueue
import LwConc.MVar
import Data.Typeable
import qualified Control.Exception as Exception
diff --git a/tests/blackhole-test.hs b/tests/blackhole-test.hs
index 6d53030..1f8c870 100644
--- a/tests/blackhole-test.hs
+++ b/tests/blackhole-test.hs
@@ -1,7 +1,7 @@
{-# Language ScopedTypeVariables #-}
module Main where
-import LwConc.Concurrent
+import LwConc.RunQueue
import PChan
import LwConc.MVar
import LwConc.Substrate
diff --git a/tests/indefinite-blocking-test.hs b/tests/indefinite-blocking-test.hs
index a05993c..48e103e 100644
--- a/tests/indefinite-blocking-test.hs
+++ b/tests/indefinite-blocking-test.hs
@@ -1,4 +1,4 @@
-import LwConc.Concurrent
+import LwConc.RunQueue
import LwConc.MVar
import System.Environment
diff --git a/tests/indefinite-blocking-test2.hs b/tests/indefinite-blocking-test2.hs
index 41446c6..566e2b2 100644
--- a/tests/indefinite-blocking-test2.hs
+++ b/tests/indefinite-blocking-test2.hs
@@ -1,6 +1,6 @@
{-# LANGUAGE ScopedTypeVariables #-}
-import LwConc.Concurrent
+import LwConc.RunQueue
import LwConc.MVar
import System.Environment
import Control.Exception
diff --git a/tests/retry-test.hs b/tests/retry-test.hs
index 855006a..7319753 100644
--- a/tests/retry-test.hs
+++ b/tests/retry-test.hs
@@ -1,4 +1,4 @@
-import LwConc.Concurrent
+import LwConc.RunQueue
import LwConc.MVar
main = do
diff --git a/tests/spawn-test.hs b/tests/spawn-test.hs
index 6a86933..6577616 100644
--- a/tests/spawn-test.hs
+++ b/tests/spawn-test.hs
@@ -1,4 +1,4 @@
-import LwConc.Concurrent
+import LwConc.RunQueue
import LwConc.Substrate
import System.Environment
More information about the ghc-commits
mailing list