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) (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, Ord)
  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 Decl  = Decl String String
  36   deriving (Show,Eq)
  37 data Expr  = Seq     [Expr]
  38            | Par     [Expr]
  39            | Exprs   [Decl] Expr
  40            | Move     Int Port    Port
  41            | Literal  Int Int     Port
  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 Decl where
  59  fromTree (Tree "::" [shipName,shipType] _) = Decl    (fromTree shipName) (fromTree shipType)
  60
  61 instance FromTree Expr where
  62   fromTree (Tree "Exprs" [decls, sequents] _) = Exprs (fromTree decls) (seq $ map par $ fromTree sequents)
  63    where seq []  = Nop
  64          seq [x] = x
  65          seq x   = Seq x
  66          par []  = Nop
  67          par [x] = x
  68          par x   = Par x
  69   fromTree (Tree "-->" es _) =
  70    case es of
  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)
  79
  80 rep :: [Port] -> (Port -> Expr) -> Expr
  81 rep []   _ = error "nop"
  82 rep [x]  f = f x
  83 rep list f = Par $ map f list
  84
  85 \end{code}