refactor f0 into separate files

diff --git a/Makefile b/Makefile
index 8d18f5d..0e706d5 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -152,6 +152,8 @@ ghc += -i$(shell pwd)/build/hi/ -hidir $(shell pwd)/build/hi/ -odir $(shell pwd)
 f0: fleet.jar
        mkdir -p build/hi build/class
        cd lib;                        $(ghc) -c -java SBP.lhs
+       cd src/edu/berkeley/fleet/f0/; $(ghc) -fglasgow-exts -cpp $(hflags)    -java Util.lhs
+       cd src/edu/berkeley/fleet/f0/; $(ghc) -fglasgow-exts -cpp $(hflags)    -java Types.lhs
        cd src/edu/berkeley/fleet/f0/; $(ghc) -fglasgow-exts -cpp $(hflags)    -java Main.lhs
        $(java) -cp build/class:lib/HSbase.jar:lib/HSrts.jar:lib/HSstm.jar:fleet.jar Main
 

diff --git a/src/edu/berkeley/fleet/f0/Main.lhs b/src/edu/berkeley/fleet/f0/Main.lhs
index 7b50707..9fded1a 100644 (file)
--- a/src/edu/berkeley/fleet/f0/Main.lhs
+++ b/src/edu/berkeley/fleet/f0/Main.lhs
@@ -13,6 +13,9 @@
 module Main
 where
 import SBP
+import Types
+import Util
+
 main = do t <- parseFile "src/edu/berkeley/fleet/f0/f0.g" "contrib/demo.f0"
           putStrLn ""
           putStrLn $ show $ coalesceFlatHeadlessNodes t
@@ -24,98 +27,18 @@ main = do t <- parseFile "src/edu/berkeley/fleet/f0/f0.g" "contrib/demo.f0"
           writeFile "compiled.fleet" ("// compiled with f0\n\n"++compiled++"\n")
           putStrLn ""
 
-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
-
-indent []       = []
-indent ('\n':q) = "\n  "++(indent q)
-indent (a:b)    = a:(indent b)
-
-join c []    = ""
-join c [x]   = x
-join c (x:y) = x++c++(join c y)
-
-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
-
-
 compile :: Expr -> [Inst]
 compile (Decl _ _)      = []
 compile (Seq s)         = error "bleh"
 compile (Par e)         = concatMap compile e
-compile (Move 1 s [d])    = [ move { m_benkobox=s, m_dest=(Just d) },
-                              accept { m_benkobox=d } ]
-compile (Move 1 s d)      = [itake { m_benkobox=s }]++sends++recvs
+compile (Move 1 s [d])    = [ (move s) { m_dest=(Just d) }, (accept d) ]
+compile (Move 1 s d)      = [itake s]++sends++recvs
  where
-   sends = map (\x -> (send   { m_benkobox=s, m_dest=(Just x) })) d
-   recvs = map (\x -> (accept { m_benkobox=x })) d
-compile (Literal 0 lit ds) =  concatMap (\d -> [ ILiteral lit d,
-                                                 accept { m_benkobox=d, m_count=0 } ]) ds
-compile (Literal 1 lit ds) =  concatMap (\d -> [ ILiteral lit d,
-                                                 accept { m_benkobox=d } ]) ds
-compile (Literal n lit ds) =  concatMap (\d -> [ ILiteral lit d,
-                                                 accept { m_benkobox=d, m_count=n } ]) ds
+   sends = map (\x -> ((send   s) { m_dest=(Just x) })) d
+   recvs = map (\x -> ((accept x) )) d
+compile (Literal 0 lit ds) =  concatMap (\d -> [ ILiteral lit d, (accept d) {m_count=0} ]) ds
+compile (Literal 1 lit ds) =  concatMap (\d -> [ ILiteral lit d, (accept d)             ]) ds
+compile (Literal n lit ds) =  concatMap (\d -> [ ILiteral lit d, (accept d) {m_count=n} ]) ds
 
 getdecls (Decl n t) = ["#ship " ++ n ++ " : " ++ t]
 getdecls (Seq es)   = concatMap getdecls es
@@ -127,48 +50,13 @@ compileDef (Def s _ _ e) =
     (join "\n" $ getdecls e)++"\n"++
     (join "\n" $ map show (compile e))
 
-itake  = IMove { m_count=1, m_recycle=False, m_tokenIn=False, m_dataIn=True,
-                 m_latch=True, m_dataOut=False, m_tokenOut=False, m_dest=Nothing }
-move   = itake { m_dataOut=True }
-send   = move { m_dataIn=False, m_latch=False }
-accept = move
-
-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 1 r     = ""
-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 []
+itake  box = IMove { m_count=1, m_recycle=False, m_tokenIn=False, m_dataIn=True,
+                     m_latch=True, m_dataOut=False, m_tokenOut=False, m_dest=Nothing,
+                     m_benkobox=box }
+move   box = (itake box){ m_dataOut=True }
+send   box = (move box){ m_dataIn=False, m_latch=False }
+accept box = move box
+
 
 
 \end{code}

diff --git a/src/edu/berkeley/fleet/f0/Types.lhs b/src/edu/berkeley/fleet/f0/Types.lhs
new file mode 100644 (file)
index 0000000..9b478b1
--- /dev/null
+++ b/src/edu/berkeley/fleet/f0/Types.lhs
@@ -0,0 +1,109 @@
+\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

diff --git a/src/edu/berkeley/fleet/f0/Util.lhs b/src/edu/berkeley/fleet/f0/Util.lhs
new file mode 100644 (file)
index 0000000..e2cb5de
--- /dev/null
+++ b/src/edu/berkeley/fleet/f0/Util.lhs
@@ -0,0 +1,11 @@
+\begin{code}
+module Util where
+
+indent []       = []
+indent ('\n':q) = "\n  "++(indent q)
+indent (a:b)    = a:(indent b)
+
+join c []    = ""
+join c [x]   = x
+join c (x:y) = x++c++(join c y)
+\end{code}
\ No newline at end of file