7 -- Def ------------------------------------------------------------------------------
8 data Def = Def String [String] [String] Expr
10 instance Show Def where
11 show (Def name inp outp exprs) =
12 name ++ "(" ++ (commify inp) ++ " -> " ++ (commify outp) ++ ") =\n " ++ (indent (show exprs))
14 commify x = join "," x
15 instance FromTree Def where
16 fromTree (Tree "Def" [name,inp,outp,es] _) =
17 Def (fromTree name) (fromTree inp) (fromTree outp) (fromTree es)
18 fromTree (Tree "Def" q _) = error $ show q
22 -- Expr ------------------------------------------------------------------------------
23 data Op = Lt | Gt | Leq | Geq | Eq | Neq
25 instance FromTree Op where
26 fromTree (Tree s _ _) =
35 data Expr = Seq [Expr]
37 | Decl [(String,String)] Expr
40 | Literal Int Int Port
41 | While Port Op Int Expr
45 instance Show Expr where
46 show (Decl shipName shipType) = shipName ++ " :: " ++ shipType
47 show (Seq exprs) = join " ;; " $ map (\x -> "{ "++x++" }") $ map show exprs
48 show (Par [expr]) = show expr
49 show (Par exprs) = "{ " ++ (join "\n " $ map show exprs) ++ " }"
50 show (Move 0 source dest) = (show source) ++ " -[*]-> " ++ (show dest)
51 show (Move 1 source dest) = (show source) ++ " --> " ++ (show dest)
52 show (Move count source dest) = (show source) ++ " -["++(show count)++"]-> " ++ (show dest)
53 show (Literal 0 i dest) = (show i) ++ " -[*]-> " ++ (show dest)
54 show (Literal 1 i dest) = (show i) ++ " --> " ++ (show dest)
55 show (Literal count i dest) = (show i) ++ " -["++(show count)++"]-> " ++ (show dest)
58 instance FromTree Expr where
59 fromTree (Tree "Exprs" [(Tree _ decls _), sequents] _) = Decl declist (seq $ map par $ fromTree sequents)
61 declist = map (\(Tree "::" [shipName,shipType] _) -> ((fromTree shipName), (fromTree shipType))) decls
68 fromTree (Tree arrow [source,dests] _) | (arrow=="-->" || arrow=="+->") =
70 (Tree "{" [Tree _ is _] _) -> Par $ concatMap (\d -> map (\(Tree i _ _) -> Literal 1 (read i) d) is) dest
71 (Tree i [] _) -> rep' dest $ \d -> Literal 1 (read i) d
72 source -> case dests of
73 (Tree ";" [Tree _ d _] _) -> rep' dest $ \d -> mc 1 (fromTree source) d
74 (Tree "," [Tree _ (d:ds) _] _) ->
76 ((mc 1 (fromTree source) (fromTree d)):
77 (map (\d' -> Copy 1 (fromTree source) d') (map fromTree ds)))
79 mc = if arrow=="-->" then Move else Copy
81 (Tree ";" [Tree _ d _] _) -> map fromTree d
82 rep' [] _ = error "nop"
84 rep' list f = Par $ map f list
86 -- fromTree (Tree "-[" [(Tree i [] _),(Tree c [] _),dest] _) = Literal (read c) (read i) (fromTree dest)
87 -- fromTree (Tree "-[" [source,(Tree c [] _),dest] _) = Move (read c) (fromTree source) (fromTree dest)
88 -- fromTree (Tree "-[*]->" [(Tree i [] _),dest] _) = Literal 0 (read i) (fromTree dest)
89 -- fromTree (Tree "-[*]->" [source,dest] _) = Move 0 (fromTree source) (fromTree dest)
90 fromTree (Tree "while" [(Tree "Cond" [port, op, (Tree i _ _)] _), e] _) =
91 While (fromTree port) (fromTree op) (read i) (fromTree e)
92 fromTree other = error $ (show other)