suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merged Alternative and AlternativeCond into a single Alternative item that always has a pre-condition

Browse Source
This commit is contained in:
Neil Brown 2008-04-03 14:52:37 +00:00
parent 04da66531f
commit 3daf82d318
18 changed files with 74 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
backends/BackendPasses.hs
View File

@ -62,7 +62,7 @@ transformWaitFor = doGeneric `extM` doAlt
addSpec spec inner = spec inner
doWaitFor :: A.Alternative -> StateT ([A.Structured A.Process -> A.Structured A.Process], [A.Structured A.Process]) PassM A.Alternative
doWaitFor a@(A.Alternative m tim (A.InputTimerFor m' e) p)
doWaitFor a@(A.Alternative m cond tim (A.InputTimerFor m' e) p)
= do (specs, init) <- get
id <- lift $ makeNonce "waitFor"
let n = (A.Name m A.VariableName id)
@ -71,7 +71,7 @@ transformWaitFor = doGeneric `extM` doAlt
init ++ [A.Only m $ A.Input m tim
(A.InputTimerRead m (A.InVariable m var)),
A.Only m $ A.Assign m [var] $ A.ExpressionList m [A.Dyadic m A.Plus (A.ExprVariable m var) e]])
return $ A.Alternative m tim (A.InputTimerAfter m' (A.ExprVariable m' var)) p
return $ A.Alternative m cond tim (A.InputTimerAfter m' (A.ExprVariable m' var)) p
doWaitFor a = return a

6
backends/BackendPassesTest.hs
View File

@ -43,17 +43,17 @@ m :: Meta
m = emptyMeta
waitFor :: A.Expression -> A.Process -> A.Alternative
waitFor e body = A.Alternative emptyMeta (A.Variable emptyMeta $ simpleName
waitFor e body = A.Alternative emptyMeta (A.True emptyMeta) (A.Variable emptyMeta $ simpleName
(ghostVarPrefix ++ "raintimer" ++ ghostVarSuffix)) (A.InputTimerFor emptyMeta e)
body
waitUntil :: A.Expression -> A.Process -> A.Alternative
waitUntil e body = A.Alternative emptyMeta (A.Variable emptyMeta $ simpleName
waitUntil e body = A.Alternative emptyMeta (A.True emptyMeta) (A.Variable emptyMeta $ simpleName
(ghostVarPrefix ++ "raintimer" ++ ghostVarSuffix)) (A.InputTimerAfter emptyMeta e)
body
mWaitUntil :: (Data a, Data b) => a -> b -> Pattern
mWaitUntil e body = mAlternative (mVariable $ simpleName (ghostVarPrefix ++ "raintimer"
mWaitUntil e body = mAlternative (A.True emptyMeta) (mVariable $ simpleName (ghostVarPrefix ++ "raintimer"
++ ghostVarSuffix)) (mInputTimerAfter e) body
mGetTime :: Pattern -> Pattern

13
backends/GenerateC.hs
View File

@ -1668,8 +1668,8 @@ cgenAlt isPri s
containsTimers (A.ProcThen _ _ s) = containsTimers s
containsTimers (A.Only _ a)
= case a of
A.Alternative _ _ (A.InputTimerRead _ _) _ -> True
A.Alternative _ _ (A.InputTimerAfter _ _) _ -> True
A.Alternative _ _ _ (A.InputTimerRead _ _) _ -> True
A.Alternative _ _ _ (A.InputTimerAfter _ _) _ -> True
_ -> False
containsTimers (A.Several _ ss) = or $ map containsTimers ss
@ -1678,8 +1678,7 @@ cgenAlt isPri s
where
doA _ alt
= case alt of
A.Alternative _ c im _ -> doIn c im
A.AlternativeCond _ e c im _ -> withIf e $ doIn c im
A.Alternative _ e c im _ -> withIf e $ doIn c im
A.AlternativeSkip _ e _ -> withIf e $ tell ["AltEnableSkip (wptr,", id, "++);\n"]
doIn c im
@ -1699,8 +1698,7 @@ cgenAlt isPri s
where
doA _ alt
= case alt of
A.Alternative _ c im _ -> doIn c im
A.AlternativeCond _ e c im _ -> withIf e $ doIn c im
A.Alternative _ e c im _ -> withIf e $ doIn c im
A.AlternativeSkip _ e _ -> withIf e $ tell ["AltDisableSkip (wptr,", id, "++);\n"]
doIn c im
@ -1720,8 +1718,7 @@ cgenAlt isPri s
where
doA _ alt
= case alt of
A.Alternative _ c im p -> doIn c im p
A.AlternativeCond _ e c im p -> withIf e $ doIn c im p
A.Alternative _ e c im p -> withIf e $ doIn c im p
A.AlternativeSkip _ e p -> withIf e $ doCheck (call genProcess p)
doIn c im p

6
backends/GenerateCPPCSP.hs
View File

@ -433,8 +433,7 @@ cppgenAlt _ s
where
doA _ alt
= case alt of
A.Alternative _ c im _ -> doIn c im
A.AlternativeCond _ e c im _ -> withIf e $ doIn c im
A.Alternative _ e c im _ -> withIf e $ doIn c im
A.AlternativeSkip _ e _ -> withIf e $ tell [guardList, " . push_back( new csp::SkipGuard() );\n"]
doIn c im
@ -455,8 +454,7 @@ cppgenAlt _ s
where
doA _ alt
= case alt of
A.Alternative _ c im p -> doIn c im p
A.AlternativeCond _ e c im p -> withIf e $ doIn c im p
A.Alternative _ e c im p -> withIf e $ doIn c im p
A.AlternativeSkip _ e p -> withIf e $ doCheck (call genProcess p)
doIn c im p

10
common/ShowCode.hs
View File

@ -484,8 +484,14 @@ instance ShowOccam A.InputMode where
instance ShowOccam A.Alternative where
showOccamM (A.Alternative _ v im p) = showInputModeOccamM v im >> occamIndent >> showOccamM p >> occamOutdent
showOccamM (A.AlternativeCond _ e v im p) = showOccamM e >> tell [" & "] >> suppressIndent >> showOccamM (A.Alternative undefined v im p)
showOccamM (A.Alternative _ e v im p)
= do showOccamM e
tell [" & "]
suppressIndent
showInputModeOccamM v im
occamIndent
showOccamM p
occamOutdent
instance ShowOccam A.Replicator where
showOccamM (A.For _ n start count) = tell [" "] >> showName n >> tell [" = "] >> showOccamM start >> tell [" FOR "] >> showOccamM count

9
data/AST.hs
View File

@ -360,14 +360,11 @@ data Choice = Choice Meta Expression Process
-- | A guard in an @ALT@.
data Alternative =
-- | A plain guard.
-- | A plain/conditional guard.
-- The channel or timer is the 'Variable', and the destination (or @AFTER@
-- clause) is inside the 'InputMode'. The process is the body of the guard.
Alternative Meta Variable InputMode Process
-- | A conditional guard.
-- The 'Expression' is the pre-condition, everything else is as 'Alternative'
-- above.
| AlternativeCond Meta Expression Variable InputMode Process
-- The 'Expression' is the pre-condition.
Alternative Meta Expression Variable InputMode Process
-- | A @SKIP@ guard (one that is always ready).
-- The 'Expression' is the pre-condition.
| AlternativeSkip Meta Expression Process

3
flow/FlowGraph.hs
View File

@ -533,8 +533,7 @@ buildOnlyAlternative :: (Monad mLabel, Monad mAlter) => ASTModifier mAlter A.Alt
GraphMaker mLabel mAlter label structType (Node, Node)
buildOnlyAlternative route alt
= do let (m,p,r) = case alt of
(A.Alternative m _ _ p) -> (m,p, route44 route A.Alternative)
(A.AlternativeCond m _ _ _ p) -> (m,p, route55 route A.AlternativeCond)
(A.Alternative m _ _ _ p) -> (m,p, route55 route A.Alternative)
(A.AlternativeSkip m _ p) -> (m,p, route33 route A.AlternativeSkip)
guardNode <- addNode' m labelAlternative alt (AlterAlternative route)
(bodyNodeStart, bodyNodeEnd) <- buildProcess p r

2
flow/FlowGraphTest.hs
View File

@ -393,7 +393,7 @@ testAlt = TestLabel "testAlt" $ TestList
]
where
guard45 = A.AlternativeSkip m4 (A.True mU) sm5
guard67 = A.Alternative m6 (variable "c") (A.InputSimple mU []) sm7
guard67 = A.Alternative m6 (A.True mU) (variable "c") (A.InputSimple mU []) sm7
spec8 = A.Spec mU (A.Specification m8 undefined undefined)
spec9 = A.Spec mU (A.Specification m9 undefined undefined)

12
frontends/OccamTypes.hs
View File

@ -1214,14 +1214,12 @@ checkProcesses = checkDepthM doProcess
Nothing -> dieP m $ n ++ " is not an intrinsic procedure"
doAlternative :: Check A.Alternative
doAlternative (A.Alternative m v im _)
= case im of
A.InputTimerRead _ _ ->
dieP m $ "Timer read not permitted as alternative"
_ -> doInput v im
doAlternative (A.AlternativeCond m e v im p)
doAlternative (A.Alternative m e v im p)
= do checkExpressionBool e
doAlternative (A.Alternative m v im p)
case im of
A.InputTimerRead _ _ ->
dieP m $ "Timer read not permitted as alternative"
_ -> doInput v im
doAlternative (A.AlternativeSkip _ e _)
= checkExpressionBool e

13
frontends/OccamTypesTest.hs
View File

@ -328,17 +328,17 @@ testOccamTypes = TestList
$ A.FunctionCallList m function22 [realE]
-- Alt
, testOK 1500 $ testAlt $ A.Alternative m intC (insim [inv intV]) skip
, testOK 1501 $ testAlt $ A.Alternative m tim
, testOK 1500 $ testAlt $ A.Alternative m true intC (insim [inv intV]) skip
, testOK 1501 $ testAlt $ A.Alternative m true tim
(A.InputTimerAfter m intE) skip
, testOK 1502 $ testAlt $ A.AlternativeCond m boolE intC
, testOK 1502 $ testAlt $ A.Alternative m boolE intC
(insim [inv intV]) skip
, testOK 1503 $ testAlt $ A.AlternativeSkip m boolE skip
, testFail 1504 $ testAlt $ A.Alternative m intC (insim [inv realV]) skip
, testFail 1505 $ testAlt $ A.Alternative m tim
, testFail 1504 $ testAlt $ A.Alternative m true intC (insim [inv realV]) skip
, testFail 1505 $ testAlt $ A.Alternative m true tim
(A.InputTimerRead m $ inv intV)
skip
, testFail 1506 $ testAlt $ A.AlternativeCond m intE intC
, testFail 1506 $ testAlt $ A.Alternative m intE intC
(insim [inv intV]) skip
, testFail 1507 $ testAlt $ A.AlternativeSkip m intE skip
@ -524,6 +524,7 @@ testOccamTypes = TestList
--{{{ expression fragments
true = A.True emptyMeta
subex sub = A.SubscriptedExpr m sub twoIntsE
intV = variable "varInt"
intE = intLiteral 42

8
frontends/ParseOccam.hs
View File

@ -1500,11 +1500,11 @@ alternative
<|> do m <- md
(b, c) <- tryVXVX expression sAmp channel (sQuest >> sCASE >> eol)
vs <- maybeIndentedList m "empty ? CASE" variant
return $ A.Only m (A.AlternativeCond m b c (A.InputCase m $ A.Several m vs) (A.Skip m))
return $ A.Only m (A.Alternative m b c (A.InputCase m $ A.Several m vs) (A.Skip m))
<|> do m <- md
c <- tryVXX channel sQuest (sCASE >> eol)
vs <- maybeIndentedList m "empty ? CASE" variant
return $ A.Only m (A.Alternative m c (A.InputCase m $ A.Several m vs) (A.Skip m))
return $ A.Only m (A.Alternative m (A.True m) c (A.InputCase m $ A.Several m vs) (A.Skip m))
<|> guardedAlternative
<|> handleSpecs specification alternative A.Spec
<?> "alternative"
@ -1523,10 +1523,10 @@ guard :: OccParser (A.Process -> A.Alternative)
guard
= do m <- md
(c, im) <- input
return $ A.Alternative m c im
return $ A.Alternative m (A.True m) c im
<|> do m <- md
b <- tryVX expression sAmp
do { (c, im) <- input; return $ A.AlternativeCond m b c im }
do { (c, im) <- input; return $ A.Alternative m b c im }
<|> do { sSKIP; eol; return $ A.AlternativeSkip m b }
<?> "guard"
--}}}

8
frontends/ParseRain.hs
View File

@ -389,12 +389,14 @@ alt = do {m <- sPri ; sAlt ; m' <- sLeftC ; cases <- many altCase ; optElseCase
altCase :: RainParser (A.Structured A.Alternative)
altCase = do input <- comm True
case input of
A.Input m lv im -> do { body <- block ; return $ A.Only m $ A.Alternative m lv im body }
A.Input m lv im -> do body <- block
return $ A.Only m $ A.Alternative m
(A.True m) lv im body
_ -> dieP (findMeta input) $ "communication type not supported in an alt: \"" ++ show input ++ "\""
<|> do (m, wm) <- waitStatement True
body <- block
return $ A.Only m $ A.Alternative m (A.Variable m rainTimerName)
wm body
return $ A.Only m $ A.Alternative m (A.True m)
(A.Variable m rainTimerName) wm body
elseCase :: RainParser (A.Structured A.Alternative)
elseCase = do m <- sElse
body <- block

16
frontends/ParseRainTest.hs
View File

@ -624,24 +624,24 @@ testAlt =
[
passAlt (0, "pri alt {}", A.Alt m True $ A.Several m [])
,passAlt (1, "pri alt { c ? x {} }", A.Alt m True $ A.Several m [A.Only m $ A.Alternative m
(variable "c") (A.InputSimple m [A.InVariable m (variable "x")]) emptyBlock])
(A.True m) (variable "c") (A.InputSimple m [A.InVariable m (variable "x")]) emptyBlock])
,passAlt (2, "pri alt { c ? x {} d ? y {} }", A.Alt m True $ A.Several m [
A.Only m $ A.Alternative m (variable "c") (A.InputSimple m [A.InVariable m (variable "x")]) emptyBlock
,A.Only m $ A.Alternative m (variable "d") (A.InputSimple m [A.InVariable m (variable "y")]) emptyBlock])
A.Only m $ A.Alternative m (A.True m) (variable "c") (A.InputSimple m [A.InVariable m (variable "x")]) emptyBlock
,A.Only m $ A.Alternative m (A.True m) (variable "d") (A.InputSimple m [A.InVariable m (variable "y")]) emptyBlock])
--Fairly nonsensical, but valid:
,passAlt (3, "pri alt { else {} }", A.Alt m True $ A.Several m [
A.Only m $ A.AlternativeSkip m (A.True m) emptyBlock])
,passAlt (4, "pri alt { c ? x {} else {} }", A.Alt m True $ A.Several m [
A.Only m $ A.Alternative m (variable "c") (A.InputSimple m [A.InVariable m (variable "x")]) emptyBlock
A.Only m $ A.Alternative m (A.True m) (variable "c") (A.InputSimple m [A.InVariable m (variable "x")]) emptyBlock
,A.Only m $ A.AlternativeSkip m (A.True m) emptyBlock])
,passAlt (100, "pri alt { wait for t {} }", A.Alt m True $ A.Several m [
A.Only m $ A.Alternative m timer (A.InputTimerFor m $ exprVariable "t") emptyBlock])
A.Only m $ A.Alternative m (A.True m) timer (A.InputTimerFor m $ exprVariable "t") emptyBlock])
,passAlt (101, "pri alt { wait for t {} wait until t {} }", A.Alt m True $ A.Several m [
A.Only m $ A.Alternative m timer (A.InputTimerFor m $ exprVariable "t") emptyBlock
,A.Only m $ A.Alternative m timer (A.InputTimerAfter m $ exprVariable "t") emptyBlock])
A.Only m $ A.Alternative m (A.True m) timer (A.InputTimerFor m $ exprVariable "t") emptyBlock
,A.Only m $ A.Alternative m (A.True m) timer (A.InputTimerAfter m $ exprVariable "t") emptyBlock])
,passAlt (102, "pri alt { wait until t + t {} else {} }", A.Alt m True $ A.Several m [
A.Only m $ A.Alternative m timer (A.InputTimerAfter m (buildExpr $ Dy (Var "t") A.Plus (Var "t"))) emptyBlock
A.Only m $ A.Alternative m (A.True m) timer (A.InputTimerAfter m (buildExpr $ Dy (Var "t") A.Plus (Var "t"))) emptyBlock
,A.Only m $ A.AlternativeSkip m (A.True m) emptyBlock])

6
frontends/RainTypes.hs
View File

@ -402,12 +402,12 @@ checkCommTypes = applyDepthM2 checkInputOutput checkAltInput
checkInputOutput p = return p
checkAltInput :: A.Alternative -> PassM A.Alternative
checkAltInput a@(A.Alternative m chanVar (A.InputSimple _ [A.InVariable _ destVar]) body)
checkAltInput a@(A.Alternative m _ chanVar (A.InputSimple _ [A.InVariable _ destVar]) body)
= checkInput chanVar destVar m a
checkAltInput a@(A.Alternative m _ im@(A.InputTimerFor {}) _)
checkAltInput a@(A.Alternative m _ _ im@(A.InputTimerFor {}) _)
= do checkWait im
return a
checkAltInput a@(A.Alternative m _ im@(A.InputTimerAfter {}) _)
checkAltInput a@(A.Alternative m _ _ im@(A.InputTimerAfter {}) _)
= do checkWait im
return a
checkAltInput a = return a

6
frontends/RainTypesTest.hs
View File

@ -325,8 +325,8 @@ checkExpressionTest = TestList
waitFor = A.Input m tim . A.InputTimerFor m
waitUntil = A.Input m tim . A.InputTimerAfter m
altWaitFor, altWaitUntil :: A.Expression -> A.Process -> A.Alternative
altWaitFor e body = A.Alternative m tim (A.InputTimerFor m e) body
altWaitUntil e body = A.Alternative m tim (A.InputTimerAfter m e) body
altWaitFor e body = A.Alternative m (A.True m) tim (A.InputTimerFor m e) body
altWaitUntil e body = A.Alternative m (A.True m) tim (A.InputTimerAfter m e) body
testPassUntouched :: Data t => Int -> (t -> PassM t) -> t -> Test
@ -394,7 +394,7 @@ checkExpressionTest = TestList
then TestCase $ testPass ("testCheckCommTypesIn " ++ show n) (mkPattern st) (checkCommTypes st) state
else TestCase $ testPassShouldFail ("testCheckCommTypesIn " ++ show n) (checkCommTypes st) state
where
st = A.Alt m True $ A.Only m $ A.Alternative m chanVar (A.InputSimple m [A.InVariable m destVar]) $ A.Skip m
st = A.Alt m True $ A.Only m $ A.Alternative m (A.True m) chanVar (A.InputSimple m [A.InVariable m destVar]) $ A.Skip m
--Automatically tests checking inputs and outputs for various combinations of channel type and direction
testAllCheckCommTypes :: Int -> Test

2
pass/Properties.hs
View File

@ -365,7 +365,7 @@ parsIdentified :: Property
parsIdentified = Property "parsIdentified" nocheck
findWaitFor :: A.Alternative -> Bool
findWaitFor (A.Alternative _ _ (A.InputTimerFor {}) _) = True
findWaitFor (A.Alternative _ _ _ (A.InputTimerFor {}) _) = True
findWaitFor _ = False
waitForRemoved :: Property

15
transformations/PassTest.hs
View File

@ -489,13 +489,13 @@ testInputCase = TestList
,TestCase $ testPass "testInputCase 100"
(tag3 A.Alt DontCare False $
mSpecA (tag3 A.Specification DontCare (Named "tag" DontCare) $ mDeclaration A.Int) $
mOnlyA $ tag4 A.Alternative DontCare c
mOnlyA $ mAlternative (A.True emptyMeta) c
(tag2 A.InputSimple DontCare [tag2 A.InVariable DontCare $ tag2 A.Variable DontCare (Named "tag" DontCare)]) $
tag3 A.Case DontCare (tag2 A.ExprVariable DontCare $ tag2 A.Variable DontCare (Named "tag" DontCare)) $
mOnlyO $ tag3 A.Option DontCare [intLiteralPattern 0] p0
)
(transformInputCase $
A.Alt emptyMeta False $ A.Only emptyMeta $ A.Alternative emptyMeta c
A.Alt emptyMeta False $ A.Only emptyMeta $ A.Alternative emptyMeta (A.True emptyMeta) c
(A.InputCase emptyMeta $ A.Only emptyMeta $ A.Variant emptyMeta a0 [] p0)
(A.Skip emptyMeta)
)
@ -542,13 +542,15 @@ testTransformProtocolInput = TestList
(return ())
,TestCase $ testPass "testTransformProtocolInput3"
(A.Alt emptyMeta True $ A.Only emptyMeta $ A.Alternative emptyMeta (variable "c") (A.InputSimple emptyMeta [ii0]) $
(A.Alt emptyMeta True $ A.Only emptyMeta $ A.Alternative emptyMeta (A.True
emptyMeta) (variable "c") (A.InputSimple emptyMeta [ii0]) $
A.Seq emptyMeta $ A.Several emptyMeta $ onlySingle ii1 : [A.Only emptyMeta $ A.Skip emptyMeta])
(transformProtocolInput $ A.Alt emptyMeta True $ A.Only emptyMeta $ altItems [ii0, ii1])
(return ())
,TestCase $ testPass "testTransformProtocolInput4"
(A.Alt emptyMeta False $ A.Only emptyMeta $ A.Alternative emptyMeta (variable "c") (A.InputSimple emptyMeta [ii0]) $
(A.Alt emptyMeta False $ A.Only emptyMeta $ A.Alternative emptyMeta (A.True
emptyMeta) (variable "c") (A.InputSimple emptyMeta [ii0]) $
A.Seq emptyMeta $ A.Several emptyMeta $ map onlySingle [ii1,ii2] ++ [A.Only emptyMeta $ A.Skip emptyMeta])
(transformProtocolInput $ A.Alt emptyMeta False $ A.Only emptyMeta $ altItems [ii0, ii1, ii2])
(return ())
@ -559,9 +561,10 @@ testTransformProtocolInput = TestList
ii2 = A.InVariable emptyMeta (variable "a")
onlySingle = A.Only emptyMeta . A.Input emptyMeta (variable "c") . A.InputSimple emptyMeta . singleton
onlySingleAlt = A.Only emptyMeta . flip (A.Alternative emptyMeta (variable "c")) (A.Skip emptyMeta) . A.InputSimple emptyMeta . singleton
onlySingleAlt = A.Only emptyMeta . flip (A.Alternative emptyMeta (A.True
emptyMeta) (variable "c")) (A.Skip emptyMeta) . A.InputSimple emptyMeta . singleton
seqItems = A.Input emptyMeta (variable "c") . A.InputSimple emptyMeta
altItems = flip (A.Alternative emptyMeta (variable "c")) (A.Skip emptyMeta) . A.InputSimple emptyMeta
altItems = flip (A.Alternative emptyMeta (A.True emptyMeta) (variable "c")) (A.Skip emptyMeta) . A.InputSimple emptyMeta
testPullRepCounts :: Test

19
transformations/SimplifyComms.hs
View File

@ -197,17 +197,11 @@ transformInputCase = doGeneric `extM` doProcess
-- Transform alt guards:
-- The processes that are the body of input-case guards are always skip, so we can discard them:
doStructuredA (A.Only m (A.Alternative m' v (A.InputCase m'' s) _))
doStructuredA (A.Only m (A.Alternative m' e v (A.InputCase m'' s) _))
= do spec@(A.Specification _ n _) <- defineNonce m "input_tag" (A.Declaration m' A.Int) A.VariableName A.Original
s' <- doStructuredV v s
return $ A.Spec m' spec $ A.Only m $
A.Alternative m' v (A.InputSimple m [A.InVariable m (A.Variable m n)]) $
A.Case m'' (A.ExprVariable m'' $ A.Variable m n) s'
doStructuredA (A.Only m (A.AlternativeCond m' e v (A.InputCase m'' s) _))
= do spec@(A.Specification _ n _) <- defineNonce m "input_tag" (A.Declaration m' A.Int) A.VariableName A.Original
s' <- doStructuredV v s
return $ A.Spec m' spec $ A.Only m $
A.AlternativeCond m' e v (A.InputSimple m [A.InVariable m (A.Variable m n)]) $
A.Alternative m' e v (A.InputSimple m [A.InVariable m (A.Variable m n)]) $
A.Case m'' (A.ExprVariable m'' $ A.Variable m n) s'
-- Leave other guards (and parts of Structured) untouched:
doStructuredA s = return s
@ -225,14 +219,9 @@ transformProtocolInput = doGeneric `extM` doProcess `extM` doAlternative
doProcess p = doGeneric p
doAlternative :: A.Alternative -> PassM A.Alternative
doAlternative (A.Alternative m v (A.InputSimple m' (firstII:(otherIIS@(_:_)))) body)
doAlternative (A.Alternative m cond v (A.InputSimple m' (firstII:(otherIIS@(_:_)))) body)
= do body' <- doProcess body
return $ A.Alternative m v (A.InputSimple m' [firstII]) $ A.Seq m' $ A.Several m' $
map (A.Only m' . A.Input m' v . A.InputSimple m' . singleton) otherIIS
++ [A.Only m' body']
doAlternative (A.AlternativeCond m cond v (A.InputSimple m' (firstII:(otherIIS@(_:_)))) body)
= do body' <- doProcess body
return $ A.AlternativeCond m cond v (A.InputSimple m' [firstII]) $ A.Seq m' $ A.Several m' $
return $ A.Alternative m cond v (A.InputSimple m' [firstII]) $ A.Seq m' $ A.Several m' $
map (A.Only m' . A.Input m' v . A.InputSimple m' . singleton) otherIIS
++ [A.Only m' body']
doAlternative s = doGeneric s