c3cda15900a897aa0ace88f60d6f298b0b0daa09
[nofib.git] / parallel / transclos / Main.hs
1 {-# OPTIONS_GHC -XFlexibleInstances -XBangPatterns #-}
2 -- Time-stamp: <2010-11-03 12:01:15 simonmar>
3 --
4 -- Test wrapper for (parallel) transitive closure computation.
5 -- The main parallel version is: TRANSCL_NESTED
6 -- Other versions are:
7 -- TRANSCL ... seq, circular implementation over lists
8 -- TRANSCL_SET ... seq, circular implementation over sets
9 -----------------------------------------------------------------------------
10
11 module Main where
12
13 import System.Environment(getArgs)
14 import Data.List
15 #if defined(STRATEGIES)
16 import Control.Parallel
17 import Control.DeepSeq
18 import Control.Parallel.Strategies
19 #else
20 import GHC.Conc -- hiding (pseq,par)
21 #endif
22 --import Random
23 import Control.Monad
24 import TransClos
25 import qualified Data.Set
26
27
28 {-
29 evalKlustered :: Kluster c => Int -> Strategy (c (c a)) -> Strategy (c a)
30 evalKlustered n strat xs = return (dekluster (kluster n xs `using` strat))
31
32 parChunkN :: (Kluster c, Traversable c) => Int -> Int -> Strategy a -> Strategy (c a)
33 parChunkN n m strat = evalKlustered m (evalDepthN n (evalTraversable (rpar `dot` evalTraversable strat)))
34 -}
35
36 #define TRANS_CLOS 1
37
38 main = do
39 args <- getArgs
40 #ifndef TRANS_CLOS
41 when (length args < 4) $
42 error "Usage: Main <version> <list len> <block size> <nfib input>"
43 let [v,n,z,m] = (map read args) :: [Int]
44 {- test parBuffer -}
45 let (strat, str) = case v of
46 1 -> (parList rnf, "parList rnf: expect "++(show n)++" converted sparks")
47 2 -> (parListChunk z rnf, "parListChunk: expect "++(show (n `div` z))++" converted sparks")
48 3 -> (parListChunk_ z rnf, "parListChunk_: expect "++(show (n `div` z))++" converted sparks")
49 4 -> (parListChunkS z rnf, "parListChunkS: expect "++(show (n
50 `div` z))++" converted sparks")
51 5 -> (parBuffer' z rnf, "parBuffer': expect "++(show n)++" converted sparks, at most "++(show z)++" running at the same time")
52 6 -> (parBuffer z rnf, "parBuffer: expect "++(show n)++" converted sparks, at most "++(show z)++" running at the same time")
53 7 -> (parBuffer_ z rnf, "parBuffer_: expect "++(show n)++" converted sparks, at most "++(show z)++" running at the same time")
54 8 -> (evalBuffer_ z (rpar `dot` rnf), "evalBuffer_: expect "++(show n)++" converted sparks, at most "++(show z)++" running at the same time")
55 9 -> (parBufferChunk_ 2 z rnf , "parBufferChunk_: chunksize 2; expect "++(show (n `div` 2))++" converted sparks, at most "++(show z)++" running at the same time")
56 10 -> (evalBufferChunk 2 z (rpar `dot` seqList rnf) , "parBufferChunk: chunksize 2; expect "++(show (n `div` 2))++" converted sparks, at most "++(show z)++" running at the same time")
57 _ -> error "Unknown version"
58 let res = map nfib (take n (repeat m)) `using` strat
59 putStrLn ("Computing: map nfib (take n (repeat m)) for n = "++(show n)++" and m = "++(show m))
60 putStrLn ("Version: "++str)
61 putStrLn ("Res: "++(show res))
62 #else
63 when (length args < 5) $
64 error "Usage: Main <version> <buffer size> <chunk size> <value> <delay>"
65 let [v,n,z,m,d] = (map read args) :: [Int]
66 -- g <- newStdGen
67 let seeds = [1..10] -- take 10 $ randomRs (0::Int,m) g
68 let rel_one = \ n -> nfib d `pseq` n+1
69 let rel_list = \ n -> nfib ((d-1) `min` (n `max` d)) `pseq` [n+1..n+11]
70 let rel_set = \n -> nfib d `pseq` Data.Set.fromList [n+1..n+11]
71 #if defined(TRANSCL)
72 let zs = {- take n $ -} transcl rel_list seeds -- list-based with 1-to-n rel
73 #elif defined(TRANSCL_NESTED)
74 let zs = {- take n $ -} transcl_nested rel_list seeds -- list-based with 1-to-n rel; main PARALLEL version
75 #elif defined(TRANSCL_SET)
76 let zs = Data.Set.toList $ {- take n $ -} transcl_set rel_set (Data.Set.fromList seeds) -- set-based with 1-to-n rel
77 #else
78 let zs = {- take n $ -} transcl rel_list seeds -- default: seq, circular, with a 1-to-n list-based relation
79 -- unused verions
80 -- let zs = {- take n $ -} transcl_dup rel_one seeds -- no elim of duplicates; good parallelism but stupid
81 -- let zs = {- take n $ -} transcl_simp rel_one seeds -- list-based with 1-to-1 rel
82 #endif
83 let (strat, str) = case v of
84 {- temp out of order
85 1 -> (\ _ -> parListN n rnf (drop (length seeds) zs), "parListN with n = "++(show n))
86 2 -> (\ _ -> parListChunkK z rnf (drop (length seeds) zs), "parListChunkK with z = "++(show z))
87 3 -> (\ _ -> parListChunkN z n rnf (drop (length seeds) zs), "parListChunkN with blocksize z = "++(show z)++" and length n = "++(show n))
88 -}
89 4 -> (\ _ -> error "parBuffer' ", "parBuffer with buffer size "++(show n))
90 -- 5 -> (\ _ -> parBufferLChunk n z (ins rnf) (drop (length seeds) zs), "parBufferLChunk with buffer size "++(show n)++" chunk size size "++(show z))
91 -- 6 -> (\ _ -> parBufferQChunk n z (ins rnf) (drop (length seeds) zs), "parBufferQChunk with buffer size "++(show n)++" chunk size size "++(show z))
92 -- 7 -> (\ _ -> parBufferAChunk n z (ins rnf) (drop (length seeds) zs), "parBufferAChunk with buffer size "++(show n)++" chunk size size "++(show z))
93 -- 10 -> (\ _ -> parBufferChunk_ z n rnf (drop (length seeds) zs), "parBufferChunk with buffer size "++(show n)++" chunk size size "++(show z))
94 -- 11 -> (\ _ -> evalBufferChunk z n (rpar `dot` seqList rnf) (drop (length seeds) zs), "evalBufferChunk with buffer size "++(show n)++" chunk size size "++(show z))
95 -- 12 -> (\ _ -> parBufferLSliceChunk n z z (rpar `dot` seqList (ins rnf)) (drop (length seeds) zs), "parBufferLSliceChunk with buffer size "++(show n)++" stride "++(show z)++" chunk size "++(show z))
96 -- 13 -> (\ _ -> parBufferQSliceChunk n z z (rpar `dot` seqList (ins rnf)) (drop (length seeds) zs), "parBufferQSliceChunk with buffer size "++(show n)++" stride "++(show z)++" chunk size "++(show z))
97 -- 14 -> (\ _ -> parBufferASliceChunk n z z (rpar `dot` seqList (ins rnf)) (drop (length seeds) zs), "parBufferASliceChunk with buffer size "++(show n)++" stride "++(show z)++" chunk size "++(show z))
98 -- 13 -> (\ b -> parBuffer_ z (drop (length seeds) zs) >> return b, "parBuffer_ with buffer size "++(show z))
99 v' -> error $ "Unknown version "++(show v')
100 #if defined(TRANSCL)
101 let res = m `elem` zs -- NO: parallelism is hopeless on this one: `using` strat)
102 #elif defined(TRANSCL_NESTED)
103 let res = if (v==4) -- special case for parBuffer (not of strategy type!)
104 then m `elem` (nub (concat (runEval $ do let (first, rest) = splitAt (length seeds) zs
105 rest' <- parBuffer n rdeepseq rest
106 return (first ++ rest') ))) -- main PARALLEL version
107 else m `elem` (nub (concat (zs `using` strat))) -- main PARALLEL version
108 #elif defined(TRANSCL_SET)
109 let res = m `elem` zs -- default: seq, circular, with a 1-to-n list-based relation
110 #else
111 let res = m `elem` zs -- default: seq, circular, with a 1-to-n list-based relation
112 #endif
113 putStrLn ("Searching for value "++(show m)++" in transitive closure of relation \\ n -> [n+1..n+11] with seeds "++(show seeds))
114 putStrLn ("Version: "++str)
115 putStrLn ("Res: "++(show res))
116 #endif
117
118
119 nfib :: Int -> Int
120 nfib 0 = 1
121 nfib 1 = 1
122 nfib n = nfib (n-1) + nfib (n-2) + 1
123