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 Fleet.lhs
+ cd src/edu/berkeley/fleet/f0/; $(ghc) -fglasgow-exts -cpp $(hflags) -java Compile.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
--- /dev/null
+\begin{code}
+module Compile where
+import SBP
+import Types
+import Util
+import Fleet
+
+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
+ 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
+
+getdecls (Decl n t) = ["#ship " ++ n ++ " : " ++ t]
+getdecls (Seq es) = concatMap getdecls es
+getdecls (Par es) = concatMap getdecls es
+getdecls _ = []
+
+compileDef (Def s _ _ e) =
+ "// " ++ s ++ "\n" ++
+ (join "\n" $ getdecls e)++"\n"++
+ (join "\n" $ map show (compile e))
+\end{code}
\ No newline at end of file
--- /dev/null
+\begin{code}
+module Fleet where
+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 }
+send box = (move box){ m_dataIn=False, m_latch=False }
+accept box = move box
+
+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
import SBP
import Types
import Util
+import Fleet
+import Compile
main = do t <- parseFile "src/edu/berkeley/fleet/f0/f0.g" "contrib/demo.f0"
putStrLn ""
writeFile "compiled.fleet" ("// compiled with f0\n\n"++compiled++"\n")
putStrLn ""
-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
- 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
-
-getdecls (Decl n t) = ["#ship " ++ n ++ " : " ++ t]
-getdecls (Seq es) = concatMap getdecls es
-getdecls (Par es) = concatMap getdecls es
-getdecls _ = []
-
-compileDef (Def s _ _ e) =
- "// " ++ s ++ "\n" ++
- (join "\n" $ getdecls e)++"\n"++
- (join "\n" $ map show (compile e))
-
-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}
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
-
+-- Def ------------------------------------------------------------------------------
data Def = Def String [String] [String] Expr
deriving Eq
instance Show Def where
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
+-- Port ------------------------------------------------------------------------------
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)
+
+-- Expr ------------------------------------------------------------------------------
data Expr = Decl String String
| Seq [Expr]
| Par [Expr]
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
\begin{code}
module Util where
+import SBP
indent [] = []
indent ('\n':q) = "\n "++(indent q)
join c [] = ""
join c [x] = x
join c (x:y) = x++c++(join c y)
+
+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
+instance FromTree String where
+ fromTree (Tree h c _) = h++(concatMap fromTree c)
+instance FromTrees String where
+ fromTrees ts = concatMap (fromTree :: Tree -> String) ts
+
\end{code}
\ No newline at end of file
projects / fleet.git / commitdiff