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

Added tests and implementation for a new pass for transforming input-case statements into case statements

Browse Source
This commit is contained in:
Neil Brown 2007-10-13 23:28:41 +00:00
parent 443b648d73
commit 8b2e14f3bd
2 changed files with 264 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

167
transformations/PassTest.hs
View File

@ -254,6 +254,170 @@ testOutExprs = TestList
chan = variable "c"
xName = simpleName "x"
testInputCase :: Test
testInputCase = TestList
[
-- Input that only involves tags:
{-
The idea is to transform:
c ? CASE
a0
--Process p0
into:
SEQ
INT tag:
SEQ
c ? tag
CASE tag
a0
--Process p0
-}
TestCase $ testPass "testInputCase 0"
(tag2 A.Seq DontCare $
tag3 A.Spec DontCare (tag3 A.Specification DontCare (Named "tag" DontCare) $ tag2 A.Declaration DontCare A.Int) $
tag2 A.Several DontCare
[tag2 A.OnlyP DontCare $ tag3 A.Input DontCare c $ tag2 A.InputSimple DontCare [tag2 A.InVariable DontCare $ tag2 A.Variable DontCare (Named "tag" DontCare)]
,tag2 A.OnlyP DontCare $ tag3 A.Case DontCare (tag2 A.ExprVariable DontCare $ tag2 A.Variable DontCare (Named "tag" DontCare)) $
tag2 A.OnlyO DontCare $ tag3 A.Option DontCare [intLiteralPattern 0] p0
]
)
(transformInputCase $
A.Input emptyMeta c $ A.InputCase emptyMeta $ A.OnlyV emptyMeta $ A.Variant emptyMeta a0 [] p0
)
(defineMyProtocol >> defineC)
-- Input that involves multiple tags and multiple inputs:
{-
The idea is to transform:
c ? CASE
a0
--Process p0
c1 ; z
--Process p1
b2 ; x ; y
--Process p2
into:
SEQ
INT tag:
SEQ
c ? tag
CASE tag
a0
--Process p0
c1
SEQ
c ? z
--Process p1
b2
SEQ
c ? x ; y
--Process p2
-}
,TestCase $ testPass "testInputCase 1"
(tag2 A.Seq DontCare $
tag3 A.Spec DontCare (tag3 A.Specification DontCare (Named "tag" DontCare) $ tag2 A.Declaration DontCare A.Int) $
tag2 A.Several DontCare
[tag2 A.OnlyP DontCare $ tag3 A.Input DontCare c $ tag2 A.InputSimple DontCare [tag2 A.InVariable DontCare $ tag2 A.Variable DontCare (Named "tag" DontCare)]
,tag2 A.OnlyP DontCare $ tag3 A.Case DontCare (tag2 A.ExprVariable DontCare $ tag2 A.Variable DontCare (Named "tag" DontCare)) $ tag2 A.Several emptyMeta
[tag2 A.OnlyO DontCare $ tag3 A.Option DontCare [intLiteralPattern 0] p0
,tag2 A.OnlyO DontCare $ tag3 A.Option DontCare [intLiteralPattern 2] $
tag2 A.Seq DontCare $ tag2 A.Several DontCare
[tag2 A.OnlyP DontCare $ A.Input emptyMeta c $ A.InputSimple emptyMeta [A.InVariable emptyMeta z],tag2 A.OnlyP DontCare p1]
,tag2 A.OnlyO DontCare $ tag3 A.Option DontCare [intLiteralPattern 1] $
tag2 A.Seq DontCare $ tag2 A.Several DontCare
[tag2 A.OnlyP DontCare $ A.Input emptyMeta c $ A.InputSimple emptyMeta [A.InVariable emptyMeta x,A.InVariable emptyMeta y],tag2 A.OnlyP DontCare p2]
]
]
)
(transformInputCase $
A.Input emptyMeta c $ A.InputCase emptyMeta $ A.Several emptyMeta
[A.OnlyV emptyMeta $ A.Variant emptyMeta a0 [] p0
,A.OnlyV emptyMeta $ A.Variant emptyMeta c1 [A.InVariable emptyMeta z] p1
,A.OnlyV emptyMeta $ A.Variant emptyMeta b2 [A.InVariable emptyMeta x,A.InVariable emptyMeta y] p2
]
)
(defineMyProtocol >> defineC)
-- Input that involves multiple tags and multiple inputs and specs (sheesh!):
{-
The idea is to transform:
c ? CASE
a0
--Process p0
INT z:
c1 ; z
--Process p1
INT x:
INT y:
b2 ; x ; y
--Process p2
into:
SEQ
INT tag:
SEQ
c ? tag
CASE tag
a0
--Process p0
INT z:
c1
SEQ
c ? z
--Process p1
INT x:
INT y:
b2
SEQ
c ? x ; y
--Process p2
-}
,TestCase $ testPass "testInputCase 2"
(tag2 A.Seq DontCare $
tag3 A.Spec DontCare (tag3 A.Specification DontCare (Named "tag" DontCare) $ tag2 A.Declaration DontCare A.Int) $
tag2 A.Several DontCare
[tag2 A.OnlyP DontCare $ tag3 A.Input DontCare c $ tag2 A.InputSimple DontCare [tag2 A.InVariable DontCare $ tag2 A.Variable DontCare (Named "tag" DontCare)]
,tag2 A.OnlyP DontCare $ tag3 A.Case DontCare (tag2 A.ExprVariable DontCare $ tag2 A.Variable DontCare (Named "tag" DontCare)) $ tag2 A.Several emptyMeta
[tag2 A.OnlyO DontCare $ tag3 A.Option DontCare [intLiteralPattern 0] p0
,specIntPatt "z" $ tag2 A.OnlyO DontCare $ tag3 A.Option DontCare [intLiteralPattern 2] $
tag2 A.Seq DontCare $ tag2 A.Several DontCare
[tag2 A.OnlyP DontCare $ A.Input emptyMeta c $ A.InputSimple emptyMeta [A.InVariable emptyMeta z],tag2 A.OnlyP DontCare p1]
,specIntPatt "x" $ specIntPatt "y" $ tag2 A.OnlyO DontCare $ tag3 A.Option DontCare [intLiteralPattern 1] $
tag2 A.Seq DontCare $ tag2 A.Several DontCare
[tag2 A.OnlyP DontCare $ A.Input emptyMeta c $ A.InputSimple emptyMeta [A.InVariable emptyMeta x,A.InVariable emptyMeta y],tag2 A.OnlyP DontCare p2]
]
]
)
(transformInputCase $
A.Input emptyMeta c $ A.InputCase emptyMeta $ A.Several emptyMeta
[A.OnlyV emptyMeta $ A.Variant emptyMeta a0 [] p0
,specInt "z" $ A.OnlyV emptyMeta $ A.Variant emptyMeta c1 [A.InVariable emptyMeta z] p1
,specInt "x" $ specInt "y" $ A.OnlyV emptyMeta $ A.Variant emptyMeta b2 [A.InVariable emptyMeta x,A.InVariable emptyMeta y] p2
]
)
(defineMyProtocol >> defineC)
--TODO test alt guards
]
where
-- Various distinct simple processes:
p0 = A.Skip emptyMeta
p1 = A.Main emptyMeta
p2 = A.Stop emptyMeta
c = variable "c"
x = variable "x"
y = variable "y"
z = variable "z"
a0 = simpleName "a0"
b2 = simpleName "b2"
c1 = simpleName "c1"
defineMyProtocol = defineName (simpleName "prot") $ A.NameDef emptyMeta "prot" "prot" A.ProtocolName
(A.ProtocolCase emptyMeta [(a0,[]),(b2,[A.Int,A.Int]),(c1,[A.Int])])
A.Original A.Unplaced
defineC = defineName (simpleName "c") $ simpleDefDecl "c" (A.Chan A.DirUnknown (A.ChanAttributes False False) (A.UserProtocol $ simpleName "prot"))
specInt s = A.Spec emptyMeta (A.Specification emptyMeta (simpleName s) $ A.Declaration emptyMeta A.Int)
specIntPatt s = tag3 A.Spec emptyMeta (A.Specification emptyMeta (simpleName s) $ A.Declaration emptyMeta A.Int)
--Returns the list of tests:
tests :: Test
@ -262,8 +426,9 @@ tests = TestList
testFunctionsToProcs0
,testFunctionsToProcs1
,testFunctionsToProcs2
,testTransformConstr0
,testInputCase
,testOutExprs
,testTransformConstr0
]

