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

Added an optional initialiser-expression to Declaration in the AST, and changed the rest of the code accordingly

Browse Source
This commit is contained in:
Neil Brown 2007-10-24 23:50:00 +00:00
parent 83f654a273
commit 6b95827cab
19 changed files with 100 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
backends/BackendPasses.hs
View File

@ -63,7 +63,7 @@ transformWaitFor = everywhereM (mkM doAlt)
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))],
put (specs ++ [A.Spec m (A.Specification m n (A.Declaration m A.Time Nothing))],
init ++ [A.OnlyP m $ A.GetTime m var, A.OnlyP 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

14
backends/BackendPassesTest.hs
View File

@ -40,7 +40,7 @@ testTransformWaitFor1 :: Test
testTransformWaitFor1 = TestCase $ testPass "testTransformWaitFor1" exp (transformWaitFor orig) (return ())
where
orig = A.Alt m True $ A.OnlyA m $ A.AlternativeWait m A.WaitFor (exprVariable "t") (A.Skip m)
exp = tag2 A.Seq DontCare $ tag3 A.Spec DontCare (tag3 A.Specification DontCare varName $ tag2 A.Declaration DontCare A.Time) $
exp = tag2 A.Seq DontCare $ tag3 A.Spec DontCare (tag3 A.Specification DontCare varName $ A.Declaration m A.Time Nothing) $
tag2 A.Several DontCare
[
tag2 A.OnlyP DontCare $ tag2 A.GetTime DontCare var
@ -57,8 +57,8 @@ testTransformWaitFor2 = TestCase $ testPass "testTransformWaitFor2" exp (transfo
where
orig = A.Alt m True $ A.Several m [A.OnlyA m $ A.AlternativeWait m A.WaitFor (exprVariable "t0") (A.Skip m),
A.OnlyA m $ A.AlternativeWait m A.WaitFor (exprVariable "t1") (A.Skip m)]
exp = tag2 A.Seq DontCare $ tag3 A.Spec DontCare (tag3 A.Specification DontCare varName0 $ tag2 A.Declaration DontCare A.Time) $
tag3 A.Spec DontCare (tag3 A.Specification DontCare varName1 $ tag2 A.Declaration DontCare A.Time) $
exp = tag2 A.Seq DontCare $ tag3 A.Spec DontCare (tag3 A.Specification DontCare varName0 $ A.Declaration m A.Time Nothing) $
tag3 A.Spec DontCare (tag3 A.Specification DontCare varName1 $ A.Declaration m A.Time Nothing) $
tag2 A.Several DontCare
[
tag2 A.OnlyP DontCare $ tag2 A.GetTime DontCare var0
@ -81,7 +81,7 @@ testTransformWaitFor3 :: Test
testTransformWaitFor3 = TestCase $ testPass "testTransformWaitFor3" exp (transformWaitFor orig) (return ())
where
orig = A.Alt m True $ A.OnlyA m $ A.AlternativeWait m A.WaitFor (A.Dyadic m A.Plus (exprVariable "t0") (exprVariable "t1")) (A.Skip m)
exp = tag2 A.Seq DontCare $ tag3 A.Spec DontCare (tag3 A.Specification DontCare varName $ tag2 A.Declaration DontCare A.Time) $
exp = tag2 A.Seq DontCare $ tag3 A.Spec DontCare (tag3 A.Specification DontCare varName $ A.Declaration m A.Time Nothing) $
tag2 A.Several DontCare
[
tag2 A.OnlyP DontCare $ tag2 A.GetTime DontCare var
@ -98,7 +98,7 @@ testTransformWaitFor4 :: Test
testTransformWaitFor4 = TestCase $ testPass "testTransformWaitFor4" exp (transformWaitFor orig) (return ())
where
orig = A.Alt m True $ A.Several m [A.OnlyA m $ A.AlternativeWait m A.WaitFor (exprVariable "t") (A.Skip m)]
exp = tag2 A.Seq DontCare $ tag3 A.Spec DontCare (tag3 A.Specification DontCare varName $ tag2 A.Declaration DontCare A.Time) $
exp = tag2 A.Seq DontCare $ tag3 A.Spec DontCare (tag3 A.Specification DontCare varName $ A.Declaration m A.Time Nothing) $
tag2 A.Several DontCare
[
tag2 A.OnlyP DontCare $ tag2 A.GetTime DontCare var
@ -116,8 +116,8 @@ testTransformWaitFor5 = TestCase $ testPass "testTransformWaitFor5" exp (transfo
where
orig = A.Alt m True $ A.Several m [A.OnlyA m $ A.AlternativeWait m A.WaitFor (exprVariable "t") (A.Skip m),
A.OnlyA m $ A.AlternativeWait m A.WaitFor (exprVariable "t") (A.Skip m)]
exp = tag2 A.Seq DontCare $ tag3 A.Spec DontCare (tag3 A.Specification DontCare varName0 $ tag2 A.Declaration DontCare A.Time) $
tag3 A.Spec DontCare (tag3 A.Specification DontCare varName1 $ tag2 A.Declaration DontCare A.Time) $
exp = tag2 A.Seq DontCare $ tag3 A.Spec DontCare (tag3 A.Specification DontCare varName0 $ A.Declaration m A.Time Nothing) $
tag3 A.Spec DontCare (tag3 A.Specification DontCare varName1 $ A.Declaration m A.Time Nothing) $
tag2 A.Several DontCare
[
tag2 A.OnlyP DontCare $ tag2 A.GetTime DontCare var0

4
backends/GenerateC.hs
View File

@ -1330,7 +1330,7 @@ CHAN OF INT c IS d: Channel *c = d;
const int *ds_sizes = cs_sizes;
-}
cintroduceSpec :: GenOps -> A.Specification -> CGen ()
cintroduceSpec ops (A.Specification m n (A.Declaration _ t))
cintroduceSpec ops (A.Specification m n (A.Declaration _ t _))
= do call genDeclaration ops t n False
case call declareInit ops m t (A.Variable m n) of
Just p -> p
@ -1444,7 +1444,7 @@ cgenForwardDeclaration ops (A.Specification _ n (A.Proc _ sm fs _))
cgenForwardDeclaration _ _ = return ()
cremoveSpec :: GenOps -> A.Specification -> CGen ()
cremoveSpec ops (A.Specification m n (A.Declaration _ t))
cremoveSpec ops (A.Specification m n (A.Declaration _ t _))
= case call declareFree ops m t var of
Just p -> p
Nothing -> return ()

2
backends/GenerateCPPCSP.hs
View File

@ -620,7 +620,7 @@ cppdeclareFree _ _ _ _ = Nothing
-- | Changed to work properly with declareFree to free channel arrays.
cppremoveSpec :: GenOps -> A.Specification -> CGen ()
cppremoveSpec ops (A.Specification m n (A.Declaration _ t))
cppremoveSpec ops (A.Specification m n (A.Declaration _ t _))
= do case call declareFree ops m t var of
Just p -> p
Nothing -> return ()

16
backends/GenerateCTest.hs
View File

@ -495,9 +495,9 @@ testDeclareInitFree = TestList
testAll' :: Int -> (String,String) -> (String,String) -> A.Type -> State CompState () -> Test
testAll' n (iC,fC) (iCPP,fCPP) t state = TestList
[
testBothS ("testDeclareInitFree/a" ++ show n) ("@" ++ iC) ("@" ++ iCPP) ((tcall introduceSpec $ A.Specification emptyMeta foo (A.Declaration emptyMeta t)) . over) state
testBothS ("testDeclareInitFree/a" ++ show n) ("@" ++ iC) ("@" ++ iCPP) ((tcall introduceSpec $ A.Specification emptyMeta foo (A.Declaration emptyMeta t Nothing)) . over) state
,testBothS ("testDeclareInitFree/b" ++ show n) iC iCPP ((fromMaybe (return ())) . (tcall3 declareInit emptyMeta t (A.Variable emptyMeta foo)) . over) state
,testBothS ("testDeclareInitFree/c" ++ show n) fC fCPP ((tcall removeSpec $ A.Specification emptyMeta foo (A.Declaration emptyMeta t)) . over) state
,testBothS ("testDeclareInitFree/c" ++ show n) fC fCPP ((tcall removeSpec $ A.Specification emptyMeta foo (A.Declaration emptyMeta t Nothing)) . over) state
,testBothS ("testDeclareInitFree/d" ++ show n) fC fCPP ((fromMaybe (return ())) . (tcall3 declareFree emptyMeta t (A.Variable emptyMeta foo)) . over) state
]
where
@ -513,10 +513,12 @@ testSpec :: Test
testSpec = TestList
[
--Declaration:
testAllSame 0 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta A.Int
,testAllSame 1 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int
,testAllSame 2 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta $ A.Array [A.Dimension 3] A.Int
,testAllSame 3 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta $ A.Array [A.Dimension 3] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int
testAllSame 0 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta A.Int Nothing
,testAllSame 1 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta (A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) Nothing
,testAllSame 2 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta (A.Array [A.Dimension 3] A.Int) Nothing
,testAllSame 3 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta (A.Array [A.Dimension 3] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) Nothing
-- TODO test declarations with initialisers
--Empty/failure cases:
,testAllSame 100 ("","") $ A.DataType undefined undefined
@ -744,7 +746,7 @@ testGenVariable = TestList
,testBothS ("testGenVariable/unchecked" ++ show n) eUC eUCPP ((tcall genVariableUnchecked $ sub $ A.Variable emptyMeta foo) . over) state
]
where
state = do defineName (simpleName "foo") $ A.NameDef emptyMeta "foo" "foo" A.VariableName (A.Declaration emptyMeta t) am A.Unplaced
state = do defineName (simpleName "foo") $ A.NameDef emptyMeta "foo" "foo" A.VariableName (A.Declaration emptyMeta t Nothing) am A.Unplaced
defRecord "bar" "x" $ A.Array [A.Dimension 7] A.Int
over ops = ops {genArraySubscript = (\_ b _ subs -> at >> (tell [if b then "C" else "U"]) >> (seqComma $ map (call genExpression ops) subs))
,genDirectedVariable = (\_ cg _ -> dollar >> cg >> dollar)}

4
common/AST.hs
View File

@ -409,8 +409,8 @@ data Specification =
data SpecType =
-- | Set placement for an existing variable.
Place Meta Expression
-- | Declare a variable.
| Declaration Meta Type
-- | Declare a variable, with an optional value to initialise it to.
| Declaration Meta Type (Maybe Expression)
-- | Declare an abbreviation of a variable.
| Is Meta AbbrevMode Type Variable
-- | Declare an abbreviation of an expression.

4
common/CompState.hs
View File

@ -228,7 +228,7 @@ makeNonceProc m p
-- | Generate and define a counter for a replicator.
makeNonceCounter :: CSM m => String -> Meta -> m A.Name
makeNonceCounter s m
= do (A.Specification _ n _) <- defineNonce m s (A.Declaration m A.Int) A.VariableName A.ValAbbrev
= do (A.Specification _ n _) <- defineNonce m s (A.Declaration m A.Int Nothing) A.VariableName A.ValAbbrev
return n
-- | Generate and define a variable abbreviation.
@ -244,7 +244,7 @@ makeNonceIsExpr s m t e
-- | Generate and define a variable.
makeNonceVariable :: CSM m => String -> Meta -> A.Type -> A.NameType -> A.AbbrevMode -> m A.Specification
makeNonceVariable s m t nt am
= defineNonce m s (A.Declaration m t) nt am
= defineNonce m s (A.Declaration m t Nothing) nt am
--}}}
diePC :: (CSM m, Die m) => Meta -> m String -> m a

4
common/ShowCode.hs
View File

@ -367,8 +367,10 @@ instance ShowOccam A.Specification where
params' <- showAll (intersperse (return ",") $ map showOccamM params)
--TODO use the occamdoc setting
showOccamLine (return $ "PROC " ++ n' ++ "(" ++ params' ++ ")") +>> occamIndent +>> showOccamM body +>> occamOutdent +>> showOccamLine (return ":")
showOccamM (A.Specification _ n (A.Declaration _ t))
showOccamM (A.Specification _ n (A.Declaration _ t Nothing))
= showOccamLine $ showOccamM t +>> space +>> showName n +>> colon
showOccamM (A.Specification _ n (A.Declaration _ t (Just e)))
= showOccamLine $ return "INITIAL " +>> showOccamM t +>> space +>> showName n +>> return " IS " +>> showOccamM e +>> colon
showOccamM (A.Specification _ n (A.Is _ am t v))
= showOccamLine $ (maybeVal am) +>> showOccamM t +>> space +>> showName n +>> return " IS " +>> showOccamM v +>> colon
showOccamM (A.Specification _ n (A.IsExpr _ am t e))

2
common/TestUtil.hs
View File

@ -378,7 +378,7 @@ simpleDef n sp = A.NameDef {A.ndMeta = m, A.ndName = n, A.ndOrigName = n, A.ndNa
-- | A simple definition of a declared variable
simpleDefDecl :: String -> A.Type -> A.NameDef
simpleDefDecl n t = simpleDef n (A.Declaration m t)
simpleDefDecl n t = simpleDef n (A.Declaration m t Nothing)
-- | A pattern that will match simpleDef, with a different abbreviation mode
simpleDefPattern :: String -> A.AbbrevMode -> Pattern -> Pattern

2
common/Types.hs
View File

@ -70,7 +70,7 @@ typeOfName n
typeOfSpec :: (CSM m, Die m) => A.SpecType -> m (Maybe A.Type)
typeOfSpec st
= case st of
A.Declaration _ t -> return $ Just t
A.Declaration _ t _ -> return $ Just t
A.Is _ _ _ v -> (liftM Just) (typeOfVariable v)
A.IsExpr _ _ _ e -> (liftM Just) (typeOfExpression e)
A.IsChannelArray _ _ (c:_) -> liftM (Just . (A.Array [A.UnknownDimension])) $ typeOfVariable c

6
frontends/ParseOccam.hs
View File

@ -449,7 +449,7 @@ scopeOut n@(A.Name m nt s)
-- FIXME: Do these with generics? (going carefully to avoid nested code blocks)
scopeInRep :: A.Replicator -> OccParser A.Replicator
scopeInRep (A.For m n b c)
= do n' <- scopeIn n (A.Declaration m A.Int) A.ValAbbrev
= do n' <- scopeIn n (A.Declaration m A.Int Nothing) A.ValAbbrev
return $ A.For m n' b c
scopeOutRep :: A.Replicator -> OccParser ()
@ -465,7 +465,7 @@ scopeOutSpec (A.Specification _ n _) = scopeOut n
scopeInFormal :: A.Formal -> OccParser A.Formal
scopeInFormal (A.Formal am t n)
= do n' <- scopeIn n (A.Declaration (A.nameMeta n) t) am
= do n' <- scopeIn n (A.Declaration (A.nameMeta n) t Nothing) am
return (A.Formal am t n')
scopeInFormals :: [A.Formal] -> OccParser [A.Formal]
@ -1232,7 +1232,7 @@ declOf spec newName
= do m <- md
(d, ns) <- tryVVX spec (sepBy1 newName sComma) sColon
eol
return (ns, A.Declaration m d)
return (ns, A.Declaration m d Nothing)
abbreviation :: OccParser A.Specification
abbreviation

2
frontends/ParseRain.hs
View File

@ -394,7 +394,7 @@ declaration = try $ do {t <- dataType; sColon ; ns <- name `sepBy1` sComma ; sSe
return (findMeta t, \x -> foldr (foldSpec t) x ns) }
where
foldSpec :: A.Type -> A.Name -> (A.Structured -> A.Structured)
foldSpec t n = A.Spec (findMeta t) $ A.Specification (findMeta t) n $ A.Declaration (findMeta t) t
foldSpec t n = A.Spec (findMeta t) $ A.Specification (findMeta t) n $ A.Declaration (findMeta t) t Nothing
terminator :: A.Structured
terminator = A.Several emptyMeta []

26
frontends/ParseRainTest.hs
View File

@ -67,6 +67,8 @@ testParseFail (text,prod)
emptyBlock :: A.Process
emptyBlock = A.Seq m $ A.Several m []
noInit :: Maybe A.Expression
noInit = Nothing
--You are allowed to chain arithmetic operators without brackets, but not comparison operators
-- (the meaning of "b == c == d" is obscure enough to be dangerous, even if it passes the type checker)
@ -330,14 +332,14 @@ testPar =
--Rain only allows declarations at the beginning of a par block:
,pass ("par {int:x; {} }",RP.statement,
assertEqual "Par Decl Test 0" $ A.Par m A.PlainPar $ A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Int) $ A.Several m
assertEqual "Par Decl Test 0" $ A.Par m A.PlainPar $ A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Int Nothing) $ A.Several m
[A.OnlyP m $ A.Seq m $ A.Several m []] )
,pass ("par {uint16:x; uint32:y; {} }",RP.statement,
assertEqual "Par Decl Test 1" $ A.Par m A.PlainPar $
A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.UInt16) $
A.Spec m (A.Specification m (simpleName "y") $ A.Declaration m A.UInt32) $
A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.UInt16 Nothing) $
A.Spec m (A.Specification m (simpleName "y") $ A.Declaration m A.UInt32 Nothing) $
A.Several m [A.OnlyP m $ A.Seq m $ A.Several m []] )
,fail ("par { {} int: x; }",RP.statement)
@ -351,16 +353,16 @@ testBlock =
,pass("{ a = b; b = c; }",RP.innerBlock False,assertPatternMatch "testBlock 1" (tag2 A.Several DontCare
[tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "a" "b",tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "b" "c"]) )
,pass("{ uint8: x; a = b; }",RP.innerBlock False,assertPatternMatch "testBlock 2" $ tag3 A.Spec DontCare
(tag3 A.Specification DontCare (simpleNamePattern "x") $ tag2 A.Declaration DontCare A.Byte) $ tag2 A.Several DontCare
(tag3 A.Specification DontCare (simpleNamePattern "x") $ tag3 A.Declaration DontCare A.Byte noInit) $ tag2 A.Several DontCare
[tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "a" "b"]
)
,pass("{ uint8: x; a = b; b = c; }",RP.innerBlock False,assertPatternMatch "testBlock 3" $ tag3 A.Spec DontCare
(tag3 A.Specification DontCare (simpleNamePattern "x") $ tag2 A.Declaration DontCare A.Byte) $ tag2 A.Several DontCare
(tag3 A.Specification DontCare (simpleNamePattern "x") $ tag3 A.Declaration DontCare A.Byte noInit) $ tag2 A.Several DontCare
[tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "a" "b",tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "b" "c"]
)
,pass("{ b = c; uint8: x; a = b; }",RP.innerBlock False,assertPatternMatch "testBlock 4" $ tag2 A.Several DontCare [tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "b" "c",
tag3 A.Spec DontCare
(tag3 A.Specification DontCare (simpleNamePattern "x") $ tag2 A.Declaration DontCare A.Byte) $ tag2 A.Several DontCare
(tag3 A.Specification DontCare (simpleNamePattern "x") $ tag3 A.Declaration DontCare A.Byte noInit) $ tag2 A.Several DontCare
[tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "a" "b"]
])
,fail("{b}",RP.innerBlock False)
@ -496,13 +498,13 @@ testDataType =
testDecl :: [ParseTest (Meta, A.Structured -> A.Structured)]
testDecl =
[
passd ("bool: b;",0,tag3 A.Specification DontCare (simpleNamePattern "b") $ tag2 A.Declaration DontCare A.Bool)
,passd ("uint8: x;",1,tag3 A.Specification DontCare (simpleNamePattern "x") $ tag2 A.Declaration DontCare A.Byte)
,passd ("?bool: bc;",2,tag3 A.Specification DontCare (simpleNamePattern "bc") $ tag2 A.Declaration DontCare $ A.Chan A.DirInput nonShared A.Bool)
,passd ("a: b;",3,tag3 A.Specification DontCare (simpleNamePattern "b") $ tag2 A.Declaration DontCare (tag1 A.UserDataType $ tag3 A.Name DontCare A.DataTypeName "a"))
passd ("bool: b;",0,tag3 A.Specification DontCare (simpleNamePattern "b") $ tag3 A.Declaration DontCare A.Bool noInit)
,passd ("uint8: x;",1,tag3 A.Specification DontCare (simpleNamePattern "x") $ tag3 A.Declaration DontCare A.Byte noInit)
,passd ("?bool: bc;",2,tag3 A.Specification DontCare (simpleNamePattern "bc") $ tag3 A.Declaration DontCare (A.Chan A.DirInput nonShared A.Bool) noInit)
,passd ("a: b;",3,tag3 A.Specification DontCare (simpleNamePattern "b") $ tag3 A.Declaration DontCare (tag1 A.UserDataType $ tag3 A.Name DontCare A.DataTypeName "a") noInit)
,passd2 ("bool: b0,b1;",100,tag3 A.Specification DontCare (simpleNamePattern "b0") $ tag2 A.Declaration DontCare A.Bool,
tag3 A.Specification DontCare (simpleNamePattern "b1") $ tag2 A.Declaration DontCare A.Bool)
,passd2 ("bool: b0,b1;",100,tag3 A.Specification DontCare (simpleNamePattern "b0") $ tag3 A.Declaration DontCare A.Bool noInit,
tag3 A.Specification DontCare (simpleNamePattern "b1") $ tag3 A.Declaration DontCare A.Bool noInit)
,fail ("bool:;",RP.declaration)

2
frontends/RainPasses.hs
View File

@ -122,7 +122,7 @@ uniquifyAndResolveVars = everywhereM (mkM uniquifyAndResolveVars')
let newName = (n {A.nameName = n'})
let m = A.nameMeta n
defineName newName A.NameDef {A.ndMeta = m, A.ndName = n', A.ndOrigName = A.nameName n,
A.ndNameType = A.VariableName, A.ndType = (A.Declaration m t),
A.ndNameType = A.VariableName, A.ndType = (A.Declaration m t Nothing),
A.ndAbbrevMode = am, A.ndPlacement = A.Unplaced}
let scope' = everywhere (mkT $ replaceNameName (A.nameName n) n') scope
return (A.Formal am t newName, scope')

62
frontends/RainPassesTest.hs
View File

@ -47,7 +47,7 @@ testEachPass0 :: Test
testEachPass0 = TestCase $ testPassWithItemsStateCheck "testEachPass0" exp (transformEach orig) startState' check
where
startState' :: State CompState ()
startState' = do defineName (simpleName "c") $ simpleDef "c" (A.Declaration m A.Byte)
startState' = do defineName (simpleName "c") $ simpleDef "c" (A.Declaration m A.Byte Nothing)
orig = A.Seq m
(A.Rep m
@ -84,7 +84,7 @@ testEachPass0 = TestCase $ testPassWithItemsStateCheck "testEachPass0" exp (tran
check (items,st) =
do case castADI (Map.lookup "indexVar" items) of
Just indexVarName -> assertVarDef "testEachPass0" st (A.nameName indexVarName)
(simpleDefPattern (A.nameName indexVarName) A.Original (tag2 A.Declaration DontCare A.Int64))
(simpleDefPattern (A.nameName indexVarName) A.Original (tag3 A.Declaration m A.Int64 (Nothing :: Maybe A.Expression)))
Nothing -> assertFailure "testEachPass0: Internal error, indexVar not found"
case castADI (Map.lookup "listVarName" items) of
Just listVarName -> assertVarDef "testEachPass0" st (A.nameName listVarName)
@ -95,8 +95,8 @@ testEachPass1 :: Test
testEachPass1 = TestCase $ testPassWithItemsStateCheck "testEachPass0" exp (transformEach orig) startState' check
where
startState' :: State CompState ()
startState' = do defineName (simpleName "c") $ simpleDef "c" (A.Declaration m A.Byte)
defineName (simpleName "d") $ simpleDef "d" (A.Declaration m (A.Array [A.Dimension 10] A.Byte))
startState' = do defineName (simpleName "c") $ simpleDef "c" (A.Declaration m A.Byte Nothing)
defineName (simpleName "d") $ simpleDef "d" (A.Declaration m (A.Array [A.Dimension 10] A.Byte) Nothing)
orig = A.Par m A.PlainPar
(A.Rep m
@ -124,7 +124,7 @@ testEachPass1 = TestCase $ testPassWithItemsStateCheck "testEachPass0" exp (tran
check (items,st) =
do case castADI (Map.lookup "indexVar" items) of
Just indexVarName -> assertVarDef "testEachPass1" st (A.nameName indexVarName)
(simpleDefPattern (A.nameName indexVarName) A.Original (tag2 A.Declaration DontCare A.Int64))
(simpleDefPattern (A.nameName indexVarName) A.Original (tag3 A.Declaration m A.Int64 (Nothing :: Maybe A.Expression)))
Nothing -> assertFailure "testEachPass1: Internal error, indexVar not found"
testEachRangePass0 :: Test
@ -172,22 +172,22 @@ testEachRangePass3 = TestCase $ testPass "testEachRangePass3" exp (transformEach
testUnique0 :: Test
testUnique0 = TestCase $ testPassWithItemsStateCheck "testUnique0" exp (uniquifyAndResolveVars orig) (return ()) check
where
orig = A.Spec m (A.Specification m (simpleName "c") $ A.Declaration m $ A.Byte) skipP
exp = tag3 A.Spec DontCare (tag3 A.Specification DontCare (Named "newc" DontCare) $ A.Declaration m $ A.Byte) skipP
orig = A.Spec m (A.Specification m (simpleName "c") $ A.Declaration m A.Byte Nothing) skipP
exp = tag3 A.Spec DontCare (tag3 A.Specification DontCare (Named "newc" DontCare) $ A.Declaration m A.Byte Nothing) skipP
check (items,state)
= do newcName <- castAssertADI (Map.lookup "newc" items)
assertNotEqual "testUnique0: Variable was not made unique" "c" (A.nameName newcName)
assertVarDef "testUnique0: Variable was not recorded" state (A.nameName newcName)
(tag7 A.NameDef DontCare (A.nameName newcName) "c" A.VariableName (A.Declaration m A.Byte) A.Original A.Unplaced)
(tag7 A.NameDef DontCare (A.nameName newcName) "c" A.VariableName (A.Declaration m A.Byte Nothing) A.Original A.Unplaced)
-- | Tests that two declarations of a variable with the same name are indeed made unique:
testUnique1 :: Test
testUnique1 = TestCase $ testPassWithItemsStateCheck "testUnique1" exp (uniquifyAndResolveVars orig) (return ()) check
where
orig = A.Several m [A.Spec m (A.Specification m (simpleName "c") $ A.Declaration m $ A.Byte) skipP,
A.Spec m (A.Specification m (simpleName "c") $ A.Declaration m $ A.Int64) skipP]
exp = tag2 A.Several m [tag3 A.Spec DontCare (tag3 A.Specification DontCare (Named "newc0" DontCare) $ A.Declaration m $ A.Byte) skipP,
tag3 A.Spec DontCare (tag3 A.Specification DontCare (Named "newc1" DontCare) $ A.Declaration m $ A.Int64) skipP]
orig = A.Several m [A.Spec m (A.Specification m (simpleName "c") $ A.Declaration m A.Byte Nothing) skipP,
A.Spec m (A.Specification m (simpleName "c") $ A.Declaration m A.Int64 Nothing) skipP]
exp = tag2 A.Several m [tag3 A.Spec DontCare (tag3 A.Specification DontCare (Named "newc0" DontCare) $ A.Declaration m A.Byte Nothing) skipP,
tag3 A.Spec DontCare (tag3 A.Specification DontCare (Named "newc1" DontCare) $ A.Declaration m A.Int64 Nothing) skipP]
check (items,state)
= do newc0Name <- castAssertADI (Map.lookup "newc0" items)
newc1Name <- castAssertADI (Map.lookup "newc1" items)
@ -195,16 +195,16 @@ testUnique1 = TestCase $ testPassWithItemsStateCheck "testUnique1" exp (uniquify
assertNotEqual "testUnique1: Variable was not made unique" "c" (A.nameName newc1Name)
assertNotEqual "testUnique1: Variables were not made unique" (A.nameName newc0Name) (A.nameName newc1Name)
assertVarDef "testUnique1: Variable was not recorded" state (A.nameName newc0Name)
(tag7 A.NameDef DontCare (A.nameName newc0Name) "c" A.VariableName (A.Declaration m A.Byte) A.Original A.Unplaced)
(tag7 A.NameDef DontCare (A.nameName newc0Name) "c" A.VariableName (A.Declaration m A.Byte Nothing) A.Original A.Unplaced)
assertVarDef "testUnique1: Variable was not recorded" state (A.nameName newc1Name)
(tag7 A.NameDef DontCare (A.nameName newc1Name) "c" A.VariableName (A.Declaration m A.Int64) A.Original A.Unplaced)
(tag7 A.NameDef DontCare (A.nameName newc1Name) "c" A.VariableName (A.Declaration m A.Int64 Nothing) A.Original A.Unplaced)
-- | Tests that the unique pass does resolve the variables that are in scope
testUnique2 :: Test
testUnique2 = TestCase $ testPassWithItemsStateCheck "testUnique2" exp (uniquifyAndResolveVars orig) (return ()) check
where
orig = A.Spec m (A.Specification m (simpleName "c") $ A.Declaration m $ A.Byte) (A.OnlyP m $ makeSimpleAssign "c" "d")
exp = tag3 A.Spec DontCare (tag3 A.Specification DontCare (Named "newc" DontCare) $ A.Declaration m $ A.Byte)
orig = A.Spec m (A.Specification m (simpleName "c") $ A.Declaration m A.Byte Nothing) (A.OnlyP m $ makeSimpleAssign "c" "d")
exp = tag3 A.Spec DontCare (tag3 A.Specification DontCare (Named "newc" DontCare) $ A.Declaration m A.Byte Nothing)
(tag2 A.OnlyP m $ tag3 A.Assign DontCare [tag2 A.Variable DontCare (Named "newc" DontCare)] (tag2 A.ExpressionList DontCare [(exprVariable "d")]))
check (items,state) = do newcName <- castAssertADI (Map.lookup "newc" items)
assertNotEqual "testUnique2: Variable was not made unique" "c" (A.nameName newcName)
@ -213,9 +213,9 @@ testUnique2 = TestCase $ testPassWithItemsStateCheck "testUnique2" exp (uniquify
testUnique2b :: Test
testUnique2b = TestCase $ testPassWithItemsStateCheck "testUnique2b" exp (uniquifyAndResolveVars orig) (return ()) check
where
orig = A.Spec m (A.Specification m (simpleName "c") $ A.Declaration m $ A.Byte) $
orig = A.Spec m (A.Specification m (simpleName "c") $ A.Declaration m A.Byte Nothing) $
A.Several m [(A.OnlyP m $ makeSimpleAssign "c" "d"),(A.OnlyP m $ makeSimpleAssign "c" "e")]
exp = tag3 A.Spec DontCare (tag3 A.Specification DontCare (Named "newc" DontCare) $ A.Declaration m $ A.Byte) $
exp = tag3 A.Spec DontCare (tag3 A.Specification DontCare (Named "newc" DontCare) $ A.Declaration m A.Byte Nothing) $
tag2 A.Several DontCare [
(tag2 A.OnlyP m $ tag3 A.Assign DontCare [tag2 A.Variable DontCare (Named "newc" DontCare)] (tag2 A.ExpressionList DontCare [(exprVariable "d")]))
,(tag2 A.OnlyP m $ tag3 A.Assign DontCare [tag2 A.Variable DontCare (Named "newc" DontCare)] (tag2 A.ExpressionList DontCare [(exprVariable "e")]))
@ -254,7 +254,7 @@ testUnique4 = TestCase $ testPassWithItemsStateCheck "testUnique4" exp (uniquify
= do newcName <- castAssertADI (Map.lookup "newc" items)
assertNotEqual "testUnique4: Variable was not made unique" "c" (A.nameName newcName)
assertVarDef "testUnique4: Variable was not recorded" state (A.nameName newcName)
(tag7 A.NameDef DontCare (A.nameName newcName) "c" A.VariableName (A.Declaration m A.Byte) A.ValAbbrev A.Unplaced)
(tag7 A.NameDef DontCare (A.nameName newcName) "c" A.VariableName (A.Declaration m A.Byte Nothing) A.ValAbbrev A.Unplaced)
assertVarDef "testUnique4: Variable was not recorded" state "foo"
(tag7 A.NameDef DontCare "foo" "foo" A.ProcName (tag4 A.Proc DontCare A.PlainSpec
[tag3 A.Formal A.ValAbbrev A.Byte newcName] (bodyPattern newcName)) A.Original A.Unplaced)
@ -269,32 +269,32 @@ testRecordInfNames0 = TestCase $ testPassWithStateCheck "testRecordInfNames0" ex
orig = (A.Rep m (A.ForEach m (simpleName "c") (makeLiteralString "hello")) skipP)
exp = orig
check state = assertVarDef "testRecordInfNames0" state "c"
(tag7 A.NameDef DontCare "c" "c" A.VariableName (A.Declaration m A.Byte) A.Original A.Unplaced)
(tag7 A.NameDef DontCare "c" "c" A.VariableName (A.Declaration m A.Byte Nothing) A.Original A.Unplaced)
-- | checks that c's type is recorded in: ***each (c : str) {}, where str is known to be of type string
testRecordInfNames1 :: Test
testRecordInfNames1 = TestCase $ testPassWithStateCheck "testRecordInfNames1" exp (recordInfNameTypes orig) (startState') check
where
startState' :: State CompState ()
startState' = do defineName (simpleName "str") $ simpleDef "str" (A.Declaration m (A.Array [A.Dimension 10] A.Byte))
startState' = do defineName (simpleName "str") $ simpleDef "str" (A.Declaration m (A.Array [A.Dimension 10] A.Byte) Nothing)
orig = (A.Rep m (A.ForEach m (simpleName "c") (exprVariable "str")) skipP)
exp = orig
check state = assertVarDef "testRecordInfNames1" state "c"
(tag7 A.NameDef DontCare "c" "c" A.VariableName (A.Declaration m A.Byte) A.Original A.Unplaced)
(tag7 A.NameDef DontCare "c" "c" A.VariableName (A.Declaration m A.Byte Nothing) A.Original A.Unplaced)
-- | checks that c's and d's type are recorded in: ***each (c : multi) { seqeach (d : c) {} } where multi is known to be of type [string]
testRecordInfNames2 :: Test
testRecordInfNames2 = TestCase $ testPassWithStateCheck "testRecordInfNames2" exp (recordInfNameTypes orig) (startState') check
where
startState' :: State CompState ()
startState' = do defineName (simpleName "multi") $ simpleDef "multi" (A.Declaration m (A.Array [A.Dimension 10, A.Dimension 20] A.Byte))
startState' = do defineName (simpleName "multi") $ simpleDef "multi" (A.Declaration m (A.Array [A.Dimension 10, A.Dimension 20] A.Byte) Nothing)
orig = A.Rep m (A.ForEach m (simpleName "c") (exprVariable "multi")) $
A.OnlyP m $ A.Seq m $ A.Rep m (A.ForEach m (simpleName "d") (exprVariable "c")) skipP
exp = orig
check state = do assertVarDef "testRecordInfNames2" state "c"
(tag7 A.NameDef DontCare "c" "c" A.VariableName (A.Declaration m (A.Array [A.Dimension 20] A.Byte)) A.Original A.Unplaced)
(tag7 A.NameDef DontCare "c" "c" A.VariableName (A.Declaration m (A.Array [A.Dimension 20] A.Byte) Nothing) A.Original A.Unplaced)
assertVarDef "testRecordInfNames2" state "d"
(tag7 A.NameDef DontCare "d" "d" A.VariableName (A.Declaration m A.Byte) A.Original A.Unplaced)
(tag7 A.NameDef DontCare "d" "d" A.VariableName (A.Declaration m A.Byte Nothing) A.Original A.Unplaced)
-- | checks that doing a foreach over a non-array type is barred:
testRecordInfNames3 :: Test
@ -491,18 +491,18 @@ testPullUpParDecl1 :: Test
testPullUpParDecl1 = TestCase $ testPass "testPullUpParDecl1" exp (pullUpParDeclarations orig) (return ())
where
orig = A.Par m A.PlainPar $
A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Int) (A.Several m [])
exp = A.Seq m $ A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Int) (A.OnlyP m $ A.Par m A.PlainPar $ A.Several m [])
A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Int Nothing) (A.Several m [])
exp = A.Seq m $ A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Int Nothing) (A.OnlyP m $ A.Par m A.PlainPar $ A.Several m [])
testPullUpParDecl2 :: Test
testPullUpParDecl2 = TestCase $ testPass "testPullUpParDecl2" exp (pullUpParDeclarations orig) (return ())
where
orig = A.Par m A.PlainPar $
A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Int) $
A.Spec m (A.Specification m (simpleName "y") $ A.Declaration m A.Byte) $
A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Int Nothing) $
A.Spec m (A.Specification m (simpleName "y") $ A.Declaration m A.Byte Nothing) $
(A.Several m [])
exp = A.Seq m $ A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Int)
$ A.Spec m (A.Specification m (simpleName "y") $ A.Declaration m A.Byte)
exp = A.Seq m $ A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Int Nothing)
$ A.Spec m (A.Specification m (simpleName "y") $ A.Declaration m A.Byte Nothing)
(A.OnlyP m $ A.Par m A.PlainPar $ A.Several m [])
---Returns the list of tests:

2
frontends/RainTypes.hs
View File

@ -45,7 +45,7 @@ recordInfNameTypes = everywhereM (mkM recordInfNameTypes')
_ -> A.Array innerDims t
_ -> dieP m "Cannot do a foreach loop over a non-array type (or array with zero dimensions)"
defineName n A.NameDef {A.ndMeta = m, A.ndName = A.nameName n, A.ndOrigName = A.nameName n,
A.ndNameType = A.VariableName, A.ndType = (A.Declaration m innerT),
A.ndNameType = A.VariableName, A.ndType = (A.Declaration m innerT Nothing),
A.ndAbbrevMode = A.Original, A.ndPlacement = A.Unplaced}
return input
recordInfNameTypes' r = return r

29
transformations/PassTest.hs
View File

@ -32,6 +32,9 @@ import SimplifyExprs
import TestUtil
import TreeUtil
noInit :: Maybe A.Expression
noInit = Nothing
valof0 :: A.Structured
valof0 = A.OnlyEL m $ A.ExpressionList m [intLiteral 0]
@ -70,7 +73,7 @@ testFunctionsToProcs0 = TestCase $ testPassWithItemsStateCheck "testFunctionsToP
--check return parameters were defined:
check (items,state) = do ret0 <- ((assertGetItemCast "ret0" items) :: IO A.Name)
assertVarDef "testFunctionsToProcs0" state (A.nameName ret0) $
tag7 A.NameDef DontCare (A.nameName ret0) (A.nameName ret0) A.VariableName (A.Declaration m A.Int) A.Abbrev A.Unplaced
tag7 A.NameDef DontCare (A.nameName ret0) (A.nameName ret0) A.VariableName (A.Declaration m A.Int Nothing) A.Abbrev A.Unplaced
--check proc was defined:
assertVarDef "testFunctionsToProcs0" state "foo" $
tag7 A.NameDef DontCare ("foo") ("foo") A.ProcName procSpec A.Original A.Unplaced
@ -96,9 +99,9 @@ testFunctionsToProcs1 = TestCase $ testPassWithItemsStateCheck "testFunctionsToP
check (items,state) = do ret0 <- ((assertGetItemCast "ret0" items) :: IO A.Name)
ret1 <- ((assertGetItemCast "ret1" items) :: IO A.Name)
assertVarDef "testFunctionsToProcs1 B" state (A.nameName ret0) $
tag7 A.NameDef DontCare (A.nameName ret0) (A.nameName ret0) A.VariableName (A.Declaration m A.Int) A.Abbrev A.Unplaced
tag7 A.NameDef DontCare (A.nameName ret0) (A.nameName ret0) A.VariableName (A.Declaration m A.Int Nothing) A.Abbrev A.Unplaced
assertVarDef "testFunctionsToProcs1 C" state (A.nameName ret1) $
tag7 A.NameDef DontCare (A.nameName ret1) (A.nameName ret1) A.VariableName (A.Declaration m A.Real32) A.Abbrev A.Unplaced
tag7 A.NameDef DontCare (A.nameName ret1) (A.nameName ret1) A.VariableName (A.Declaration m A.Real32 Nothing) A.Abbrev A.Unplaced
--check proc was defined:
assertVarDef "testFunctionsToProcs1 D" state "foo" $
tag7 A.NameDef DontCare ("foo") ("foo") A.ProcName procBody A.Original A.Unplaced
@ -126,9 +129,9 @@ testFunctionsToProcs2 = TestCase $ testPassWithItemsStateCheck "testFunctionsToP
check (items,state) = do retOuter0 <- ((assertGetItemCast "retOuter0" items) :: IO A.Name)
ret0 <- ((assertGetItemCast "ret0" items) :: IO A.Name)
assertVarDef "testFunctionsToProcs2 B" state (A.nameName ret0) $
tag7 A.NameDef DontCare (A.nameName ret0) (A.nameName ret0) A.VariableName (A.Declaration m A.Int) A.Abbrev A.Unplaced
tag7 A.NameDef DontCare (A.nameName ret0) (A.nameName ret0) A.VariableName (A.Declaration m A.Int Nothing) A.Abbrev A.Unplaced
assertVarDef "testFunctionsToProcs2 C" state (A.nameName retOuter0) $
tag7 A.NameDef DontCare (A.nameName retOuter0) (A.nameName retOuter0) A.VariableName (A.Declaration m A.Int) A.Abbrev A.Unplaced
tag7 A.NameDef DontCare (A.nameName retOuter0) (A.nameName retOuter0) A.VariableName (A.Declaration m A.Int Nothing) A.Abbrev A.Unplaced
--check proc was defined:
assertVarDef "testFunctionsToProcs2 D" state "foo" $
tag7 A.NameDef DontCare ("foo") ("foo") A.ProcName (singleParamSpecExp DontCare) A.Original A.Unplaced
@ -149,9 +152,9 @@ testTransformConstr0 = TestCase $ testPass "transformConstr0" exp (transformCons
A.RepConstr m (A.For m (simpleName "x") (intLiteral 0) (intLiteral 10)) (exprVariable "x")
) skipP
exp = nameAndStopCaringPattern "indexVar" "i" $ mkPattern exp'
exp' = A.Spec m (A.Specification m (simpleName "arr") (A.Declaration m (A.Array [A.Dimension 10] A.Int))) $
exp' = A.Spec m (A.Specification m (simpleName "arr") (A.Declaration m (A.Array [A.Dimension 10] A.Int) Nothing)) $
A.ProcThen m
(A.Seq m $ A.Spec m (A.Specification m (simpleName "i") (A.Declaration m A.Int)) $
(A.Seq m $ A.Spec m (A.Specification m (simpleName "i") (A.Declaration m A.Int Nothing)) $
A.Several m [A.OnlyP m $ A.Assign m [variable "i"] $ A.ExpressionList m [intLiteral 0],
A.Rep m (A.For m (simpleName "x") (intLiteral 0) (intLiteral 10)) $ A.OnlyP m $ A.Seq m $ A.Several m
[A.OnlyP m $ A.Assign m [A.SubscriptedVariable m (A.Subscript m $ exprVariable "i") (variable "arr")] $ A.ExpressionList m [exprVariable "x"],
@ -275,7 +278,7 @@ testInputCase = TestList
-}
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) $
tag3 A.Spec DontCare (tag3 A.Specification DontCare (Named "tag" DontCare) $ tag3 A.Declaration DontCare A.Int noInit) $
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)) $
@ -316,7 +319,7 @@ testInputCase = TestList
-}
,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) $
tag3 A.Spec DontCare (tag3 A.Specification DontCare (Named "tag" DontCare) $ tag3 A.Declaration DontCare A.Int noInit) $
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
@ -374,7 +377,7 @@ testInputCase = TestList
-}
,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) $
tag3 A.Spec DontCare (tag3 A.Specification DontCare (Named "tag" DontCare) $ tag3 A.Declaration DontCare A.Int noInit) $
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
@ -416,7 +419,7 @@ testInputCase = TestList
-}
,TestCase $ testPass "testInputCase 100"
(tag3 A.Alt DontCare False $
tag3 A.Spec DontCare (tag3 A.Specification DontCare (Named "tag" DontCare) $ tag2 A.Declaration DontCare A.Int) $
tag3 A.Spec DontCare (tag3 A.Specification DontCare (Named "tag" DontCare) $ tag3 A.Declaration DontCare A.Int noInit) $
tag2 A.OnlyA DontCare $ tag4 A.Alternative DontCare 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)) $
@ -447,8 +450,8 @@ testInputCase = TestList
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)
specInt s = A.Spec emptyMeta (A.Specification emptyMeta (simpleName s) $ A.Declaration emptyMeta A.Int Nothing)
specIntPatt s = tag3 A.Spec emptyMeta (A.Specification emptyMeta (simpleName s) $ A.Declaration emptyMeta A.Int Nothing)
--Returns the list of tests:
tests :: Test

6
transformations/SimplifyComms.hs
View File

@ -140,7 +140,7 @@ transformInputCase = doGeneric `extM` doProcess
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
= do spec@(A.Specification _ n _) <- defineNonce m "input_tag" (A.Declaration m' A.Int Nothing) 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)])
@ -181,13 +181,13 @@ 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:
doStructured _ (A.OnlyA m (A.Alternative m' v (A.InputCase m'' s) _))
= do spec@(A.Specification _ n _) <- defineNonce m "input_tag" (A.Declaration m' A.Int) A.VariableName A.Original
= do spec@(A.Specification _ n _) <- defineNonce m "input_tag" (A.Declaration m' A.Int Nothing) A.VariableName A.Original
s' <- doStructured v s
return $ A.Spec m' spec $ A.OnlyA 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'
doStructured _ (A.OnlyA 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
= do spec@(A.Specification _ n _) <- defineNonce m "input_tag" (A.Declaration m' A.Int Nothing) A.VariableName A.Original
s' <- doStructured v s
return $ A.Spec m' spec $ A.OnlyA m $
A.AlternativeCond m' e v (A.InputSimple m [A.InVariable m (A.Variable m n)]) $

2
transformations/SimplifyExprs.hs
View File

@ -129,7 +129,7 @@ transformConstr = doGeneric `extM` doStructured
doStructured (A.Spec m (A.Specification m' n (A.IsExpr _ _ t (A.ExprConstr m'' (A.RepConstr _ rep exp)))) scope)
= do indexVarSpec@(A.Specification _ indexVar _) <- makeNonceVariable "array_constr_index" m'' A.Int A.VariableName A.Original
scope' <- doGeneric scope
return $ A.Spec m (A.Specification m' n (A.Declaration m' t)) $ A.ProcThen m''
return $ A.Spec m (A.Specification m' n (A.Declaration m' t Nothing)) $ A.ProcThen m''
(A.Seq m'' $ A.Spec m'' (indexVarSpec) $ A.Several m'' [
A.OnlyP m'' $ A.Assign m'' [A.Variable m'' indexVar] $ A.ExpressionList m'' [A.Literal m'' A.Int $ A.IntLiteral m'' "0"],
A.Rep m'' rep $ A.OnlyP m'' $ A.Seq m'' $ A.Several m''