From: adam Date: Sun, 6 May 2007 08:52:06 +0000 (+0100) Subject: f0 checkin X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=d8e3ea43bfb2b252184d7afc1889f4053942ca46;p=fleet.git f0 checkin --- diff --git a/src/edu/berkeley/fleet/f0/Compile.lhs b/src/edu/berkeley/fleet/f0/Compile.lhs index ec26258..5c1bbb8 100644 --- a/src/edu/berkeley/fleet/f0/Compile.lhs +++ b/src/edu/berkeley/fleet/f0/Compile.lhs @@ -10,40 +10,68 @@ import Fleet -- the last datum leaving the ship must leave after all arriving -- datums have arrived -getInboxes :: Expr -> [Port] -getInboxes (Move 1 s d) = [d] -getInboxes (Decl d e) = getInboxes e -getInboxes (Par e) = concatMap getInboxes e -getInboxes (Seq [a,b]) = getInboxes a -getInboxes _ = [] +getBoxes :: Bool -> Expr -> [Port] +getBoxes True (Move 1 s d) = [s] +getBoxes True (Copy 1 s d) = [s] +getBoxes inb (Decl d e) = getBoxes inb e +getBoxes inb (Par es) = concatMap (getBoxes inb) es +getBoxes True (Seq es) = getBoxes True $ last es +getBoxes False (Seq es) = getBoxes False $ head es +getBoxes True (While p o i e) = [cbdPort] -- FIXME +getBoxes False (While p o i e) = [] -- FIXME +getBoxes _ _ = [] -getOutboxes :: Expr -> [Port] -getOutboxes (Move 1 s d) = [s] -getOutboxes (Decl d e) = getOutboxes e -getOutboxes (Par e) = concatMap getOutboxes e -getOutboxes (Seq [a,b]) = getOutboxes b -getOutboxes _ = [] +cbdPort = ShipPort "mem" "inCBD" + compile :: Expr -> [Inst] -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 (Decl 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 +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 (Decl d e) = compile e +compile (Par e) = concatMap compile e +compile (Move 1 s d) = [ (move s) { m_dest=(Just d) }, (accept d) ] +compile (Copy 1 s d) = [ (copy s) { m_dest=(Just d) }, (accept d) ] +compile (While p op i e) = think ++ [IBagDef "WHILECODEBAG" $ think ++ (compile e) ] + where + think = [ + ILiteralBag "WHILECODEBAG" (ShipPort "choice" "in2"), + (move p) { m_dataIn=False, m_dest=(Just (ShipPort "ifalu" "in1")) }, + (move (ShipPort "ifalu" "out")) { m_dest = (Just (ShipPort "choice" ("in."++(swapPort op)))) }, + ILiteral i (ShipPort "ifalu" "in2"), + ILiteral 1 (ShipPort "ifalu" "inOp"), + ILiteral 0 (ShipPort "choice" "in1"), -- FIXME + accept (ShipPort "ifalu" "in1"), + accept (ShipPort "ifalu" "in2"), + accept (ShipPort "ifalu" "inOp"), + accept (ShipPort "choice" "in1"), + accept (ShipPort "choice" "in2"), + accept (ShipPort "choice" "in"), + (move (ShipPort "choice" "out1")) { m_dest = Just cbdPort }, + (dismiss (ShipPort "choice" "out2")), + (accept cbdPort) + ] + swapPort Lt = "swapIfNegative" + swapPort Gt = "swapIfPositive" + swapPort Leq = "swapIfNonPositive" + swapPort Geq = "swapIfNonNegative" + swapPort Eq = "swapIfZero" + swapPort Neq = "swapIfNonZero" +compile (Seq [a]) = compile a +compile (Seq (a:b:rest)) = (compile a)++(bridge (getBoxes True a) (uniq (getBoxes False b)))++(compile $ Seq (b:rest)) where - notifyFromOutboxes = map (\ob -> notify ob ib) obs - waitForOutboxNotifications = [(wait ib){m_count=(length obs)}] - notifyInboxes = map (notify ib) ibs - waitForInboxNotifications = map wait ibs + bridge :: [Port] -> [Port] -> [Inst] + bridge [] _ = [] + bridge _ [] = [] + bridge obs (ib:ibs) = notifyFromOutboxes ++ waitForOutboxNotifications ++ notifyInboxes ++ waitForInboxNotifications + where + 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 d e) = map (\(n,t) -> ("#ship " ++ n ++ " : " ++ t)) d +getdecls (Decl d e) = ["#ship mem : Memory", "#ship choice : Choice", "#ship ifalu : Alu2" ] ++ + map (\(n,t) -> ("#ship " ++ n ++ " : " ++ t)) d getdecls (Seq es) = concatMap getdecls es getdecls (Par es) = concatMap getdecls es getdecls _ = [] diff --git a/src/edu/berkeley/fleet/f0/Fleet.lhs b/src/edu/berkeley/fleet/f0/Fleet.lhs index 0b2206d..d73471e 100644 --- a/src/edu/berkeley/fleet/f0/Fleet.lhs +++ b/src/edu/berkeley/fleet/f0/Fleet.lhs @@ -1,12 +1,13 @@ \begin{code} module Fleet where +import SBP import Util -import Types itake box = IMove { m_count=1, m_recycle=False, m_tokenIn=False, m_dataIn=True, m_latch=True, m_dataOut=False, m_tokenOut=False, m_dest=Nothing, m_benkobox=box } move box = (itake box){ m_dataOut=True } +copy box = (move box){ m_dataIn=False } send box = (move box){ m_dataIn=False, m_latch=False } notify box dest = IMove { m_count=1, m_recycle=False, m_tokenIn=False, m_dataIn=False, m_latch=False, m_dataOut=False, m_tokenOut=True, m_dest=(Just dest), @@ -14,12 +15,31 @@ notify box dest = IMove { m_count=1, m_recycle=False, m_tokenIn=False, m_dataIn= wait box = IMove { m_count=1, m_recycle=False, m_tokenIn=True, m_dataIn=False, m_latch=False, m_dataOut=False, m_tokenOut=False, m_dest=Nothing, m_benkobox=box } +dismiss box = IMove { m_count=1, m_recycle=False, m_tokenIn=False, m_dataIn=True, + m_latch=False, m_dataOut=False, m_tokenOut=False, m_dest=Nothing, + m_benkobox=box } accept box = move box +-- Port ------------------------------------------------------------------------------ +data Port = ShipPort String String + | IdPort String + deriving (Eq, Ord) + +instance Show Port where + show (ShipPort a b) = a++"."++b + show (IdPort a) = a + +instance FromTree Port where + fromTree (Tree "Port" [s] _) = IdPort (fromTree s) + fromTree (Tree "Port" [a,b] _) = ShipPort (fromTree a) (fromTree b) + fromTree t = error (show t) + type BenkoBox = Port data Inst = - IKill BenkoBox Int - | ILiteral Int BenkoBox + IKill BenkoBox Int + | ILiteral Int BenkoBox + | ILiteralBag String BenkoBox + | IBagDef String [Inst] | IMove { m_benkobox :: BenkoBox , m_dest :: Maybe BenkoBox , m_count :: Int , @@ -39,6 +59,8 @@ showCount n False = "["++(show n)++"] " instance Show Inst where show (IKill bb count) = (show bb)++": "++(showCount count False)++" kill;" show (ILiteral lit bb) = (show lit)++": sendto "++(show bb)++";" + show (ILiteralBag bagname bb) = bagname++": sendto "++(show bb)++";" + show (IBagDef bagname is) = bagname++": {\n "++(join "" $ map (\i -> (show i)++"\n ") is)++"}\n" show m@(_) = (show $ m_benkobox m) ++ ": "++ (showCount (m_count m) $ m_recycle m) ++ @@ -48,7 +70,7 @@ instance Show Inst where showrest m = wait++takelatch++out++ack where wait = if m_tokenIn m then ["wait"] else [] - takelatch = if m_dataIn m then (if m_latch m then ["take"] else ["drop"]) else [] + takelatch = if m_dataIn m then (if m_latch m then ["take"] else ["dismiss"]) else [] out = if m_dataOut m then (case m_dest m of { Nothing -> ["deliver"]; (Just j) -> ["sendto "++(show j)] }) else [] ack = if m_tokenOut m then (case m_dest m of (Just j) -> ["notify "++(show j)]) else [] \end{code} \ No newline at end of file diff --git a/src/edu/berkeley/fleet/f0/Types.lhs b/src/edu/berkeley/fleet/f0/Types.lhs index d9290b8..be42cb2 100644 --- a/src/edu/berkeley/fleet/f0/Types.lhs +++ b/src/edu/berkeley/fleet/f0/Types.lhs @@ -2,6 +2,7 @@ module Types where import SBP import Util +import Fleet -- Def ------------------------------------------------------------------------------ data Def = Def String [String] [String] Expr @@ -17,27 +18,27 @@ instance FromTree Def where fromTree (Tree "Def" q _) = error $ show q --- Port ------------------------------------------------------------------------------ -data Port = ShipPort String String - | IdPort String - deriving (Eq, Ord) - -instance Show Port where - show (ShipPort a b) = a++"."++b - show (IdPort a) = a - -instance FromTree Port where - fromTree (Tree "Port" [s] _) = IdPort (fromTree s) - fromTree (Tree "Port" [a,b] _) = ShipPort (fromTree a) (fromTree b) - fromTree t = error (show t) - -- Expr ------------------------------------------------------------------------------ +data Op = Lt | Gt | Leq | Geq | Eq | Neq + deriving (Show,Eq) +instance FromTree Op where + fromTree (Tree s _ _) = + case s of + "==" -> Eq + "!=" -> Neq + ">=" -> Geq + "<=" -> Leq + ">" -> Gt + "<" -> Lt + data Expr = Seq [Expr] | Par [Expr] | Decl [(String,String)] Expr - | Move Int Port Port - | Literal Int Int Port + | Move Int Port Port + | Copy Int Port Port + | Literal Int Int Port + | While Port Op Int Expr | Nop deriving (Show,Eq) {- @@ -64,20 +65,31 @@ instance FromTree Expr where par [] = Nop par [x] = x par x = Par x - fromTree (Tree "-->" es _) = - case es of - [(Tree i [] _),dest] -> rep (fromTree dest) $ \d -> Literal 1 (read i) d - [(Tree "{" [Tree _ is _] _),dest] -> Par $ concatMap (\d -> map (\(Tree i _ _) -> Literal 1 (read i) d) is) (fromTree dest) - [source,dest] -> rep (fromTree dest) $ \d -> Move 1 (fromTree source) d + fromTree (Tree arrow [source,dests] _) | (arrow=="-->" || arrow=="+->") = + case source of + (Tree "{" [Tree _ is _] _) -> Par $ concatMap (\d -> map (\(Tree i _ _) -> Literal 1 (read i) d) is) dest + (Tree i [] _) -> rep' dest $ \d -> Literal 1 (read i) d + source -> case dests of + (Tree ";" [Tree _ d _] _) -> rep' dest $ \d -> mc 1 (fromTree source) d + (Tree "," [Tree _ (d:ds) _] _) -> + Par $ + ((mc 1 (fromTree source) (fromTree d)): + (map (\d' -> Copy 1 (fromTree source) d') (map fromTree ds))) + where + mc = if arrow=="-->" then Move else Copy + dest = case dests of + (Tree ";" [Tree _ d _] _) -> map fromTree d + rep' [] _ = error "nop" + rep' [x] f = f x + rep' list f = Par $ map f list + -- fromTree (Tree "-[" [(Tree i [] _),(Tree c [] _),dest] _) = Literal (read c) (read i) (fromTree dest) -- fromTree (Tree "-[" [source,(Tree c [] _),dest] _) = Move (read c) (fromTree source) (fromTree dest) -- fromTree (Tree "-[*]->" [(Tree i [] _),dest] _) = Literal 0 (read i) (fromTree dest) -- fromTree (Tree "-[*]->" [source,dest] _) = Move 0 (fromTree source) (fromTree dest) + fromTree (Tree "while" [(Tree "Cond" [port, op, (Tree i _ _)] _), e] _) = + While (fromTree port) (fromTree op) (read i) (fromTree e) fromTree other = error $ (show other) -rep :: [Port] -> (Port -> Expr) -> Expr -rep [] _ = error "nop" -rep [x] f = f x -rep list f = Par $ map f list \end{code} \ No newline at end of file diff --git a/src/edu/berkeley/fleet/f0/f0.g b/src/edu/berkeley/fleet/f0/f0.g index dbd10dd..f5c1912 100644 --- a/src/edu/berkeley/fleet/f0/f0.g +++ b/src/edu/berkeley/fleet/f0/f0.g @@ -11,12 +11,17 @@ Decl = Id ^"::" ShipName /ws Expr = "{" Exprs "}" /ws | (Literal|Port) ^"-->" Ports /ws + | (Literal|Port) ^"+->" Ports /ws | (Literal|Port) ws! ^"-[" Int "]->" ws! Ports | (Literal|Port) ^"-[*]->" Ports /ws + | ^"while" Cond Expr /ws // | "if" "then" "else" -// | "while" -Ports = Port +/ comma +CondOp = ^"==" | ^"!=" | ^">" | ^">=" | ^"<" | ^"<=" +Cond = Cond:: Port CondOp Int /ws + +Ports = ";":: Port +/ semicolon + > ",":: Port +/ comma Port = "Port":: Id | "Port":: Id "." Id @@ -25,11 +30,12 @@ Int = [\-0-9]++ ShipName = "":: [A-Z] [a-zA-Z0-9_]* Id = "":: [a-z] [a-zA-Z0-9_]* -Comment = "//" (~eol)* eol! +Comment = "//" (~eol)* eol! | "/*" (any* &~ (any*! "*/" any*!)) "*/" -ws = (wsc | Comment)* -> ~wsc -eol = [\r\n] -wsc = [\r\n ] | \{ | \} +ws = (wsc | Comment)* -> ~wsc +eol = [\r\n] +wsc = [\r\n ] | \{ | \} comma = ws! "," ws! +semicolon = ws! ";" ws! semicolons = ws! ";;" ws! -any = ~[] +any = ~[]