98
transformations/SimplifyComms.hs
View File

@ -21,6 +21,7 @@ module SimplifyComms where
import Control.Monad.State
import Data.Generics
import Data.List
import qualified AST as A
import CompState
@ -69,3 +70,100 @@ outExprs = doGeneric `extM` doProcess
abbrevExpr m e = do t <- typeOfExpression e
specification@(A.Specification _ nm _) <- defineNonce m "output_var" (A.IsExpr m A.ValAbbrev t e) A.VariableName A.ValAbbrev
return (nm, A.Spec m specification)
{- The explanation for this pass is taken from my (Neil's) mailing list post "Case protocols" on tock-discuss, dated 10th October 2007:
Currently in Tock (from occam) we have CASE statements, and inputs for variant
protocols. They are parsed into separate AST entries, which is sensible. But
then in the backend there is some duplicate code because both things get turned
into some form of switch statement. It would be straightforward to unify the
code in the C/C++ backends, but I was wondering about doing something which
would be a bit cleaner; unifying them in an earlier pass (everything should be
a pass in nanopass :). The idea would be to turn (example is from the occam 2
manual):
from.dfs ? CASE
record; rnumber; rlen::buffer
-- process A
error ; enumber; elen::buffer
-- process B
into:
INT temp.var:
SEQ
from.dfs ? temp.var
CASE temp.var
3
SEQ
from.dfs ? rnumber ; rlen::buffer
-- process A
4
SEQ
from.dfs ? enumber ; elen::buffer
-- process B
Note that the tags are turned into integer literals, which is what happens in
Tock already anyway. Note that in Tock each protocol item is already a
separate communication, so splitting out the sequential inputs is fine. ALTs
would have to be split as follows, by turning:
ALT
from.dfs ? CASE
request ; query
-- process C
error ; enumber; elen::buffer
-- process D
into:
ALT
INT temp.var:
from.dfs ? temp.var
CASE temp.var
0
SEQ
from.dfs ? query
-- process C
1
SEQ
from.dfs ? enumber ; elen::buffer
-- process D
-}
transformInputCase :: Data t => t -> PassM t
transformInputCase = doGeneric `extM` doProcess
where
doGeneric :: Data t => t -> PassM t
doGeneric = makeGeneric transformInputCase
doProcess :: A.Process -> PassM A.Process
doProcess (A.Input m v (A.InputCase m' s))
= do spec@(A.Specification _ n _) <- defineNonce m "input_tag" (A.Declaration m' A.Int) A.VariableName A.Original
s' <- doStructured v s
return $ A.Seq m $ A.Spec m' spec $ A.Several m'
[A.OnlyP m $ A.Input m v (A.InputSimple m [A.InVariable m (A.Variable m n)])
,A.OnlyP m' $ A.Case m' (A.ExprVariable m $ A.Variable m n) s']
doProcess p = doGeneric p
doStructured :: A.Variable -> A.Structured -> PassM A.Structured
doStructured v (A.ProcThen m p s)
= do s' <- doStructured v s
p' <- doProcess p
return (A.ProcThen m p' s')
doStructured v (A.Spec m sp st)
= do st' <- doStructured v st
return (A.Spec m sp st')
doStructured v (A.Several m ss)
= do ss' <- mapM (doStructured v) ss
return (A.Several m ss')
doStructured chanVar (A.OnlyV m (A.Variant m' n iis p))
= do (Right items) <- protocolItems chanVar
let (Just idx) = elemIndex n (fst $ unzip items)
p' <- doProcess p
return $ A.OnlyO m $ A.Option m' [makeConstant m' idx] $
if (length iis == 0)
then p'
else A.Seq m' $ A.Several m'
[A.OnlyP m' $ A.Input m' chanVar (A.InputSimple m' iis)
,A.OnlyP (findMeta p') p']