Commit cea71068 authored by rl@cse.unsw.edu.au's avatar rl@cse.unsw.edu.au
Browse files

Move and clean up concomp benchmark

parent 1f7761f2
TESTDIR = ..
PROGS = mkg concomp
include $(TESTDIR)/mk/test.mk
ALGS = AwShU.hs AwShUP.hs HybU.hs HybUP.hs
mkg.o: Graph.hi
mkg: Graph.o
concomp.o: Graph.hi $(ALGS:.hs=.hi)
concomp: Graph.o $(ALGS:.hs=.o)
import Data.Array.Parallel.Unlifted
import Data.Array.Parallel.Unlifted.Distributed
import Graph
import qualified AwShU
import qualified AwShUP
import qualified HybU
import qualified HybUP
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 = UArr (Int :*: Int) -> Int -> Int :*: UArr Int
algs = [("awshu", AwShU.aw_connected_components)
,("awshup", AwShUP.aw_connected_components)
,("hybu", HybU.hybrid_connected_components)
,("hybup", HybUP.hybrid_connected_components)
]
main = ndpMain "Connected components"
"[OPTION] ... FILES ..."
run [Option ['a'] ["algo"] (ReqArg const "ALGORITHM")
"use the specified algorithm"]
"<none>"
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 loadGraph $ files fs)
showRes
return ()
where
files [] = [""]
files fs = fs
showRes (r :*: _) = "d=" ++ show r
loadGraph :: String -> IO (Point (UArr (Int :*: Int), Int))
loadGraph fname =
do
s <- if null fname then getContents else readFile fname
let g = read s
evaluate (edges g)
return $ mkPoint ( "n=" ++ show (nodeCount g) ++ ", "
++ "e=" ++ show (edgeCount g))
(edges g, nodeCount g)
import Data.Array.Parallel.Unlifted
import Data.Array.Parallel.Unlifted.Distributed
import Graph
import qualified AwShU
import qualified AwShUP
import qualified HybU
import qualified HybUP
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
type Alg = UArr (Int :*: Int) -> Int -> Int :*: UArr Int
algs = [("awshu", AwShU.aw_connected_components)
,("awshup", AwShUP.aw_connected_components)
,("hybu", HybU.hybrid_connected_components)
,("hybup", HybUP.hybrid_connected_components)
]
data Opts = Opts { optAlg :: String
, optRuns :: Int
, optVerbosity :: Int
, optSetGang :: IO ()
}
dftOpts = Opts { optAlg = "<none>"
, optRuns = 1
, optVerbosity = dftVerbosity
, optSetGang = setSequentialGang 1
}
opts = [Option ['a'] ["alg"]
(ReqArg (\s o -> o { optAlg = s }) "ALG")
"use the specified algorithm"
,Option ['r'] ["runs"]
(ReqArg (\s o -> o { optRuns = read s }) "N")
"repeat each benchmark N times"
,Option ['t'] ["threads"]
(ReqArg (\s o -> o { optSetGang = setGang (read s)}) "N")
"use N threads"
,Option ['s'] ["seq"]
(OptArg (\r o -> let n = case r of
Nothing -> 1
Just s -> read s
in o { optSetGang = setSequentialGang n}) "N")
"simulate N threads (default 1)"
,Option ['v'] ["verbose"]
(OptArg (\r o -> let n = case r of
Nothing -> dftVerbosity
Just s -> read s
in o { optVerbosity = n }) "N")
"verbosity level"
]
measure :: Alg -> UArr (Int :*: Int) -> Int -> IO (Time,Int)
measure alg es n =
es `seq`
do
performGC
start <- getTime
let r :*: cs = alg es n
evaluate cs
end <- getTime
return (end `minusT` start,r)
main =
do
args <- getArgs
case getOpt Permute opts args of
(fs, files, []) -> let os = foldr ($) dftOpts fs
in
case lookup (optAlg os) algs of
Just alg -> do
optSetGang os
procFiles os alg files
Nothing -> err ["Unknown algorithm " ++ optAlg os]
(_, _, errs) -> err errs
where
err ss = do
mapM_ (hPutStrLn stderr) ss
exitFailure
{-
procFiles :: Opts -> Alg -> [String] -> IO ()
procFiles os alg [] = do
s <- getContents
process os alg "<stdin>" s
procFiles os alg fs = mapM_ (\f -> do
s <- readFile f
process os alg f s) fs
process :: Opts -> Alg -> String -> String -> IO ()
process os alg fname s =
do
let g = read s
putStr $ concat [ "n=" ++ show (nodeCount g) ++ ", "
, "e=" ++ show (edgeCount g)
, ": "
]
hFlush stdout
(t,r) <- measure alg (edges g) (nodeCount g)
putStrLn $ concat [ show (milliseconds $ clockTime t) ++ "ms"
, " (d=" ++ show r ++ ")"
]
hFlush stdout
-}
procFiles :: Opts -> Alg -> [String] -> IO ()
procFiles os alg fs =
do
benchmark (dftBenchOpts { runsB = optRuns os
, verbosityB = optVerbosity os })
(uncurry alg)
(map loadGraph $ files fs)
showRes
return ()
where
files [] = [""]
files fs = fs
showRes (r :*: _) = "d=" ++ show r
loadGraph :: String -> IO (Point (UArr (Int :*: Int), Int))
loadGraph fname =
do
s <- if null fname then getContents else readFile fname
let g = read s
evaluate (edges g)
return $ mkPoint ( "n=" ++ show (nodeCount g) ++ ", "
++ "e=" ++ show (edgeCount g))
(edges g, nodeCount g)
GHC = ../../../../../../../../compiler/stage1/ghc-inplace
LIB = ../../../../../../libHSndp.a
HC = $(GHC)
HCFLAGS = -package ndp\
-fglasgow-exts -O2 -funbox-strict-fields\
-fliberate-case-threshold100 -fno-method-sharing -fdicts-cheap\
-threaded
ALGS = AwShU.hs AwShUP.hs HybU.hs HybUP.hs
.PHONY: all clean
all: mkg concomp
%.o: %.hs $(LIB)
$(HC) -c $< $(HCFLAGS) -no-recomp
%.hi: %.o
@:
Main.o: Graph.hi Timing.hi Bench.hi $(ALGS:.hs=.hi)
concomp: Main.o Graph.o Timing.o Bench.o $(ALGS:.hs=.o)
$(HC) -o $@ $^ $(HCFLAGS)
Bench.o: Timing.hi
MkG.o: Graph.hi
mkg: MkG.o Graph.o
$(HC) -o $@ $^ $(HCFLAGS)
clean:
rm -f *.o *.hi concomp mkg
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment