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

Changed transformWaitFor (and its tests) to transform the new InputTimerFor into InputTimerAfter

Browse Source
This commit is contained in:
Neil Brown 2008-03-24 15:09:05 +00:00
parent 2d0d6463d5
commit bbdb429498
3 changed files with 46 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
backends/BackendPasses.hs
View File

@ -62,14 +62,16 @@ 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.AlternativeWait m A.WaitFor e p)
doWaitFor a@(A.Alternative m tim (A.InputTimerFor m' e) p)
= do (specs, init) <- get
id <- lift $ makeNonce "waitFor"
let n = (A.Name m A.VariableName id)
let var = A.Variable m n
put (specs ++ [A.Spec m (A.Specification m n (A.Declaration m A.Time))],
init ++ [A.Only m $ A.GetTime m var, A.Only m $ A.Assign m [var] $ A.ExpressionList m [A.Dyadic m A.Plus (A.ExprVariable m var) e]])
return $ A.AlternativeWait m A.WaitUntil (A.ExprVariable m var) p
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
doWaitFor a = return a

62
backends/BackendPassesTest.hs
View File

@ -42,23 +42,41 @@ import Utils
m :: Meta
m = emptyMeta
waitFor :: A.Expression -> A.Process -> A.Alternative
waitFor e body = A.Alternative 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
(ghostVarPrefix ++ "raintimer" ++ ghostVarSuffix)) (A.InputTimerAfter emptyMeta e)
body
mWaitUntil :: (Data a, Data b) => a -> b -> Pattern
mWaitUntil e body = mAlternative (mVariable $ simpleName (ghostVarPrefix ++ "raintimer"
++ ghostVarSuffix)) (mInputTimerAfter e) body
mGetTime :: Pattern -> Pattern
mGetTime v = mInput (mVariable $ simpleName (ghostVarPrefix ++ "raintimer"
++ ghostVarSuffix)) (mInputTimerRead $ mInVariable v)
-- | Test WaitUntil guard (should be unchanged)
testTransformWaitFor0 :: Test
testTransformWaitFor0 = TestCase $ testPass "testTransformWaitFor0" orig (transformWaitFor orig) (return ())
where
orig = A.Alt m True $ A.Only m $ A.AlternativeWait m A.WaitUntil (exprVariable "t") (A.Skip m)
orig = A.Alt m True $ A.Only m $ waitUntil (exprVariable "t") (A.Skip m)
-- | Test pulling out a single WaitFor:
testTransformWaitFor1 :: Test
testTransformWaitFor1 = TestCase $ testPass "testTransformWaitFor1" exp (transformWaitFor orig) (return ())
where
orig = A.Alt m True $ A.Only m $ A.AlternativeWait m A.WaitFor (exprVariable "t") (A.Skip m)
orig = A.Alt m True $ A.Only m $ waitFor (exprVariable "t") (A.Skip m)
exp = tag2 A.Seq DontCare $ mSpecP (tag3 A.Specification DontCare varName $ A.Declaration m A.Time) $
mSeveralP
[
mOnlyP $ tag2 A.GetTime DontCare var
mOnlyP $ mGetTime var
,mOnlyP $ tag3 A.Assign DontCare [var] $ tag2 A.ExpressionList DontCare [tag4 A.Dyadic DontCare A.Plus evar (exprVariablePattern "t")]
,mOnlyP $ tag3 A.Alt DontCare True $ mOnlyA $ tag4 A.AlternativeWait DontCare A.WaitUntil evar (A.Skip m)
,mOnlyP $ tag3 A.Alt DontCare True $ mOnlyA $ mWaitUntil evar (A.Skip m)
]
varName = (tag3 A.Name DontCare A.VariableName $ Named "nowt" DontCare)
var = tag2 A.Variable DontCare varName
@ -68,19 +86,19 @@ testTransformWaitFor1 = TestCase $ testPass "testTransformWaitFor1" exp (transfo
testTransformWaitFor2 :: Test
testTransformWaitFor2 = TestCase $ testPass "testTransformWaitFor2" exp (transformWaitFor orig) (return ())
where
orig = A.Alt m True $ A.Several m [A.Only m $ A.AlternativeWait m A.WaitFor (exprVariable "t0") (A.Skip m),
A.Only m $ A.AlternativeWait m A.WaitFor (exprVariable "t1") (A.Skip m)]
orig = A.Alt m True $ A.Several m [A.Only m $ waitFor (exprVariable "t0") (A.Skip m),
A.Only m $ waitFor (exprVariable "t1") (A.Skip m)]
exp = tag2 A.Seq DontCare $ mSpecP (tag3 A.Specification DontCare varName0 $ A.Declaration m A.Time) $
mSpecP (tag3 A.Specification DontCare varName1 $ A.Declaration m A.Time) $
mSeveralP
[
mOnlyP $ tag2 A.GetTime DontCare var0
mOnlyP $ mGetTime var0
,mOnlyP $ tag3 A.Assign DontCare [var0] $ tag2 A.ExpressionList DontCare [tag4 A.Dyadic DontCare A.Plus evar0 (exprVariablePattern "t0")]
,mOnlyP $ tag2 A.GetTime DontCare var1
,mOnlyP $ mGetTime var1
,mOnlyP $ tag3 A.Assign DontCare [var1] $ tag2 A.ExpressionList DontCare [tag4 A.Dyadic DontCare A.Plus evar1 (exprVariablePattern "t1")]
,mOnlyP $ tag3 A.Alt DontCare True $ mSeveralA
[mOnlyA $ tag4 A.AlternativeWait DontCare A.WaitUntil evar0 (A.Skip m)
,mOnlyA $ tag4 A.AlternativeWait DontCare A.WaitUntil evar1 (A.Skip m)]
[mOnlyA $ mWaitUntil evar0 (A.Skip m)
,mOnlyA $ mWaitUntil evar1 (A.Skip m)]
]
varName0 = (tag3 A.Name DontCare A.VariableName $ Named "nowt0" DontCare)
var0 = tag2 A.Variable DontCare varName0
@ -93,14 +111,14 @@ testTransformWaitFor2 = TestCase $ testPass "testTransformWaitFor2" exp (transfo
testTransformWaitFor3 :: Test
testTransformWaitFor3 = TestCase $ testPass "testTransformWaitFor3" exp (transformWaitFor orig) (return ())
where
orig = A.Alt m True $ A.Only m $ A.AlternativeWait m A.WaitFor (A.Dyadic m A.Plus (exprVariable "t0") (exprVariable "t1")) (A.Skip m)
orig = A.Alt m True $ A.Only m $ waitFor (A.Dyadic m A.Plus (exprVariable "t0") (exprVariable "t1")) (A.Skip m)
exp = tag2 A.Seq DontCare $ mSpecP (tag3 A.Specification DontCare varName $ A.Declaration m A.Time) $
mSeveralP
[
mOnlyP $ tag2 A.GetTime DontCare var
mOnlyP $ mGetTime var
,mOnlyP $ tag3 A.Assign DontCare [var] $ tag2 A.ExpressionList DontCare [tag4 A.Dyadic DontCare A.Plus evar
(A.Dyadic m A.Plus (exprVariable "t0") (exprVariable "t1"))]
,mOnlyP $ tag3 A.Alt DontCare True $ mOnlyA $ tag4 A.AlternativeWait DontCare A.WaitUntil evar (A.Skip m)
,mOnlyP $ tag3 A.Alt DontCare True $ mOnlyA $ mWaitUntil evar (A.Skip m)
]
varName = (tag3 A.Name DontCare A.VariableName $ Named "nowt" DontCare)
var = tag2 A.Variable DontCare varName
@ -110,14 +128,14 @@ testTransformWaitFor3 = TestCase $ testPass "testTransformWaitFor3" exp (transfo
testTransformWaitFor4 :: Test
testTransformWaitFor4 = TestCase $ testPass "testTransformWaitFor4" exp (transformWaitFor orig) (return ())
where
orig = A.Alt m True $ A.Several m [A.Only m $ A.AlternativeWait m A.WaitFor (exprVariable "t") (A.Skip m)]
orig = A.Alt m True $ A.Several m [A.Only m $ waitFor (exprVariable "t") (A.Skip m)]
exp = tag2 A.Seq DontCare $ mSpecP (tag3 A.Specification DontCare varName $ A.Declaration m A.Time) $
mSeveralP
[
mOnlyP $ tag2 A.GetTime DontCare var
mOnlyP $ mGetTime var
,mOnlyP $ tag3 A.Assign DontCare [var] $ tag2 A.ExpressionList DontCare [tag4 A.Dyadic DontCare A.Plus evar (exprVariablePattern "t")]
,mOnlyP $ tag3 A.Alt DontCare True $ mSeveralA
[mOnlyA $ tag4 A.AlternativeWait DontCare A.WaitUntil evar (A.Skip m)]
[mOnlyA $ mWaitUntil evar (A.Skip m)]
]
varName = (tag3 A.Name DontCare A.VariableName $ Named "nowt" DontCare)
var = tag2 A.Variable DontCare varName
@ -127,19 +145,19 @@ testTransformWaitFor4 = TestCase $ testPass "testTransformWaitFor4" exp (transfo
testTransformWaitFor5 :: Test
testTransformWaitFor5 = TestCase $ testPass "testTransformWaitFor5" exp (transformWaitFor orig) (return ())
where
orig = A.Alt m True $ A.Several m [A.Only m $ A.AlternativeWait m A.WaitFor (exprVariable "t") (A.Skip m),
A.Only m $ A.AlternativeWait m A.WaitFor (exprVariable "t") (A.Skip m)]
orig = A.Alt m True $ A.Several m [A.Only m $ waitFor (exprVariable "t") (A.Skip m),
A.Only m $ waitFor (exprVariable "t") (A.Skip m)]
exp = tag2 A.Seq DontCare $ mSpecP (tag3 A.Specification DontCare varName0 $ A.Declaration m A.Time) $
mSpecP (tag3 A.Specification DontCare varName1 $ A.Declaration m A.Time) $
mSeveralP
[
mOnlyP $ tag2 A.GetTime DontCare var0
mOnlyP $ mGetTime var0
,mOnlyP $ tag3 A.Assign DontCare [var0] $ tag2 A.ExpressionList DontCare [tag4 A.Dyadic DontCare A.Plus evar0 (exprVariablePattern "t")]
,mOnlyP $ tag2 A.GetTime DontCare var1
,mOnlyP $ mGetTime var1
,mOnlyP $ tag3 A.Assign DontCare [var1] $ tag2 A.ExpressionList DontCare [tag4 A.Dyadic DontCare A.Plus evar1 (exprVariablePattern "t")]
,mOnlyP $ tag3 A.Alt DontCare True $ mSeveralA
[mOnlyA $ tag4 A.AlternativeWait DontCare A.WaitUntil evar0 (A.Skip m)
,mOnlyA $ tag4 A.AlternativeWait DontCare A.WaitUntil evar1 (A.Skip m)]
[mOnlyA $ mWaitUntil evar0 (A.Skip m)
,mOnlyA $ mWaitUntil evar1 (A.Skip m)]
]
varName0 = (tag3 A.Name DontCare A.VariableName $ Named "nowt0" DontCare)
var0 = tag2 A.Variable DontCare varName0

2
pass/Properties.hs
View File

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