contrib/f0/Types.lhs

   1 \begin{code}
   2 module Types where
   3 import SBP
   4 import Util
   5 import Fleet
   6
   7 -- Def ------------------------------------------------------------------------------
   8 data Def = Def String [String] [String] Expr
   9   deriving Eq
  10 instance Show Def where
  11  show (Def name inp outp exprs) =
  12      name ++ "(" ++ (commify inp) ++ " -> " ++ (commify outp) ++ ") =\n   " ++ (indent (show exprs))
  13   where
  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
  19
  20
  21
  22 -- Expr ------------------------------------------------------------------------------
  23 data Op = Lt | Gt | Leq | Geq | Eq | Neq
  24  deriving (Show,Eq)
  25 instance FromTree Op where
  26   fromTree (Tree s _ _) =
  27    case s of
  28     "==" -> Eq
  29     "!=" -> Neq
  30     ">=" -> Geq
  31     "<=" -> Leq
  32     ">"  -> Gt
  33     "<"  -> Lt
  34
  35 data Expr  = Seq     [Expr]
  36            | Par     [Expr]
  37            | Decl    [(String,String)] Expr
  38            | Move    Int Port Port
  39            | Copy    Int Port Port
  40            | Literal Int Int  Port
  41            | While   Port Op Int Expr
  42            | Nop
  43   deriving (Show,Eq)
  44 {-
  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)
  56 -}
  57
  58 instance FromTree Expr where
  59   fromTree (Tree "Exprs" [(Tree _ decls _), sequents] _) = Decl declist (seq $ map par $ fromTree sequents)
  60    where
  61          declist = map (\(Tree "::" [shipName,shipType] _) -> ((fromTree shipName), (fromTree shipType))) decls
  62          seq []  = Nop
  63          seq [x] = x
  64          seq x   = Seq x
  65          par []  = Nop
  66          par [x] = x
  67          par x   = Par x
  68   fromTree (Tree arrow [source,dests] _) | (arrow=="-->" || arrow=="+->") =
  69    case source of
  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) _] _) ->
  75                                        Par $
  76                                          ((mc 1 (fromTree source) (fromTree d)):
  77                                           (map (\d' -> Copy 1 (fromTree source) d') (map fromTree ds)))
  78    where
  79     mc = if arrow=="-->" then Move else Copy
  80     dest = case dests of
  81              (Tree ";" [Tree _ d _] _) -> map fromTree d
  82     rep' []   _ = error "nop"
  83     rep' [x]  f = f x
  84     rep' list f = Par $ map f list
  85
  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)
  93
  94
  95 \end{code}