From: adam <adam@megacz.com>
Date: Mon, 26 Feb 2007 16:35:16 +0000 (+0100)
Subject: further separation on f0 code
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=c721b45edfa82397a1f286a63dbb32fbc658f1dc;p=fleet.git

further separation on f0 code
---

diff --git a/Makefile b/Makefile
index 0e706d5..29a0551 100644
--- a/Makefile
+++ b/Makefile
@@ -154,6 +154,8 @@ f0: fleet.jar
 	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 Fleet.lhs
+	cd src/edu/berkeley/fleet/f0/; $(ghc) -fglasgow-exts -cpp $(hflags)    -java Compile.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/Compile.lhs b/src/edu/berkeley/fleet/f0/Compile.lhs
new file mode 100644
index 0000000..cdbf292
--- /dev/null
+++ b/src/edu/berkeley/fleet/f0/Compile.lhs
@@ -0,0 +1,30 @@
+\begin{code}
+module Compile where
+import SBP
+import Types
+import Util
+import Fleet
+
+compile :: Expr -> [Inst]
+compile (Decl _ _)      = []
+compile (Seq s)         = error "bleh"
+compile (Par e)         = concatMap compile e
+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   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
+getdecls (Par es)   = concatMap getdecls es
+getdecls _          = []
+
+compileDef (Def s _ _ e) =
+    "// " ++ s ++ "\n" ++
+    (join "\n" $ getdecls e)++"\n"++
+    (join "\n" $ map show (compile e))
+\end{code}
\ No newline at end of file
diff --git a/src/edu/berkeley/fleet/f0/Fleet.lhs b/src/edu/berkeley/fleet/f0/Fleet.lhs
new file mode 100644
index 0000000..0cad15f
--- /dev/null
+++ b/src/edu/berkeley/fleet/f0/Fleet.lhs
@@ -0,0 +1,48 @@
+\begin{code}
+module Fleet where
+import Util
+import Types
+
+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
+
+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/Main.lhs b/src/edu/berkeley/fleet/f0/Main.lhs
index 9fded1a..f81a0b9 100644
--- a/src/edu/berkeley/fleet/f0/Main.lhs
+++ b/src/edu/berkeley/fleet/f0/Main.lhs
@@ -15,6 +15,8 @@ where
 import SBP
 import Types
 import Util
+import Fleet
+import Compile
 
 main = do t <- parseFile "src/edu/berkeley/fleet/f0/f0.g" "contrib/demo.f0"
           putStrLn ""
@@ -27,38 +29,6 @@ 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 ""
 
-compile :: Expr -> [Inst]
-compile (Decl _ _)      = []
-compile (Seq s)         = error "bleh"
-compile (Par e)         = concatMap compile e
-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   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
-getdecls (Par es)   = concatMap getdecls es
-getdecls _          = []
-
-compileDef (Def s _ _ e) =
-    "// " ++ s ++ "\n" ++
-    (join "\n" $ getdecls e)++"\n"++
-    (join "\n" $ map show (compile e))
-
-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
index 9b478b1..eb955e8 100644
--- a/src/edu/berkeley/fleet/f0/Types.lhs
+++ b/src/edu/berkeley/fleet/f0/Types.lhs
@@ -3,13 +3,7 @@ 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
-
+-- Def ------------------------------------------------------------------------------
 data Def = Def String [String] [String] Expr
   deriving Eq
 instance Show Def where
@@ -17,23 +11,27 @@ instance Show Def where
      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
 
+-- Port ------------------------------------------------------------------------------
 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)
 
+
+-- Expr ------------------------------------------------------------------------------
 data Expr = Decl     String  String
           | Seq      [Expr] 
           | Par      [Expr]
@@ -65,45 +63,4 @@ instance FromTree Expr where
   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
index e2cb5de..6f27ee9 100644
--- a/src/edu/berkeley/fleet/f0/Util.lhs
+++ b/src/edu/berkeley/fleet/f0/Util.lhs
@@ -1,5 +1,6 @@
 \begin{code}
 module Util where
+import SBP
 
 indent []       = []
 indent ('\n':q) = "\n  "++(indent q)
@@ -8,4 +9,16 @@ indent (a:b)    = a:(indent b)
 join c []    = ""
 join c [x]   = x
 join c (x:y) = x++c++(join c y)
+
+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
+instance FromTree  String where
+  fromTree  (Tree h c _) = h++(concatMap fromTree c)
+instance FromTrees String where
+  fromTrees ts           = concatMap (fromTree :: Tree -> String) ts
+
 \end{code}
\ No newline at end of file