Commit 627fc2cb authored by Yiannis Tsiouris's avatar Yiannis Tsiouris

Add -Wall and fix some warnings

parent 131b1fb6
...@@ -10,8 +10,6 @@ module Bench( -- sequential benchmarks ...@@ -10,8 +10,6 @@ module Bench( -- sequential benchmarks
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
import Control.Distributed.Process import Control.Distributed.Process
import Control.Distributed.Process.Node import Control.Distributed.Process.Node
import Data.List (lookup)
import Data.Maybe (fromMaybe)
import Prelude hiding (seq) import Prelude hiding (seq)
import Network.Transport.TCP import Network.Transport.TCP
...@@ -59,6 +57,7 @@ dist_seq generators n p workers = ...@@ -59,6 +57,7 @@ dist_seq generators n p workers =
where w = length workers where w = length workers
sz :: [MasterStats] -> String sz :: [MasterStats] -> String
sz [] = "false"
sz (mainStats : _) = sz (mainStats : _) =
case "size" `lookup` mainStats of case "size" `lookup` mainStats of
Nothing -> "false" Nothing -> "false"
...@@ -71,4 +70,4 @@ seqTest = do ...@@ -71,4 +70,4 @@ seqTest = do
runProcess node $ do runProcess node $ do
res <- par gg13 11 2 res <- par gg13 11 2
liftIO $ print res liftIO $ print res
threadDelay (2 * 1000000) threadDelay (1 * 1000000)
.PHONY: FORCE clean distclean .PHONY: FORCE clean distclean
orbit: FORCE orbit: FORCE
ghc --make Bench.hs -o orbit ghc -Wall --make Bench.hs -o orbit
tests: orbit tests: orbit
ghc -package test-framework -package test-framework-hunit \ ghc -package test-framework -package test-framework-hunit \
......
...@@ -32,8 +32,9 @@ import Prelude hiding (init) ...@@ -32,8 +32,9 @@ import Prelude hiding (init)
import Credit import Credit
import qualified Sequential as Sq (orbit) import qualified Sequential as Sq (orbit)
import Table import Table
import Utils (GenClos (..), Generator, import Utils (GenClos (..),
dispatcher, now) Generator,
now)
-- counters/timers record -- counters/timers record
data Ct = Ct { verts_recvd :: Int -- #vertices received by this server so far data Ct = Ct { verts_recvd :: Int -- #vertices received by this server so far
...@@ -93,11 +94,11 @@ get_spawn_img_comp (_, _, _, _, _, spawmImgComp) = spawmImgComp ...@@ -93,11 +94,11 @@ get_spawn_img_comp (_, _, _, _, _, spawmImgComp) = spawmImgComp
set_idle_timeout :: ParConf -> Int -> ParConf set_idle_timeout :: ParConf -> Int -> ParConf
set_idle_timeout (gs, mst, wks, gts, timeout, spic) x = set_idle_timeout (gs, mst, wks, gts, _, spic) x =
(gs, mst, wks, gts, x, spic) (gs, mst, wks, gts, x, spic)
clear_spawn_img_comp :: ParConf -> ParConf clear_spawn_img_comp :: ParConf -> ParConf
clear_spawn_img_comp (gs, mst, wks, gts, tmt, spawmImgComp) = clear_spawn_img_comp (gs, mst, wks, gts, tmt, _) =
(gs, mst, wks, gts, tmt, False) (gs, mst, wks, gts, tmt, False)
-- produce readable statistics -- produce readable statistics
...@@ -155,11 +156,12 @@ init (localTableSize, idleTimeout, spawnImgComp) = ...@@ -155,11 +156,12 @@ init (localTableSize, idleTimeout, spawnImgComp) =
-- Table: hash table holding vertices -- Table: hash table holding vertices
-- StatData: various counters and timers for gathering statistics -- StatData: various counters and timers for gathering statistics
vertex_server :: ParConf -> Credit -> VTable -> Ct -> Process () vertex_server :: ParConf -> Credit -> VTable -> Ct -> Process ()
vertex_server staticMachConf credit table statData = do vertex_server staticMachConf crdt table statData = do
let idleTimeout = get_idle_timeout staticMachConf let idleTimeout = get_idle_timeout staticMachConf
r <- receiveTimeout idleTimeout [ r <- receiveTimeout idleTimeout [
match $ \("vertex", x, slot, k) -> do match $ \("vertex", x, slot, k) -> do
let creditPlusK = credit_atomic k credit say $ "got a vertex!"
let creditPlusK = credit_atomic k crdt
nowTime = now nowTime = now
vertsRecvd = verts_recvd statData vertsRecvd = verts_recvd statData
minAtomicCredit = min_atomic_credit statData minAtomicCredit = min_atomic_credit statData
...@@ -185,7 +187,7 @@ vertex_server staticMachConf credit table statData = do ...@@ -185,7 +187,7 @@ vertex_server staticMachConf credit table statData = do
] ]
case r of case r of
Nothing -> do let creditRetd = credit_retd statData Nothing -> do let creditRetd = credit_retd statData
newCreditRetd <- return_credit staticMachConf credit creditRetd newCreditRetd <- return_credit staticMachConf crdt creditRetd
let newStatData = statData {credit_retd = newCreditRetd} let newStatData = statData {credit_retd = newCreditRetd}
vertex_server staticMachConf zero table newStatData vertex_server staticMachConf zero table newStatData
Just _ -> return () Just _ -> return ()
...@@ -196,24 +198,24 @@ vertex_server staticMachConf credit table statData = do ...@@ -196,24 +198,24 @@ vertex_server staticMachConf credit table statData = do
-- Precondition: Credit is non-zero. -- Precondition: Credit is non-zero.
handle_vertex :: ParConf -> Vertex -> Int -> Credit -> VTable handle_vertex :: ParConf -> Vertex -> Int -> Credit -> VTable
-> Process (Credit, VTable) -> Process (Credit, VTable)
handle_vertex staticMachConf x slot credit table handle_vertex staticMachConf x slot crdt table
| is_member x slot table = return (credit, table) -- x already in table; | is_member x slot table = return (crdt, table) -- x already in table;
-- do nothing -- do nothing
| otherwise = do -- x not in table | otherwise = do -- x not in table
let newTable = insert x slot table -- insert x at slot let newTable = insert x slot table -- insert x at slot
-- distribute images of x under generators to their respective workers -- distribute images of x under generators to their respective workers
newCredit <- distribute_images staticMachConf x credit newCredit <- distribute_images staticMachConf x crdt
-- return remaining credit and updated table -- return remaining credit and updated table
return (newCredit, newTable) return (newCredit, newTable)
-- return_credit sends non-zero Credit back to the master; -- return_credit sends non-zero Credit back to the master;
-- returns number of times credit has been returned so far -- returns number of times credit has been returned so far
return_credit :: ParConf -> Credit -> Int -> Process Int return_credit :: ParConf -> Credit -> Int -> Process Int
return_credit staticMachConf credit creditRetd return_credit staticMachConf crdt creditRetd
| is_zero credit = return creditRetd | is_zero crdt = return creditRetd
| otherwise = do | otherwise = do
let masterPid = get_master staticMachConf let masterPid = get_master staticMachConf
send masterPid ("done", credit) send masterPid ("done", crdt)
return (creditRetd + 1) return (creditRetd + 1)
-- dump_table sends a list containing the local partial orbit to the master, -- dump_table sends a list containing the local partial orbit to the master,
...@@ -231,38 +233,40 @@ dump_table staticMachConf table statData = do ...@@ -231,38 +233,40 @@ dump_table staticMachConf table statData = do
-- computation and sending of vertices is actually done asynchronously. -- computation and sending of vertices is actually done asynchronously.
-- Precondition: Credit is non-zero. -- Precondition: Credit is non-zero.
distribute_images :: ParConf -> Vertex -> Credit -> Process Credit distribute_images :: ParConf -> Vertex -> Credit -> Process Credit
distribute_images staticMachConf x credit = distribute_images staticMachConf x crdt =
do_distribute_images staticMachConf x credit (get_gens staticMachConf) do_distribute_images staticMachConf x crdt (get_gens staticMachConf)
do_distribute_images :: ParConf -> Vertex -> Credit -> GenClos do_distribute_images :: ParConf -> Vertex -> Credit -> GenClos
-> Process Credit -> Process Credit
do_distribute_images _ _ credit (GenClos (_, _, [])) = do_distribute_images _ _ crdt (GenClos (_, _, [])) =
return credit return crdt
do_distribute_images staticMachConf x credit (GenClos (_, _, [g])) = do do_distribute_images staticMachConf x crdt (GenClos (_, _, [g])) = do
let (k, remainingCredit) = debit_atomic credit let (k, remainingCredit) = debit_atomic crdt
if get_spawn_img_comp staticMachConf if get_spawn_img_comp staticMachConf
then spawnLocal (send_image staticMachConf x g k) >> return () then spawnLocal (send_image staticMachConf x g k) >> return ()
else send_image staticMachConf x g k else send_image staticMachConf x g k
return remainingCredit return remainingCredit
do_distribute_images staticMachConf x credit (GenClos (_, _, g : gs)) = do do_distribute_images staticMachConf x crdt (GenClos (name, n, g : gs)) = do
let (k, nonZeroRemainingCredit) = debit_atomic_nz credit let (k, nonZeroRemainingCredit) = debit_atomic_nz crdt
if get_spawn_img_comp staticMachConf if get_spawn_img_comp staticMachConf
then spawnLocal (send_image staticMachConf x g k) >> return () then spawnLocal (send_image staticMachConf x g k) >> return ()
else send_image staticMachConf x g k else send_image staticMachConf x g k
return nonZeroRemainingCredit do_distribute_images staticMachConf x nonZeroRemainingCredit
(GenClos (name, n, gs))
-- distribute_vertices distributes the list of vertices Xs to the workers -- distribute_vertices distributes the list of vertices Xs to the workers
-- determined by the hash; some ore all of of the Credit is used to send -- determined by the hash; some ore all of of the Credit is used to send
-- the messages, the remaining credit is returned. -- the messages, the remaining credit is returned.
-- Precondition: If Xs is non-empty then Credit must be non-zero. -- Precondition: If Xs is non-empty then Credit must be non-zero.
distribute_vertices :: ParConf -> Credit -> Credit -> Process Credit distribute_vertices :: ParConf -> Credit -> Credit -> Process Credit
distribute_vertices _ credit [] = return credit distribute_vertices _ crdt [] = return crdt
distribute_vertices staticMachConf credit [x] = do distribute_vertices staticMachConf crdt [x] = do
let (k, remainingCredit) = debit_atomic credit let (k, remainingCredit) = debit_atomic crdt
say $ "remaining credit = " ++ show remainingCredit ++ " k = " ++ show k
send_vertex staticMachConf x k send_vertex staticMachConf x k
return remainingCredit return remainingCredit
distribute_vetices staticMachConf credit (x : xs) = do distribute_vertices staticMachConf crdt (x : xs) = do
let (k, nonZeroRemainingCredit) = debit_atomic_nz credit let (k, nonZeroRemainingCredit) = debit_atomic_nz crdt
send_vertex staticMachConf x k send_vertex staticMachConf x k
distribute_vertices staticMachConf nonZeroRemainingCredit xs distribute_vertices staticMachConf nonZeroRemainingCredit xs
...@@ -274,7 +278,7 @@ send_image staticMachConf x g k = send_vertex staticMachConf (g x) k ...@@ -274,7 +278,7 @@ send_image staticMachConf x g k = send_vertex staticMachConf (g x) k
-- send_vertex hashes vertex X and sends it to the worker determined by -- send_vertex hashes vertex X and sends it to the worker determined by
-- the hash; the message is tagged with atomic credit K. -- the hash; the message is tagged with atomic credit K.
send_vertex :: ParConf -> Vertex -> ACredit -> Process () send_vertex :: ParConf -> Vertex -> ACredit -> Process ()
send_vertex staticMachConf x k = send pid ("vertex", x, slot, k) send_vertex staticMachConf x k = do {say $ "send to " ++ show (x, slot, k); send pid ("vertex", x, slot, k) }
where (pid, slot) = hash_vertex staticMachConf x where (pid, slot) = hash_vertex staticMachConf x
-- hash_vertex computes the two-dimensional hash table slot of vertex X where -- hash_vertex computes the two-dimensional hash table slot of vertex X where
...@@ -422,12 +426,16 @@ par_orbit gs xs hosts = do ...@@ -422,12 +426,16 @@ par_orbit gs xs hosts = do
let -- assemble StaticMachConf and distribute to Workers let -- assemble StaticMachConf and distribute to Workers
staticMachConf = mk_static_mach_conf gs self workers globTabSize staticMachConf = mk_static_mach_conf gs self workers globTabSize
mapM_ (\(pid, _, _) -> send pid ("init", staticMachConf)) workers mapM_ (\(pid, _, _) -> send pid ("init", staticMachConf)) workers
say $ "---- after send pid init, xs = " ++ show xs
let -- start wall clock timer let -- start wall clock timer
startTime = now startTime = now
-- distribute initial vertices to workers -- distribute initial vertices to workers
credit <- distribute_vertices staticMachConf one xs crdt <- distribute_vertices staticMachConf one xs
say $ "---- after distribute_vertices, credit = " ++ show crdt
-- collect credit handed back by idle workers
collect_credit crdt
say "---- after collect credit"
-- collect credit handed back by idle workers -- collect credit handed back by idle workers
collect_credit credit
let -- measure elapsed time (in milliseconds) let -- measure elapsed time (in milliseconds)
elapsedTime = now - startTime elapsedTime = now - startTime
-- tell all workers to dump their tables -- tell all workers to dump their tables
...@@ -487,8 +495,8 @@ collect_credit crdt ...@@ -487,8 +495,8 @@ collect_credit crdt
-- collect_orbit collects partial orbits and stats from N workers. -- collect_orbit collects partial orbits and stats from N workers.
collect_orbit :: Int -> Int -> Process ([Vertex], [MasterStats]) collect_orbit :: Int -> Int -> Process ([Vertex], [MasterStats])
collect_orbit elapsedTime n = do collect_orbit elapsedTime n = do
(orbit, stats) <- do_collect_orbit n [] [] (orb, stats) <- do_collect_orbit n [] []
return (concat orbit, master_stats elapsedTime stats : stats) return (concat orb, master_stats elapsedTime stats : stats)
do_collect_orbit :: Int -> [[Vertex]] -> [WorkerStats] do_collect_orbit :: Int -> [[Vertex]] -> [WorkerStats]
-> Process ([[Vertex]], [WorkerStats]) -> Process ([[Vertex]], [WorkerStats])
......
...@@ -32,7 +32,7 @@ type SeqStats = [(String, String)] ...@@ -32,7 +32,7 @@ type SeqStats = [(String, String)]
-- The function returns a pair consisting of the computed orbit and a singleton -- The function returns a pair consisting of the computed orbit and a singleton
-- list of statistics (mainly runtime and fill degree of the table). -- list of statistics (mainly runtime and fill degree of the table).
orbit :: [Generator] -> [Vertex] -> Int -> ([Vertex], [SeqStats]) orbit :: [Generator] -> [Vertex] -> Int -> ([Vertex], [SeqStats])
orbit gs xs tableSize = (orbit, [stat]) orbit gs xs tableSize = (to_list finalTable, [stat])
where -- assemble static configuration where -- assemble static configuration
staticMachConf = mk_static_mach_conf gs tableSize staticMachConf = mk_static_mach_conf gs tableSize
-- initialise hash table and work queue -- initialise hash table and work queue
...@@ -45,7 +45,6 @@ orbit gs xs tableSize = (orbit, [stat]) ...@@ -45,7 +45,6 @@ orbit gs xs tableSize = (orbit, [stat])
-- measure elapsed time (in milliseconds) -- measure elapsed time (in milliseconds)
elapsedTime = now - startTime elapsedTime = now - startTime
-- return result -- return result
orbit = to_list finalTable
stat = seq_stats elapsedTime (get_freq finalTable) vertsRecvd stat = seq_stats elapsedTime (get_freq finalTable) vertsRecvd
-- main loop working off work Queue; -- main loop working off work Queue;
......
...@@ -9,7 +9,7 @@ newtype GenClos = GenClos (String, Int, [Generator]) ...@@ -9,7 +9,7 @@ newtype GenClos = GenClos (String, Int, [Generator])
deriving (Typeable) deriving (Typeable)
instance Show GenClos where instance Show GenClos where
showsPrec p (GenClos (name, _, _)) = (name ++) showsPrec _ (GenClos (name, _, _)) = (name ++)
instance Binary GenClos where instance Binary GenClos where
put (GenClos (name, n, _)) = put (name, n) put (GenClos (name, n, _)) = put (name, n)
...@@ -68,6 +68,7 @@ r r0 n = (abs n) `rem` r0 ...@@ -68,6 +68,7 @@ r r0 n = (abs n) `rem` r0
-- f3 = fib(10..25), -- f3 = fib(10..25),
-- f4 = fib(11,19,27), bias 49- to 11, 49- to 19, 2- to 27 -- f4 = fib(11,19,27), bias 49- to 11, 49- to 19, 2- to 27
-- f5 = fib(10,20,30), bias 90- to 10, 9.9- to 20, 0.1- to 30 -- f5 = fib(10,20,30), bias 90- to 10, 9.9- to 20, 0.1- to 30
f1, f2, f3, f4, f5 :: Int -> Int -> Int
f1 n x = r n $ (fib (p3 1 0 (r 16 x))) + p3 1 0 x f1 n x = r n $ (fib (p3 1 0 (r 16 x))) + p3 1 0 x
f2 n x = r n $ (fib (p3 1 5 (r 16 x))) + p4 2 5 (-1) x f2 n x = r n $ (fib (p3 1 5 (r 16 x))) + p4 2 5 (-1) x
f3 n x = r n $ (fib (p3 1 10 (r 16 x))) + p5 (-1) 0 8 0 x f3 n x = r n $ (fib (p3 1 10 (r 16 x))) + p5 (-1) 0 8 0 x
...@@ -75,9 +76,13 @@ f4 n x = r n $ (fib (p3 8 3 (s5 0 49 98 100 (r 100 x)))) + p2 (-1) x ...@@ -75,9 +76,13 @@ f4 n x = r n $ (fib (p3 8 3 (s5 0 49 98 100 (r 100 x)))) + p2 (-1) x
f5 n x = r n $ (fib (p3 10 0 (s5 0 900 999 1000 (r 1000 x)))) + p2 1 x f5 n x = r n $ (fib (p3 10 0 (s5 0 900 999 1000 (r 1000 x)))) + p2 1 x
-- sets (= lists) of generators -- sets (= lists) of generators
g :: Vertex -> [Generator]
g _ = [] g _ = []
gg :: Vertex -> GenClos
gg n = GenClos ("g", n, (g n)) gg n = GenClos ("g", n, (g n))
g1, g2, g3, g4, g5 :: Vertex -> [Generator]
g1 n = [f1 n] g1 n = [f1 n]
g2 n = [f2 n] g2 n = [f2 n]
g3 n = [f3 n] g3 n = [f3 n]
...@@ -91,6 +96,7 @@ gg3 n = GenClos ("g3", n, (g3 n)) ...@@ -91,6 +96,7 @@ gg3 n = GenClos ("g3", n, (g3 n))
gg4 n = GenClos ("g4", n, (g4 n)) gg4 n = GenClos ("g4", n, (g4 n))
gg5 n = GenClos ("g5", n, (g5 n)) gg5 n = GenClos ("g5", n, (g5 n))
g12, g13, g14, g15, g23, g24, g25, g34, g35, g45 :: Vertex -> [Generator]
g12 n = g1 n ++ g2 n g12 n = g1 n ++ g2 n
g13 n = g1 n ++ g3 n g13 n = g1 n ++ g3 n
g14 n = g1 n ++ g4 n g14 n = g1 n ++ g4 n
...@@ -102,7 +108,7 @@ g34 n = g3 n ++ g4 n ...@@ -102,7 +108,7 @@ g34 n = g3 n ++ g4 n
g35 n = g3 n ++ g5 n g35 n = g3 n ++ g5 n
g45 n = g4 n ++ g5 n g45 n = g4 n ++ g5 n
gg12, gg13, gg14, gg15, gg23, gg24, gg25 :: Vertex -> GenClos gg12, gg13, gg14, gg15, gg23, gg24, gg25, gg34, gg35, gg45 :: Vertex -> GenClos
gg12 n = GenClos ("g12", n, (g12 n)) gg12 n = GenClos ("g12", n, (g12 n))
gg13 n = GenClos ("g13", n, (g13 n)) gg13 n = GenClos ("g13", n, (g13 n))
gg14 n = GenClos ("g14", n, (g14 n)) gg14 n = GenClos ("g14", n, (g14 n))
...@@ -110,7 +116,12 @@ gg15 n = GenClos ("g15", n, (g15 n)) ...@@ -110,7 +116,12 @@ gg15 n = GenClos ("g15", n, (g15 n))
gg23 n = GenClos ("g23", n, (g23 n)) gg23 n = GenClos ("g23", n, (g23 n))
gg24 n = GenClos ("g24", n, (g24 n)) gg24 n = GenClos ("g24", n, (g24 n))
gg25 n = GenClos ("g25", n, (g25 n)) gg25 n = GenClos ("g25", n, (g25 n))
gg34 n = GenClos ("g34", n, (g34 n))
gg35 n = GenClos ("g35", n, (g35 n))
gg45 n = GenClos ("g45", n, (g45 n))
g123, g124, g125, g134, g135, g145, g234, g235, g245, g345
:: Vertex -> [Generator]
g123 n = g12 n ++ g3 n g123 n = g12 n ++ g3 n
g124 n = g12 n ++ g4 n g124 n = g12 n ++ g4 n
g125 n = g12 n ++ g5 n g125 n = g12 n ++ g5 n
...@@ -135,6 +146,7 @@ gg235 n = GenClos ("g235", n, (g235 n)) ...@@ -135,6 +146,7 @@ gg235 n = GenClos ("g235", n, (g235 n))
gg245 n = GenClos ("g245", n, (g245 n)) gg245 n = GenClos ("g245", n, (g245 n))
gg345 n = GenClos ("g345", n, (g345 n)) gg345 n = GenClos ("g345", n, (g345 n))
g1234, g1235, g1245, g1345, g2345 :: Vertex -> [Generator]
g1234 n = g123 n ++ g4 n g1234 n = g123 n ++ g4 n
g1235 n = g123 n ++ g5 n g1235 n = g123 n ++ g5 n
g1245 n = g124 n ++ g5 n g1245 n = g124 n ++ g5 n
...@@ -148,6 +160,7 @@ gg1245 n = GenClos ("g1245", n, (g1245 n)) ...@@ -148,6 +160,7 @@ gg1245 n = GenClos ("g1245", n, (g1245 n))
gg1345 n = GenClos ("g1345", n, (g1345 n)) gg1345 n = GenClos ("g1345", n, (g1345 n))
gg2345 n = GenClos ("g2345", n, (g2345 n)) gg2345 n = GenClos ("g2345", n, (g2345 n))
g12345 :: Vertex -> [Generator]
g12345 n = g1234 n ++ g5 n g12345 n = g1234 n ++ g5 n
gg12345 :: Vertex -> GenClos gg12345 :: Vertex -> GenClos
......
Markdown is supported
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