src/edu/berkeley/fleet/f0/Compile.lhs

   1 \begin{code}
   2 module Compile where
   3 import SBP
   4 import Types
   5 import Util
   6 import Fleet
   7
   8 -- assumption:
   9 --   within a block that has data going both to and from a ship,
  10 --   the last datum leaving the ship must leave after all arriving
  11 --   datums have arrived
  12
  13 getInboxes :: Expr -> [Port]
  14 getInboxes (Move 1 s d)   = [d]
  15 getInboxes (Exprs d e)    = getInboxes e
  16 getInboxes (Par e)        = concatMap getInboxes e
  17 getInboxes (Seq [a,b])    = getInboxes a
  18 getInboxes _              = []
  19
  20 getOutboxes :: Expr -> [Port]
  21 getOutboxes (Move 1 s d)   = [s]
  22 getOutboxes (Exprs d e)    = getOutboxes e
  23 getOutboxes (Par e)        = concatMap getOutboxes e
  24 getOutboxes (Seq [a,b])    = getOutboxes b
  25 getOutboxes _              = []
  26
  27 compile :: Expr -> [Inst]
  28 compile (Literal 0 lit d) =  [ ILiteral lit d, (accept d) {m_count=0} ]
  29 compile (Literal 1 lit d) =  [ ILiteral lit d, (accept d)             ]
  30 compile (Literal n lit d) =  [ ILiteral lit d, (accept d) {m_count=n} ]
  31 compile (Exprs d e)       = compile e
  32 compile (Seq [a,b])       = (compile a)++(bridge (getInboxes a) (uniq (getOutboxes b)))++(compile b)
  33 compile (Par e)           = concatMap compile e
  34 compile (Move 1 s d)      = [ (move s) { m_dest=(Just d) }, (accept d) ]
  35
  36 bridge :: [Port] -> [Port] -> [Inst]
  37 bridge [] _         = []
  38 bridge _  []        = []
  39 bridge obs (ib:ibs) = notifyFromOutboxes ++ waitForOutboxNotifications ++ notifyInboxes ++ waitForInboxNotifications
  40  where
  41   notifyFromOutboxes         = map (\ob -> notify ob ib) obs
  42   waitForOutboxNotifications = [(wait ib){m_count=(length obs)}]
  43   notifyInboxes              = map (notify ib) ibs
  44   waitForInboxNotifications  = map wait ibs
  45
  46 getdecls (Exprs d e) = map (\(Decl n t) -> ("#ship " ++ n ++ " : " ++ t)) d
  47 getdecls (Seq es)   = concatMap getdecls es
  48 getdecls (Par es)   = concatMap getdecls es
  49 getdecls _          = []
  50
  51 compileDef (Def s _ _ e) =
  52     "// " ++ s ++ "\n" ++
  53     (join "\n" $ getdecls e)++"\n"++
  54     (join "\n" $ map show (compile e))
  55 \end{code}