--- /dev/null
+
+main(x -> out) =
+ alu :: Alu2
+ debug :: Debug
+ fifo1 :: Fifo
+ fifo2 :: Fifo
+ { 0, 1, 2 } --> fifo1.in
+ { 0, 3, 4 } --> fifo2.in
+ fifo1.out --> alu.inOp, alu.in1, alu.in2
+ alu.out --> debug.in
+ ;;
+ fifo2.out --> alu.inOp, alu.in1, alu.in2
+ alu.out --> debug.in
+
+/*
+double(a -> out) =
+ alu :: Alu2
+ a --> alu.in1, alu.in2
+ 0 --> alu.inOp
+ alu.out --> out
+
+
+half(a -> out) =
+ shift :: Shift
+ a --> shift.in
+ 1 --> shift.inAmount
+ shift.out --> out
+
+thrice(a -> out) =
+ alu :: Alu2
+ a --> alu.in1, alu.in2, alu.in2
+ 0 -[2]-> alu.inOp
+ { alu.out --> alu.in2
+ alu.out --> alu.out
+ }
+*/
import Util
import Fleet
+-- assumption:
+-- within a block that has data going both to and from a ship,
+-- the last datum leaving the ship must leave after all arriving
+-- datums have arrived
+
+getInboxes :: Expr -> [Port]
+getInboxes (Move 1 s d) = [d]
+getInboxes (Exprs d e) = getInboxes e
+getInboxes (Par e) = concatMap getInboxes e
+getInboxes (Seq [a,b]) = getInboxes a
+getInboxes _ = []
+
+getOutboxes :: Expr -> [Port]
+getOutboxes (Move 1 s d) = [s]
+getOutboxes (Exprs d e) = getOutboxes e
+getOutboxes (Par e) = concatMap getOutboxes e
+getOutboxes (Seq [a,b]) = getOutboxes b
+getOutboxes _ = []
+
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
+compile (Literal 0 lit d) = [ ILiteral lit d, (accept d) {m_count=0} ]
+compile (Literal 1 lit d) = [ ILiteral lit d, (accept d) ]
+compile (Literal n lit d) = [ ILiteral lit d, (accept d) {m_count=n} ]
+compile (Exprs d e) = compile e
+compile (Seq [a,b]) = (compile a)++(bridge (getInboxes a) (uniq (getOutboxes b)))++(compile b)
+compile (Par e) = concatMap compile e
+compile (Move 1 s d) = [ (move s) { m_dest=(Just d) }, (accept d) ]
+
+bridge :: [Port] -> [Port] -> [Inst]
+bridge [] _ = []
+bridge _ [] = []
+bridge obs (ib:ibs) = notifyFromOutboxes ++ waitForOutboxNotifications ++ notifyInboxes ++ waitForInboxNotifications
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
+ notifyFromOutboxes = map (\ob -> notify ob ib) obs
+ waitForOutboxNotifications = [(wait ib){m_count=(length obs)}]
+ notifyInboxes = map (notify ib) ibs
+ waitForInboxNotifications = map wait ibs
-getdecls (Decl n t) = ["#ship " ++ n ++ " : " ++ t]
+getdecls (Exprs d e) = map (\(Decl n t) -> ("#ship " ++ n ++ " : " ++ t)) d
getdecls (Seq es) = concatMap getdecls es
getdecls (Par es) = concatMap getdecls es
getdecls _ = []
m_benkobox=box }
move box = (itake box){ m_dataOut=True }
send box = (move box){ m_dataIn=False, m_latch=False }
+notify box dest = IMove { m_count=1, m_recycle=False, m_tokenIn=False, m_dataIn=False,
+ m_latch=False, m_dataOut=False, m_tokenOut=True, m_dest=(Just dest),
+ m_benkobox=box }
+wait box = IMove { m_count=1, m_recycle=False, m_tokenIn=True, m_dataIn=False,
+ m_latch=False, m_dataOut=False, m_tokenOut=False, m_dest=Nothing,
+ m_benkobox=box }
accept box = move box
type BenkoBox = Port
data Inst =
IKill BenkoBox Int
- | ILiteral Int BenkoBox
- | IMove { m_benkobox :: BenkoBox ,
+ | ILiteral Int BenkoBox
+ | IMove { m_benkobox :: BenkoBox ,
m_dest :: Maybe BenkoBox ,
m_count :: Int ,
m_recycle :: Bool ,
where
showrest m = wait++takelatch++out++ack
where
- wait = if m_tokenIn m then ["wait"] else []
+ 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 []
+ 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) -> ["notify "++(show j)]) else []
\end{code}
\ No newline at end of file
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))
+ Def (fromTree name) (fromTree inp) (fromTree outp) (fromTree es)
fromTree (Tree "Def" q _) = error $ show q
-- Port ------------------------------------------------------------------------------
data Port = ShipPort String String
| IdPort String
- deriving Eq
+ deriving (Eq, Ord)
instance Show Port where
show (ShipPort a b) = a++"."++b
-- Expr ------------------------------------------------------------------------------
-data Expr = Decl String String
- | Seq [Expr]
- | Par [Expr]
- | Move Int Port [Port]
- | Literal Int Int [Port]
- deriving Eq
-
+data Decl = Decl String String
+ deriving (Show,Eq)
+data Expr = Seq [Expr]
+ | Par [Expr]
+ | Exprs [Decl] Expr
+ | Move Int Port Port
+ | Literal Int Int Port
+ | Nop
+ deriving (Show,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 (Move 0 source dest) = (show source) ++ " -[*]-> " ++ (show dest)
+ show (Move 1 source dest) = (show source) ++ " --> " ++ (show dest)
+ show (Move count source dest) = (show source) ++ " -["++(show count)++"]-> " ++ (show dest)
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 Decl where
+ fromTree (Tree "::" [shipName,shipType] _) = Decl (fromTree shipName) (fromTree shipType)
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)
+ fromTree (Tree "Exprs" [decls, sequents] _) = Exprs (fromTree decls) (seq $ map par $ fromTree sequents)
+ where seq [] = Nop
+ seq [x] = x
+ seq x = Seq x
+ par [] = Nop
+ par [x] = x
+ par x = Par x
+ fromTree (Tree "-->" es _) =
+ case es of
+ [(Tree i [] _),dest] -> rep (fromTree dest) $ \d -> Literal 1 (read i) d
+ [(Tree "{" [Tree _ is _] _),dest] -> Par $ concatMap (\d -> map (\(Tree i _ _) -> Literal 1 (read i) d) is) (fromTree dest)
+ [source,dest] -> rep (fromTree dest) $ \d -> Move 1 (fromTree source) d
+-- 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 other = error $ (show other)
+
+rep :: [Port] -> (Port -> Expr) -> Expr
+rep [] _ = error "nop"
+rep [x] f = f x
+rep list f = Par $ map f list
\end{code}
\ No newline at end of file
\begin{code}
module Util where
import SBP
+import List(sort)
indent [] = []
indent ('\n':q) = "\n "++(indent q)
instance FromTrees String where
fromTrees ts = concatMap (fromTree :: Tree -> String) ts
+uniq l = rmdups $ sort l
+ where
+ rmdups [] = []
+ rmdups [x] = [x]
+ rmdups (x:y:rest) | x==y = rmdups (x:rest)
+ | otherwise = x:(rmdups (y:rest))
+
\end{code}
\ No newline at end of file
Def = Id "(" (Id+/comma) "->" (Id+/comma) ")" "=" Exprs /ws
-Exprs = Expr +/ ws
+Exprs =
+ Exprs:: Decl */ ws
+ ws!
+ ((Expr +/ ws) +/ semicolons)
-Expr = Id ^"::" ShipName /ws
- | Expr ^";;" Expr /ws
- | ^"{" Exprs "}" /ws
- | (Int|Port) ^"-->" Ports /ws
- | (Int|Port) ws! ^"-[" Int "]->" ws! Ports
- | (Int|Port) ^"-[*]->" Ports /ws
+Decl = Id ^"::" ShipName /ws
+
+Expr = "{" Exprs "}" /ws
+ | (Literal|Port) ^"-->" Ports /ws
+ | (Literal|Port) ws! ^"-[" Int "]->" ws! Ports
+ | (Literal|Port) ^"-[*]->" Ports /ws
// | "if" "then" "else"
// | "while"
Port = "Port":: Id
| "Port":: Id "." Id
+Literal = Int | ^"{" Int +/ comma "}" /ws
Int = [\-0-9]++
ShipName = "":: [A-Z] [a-zA-Z0-9_]*
Id = "":: [a-z] [a-zA-Z0-9_]*
ws = (wsc | Comment)* -> ~wsc
eol = [\r\n]
wsc = [\r\n ] | \{ | \}
-comma = ws! "," ws!
+comma = ws! "," ws!
+semicolons = ws! ";;" ws!
any = ~[]
projects / fleet.git / commitdiff