+\begin{code}
+module Types where
+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
+
+data Def = Def String [String] [String] Expr
+ deriving Eq
+instance Show Def where
+ show (Def name inp outp exprs) =
+ 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
+
+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)
+
+data Expr = Decl String String
+ | Seq [Expr]
+ | Par [Expr]
+ | Move Int Port [Port]
+ | Literal Int Int [Port]
+ deriving Eq
+
+instance Show Expr where
+ show (Decl shipName shipType) = shipName ++ " :: " ++ shipType
+ show (Seq exprs) = join " ;; " $ map (\x -> "{ "++x++" }") $ map show exprs
+ show (Par [expr]) = show expr
+ show (Par exprs) = "{ " ++ (join "\n " $ map show exprs) ++ " }"
+ show (Move 0 source dests) = (show source) ++ " -[*]-> " ++ (join "," $ map show dests)
+ show (Move 1 source dests) = (show source) ++ " --> " ++ (join "," $ map show dests)
+ show (Move count source dests) = (show source) ++ " -["++(show count)++"]-> " ++ (join "," $ map show dests)
+ show (Literal 0 i dest) = (show i) ++ " -[*]-> " ++ (show dest)
+ show (Literal 1 i dest) = (show i) ++ " --> " ++ (show dest)
+ show (Literal count i dest) = (show i) ++ " -["++(show count)++"]-> " ++ (show dest)
+
+instance FromTree Expr where
+ fromTree (Tree "::" [shipName,shipType] _) = Decl (fromTree shipName) (fromTree shipType)
+ fromTree (Tree "-->" [(Tree i [] _),dest] _) = Literal 1 (read i) (fromTree dest)
+ fromTree (Tree "-->" [source,dest] _) = Move 1 (fromTree source) (fromTree dest)
+ fromTree (Tree "-[" [(Tree i [] _),(Tree c [] _),dest] _) = Literal (read c) (read i) (fromTree dest)
+ fromTree (Tree "-[" [source,(Tree c [] _),dest] _) = Move (read c) (fromTree source) (fromTree dest)
+ fromTree (Tree "-[*]->" [(Tree i [] _),dest] _) = Literal 0 (read i) (fromTree dest)
+ fromTree (Tree "-[*]->" [source,dest] _) = Move 0 (fromTree source) (fromTree dest)
+ fromTree t@(Tree "{" [(Tree _ e _)] _) = Par (map fromTree e)
+ 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