From: adam Date: Mon, 26 Feb 2007 16:30:21 +0000 (+0100) Subject: refactor f0 into separate files X-Git-Url: http://git.megacz.com/?p=fleet.git;a=commitdiff_plain;h=8d3652086b8f9cdbc0ae708f8fd45eb90402e144 refactor f0 into separate files --- diff --git a/Makefile b/Makefile index 8d18f5d..0e706d5 100644 --- a/Makefile +++ b/Makefile @@ -152,6 +152,8 @@ ghc += -i$(shell pwd)/build/hi/ -hidir $(shell pwd)/build/hi/ -odir $(shell pwd) f0: fleet.jar mkdir -p build/hi build/class cd lib; $(ghc) -c -java SBP.lhs + cd src/edu/berkeley/fleet/f0/; $(ghc) -fglasgow-exts -cpp $(hflags) -java Util.lhs + cd src/edu/berkeley/fleet/f0/; $(ghc) -fglasgow-exts -cpp $(hflags) -java Types.lhs cd src/edu/berkeley/fleet/f0/; $(ghc) -fglasgow-exts -cpp $(hflags) -java Main.lhs $(java) -cp build/class:lib/HSbase.jar:lib/HSrts.jar:lib/HSstm.jar:fleet.jar Main diff --git a/src/edu/berkeley/fleet/f0/Main.lhs b/src/edu/berkeley/fleet/f0/Main.lhs index 7b50707..9fded1a 100644 --- a/src/edu/berkeley/fleet/f0/Main.lhs +++ b/src/edu/berkeley/fleet/f0/Main.lhs @@ -13,6 +13,9 @@ module Main where import SBP +import Types +import Util + main = do t <- parseFile "src/edu/berkeley/fleet/f0/f0.g" "contrib/demo.f0" putStrLn "" putStrLn $ show $ coalesceFlatHeadlessNodes t @@ -24,98 +27,18 @@ main = do t <- parseFile "src/edu/berkeley/fleet/f0/f0.g" "contrib/demo.f0" writeFile "compiled.fleet" ("// compiled with f0\n\n"++compiled++"\n") putStrLn "" -class FromTree a where - fromTree :: Tree -> a -class FromTrees a where - fromTrees :: [Tree] -> a -instance FromTree a => FromTree [a] where - fromTree (Tree _ c _) = map fromTree c - -indent [] = [] -indent ('\n':q) = "\n "++(indent q) -indent (a:b) = a:(indent b) - -join c [] = "" -join c [x] = x -join c (x:y) = x++c++(join c y) - -data Def = Def String [String] [String] Expr - deriving Eq -instance Show Def where - show (Def name inp outp exprs) = - name ++ "(" ++ (commify inp) ++ " -> " ++ (commify outp) ++ ") =\n " ++ (indent (show exprs)) - where - commify x = join "," x - -instance FromTree Def where - fromTree (Tree "Def" [name,inp,outp,es] _) = - Def (fromTree name) (fromTree inp) (fromTree outp) (Par (fromTree es)) - fromTree (Tree "Def" q _) = error $ show q - -data Port = ShipPort String String - | IdPort String - deriving Eq -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) - -data Expr = Decl String String - | Seq [Expr] - | Par [Expr] - | Move Int Port [Port] - | Literal Int Int [Port] - deriving Eq - -instance Show Expr where - show (Decl shipName shipType) = shipName ++ " :: " ++ shipType - show (Seq exprs) = join " ;; " $ map (\x -> "{ "++x++" }") $ map show exprs - show (Par [expr]) = show expr - show (Par exprs) = "{ " ++ (join "\n " $ map show exprs) ++ " }" - show (Move 0 source dests) = (show source) ++ " -[*]-> " ++ (join "," $ map show dests) - show (Move 1 source dests) = (show source) ++ " --> " ++ (join "," $ map show dests) - show (Move count source dests) = (show source) ++ " -["++(show count)++"]-> " ++ (join "," $ map show dests) - show (Literal 0 i dest) = (show i) ++ " -[*]-> " ++ (show dest) - show (Literal 1 i dest) = (show i) ++ " --> " ++ (show dest) - show (Literal count i dest) = (show i) ++ " -["++(show count)++"]-> " ++ (show dest) - -instance FromTree Expr where - fromTree (Tree "::" [shipName,shipType] _) = Decl (fromTree shipName) (fromTree shipType) - fromTree (Tree "-->" [(Tree i [] _),dest] _) = Literal 1 (read i) (fromTree dest) - fromTree (Tree "-->" [source,dest] _) = Move 1 (fromTree source) (fromTree dest) - 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 t@(Tree "{" [(Tree _ e _)] _) = Par (map fromTree e) - fromTree t@(Tree ";;" [a,b] _) = Seq [(fromTree a), (fromTree b)] - fromTree other = error (show other) - -instance FromTree String where - fromTree (Tree h c _) = h++(concatMap fromTree c) -instance FromTrees String where - fromTrees ts = concatMap (fromTree :: Tree -> String) ts - - compile :: Expr -> [Inst] compile (Decl _ _) = [] compile (Seq s) = error "bleh" compile (Par e) = concatMap compile e -compile (Move 1 s [d]) = [ move { m_benkobox=s, m_dest=(Just d) }, - accept { m_benkobox=d } ] -compile (Move 1 s d) = [itake { m_benkobox=s }]++sends++recvs +compile (Move 1 s [d]) = [ (move s) { m_dest=(Just d) }, (accept d) ] +compile (Move 1 s d) = [itake s]++sends++recvs where - sends = map (\x -> (send { m_benkobox=s, m_dest=(Just x) })) d - recvs = map (\x -> (accept { m_benkobox=x })) d -compile (Literal 0 lit ds) = concatMap (\d -> [ ILiteral lit d, - accept { m_benkobox=d, m_count=0 } ]) ds -compile (Literal 1 lit ds) = concatMap (\d -> [ ILiteral lit d, - accept { m_benkobox=d } ]) ds -compile (Literal n lit ds) = concatMap (\d -> [ ILiteral lit d, - accept { m_benkobox=d, m_count=n } ]) ds + 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 getdecls (Decl n t) = ["#ship " ++ n ++ " : " ++ t] getdecls (Seq es) = concatMap getdecls es @@ -127,48 +50,13 @@ compileDef (Def s _ _ e) = (join "\n" $ getdecls e)++"\n"++ (join "\n" $ map show (compile e)) -itake = 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 } -move = itake { m_dataOut=True } -send = move { m_dataIn=False, m_latch=False } -accept = move - -type BenkoBox = Port -data Inst = - IKill BenkoBox Int - | ILiteral Int BenkoBox - | IMove { m_benkobox :: BenkoBox , - m_dest :: Maybe BenkoBox , - m_count :: Int , - m_recycle :: Bool , - m_tokenIn :: Bool , - m_dataIn :: Bool , - m_latch :: Bool , - m_dataOut :: Bool , - m_tokenOut :: Bool } - -showCount 0 True = "[*r] " -showCount 0 False = "[*] " -showCount 1 _ = "" -showCount 1 r = "" -showCount n True = "["++(show n)++"r] " -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 m@(_) = (show $ m_benkobox m) ++ - ": "++ - (showCount (m_count m) $ m_recycle m) ++ - (join ", " $ showrest m)++ - ";" - 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 [] - 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) -> ["ack "++(show j)]) else [] +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 } +send box = (move box){ m_dataIn=False, m_latch=False } +accept box = move box + \end{code} diff --git a/src/edu/berkeley/fleet/f0/Types.lhs b/src/edu/berkeley/fleet/f0/Types.lhs new file mode 100644 index 0000000..9b478b1 --- /dev/null +++ b/src/edu/berkeley/fleet/f0/Types.lhs @@ -0,0 +1,109 @@ +\begin{code} +module Types where +import SBP +import Util + +class FromTree a where + fromTree :: Tree -> a +class FromTrees a where + fromTrees :: [Tree] -> a +instance FromTree a => FromTree [a] where + fromTree (Tree _ c _) = map fromTree c + +data Def = Def String [String] [String] Expr + deriving Eq +instance Show Def where + show (Def name inp outp exprs) = + name ++ "(" ++ (commify inp) ++ " -> " ++ (commify outp) ++ ") =\n " ++ (indent (show exprs)) + where + commify x = join "," x + +instance FromTree Def where + fromTree (Tree "Def" [name,inp,outp,es] _) = + Def (fromTree name) (fromTree inp) (fromTree outp) (Par (fromTree es)) + fromTree (Tree "Def" q _) = error $ show q + +data Port = ShipPort String String + | IdPort String + deriving Eq +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) + +data Expr = Decl String String + | Seq [Expr] + | Par [Expr] + | Move Int Port [Port] + | Literal Int Int [Port] + deriving Eq + +instance Show Expr where + show (Decl shipName shipType) = shipName ++ " :: " ++ shipType + show (Seq exprs) = join " ;; " $ map (\x -> "{ "++x++" }") $ map show exprs + show (Par [expr]) = show expr + show (Par exprs) = "{ " ++ (join "\n " $ map show exprs) ++ " }" + show (Move 0 source dests) = (show source) ++ " -[*]-> " ++ (join "," $ map show dests) + show (Move 1 source dests) = (show source) ++ " --> " ++ (join "," $ map show dests) + show (Move count source dests) = (show source) ++ " -["++(show count)++"]-> " ++ (join "," $ map show dests) + show (Literal 0 i dest) = (show i) ++ " -[*]-> " ++ (show dest) + show (Literal 1 i dest) = (show i) ++ " --> " ++ (show dest) + show (Literal count i dest) = (show i) ++ " -["++(show count)++"]-> " ++ (show dest) + +instance FromTree Expr where + fromTree (Tree "::" [shipName,shipType] _) = Decl (fromTree shipName) (fromTree shipType) + fromTree (Tree "-->" [(Tree i [] _),dest] _) = Literal 1 (read i) (fromTree dest) + fromTree (Tree "-->" [source,dest] _) = Move 1 (fromTree source) (fromTree dest) + 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 t@(Tree "{" [(Tree _ e _)] _) = Par (map fromTree e) + fromTree t@(Tree ";;" [a,b] _) = Seq [(fromTree a), (fromTree b)] + fromTree other = error (show other) + +instance FromTree String where + fromTree (Tree h c _) = h++(concatMap fromTree c) +instance FromTrees String where + fromTrees ts = concatMap (fromTree :: Tree -> String) ts + +type BenkoBox = Port +data Inst = + IKill BenkoBox Int + | ILiteral Int BenkoBox + | IMove { m_benkobox :: BenkoBox , + m_dest :: Maybe BenkoBox , + m_count :: Int , + m_recycle :: Bool , + m_tokenIn :: Bool , + m_dataIn :: Bool , + m_latch :: Bool , + m_dataOut :: Bool , + m_tokenOut :: Bool } + +showCount 0 True = "[*r] " +showCount 0 False = "[*] " +showCount 1 _ = "" +showCount n True = "["++(show n)++"r] " +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 m@(_) = (show $ m_benkobox m) ++ + ": "++ + (showCount (m_count m) $ m_recycle m) ++ + (join ", " $ showrest m)++ + ";" + 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 [] + 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) -> ["ack "++(show j)]) else [] + +\end{code} \ No newline at end of file diff --git a/src/edu/berkeley/fleet/f0/Util.lhs b/src/edu/berkeley/fleet/f0/Util.lhs new file mode 100644 index 0000000..e2cb5de --- /dev/null +++ b/src/edu/berkeley/fleet/f0/Util.lhs @@ -0,0 +1,11 @@ +\begin{code} +module Util where + +indent [] = [] +indent ('\n':q) = "\n "++(indent q) +indent (a:b) = a:(indent b) + +join c [] = "" +join c [x] = x +join c (x:y) = x++c++(join c y) +\end{code} \ No newline at end of file