src/edu/berkeley/fleet/f0/Types.lhs

   1 \begin{code}
   2 module Types where
   3 import SBP
   4 import Util
   5
   6 -- Def ------------------------------------------------------------------------------
   7 data Def = Def String [String] [String] Expr
   8   deriving Eq
   9 instance Show Def where
  10  show (Def name inp outp exprs) =
  11      name ++ "(" ++ (commify inp) ++ " -> " ++ (commify outp) ++ ") =\n   " ++ (indent (show exprs))
  12   where
  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) (Par (fromTree es))
  17   fromTree (Tree "Def" q _) = error $ show q
  18
  19 -- Port ------------------------------------------------------------------------------
  20 data Port = ShipPort String String
  21           | IdPort   String
  22  deriving Eq
  23
  24 instance Show Port where
  25  show (ShipPort a b) = a++"."++b
  26  show (IdPort a)     = a
  27
  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)
  32
  33
  34 -- Expr ------------------------------------------------------------------------------
  35 data Expr = Decl     String  String
  36           | Seq      [Expr]
  37           | Par      [Expr]
  38           | Move     Int Port    [Port]
  39           | Literal  Int Int     [Port]
  40   deriving Eq
  41
  42 instance Show Expr where
  43  show (Decl shipName shipType) = shipName ++ " :: " ++ shipType
  44  show (Seq  exprs)             = join " ;; " $ map (\x -> "{ "++x++" }") $ map show exprs
  45  show (Par  [expr])            = show expr
  46  show (Par  exprs)             = "{ " ++ (join "\n   " $ map show exprs) ++ " }"
  47  show (Move 0 source dests)      = (show source) ++ " -[*]-> " ++ (join "," $ map show dests)
  48  show (Move 1 source dests)      = (show source) ++ " --> " ++ (join "," $ map show dests)
  49  show (Move count source dests)      = (show source) ++ " -["++(show count)++"]-> " ++ (join "," $ map show dests)
  50  show (Literal 0 i dest)   = (show i) ++ " -[*]-> " ++ (show dest)
  51  show (Literal 1 i dest)   = (show i) ++ " --> " ++ (show dest)
  52  show (Literal count i dest)   = (show i) ++ " -["++(show count)++"]-> " ++ (show dest)
  53
  54 instance FromTree Expr where
  55   fromTree (Tree "::"     [shipName,shipType] _)                = Decl    (fromTree shipName) (fromTree shipType)
  56   fromTree (Tree "-->"    [(Tree i [] _),dest] _)               = Literal 1        (read i)          (fromTree dest)
  57   fromTree (Tree "-->"    [source,dest] _)                      = Move    1        (fromTree source) (fromTree dest)
  58   fromTree (Tree "-["     [(Tree i [] _),(Tree c [] _),dest] _) = Literal (read c) (read i)            (fromTree dest)
  59   fromTree (Tree "-["     [source,(Tree c [] _),dest] _)        = Move    (read c) (fromTree source)   (fromTree dest)
  60   fromTree (Tree "-[*]->" [(Tree i [] _),dest] _)               = Literal 0        (read i)            (fromTree dest)
  61   fromTree (Tree "-[*]->" [source,dest] _)                      = Move    0        (fromTree source)   (fromTree dest)
  62   fromTree t@(Tree "{"    [(Tree _ e _)] _)                     = Par     (map fromTree e)
  63   fromTree t@(Tree ";;"   [a,b] _)                              = Seq    [(fromTree a), (fromTree b)]
  64   fromTree other = error  (show other)
  65
  66 \end{code}