checkpoint

[fleet.git] / src / edu / berkeley / fleet / f0 / Compile.lhs

diff --git a/src/edu/berkeley/fleet/f0/Compile.lhs b/src/edu/berkeley/fleet/f0/Compile.lhs
index cdbf292..a505eec 100644 (file)
--- a/src/edu/berkeley/fleet/f0/Compile.lhs
+++ b/src/edu/berkeley/fleet/f0/Compile.lhs
@@ -5,20 +5,45 @@ import Types
 import Util
 import Fleet
 
+-- assumption: 
+--   within a block that has data going both to and from a ship,
+--   the last datum leaving the ship must leave after all arriving
+--   datums have arrived
+
+getInboxes :: Expr -> [Port]
+getInboxes (Move 1 s d)   = [d]
+getInboxes (Exprs d e)    = getInboxes e
+getInboxes (Par e)        = concatMap getInboxes e
+getInboxes (Seq [a,b])    = getInboxes a
+getInboxes _              = []
+
+getOutboxes :: Expr -> [Port]
+getOutboxes (Move 1 s d)   = [s]
+getOutboxes (Exprs d e)    = getOutboxes e
+getOutboxes (Par e)        = concatMap getOutboxes e
+getOutboxes (Seq [a,b])    = getOutboxes b
+getOutboxes _              = []
+
 compile :: Expr -> [Inst]
-compile (Decl _ _)      = []
-compile (Seq s)         = error "bleh"
-compile (Par e)         = concatMap compile e
-compile (Move 1 s [d])    = [ (move s) { m_dest=(Just d) }, (accept d) ]
-compile (Move 1 s d)      = [itake s]++sends++recvs
+compile (Literal 0 lit d) =  [ ILiteral lit d, (accept d) {m_count=0} ]
+compile (Literal 1 lit d) =  [ ILiteral lit d, (accept d)             ]
+compile (Literal n lit d) =  [ ILiteral lit d, (accept d) {m_count=n} ]
+compile (Exprs d e)       = compile e
+compile (Seq [a,b])       = (compile a)++(bridge (getInboxes a) (uniq (getOutboxes b)))++(compile b)
+compile (Par e)           = concatMap compile e
+compile (Move 1 s d)      = [ (move s) { m_dest=(Just d) }, (accept d) ]
+
+bridge :: [Port] -> [Port] -> [Inst]
+bridge [] _         = []
+bridge _  []        = []
+bridge obs (ib:ibs) = notifyFromOutboxes ++ waitForOutboxNotifications ++ notifyInboxes ++ waitForInboxNotifications
  where
-   sends = map (\x -> ((send   s) { m_dest=(Just x) })) d
-   recvs = map (\x -> ((accept x) )) d
-compile (Literal 0 lit ds) =  concatMap (\d -> [ ILiteral lit d, (accept d) {m_count=0} ]) ds
-compile (Literal 1 lit ds) =  concatMap (\d -> [ ILiteral lit d, (accept d)             ]) ds
-compile (Literal n lit ds) =  concatMap (\d -> [ ILiteral lit d, (accept d) {m_count=n} ]) ds
+  notifyFromOutboxes         = map (\ob -> notify ob ib) obs
+  waitForOutboxNotifications = [(wait ib){m_count=(length obs)}]
+  notifyInboxes              = map (notify ib) ibs
+  waitForInboxNotifications  = map wait ibs
 
-getdecls (Decl n t) = ["#ship " ++ n ++ " : " ++ t]
+getdecls (Exprs d e) = map (\(Decl n t) -> ("#ship " ++ n ++ " : " ++ t)) d
 getdecls (Seq es)   = concatMap getdecls es
 getdecls (Par es)   = concatMap getdecls es
 getdecls _          = []