6 - Transform code involving standing moves into two sequential
7 blocks: setup and teardown. Then establish proper sequencing
8 between them. The teardown block consists only of kills.
10 - Implement sequencing.
16 main = do t <- parseFile "src/edu/berkeley/fleet/f0/f0.g" "contrib/demo.f0"
18 putStrLn $ show $ coalesceFlatHeadlessNodes t
20 putStrLn $ join "\n\n" $ map show $ ((fromTree $ coalesceFlatHeadlessNodes t) :: [Def])
22 compiled <- return $ join "\n\n" $ map compileDef $ ((fromTree $ coalesceFlatHeadlessNodes t) :: [Def])
24 writeFile "compiled.fleet" ("// compiled with f0\n\n"++compiled++"\n")
27 class FromTree a where
29 class FromTrees a where
30 fromTrees :: [Tree] -> a
31 instance FromTree a => FromTree [a] where
32 fromTree (Tree _ c _) = map fromTree c
35 indent ('\n':q) = "\n "++(indent q)
36 indent (a:b) = a:(indent b)
40 join c (x:y) = x++c++(join c y)
42 data Def = Def String [String] [String] Expr
44 instance Show Def where
45 show (Def name inp outp exprs) =
46 name ++ "(" ++ (commify inp) ++ " -> " ++ (commify outp) ++ ") =\n " ++ (indent (show exprs))
48 commify x = join "," x
50 instance FromTree Def where
51 fromTree (Tree "Def" [name,inp,outp,es] _) =
52 Def (fromTree name) (fromTree inp) (fromTree outp) (Par (fromTree es))
53 fromTree (Tree "Def" q _) = error $ show q
55 data Port = ShipPort String String
58 instance Show Port where
59 show (ShipPort a b) = a++"."++b
61 instance FromTree Port where
62 fromTree (Tree "Port" [s] _) = IdPort (fromTree s)
63 fromTree (Tree "Port" [a,b] _) = ShipPort (fromTree a) (fromTree b)
64 fromTree t = error (show t)
66 data Expr = Decl String String
69 | Move Int Port [Port]
70 | Literal Int Int [Port]
73 instance Show Expr where
74 show (Decl shipName shipType) = shipName ++ " :: " ++ shipType
75 show (Seq exprs) = join " ;; " $ map (\x -> "{ "++x++" }") $ map show exprs
76 show (Par [expr]) = show expr
77 show (Par exprs) = "{ " ++ (join "\n " $ map show exprs) ++ " }"
78 show (Move 0 source dests) = (show source) ++ " -[*]-> " ++ (join "," $ map show dests)
79 show (Move 1 source dests) = (show source) ++ " --> " ++ (join "," $ map show dests)
80 show (Move count source dests) = (show source) ++ " -["++(show count)++"]-> " ++ (join "," $ map show dests)
81 show (Literal 0 i dest) = (show i) ++ " -[*]-> " ++ (show dest)
82 show (Literal 1 i dest) = (show i) ++ " --> " ++ (show dest)
83 show (Literal count i dest) = (show i) ++ " -["++(show count)++"]-> " ++ (show dest)
85 instance FromTree Expr where
86 fromTree (Tree "::" [shipName,shipType] _) = Decl (fromTree shipName) (fromTree shipType)
87 fromTree (Tree "-->" [(Tree i [] _),dest] _) = Literal 1 (read i) (fromTree dest)
88 fromTree (Tree "-->" [source,dest] _) = Move 1 (fromTree source) (fromTree dest)
89 fromTree (Tree "-[" [(Tree i [] _),(Tree c [] _),dest] _) = Literal (read c) (read i) (fromTree dest)
90 fromTree (Tree "-[" [source,(Tree c [] _),dest] _) = Move (read c) (fromTree source) (fromTree dest)
91 fromTree (Tree "-[*]->" [(Tree i [] _),dest] _) = Literal 0 (read i) (fromTree dest)
92 fromTree (Tree "-[*]->" [source,dest] _) = Move 0 (fromTree source) (fromTree dest)
93 fromTree t@(Tree "{" [(Tree _ e _)] _) = Par (map fromTree e)
94 fromTree t@(Tree ";;" [a,b] _) = Seq [(fromTree a), (fromTree b)]
95 fromTree other = error (show other)
97 instance FromTree String where
98 fromTree (Tree h c _) = h++(concatMap fromTree c)
99 instance FromTrees String where
100 fromTrees ts = concatMap (fromTree :: Tree -> String) ts
103 compile :: Expr -> [Inst]
104 compile (Decl _ _) = []
105 compile (Seq s) = error "bleh"
106 compile (Par e) = concatMap compile e
107 compile (Move 1 s [d]) = [ move { m_benkobox=s, m_dest=(Just d) },
108 accept { m_benkobox=d } ]
109 compile (Move 1 s d) = [itake { m_benkobox=s }]++sends++recvs
111 sends = map (\x -> (send { m_benkobox=s, m_dest=(Just x) })) d
112 recvs = map (\x -> (accept { m_benkobox=x })) d
113 compile (Literal 0 lit ds) = concatMap (\d -> [ ILiteral lit d,
114 accept { m_benkobox=d, m_count=0 } ]) ds
115 compile (Literal 1 lit ds) = concatMap (\d -> [ ILiteral lit d,
116 accept { m_benkobox=d } ]) ds
117 compile (Literal n lit ds) = concatMap (\d -> [ ILiteral lit d,
118 accept { m_benkobox=d, m_count=n } ]) ds
120 getdecls (Decl n t) = ["#ship " ++ n ++ " : " ++ t]
121 getdecls (Seq es) = concatMap getdecls es
122 getdecls (Par es) = concatMap getdecls es
125 compileDef (Def s _ _ e) =
126 "// " ++ s ++ "\n" ++
127 (join "\n" $ getdecls e)++"\n"++
128 (join "\n" $ map show (compile e))
130 itake = IMove { m_count=1, m_recycle=False, m_tokenIn=False, m_dataIn=True,
131 m_latch=True, m_dataOut=False, m_tokenOut=False, m_dest=Nothing }
132 move = itake { m_dataOut=True }
133 send = move { m_dataIn=False, m_latch=False }
139 | ILiteral Int BenkoBox
140 | IMove { m_benkobox :: BenkoBox ,
141 m_dest :: Maybe BenkoBox ,
150 showCount 0 True = "[*r] "
151 showCount 0 False = "[*] "
154 showCount n True = "["++(show n)++"r] "
155 showCount n False = "["++(show n)++"] "
157 instance Show Inst where
158 show (IKill bb count) = (show bb)++": "++(showCount count False)++" kill;"
159 show (ILiteral lit bb) = (show lit)++": sendto "++(show bb)++";"
160 show m@(_) = (show $ m_benkobox m) ++
162 (showCount (m_count m) $ m_recycle m) ++
163 (join ", " $ showrest m)++
166 showrest m = wait++takelatch++out++ack
168 wait = if m_tokenIn m then ["wait"] else []
169 takelatch = if m_dataIn m then (if m_latch m then ["take"] else ["drop"]) else []
170 out = if m_dataOut m then (case m_dest m of { Nothing -> ["deliver"]; (Just j) -> ["sendto "++(show j)] }) else []
171 ack = if m_tokenOut m then (case m_dest m of (Just j) -> ["ack "++(show j)]) else []