6 -- Def ------------------------------------------------------------------------------
7 data Def = Def String [String] [String] Expr
9 instance Show Def where
10 show (Def name inp outp exprs) =
11 name ++ "(" ++ (commify inp) ++ " -> " ++ (commify outp) ++ ") =\n " ++ (indent (show exprs))
13 commify x = join "," x
14 instance FromTree Def where
15 fromTree (Tree "Def" [name,inp,outp,es] _) =
16 Def (fromTree name) (fromTree inp) (fromTree outp) (fromTree es)
17 fromTree (Tree "Def" q _) = error $ show q
19 -- Port ------------------------------------------------------------------------------
20 data Port = ShipPort String String
24 instance Show Port where
25 show (ShipPort a b) = a++"."++b
28 instance FromTree Port where
29 fromTree (Tree "Port" [s] _) = IdPort (fromTree s)
30 fromTree (Tree "Port" [a,b] _) = ShipPort (fromTree a) (fromTree b)
31 fromTree t = error (show t)
34 -- Expr ------------------------------------------------------------------------------
35 data Decl = Decl String String
37 data Expr = Seq [Expr]
41 | Literal Int Int Port
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 Decl where
59 fromTree (Tree "::" [shipName,shipType] _) = Decl (fromTree shipName) (fromTree shipType)
61 instance FromTree Expr where
62 fromTree (Tree "Exprs" [decls, sequents] _) = Exprs (fromTree decls) (seq $ map par $ fromTree sequents)
69 fromTree (Tree "-->" es _) =
71 [(Tree i [] _),dest] -> rep (fromTree dest) $ \d -> Literal 1 (read i) d
72 [(Tree "{" [Tree _ is _] _),dest] -> Par $ concatMap (\d -> map (\(Tree i _ _) -> Literal 1 (read i) d) is) (fromTree dest)
73 [source,dest] -> rep (fromTree dest) $ \d -> Move 1 (fromTree source) d
74 -- fromTree (Tree "-[" [(Tree i [] _),(Tree c [] _),dest] _) = Literal (read c) (read i) (fromTree dest)
75 -- fromTree (Tree "-[" [source,(Tree c [] _),dest] _) = Move (read c) (fromTree source) (fromTree dest)
76 -- fromTree (Tree "-[*]->" [(Tree i [] _),dest] _) = Literal 0 (read i) (fromTree dest)
77 -- fromTree (Tree "-[*]->" [source,dest] _) = Move 0 (fromTree source) (fromTree dest)
78 fromTree other = error $ (show other)
80 rep :: [Port] -> (Port -> Expr) -> Expr
81 rep [] _ = error "nop"
83 rep list f = Par $ map f list