8 class FromTrees a where
9 fromTrees :: [Tree] -> a
10 instance FromTree a => FromTree [a] where
11 fromTree (Tree _ c _) = map fromTree c
13 data Def = Def String [String] [String] Expr
15 instance Show Def where
16 show (Def name inp outp exprs) =
17 name ++ "(" ++ (commify inp) ++ " -> " ++ (commify outp) ++ ") =\n " ++ (indent (show exprs))
19 commify x = join "," x
21 instance FromTree Def where
22 fromTree (Tree "Def" [name,inp,outp,es] _) =
23 Def (fromTree name) (fromTree inp) (fromTree outp) (Par (fromTree es))
24 fromTree (Tree "Def" q _) = error $ show q
26 data Port = ShipPort String String
29 instance Show Port where
30 show (ShipPort a b) = a++"."++b
32 instance FromTree Port where
33 fromTree (Tree "Port" [s] _) = IdPort (fromTree s)
34 fromTree (Tree "Port" [a,b] _) = ShipPort (fromTree a) (fromTree b)
35 fromTree t = error (show t)
37 data Expr = Decl String String
40 | Move Int Port [Port]
41 | Literal Int Int [Port]
44 instance Show Expr where
45 show (Decl shipName shipType) = shipName ++ " :: " ++ shipType
46 show (Seq exprs) = join " ;; " $ map (\x -> "{ "++x++" }") $ map show exprs
47 show (Par [expr]) = show expr
48 show (Par exprs) = "{ " ++ (join "\n " $ map show exprs) ++ " }"
49 show (Move 0 source dests) = (show source) ++ " -[*]-> " ++ (join "," $ map show dests)
50 show (Move 1 source dests) = (show source) ++ " --> " ++ (join "," $ map show dests)
51 show (Move count source dests) = (show source) ++ " -["++(show count)++"]-> " ++ (join "," $ map show dests)
52 show (Literal 0 i dest) = (show i) ++ " -[*]-> " ++ (show dest)
53 show (Literal 1 i dest) = (show i) ++ " --> " ++ (show dest)
54 show (Literal count i dest) = (show i) ++ " -["++(show count)++"]-> " ++ (show dest)
56 instance FromTree Expr where
57 fromTree (Tree "::" [shipName,shipType] _) = Decl (fromTree shipName) (fromTree shipType)
58 fromTree (Tree "-->" [(Tree i [] _),dest] _) = Literal 1 (read i) (fromTree dest)
59 fromTree (Tree "-->" [source,dest] _) = Move 1 (fromTree source) (fromTree dest)
60 fromTree (Tree "-[" [(Tree i [] _),(Tree c [] _),dest] _) = Literal (read c) (read i) (fromTree dest)
61 fromTree (Tree "-[" [source,(Tree c [] _),dest] _) = Move (read c) (fromTree source) (fromTree dest)
62 fromTree (Tree "-[*]->" [(Tree i [] _),dest] _) = Literal 0 (read i) (fromTree dest)
63 fromTree (Tree "-[*]->" [source,dest] _) = Move 0 (fromTree source) (fromTree dest)
64 fromTree t@(Tree "{" [(Tree _ e _)] _) = Par (map fromTree e)
65 fromTree t@(Tree ";;" [a,b] _) = Seq [(fromTree a), (fromTree b)]
66 fromTree other = error (show other)
68 instance FromTree String where
69 fromTree (Tree h c _) = h++(concatMap fromTree c)
70 instance FromTrees String where
71 fromTrees ts = concatMap (fromTree :: Tree -> String) ts
76 | ILiteral Int BenkoBox
77 | IMove { m_benkobox :: BenkoBox ,
78 m_dest :: Maybe BenkoBox ,
87 showCount 0 True = "[*r] "
88 showCount 0 False = "[*] "
90 showCount n True = "["++(show n)++"r] "
91 showCount n False = "["++(show n)++"] "
93 instance Show Inst where
94 show (IKill bb count) = (show bb)++": "++(showCount count False)++" kill;"
95 show (ILiteral lit bb) = (show lit)++": sendto "++(show bb)++";"
96 show m@(_) = (show $ m_benkobox m) ++
98 (showCount (m_count m) $ m_recycle m) ++
99 (join ", " $ showrest m)++
102 showrest m = wait++takelatch++out++ack
104 wait = if m_tokenIn m then ["wait"] else []
105 takelatch = if m_dataIn m then (if m_latch m then ["take"] else ["drop"]) else []
106 out = if m_dataOut m then (case m_dest m of { Nothing -> ["deliver"]; (Just j) -> ["sendto "++(show j)] }) else []
107 ack = if m_tokenOut m then (case m_dest m of (Just j) -> ["ack "++(show j)]) else []