diff --git a/backends/BackendPasses.hs b/backends/BackendPasses.hs index 35556be..ac63934 100644 --- a/backends/BackendPasses.hs +++ b/backends/BackendPasses.hs @@ -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 diff --git a/backends/BackendPassesTest.hs b/backends/BackendPassesTest.hs index 1ed4e7a..d9e8a9a 100644 --- a/backends/BackendPassesTest.hs +++ b/backends/BackendPassesTest.hs @@ -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 diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index 8b932e2..15139cd 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -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 () diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs index be8ee85..179e838 100644 --- a/backends/GenerateCPPCSP.hs +++ b/backends/GenerateCPPCSP.hs @@ -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 () diff --git a/backends/GenerateCTest.hs b/backends/GenerateCTest.hs index 7938ff6..61a4439 100644 --- a/backends/GenerateCTest.hs +++ b/backends/GenerateCTest.hs @@ -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)} diff --git a/common/AST.hs b/common/AST.hs index 7089c0e..5398b5f 100644 --- a/common/AST.hs +++ b/common/AST.hs @@ -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. diff --git a/common/CompState.hs b/common/CompState.hs index b71bcf9..7c8f940 100644 --- a/common/CompState.hs +++ b/common/CompState.hs @@ -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 diff --git a/common/ShowCode.hs b/common/ShowCode.hs index b762107..e00c3b0 100644 --- a/common/ShowCode.hs +++ b/common/ShowCode.hs @@ -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)) diff --git a/common/TestUtil.hs b/common/TestUtil.hs index e927c6d..0373ca2 100644 --- a/common/TestUtil.hs +++ b/common/TestUtil.hs @@ -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 diff --git a/common/Types.hs b/common/Types.hs index 4cc1b3b..63312bd 100644 --- a/common/Types.hs +++ b/common/Types.hs @@ -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 diff --git a/frontends/ParseOccam.hs b/frontends/ParseOccam.hs index de4a14f..6be7d2a 100644 --- a/frontends/ParseOccam.hs +++ b/frontends/ParseOccam.hs @@ -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 diff --git a/frontends/ParseRain.hs b/frontends/ParseRain.hs index 3d2e8d2..0608c13 100644 --- a/frontends/ParseRain.hs +++ b/frontends/ParseRain.hs @@ -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 [] diff --git a/frontends/ParseRainTest.hs b/frontends/ParseRainTest.hs index a581a0f..23c99d8 100644 --- a/frontends/ParseRainTest.hs +++ b/frontends/ParseRainTest.hs @@ -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) diff --git a/frontends/RainPasses.hs b/frontends/RainPasses.hs index ae1b66a..4c69e9d 100644 --- a/frontends/RainPasses.hs +++ b/frontends/RainPasses.hs @@ -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') diff --git a/frontends/RainPassesTest.hs b/frontends/RainPassesTest.hs index d7d0c95..1aa8906 100644 --- a/frontends/RainPassesTest.hs +++ b/frontends/RainPassesTest.hs @@ -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: diff --git a/frontends/RainTypes.hs b/frontends/RainTypes.hs index da786a9..9a21324 100644 --- a/frontends/RainTypes.hs +++ b/frontends/RainTypes.hs @@ -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 diff --git a/transformations/PassTest.hs b/transformations/PassTest.hs index 56ef953..96ca486 100644 --- a/transformations/PassTest.hs +++ b/transformations/PassTest.hs @@ -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 diff --git a/transformations/SimplifyComms.hs b/transformations/SimplifyComms.hs index 17ef40b..5b751dc 100644 --- a/transformations/SimplifyComms.hs +++ b/transformations/SimplifyComms.hs @@ -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)]) $ diff --git a/transformations/SimplifyExprs.hs b/transformations/SimplifyExprs.hs index d501e18..82883b9 100644 --- a/transformations/SimplifyExprs.hs +++ b/transformations/SimplifyExprs.hs @@ -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''