Changed the AST to distinguish reading a timer from reading a channel

This commit is contained in:
Neil Brown 2007-08-13 16:26:03 +00:00
parent 872864bf81
commit feebea4473
4 changed files with 51 additions and 74 deletions

3
AST.hs
View File

@ -261,7 +261,8 @@ data Structured =
data InputMode = data InputMode =
InputSimple Meta [InputItem] InputSimple Meta [InputItem]
| InputCase Meta Structured | InputCase Meta Structured
| InputAfter Meta Expression | InputTimerRead Meta InputItem
| InputTimerAfter Meta Expression
deriving (Show, Eq, Typeable, Data) deriving (Show, Eq, Typeable, Data)
-- | Abbreviation mode. -- | Abbreviation mode.

View File

@ -278,18 +278,6 @@ cgenStructured ops (A.ProcThen _ p s) def = call genProcess ops p >> call genStr
cgenStructured ops (A.Several _ ss) def = sequence_ [call genStructured ops s def | s <- ss] cgenStructured ops (A.Several _ ss) def = sequence_ [call genStructured ops s def | s <- ss]
cgenStructured _ s def = def s cgenStructured _ s def = def s
data InputType = ITTimerRead | ITTimerAfter | ITOther
-- | Given an input mode, figure out what sort of input it's actually doing.
inputType :: A.Variable -> A.InputMode -> CGen InputType
inputType c im
= do t <- typeOfVariable c
return $ case t of
A.Timer ->
case im of
A.InputSimple _ _ -> ITTimerRead
A.InputAfter _ _ -> ITTimerAfter
_ -> ITOther
--}}} --}}}
--{{{ metadata --{{{ metadata
@ -1447,15 +1435,12 @@ cgenAssign ops m [v] el
--{{{ input --{{{ input
cgenInput :: GenOps -> A.Variable -> A.InputMode -> CGen () cgenInput :: GenOps -> A.Variable -> A.InputMode -> CGen ()
cgenInput ops c im cgenInput ops c im
= do t <- typeOfVariable c = do case im of
case t of A.InputTimerRead m (A.InVariable m' v) -> call genTimerRead ops c v
A.Timer -> case im of A.InputTimerAfter m e -> call genTimerWait ops e
A.InputSimple m [A.InVariable m' v] -> call genTimerRead ops c v A.InputSimple m is -> sequence_ $ map (call genInputItem ops c) is
A.InputAfter m e -> call genTimerWait ops e A.InputCase m s -> call genInputCase ops m c s
_ -> case im of _ -> call genMissing ops $ "genInput " ++ show im
A.InputSimple m is -> sequence_ $ map (call genInputItem ops c) is
A.InputCase m s -> call genInputCase ops m c s
_ -> call genMissing ops $ "genInput " ++ show im
cgenInputCase :: GenOps -> Meta -> A.Variable -> A.Structured -> CGen () cgenInputCase :: GenOps -> Meta -> A.Variable -> A.Structured -> CGen ()
cgenInputCase ops m c s cgenInputCase ops m c s
@ -1677,15 +1662,13 @@ cgenAlt ops isPri s
A.AlternativeSkip _ e _ -> withIf ops e $ tell ["AltEnableSkip ();\n"] A.AlternativeSkip _ e _ -> withIf ops e $ tell ["AltEnableSkip ();\n"]
doIn c im doIn c im
= do t <- inputType c im = do case im of
case t of A.InputTimerRead _ _ -> call genMissing ops "timer read in ALT"
ITTimerRead -> call genMissing ops "timer read in ALT" A.InputTimerAfter _ time ->
ITTimerAfter -> do tell ["AltEnableTimer ("]
do let time = case im of A.InputAfter _ e -> e
tell ["AltEnableTimer ("]
call genExpression ops time call genExpression ops time
tell [");\n"] tell [");\n"]
ITOther -> _ ->
do tell ["AltEnableChannel ("] do tell ["AltEnableChannel ("]
call genVariable ops c call genVariable ops c
tell [");\n"] tell [");\n"]
@ -1700,15 +1683,13 @@ cgenAlt ops isPri s
A.AlternativeSkip _ e _ -> withIf ops e $ tell ["AltDisableSkip (", id, "++);\n"] A.AlternativeSkip _ e _ -> withIf ops e $ tell ["AltDisableSkip (", id, "++);\n"]
doIn c im doIn c im
= do t <- inputType c im = do case im of
case t of A.InputTimerRead _ _ -> call genMissing ops "timer read in ALT"
ITTimerRead -> call genMissing ops "timer read in ALT" A.InputTimerAfter _ time ->
ITTimerAfter -> do tell ["AltDisableTimer (", id, "++, "]
do let time = case im of A.InputAfter _ e -> e
tell ["AltDisableTimer (", id, "++, "]
call genExpression ops time call genExpression ops time
tell [");\n"] tell [");\n"]
ITOther -> _ ->
do tell ["AltDisableChannel (", id, "++, "] do tell ["AltDisableChannel (", id, "++, "]
call genVariable ops c call genVariable ops c
tell [");\n"] tell [");\n"]
@ -1723,11 +1704,10 @@ cgenAlt ops isPri s
A.AlternativeSkip _ e p -> withIf ops e $ doCheck (call genProcess ops p) A.AlternativeSkip _ e p -> withIf ops e $ doCheck (call genProcess ops p)
doIn c im p doIn c im p
= do t <- inputType c im = do case im of
case t of A.InputTimerRead _ _ -> call genMissing ops "timer read in ALT"
ITTimerRead -> call genMissing ops "timer read in ALT" A.InputTimerAfter _ _ -> doCheck (call genProcess ops p)
ITTimerAfter -> doCheck (call genProcess ops p) _ -> doCheck (call genInput ops c im >> call genProcess ops p)
ITOther -> doCheck (call genInput ops c im >> call genProcess ops p)
doCheck body doCheck body
= do tell ["if (", id, "++ == ", fired, ") {\n"] = do tell ["if (", id, "++ == ", fired, ") {\n"]

View File

@ -142,25 +142,24 @@ cppgenStop _ m s
cppgenInput :: GenOps -> A.Variable -> A.InputMode -> CGen () cppgenInput :: GenOps -> A.Variable -> A.InputMode -> CGen ()
cppgenInput ops c im cppgenInput ops c im
= do t <- typeOfVariable c = do case im of
case t of A.InputTimerRead m (A.InVariable m' v) -> call genTimerRead ops c v
A.Timer -> case im of A.InputTimerAfter m e -> call genTimerWait ops e
A.InputSimple m [A.InVariable m' v] -> call genTimerRead ops c v A.InputSimple m is ->
A.InputAfter m e -> call genTimerWait ops e do t <- typeOfVariable c
_ -> case im of case t of
A.InputSimple m is -> case t of A.Chan (A.UserProtocol innerType) ->
A.Chan (A.UserProtocol innerType) -> --We read from the channel into a temporary var, then deal with the var afterwards
--We read from the channel into a temporary var, then deal with the var afterwards do inputVar <- makeNonce "proto_var"
do inputVar <- makeNonce "proto_var" genProtocolName innerType
genProtocolName innerType tell [" ",inputVar, " ; "]
tell [" ",inputVar, " ; "] call genVariable ops c
call genVariable ops c tell [" ->reader() >> ",inputVar," ; "]
tell [" ->reader() >> ",inputVar," ; "] cases <- casesOfProtocol innerType
cases <- casesOfProtocol innerType genInputTupleAssign ops ((length cases) /= 0) inputVar is
genInputTupleAssign ops ((length cases) /= 0) inputVar is _ -> sequence_ $ map (call genInputItem ops c) is
_ -> sequence_ $ map (call genInputItem ops c) is A.InputCase m s -> call genInputCase ops m c s
A.InputCase m s -> call genInputCase ops m c s _ -> call genMissing ops $ "genInput " ++ show im
_ -> call genMissing ops $ "genInput " ++ show im
cppgenInputCase :: GenOps -> Meta -> A.Variable -> A.Structured -> CGen () cppgenInputCase :: GenOps -> Meta -> A.Variable -> A.Structured -> CGen ()
cppgenInputCase ops m c s cppgenInputCase ops m c s
@ -521,14 +520,12 @@ cppgenAlt ops _ s
A.AlternativeSkip _ e _ -> withIf ops e $ tell [guardList, " . push_back( new csp::SkipGuard() );\n"] A.AlternativeSkip _ e _ -> withIf ops e $ tell [guardList, " . push_back( new csp::SkipGuard() );\n"]
doIn c im doIn c im
= do t <- inputType c im = do case im of
case t of A.InputTimerRead _ _ -> call genMissing ops "timer read in ALT"
ITTimerRead -> call genMissing ops "timer read in ALT" A.InputTimerAfter _ time ->
ITTimerAfter -> do timeVal <- genCPPCSPTime ops time
do let time = case im of A.InputAfter _ e -> e
timeVal <- genCPPCSPTime ops time
tell [guardList, " . push_back( new csp::TimeoutGuard (",timeVal,"));\n"] tell [guardList, " . push_back( new csp::TimeoutGuard (",timeVal,"));\n"]
ITOther -> _ ->
do tell [guardList, " . push_back( "] do tell [guardList, " . push_back( "]
call genVariable ops c call genVariable ops c
tell [" -> reader() . inputGuard());\n"] tell [" -> reader() . inputGuard());\n"]
@ -545,11 +542,10 @@ cppgenAlt ops _ s
A.AlternativeSkip _ e p -> withIf ops e $ doCheck (call genProcess ops p) A.AlternativeSkip _ e p -> withIf ops e $ doCheck (call genProcess ops p)
doIn c im p doIn c im p
= do t <- inputType c im = do case im of
case t of A.InputTimerRead _ _ -> call genMissing ops "timer read in ALT"
ITTimerRead -> call genMissing ops "timer read in ALT" A.InputTimerAfter _ _ -> doCheck (call genProcess ops p)
ITTimerAfter -> doCheck (call genProcess ops p) _ -> doCheck (call genInput ops c im >> call genProcess ops p)
ITOther -> doCheck (call genInput ops c im >> call genProcess ops p)
doCheck body doCheck body
= do tell ["if (", id, "++ == ", fired, ") {\n"] = do tell ["if (", id, "++ == ", fired, ") {\n"]

View File

@ -1655,8 +1655,8 @@ timerInput :: OccParser (A.Variable, A.InputMode)
timerInput timerInput
= do m <- md = do m <- md
c <- tryVX timer sQuest c <- tryVX timer sQuest
do { v <- variableOfType A.Int; eol; return (c, A.InputSimple m [A.InVariable m v]) } do { v <- variableOfType A.Int; eol; return (c, A.InputTimerRead m (A.InVariable m v)) }
<|> do { sAFTER; e <- intExpr; eol; return (c, A.InputAfter m e) } <|> do { sAFTER; e <- intExpr; eol; return (c, A.InputTimerAfter m e) }
<?> "timer input" <?> "timer input"
taggedList :: [(A.Name, [A.Type])] -> OccParser (A.Process -> A.Variant) taggedList :: [(A.Name, [A.Type])] -> OccParser (A.Process -> A.Variant)