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

Removed the initialiser expression on the Declaration item in the AST

Browse Source
This commit is contained in:
Neil Brown 2008-03-09 00:23:13 +00:00
parent f8d4efa0e9
commit ba75f5b06c
21 changed files with 124 additions and 149 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
backends/BackendPasses.hs
View File

@ -85,7 +85,7 @@ transformWaitFor = doGeneric `extM` 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 Nothing))],
put (specs ++ [A.Spec m (A.Specification m n (A.Declaration m A.Time))],
init ++ [A.Only m $ A.GetTime m var, A.Only m $ A.Assign m [var] $ A.ExpressionList m [A.Dyadic m A.Plus (A.ExprVariable m var) e]])
return $ A.AlternativeWait m A.WaitUntil (A.ExprVariable m var) p
@ -269,7 +269,7 @@ addSizesFormalParameters = doGeneric `extM` doSpecification
,A.ndName = A.nameName n
,A.ndOrigName = A.nameName n
,A.ndNameType = A.VariableName
,A.ndType = A.Declaration m t Nothing
,A.ndType = A.Declaration m t
,A.ndAbbrevMode = A.ValAbbrev
,A.ndPlacement = A.Unplaced}

22
backends/BackendPassesTest.hs
View File

@ -52,7 +52,7 @@ testTransformWaitFor1 :: Test
testTransformWaitFor1 = TestCase $ testPass "testTransformWaitFor1" exp (transformWaitFor orig) (return ())
where
orig = A.Alt m True $ A.Only m $ A.AlternativeWait m A.WaitFor (exprVariable "t") (A.Skip m)
exp = tag2 A.Seq DontCare $ mSpecP (tag3 A.Specification DontCare varName $ A.Declaration m A.Time Nothing) $
exp = tag2 A.Seq DontCare $ mSpecP (tag3 A.Specification DontCare varName $ A.Declaration m A.Time) $
mSeveralP
[
mOnlyP $ tag2 A.GetTime DontCare var
@ -69,8 +69,8 @@ testTransformWaitFor2 = TestCase $ testPass "testTransformWaitFor2" exp (transfo
where
orig = A.Alt m True $ A.Several m [A.Only m $ A.AlternativeWait m A.WaitFor (exprVariable "t0") (A.Skip m),
A.Only m $ A.AlternativeWait m A.WaitFor (exprVariable "t1") (A.Skip m)]
exp = tag2 A.Seq DontCare $ mSpecP (tag3 A.Specification DontCare varName0 $ A.Declaration m A.Time Nothing) $
mSpecP (tag3 A.Specification DontCare varName1 $ A.Declaration m A.Time Nothing) $
exp = tag2 A.Seq DontCare $ mSpecP (tag3 A.Specification DontCare varName0 $ A.Declaration m A.Time) $
mSpecP (tag3 A.Specification DontCare varName1 $ A.Declaration m A.Time) $
mSeveralP
[
mOnlyP $ tag2 A.GetTime DontCare var0
@ -93,7 +93,7 @@ testTransformWaitFor3 :: Test
testTransformWaitFor3 = TestCase $ testPass "testTransformWaitFor3" exp (transformWaitFor orig) (return ())
where
orig = A.Alt m True $ A.Only m $ A.AlternativeWait m A.WaitFor (A.Dyadic m A.Plus (exprVariable "t0") (exprVariable "t1")) (A.Skip m)
exp = tag2 A.Seq DontCare $ mSpecP (tag3 A.Specification DontCare varName $ A.Declaration m A.Time Nothing) $
exp = tag2 A.Seq DontCare $ mSpecP (tag3 A.Specification DontCare varName $ A.Declaration m A.Time) $
mSeveralP
[
mOnlyP $ tag2 A.GetTime DontCare var
@ -110,7 +110,7 @@ testTransformWaitFor4 :: Test
testTransformWaitFor4 = TestCase $ testPass "testTransformWaitFor4" exp (transformWaitFor orig) (return ())
where
orig = A.Alt m True $ A.Several m [A.Only m $ A.AlternativeWait m A.WaitFor (exprVariable "t") (A.Skip m)]
exp = tag2 A.Seq DontCare $ mSpecP (tag3 A.Specification DontCare varName $ A.Declaration m A.Time Nothing) $
exp = tag2 A.Seq DontCare $ mSpecP (tag3 A.Specification DontCare varName $ A.Declaration m A.Time) $
mSeveralP
[
mOnlyP $ tag2 A.GetTime DontCare var
@ -128,8 +128,8 @@ testTransformWaitFor5 = TestCase $ testPass "testTransformWaitFor5" exp (transfo
where
orig = A.Alt m True $ A.Several m [A.Only m $ A.AlternativeWait m A.WaitFor (exprVariable "t") (A.Skip m),
A.Only m $ A.AlternativeWait m A.WaitFor (exprVariable "t") (A.Skip m)]
exp = tag2 A.Seq DontCare $ mSpecP (tag3 A.Specification DontCare varName0 $ A.Declaration m A.Time Nothing) $
mSpecP (tag3 A.Specification DontCare varName1 $ A.Declaration m A.Time Nothing) $
exp = tag2 A.Seq DontCare $ mSpecP (tag3 A.Specification DontCare varName0 $ A.Declaration m A.Time) $
mSpecP (tag3 A.Specification DontCare varName1 $ A.Declaration m A.Time) $
mSeveralP
[
mOnlyP $ tag2 A.GetTime DontCare var0
@ -240,7 +240,7 @@ qcTestDeclareSizes =
where
specSizes = A.Is emptyMeta A.ValAbbrev (A.Array [A.Dimension $ length destDims] A.Int) $
A.SubscriptedVariable emptyMeta (A.SubscriptFrom emptyMeta (intLiteral $ toInteger $ length srcDims - length destDims)) (variable "src_sizes")
defSrc = do defineTestName "src" (A.Declaration emptyMeta (A.Array srcDims A.Byte) Nothing) A.Original
defSrc = do defineTestName "src" (A.Declaration emptyMeta (A.Array srcDims A.Byte)) A.Original
defineTestName "src_sizes" (A.IsExpr emptyMeta A.ValAbbrev (A.Array srcDims A.Byte) dummyExpr) A.ValAbbrev
dummyExpr = A.True emptyMeta
@ -273,7 +273,7 @@ qcTestDeclareSizes =
t = A.Array (map A.Dimension ns) A.Byte
declFoo :: [Int] -> (A.SpecType, A.SpecType, State CompState ())
declFoo ns = (A.Declaration emptyMeta t Nothing, valSize ns, return ())
declFoo ns = (A.Declaration emptyMeta t, valSize ns, return ())
where
t = A.Array (map A.Dimension ns) A.Byte
@ -368,12 +368,12 @@ qcTestSizeParameters =
recordProcFormals = mapM_ rec
where
rec :: (String, A.Type, A.AbbrevMode) -> State CompState ()
rec (n, t, am) = defineTestName n (A.Declaration emptyMeta t Nothing) am
rec (n, t, am) = defineTestName n (A.Declaration emptyMeta t) am
checkProcDef :: TestMonad m r => [(String, A.Type, A.AbbrevMode)] -> CompState -> m ()
checkProcDef nts cs = checkName "p" (makeProcDef nts) A.Original cs
checkProcFormals :: TestMonad m r => [(String, A.Type, A.AbbrevMode)] -> CompState -> m ()
checkProcFormals nts cs = mapM_ (\(n,t,am) -> checkName n (A.Declaration emptyMeta t Nothing) am cs) nts
checkProcFormals nts cs = mapM_ (\(n,t,am) -> checkName n (A.Declaration emptyMeta t) am cs) nts
wrapSpec :: String -> A.SpecType -> A.Structured ()
wrapSpec n spec = A.Spec emptyMeta (A.Specification emptyMeta (simpleName n) spec) (A.Only emptyMeta ())

22
backends/GenerateC.hs
View File

@ -1106,12 +1106,12 @@ cgenFlatArraySize ds
tell ["]"]
-- | Initialise an item being declared.
cdeclareInit :: Meta -> A.Type -> A.Variable -> Maybe A.Expression -> Maybe (CGen ())
cdeclareInit _ (A.Chan A.DirUnknown _ _) var _
cdeclareInit :: Meta -> A.Type -> A.Variable -> Maybe (CGen ())
cdeclareInit _ (A.Chan A.DirUnknown _ _) var
= Just $ do tell ["ChanInit(wptr,"]
call genVariableUnchecked var
tell [");"]
cdeclareInit m t@(A.Array ds t') var _
cdeclareInit m t@(A.Array ds t') var
= Just $ do case t' of
A.Chan A.DirUnknown _ _ ->
do tell ["tock_init_chan_array("]
@ -1123,19 +1123,17 @@ cdeclareInit m t@(A.Array ds t') var _
tell [");"]
_ -> return ()
fdeclareInit <- fget declareInit
init <- return (\sub -> fdeclareInit m t' (sub var) Nothing)
init <- return (\sub -> fdeclareInit m t' (sub var))
call genOverArray m var init
cdeclareInit m rt@(A.Record _) var _
cdeclareInit m rt@(A.Record _) var
= Just $ do fs <- recordFields m rt
sequence_ [initField t (A.SubscriptedVariable m (A.SubscriptField m n) var)
| (n, t) <- fs]
where
initField :: A.Type -> A.Variable -> CGen ()
initField t v = do fdeclareInit <- fget declareInit
doMaybe $ fdeclareInit m t v Nothing
cdeclareInit m _ v (Just e)
= Just $ call genAssign m [v] $ A.ExpressionList m [e]
cdeclareInit _ _ _ _ = Nothing
doMaybe $ fdeclareInit m t v
cdeclareInit _ _ _ = Nothing
-- | Free a declared item that's going out of scope.
cdeclareFree :: Meta -> A.Type -> A.Variable -> Maybe (CGen ())
@ -1157,10 +1155,10 @@ CHAN OF INT c IS d: Channel *c = d;
const int *ds_sizes = cs_sizes;
-}
cintroduceSpec :: A.Specification -> CGen ()
cintroduceSpec (A.Specification m n (A.Declaration _ t init))
cintroduceSpec (A.Specification m n (A.Declaration _ t))
= do call genDeclaration t n False
fdeclareInit <- fget declareInit
case fdeclareInit m t (A.Variable m n) init of
case fdeclareInit m t (A.Variable m n) of
Just p -> p
Nothing -> return ()
cintroduceSpec (A.Specification _ n (A.Is _ am t v))
@ -1272,7 +1270,7 @@ cgenForwardDeclaration (A.Specification _ n (A.RecordType _ b fs))
cgenForwardDeclaration _ = return ()
cremoveSpec :: A.Specification -> CGen ()
cremoveSpec (A.Specification m n (A.Declaration _ t _))
cremoveSpec (A.Specification m n (A.Declaration _ t))
= do fdeclareFree <- fget declareFree
case fdeclareFree m t var of
Just p -> p

2
backends/GenerateCBased.hs
View File

@ -89,7 +89,7 @@ data GenOps = GenOps {
-- | Generates code when a variable goes out of scope (e.g. deallocating memory).
declareFree :: Meta -> A.Type -> A.Variable -> Maybe (CGen ()),
-- | Generates code when a variable comes into scope (e.g. allocating memory, initialising variables).
declareInit :: Meta -> A.Type -> A.Variable -> Maybe A.Expression -> Maybe (CGen ()),
declareInit :: Meta -> A.Type -> A.Variable -> Maybe (CGen ()),
-- | Generates an individual parameter to a function\/proc.
genActual :: A.Actual -> CGen (),
-- | Generates the list of actual parameters to a function\/proc.

14
backends/GenerateCPPCSP.hs
View File

@ -473,8 +473,8 @@ cppgenProcCall n as
tell [");"]
-- | Changed because we initialise channels and arrays differently in C++
cppdeclareInit :: Meta -> A.Type -> A.Variable -> Maybe A.Expression -> Maybe (CGen ())
cppdeclareInit m t@(A.Array ds t') var _
cppdeclareInit :: Meta -> A.Type -> A.Variable -> Maybe (CGen ())
cppdeclareInit m t@(A.Array ds t') var
= Just $ do case t' of
A.Chan A.DirUnknown _ _ ->
do tell ["tockInitChanArray("]
@ -485,17 +485,15 @@ cppdeclareInit m t@(A.Array ds t') var _
sequence_ $ intersperse (tell ["*"]) [case dim of A.Dimension d -> tell [show d] | dim <- ds]
tell [");"]
_ -> return ()
cppdeclareInit m rt@(A.Record _) var _
cppdeclareInit m rt@(A.Record _) var
= Just $ do fs <- recordFields m rt
sequence_ [initField t (A.SubscriptedVariable m (A.SubscriptField m n) var)
| (n, t) <- fs]
where
initField :: A.Type -> A.Variable -> CGen ()
initField t v = do fdeclareInit <- fget declareInit
doMaybe $ fdeclareInit m t v Nothing
cppdeclareInit m _ v (Just e)
= Just $ call genAssign m [v] $ A.ExpressionList m [e]
cppdeclareInit _ _ _ _ = Nothing
doMaybe $ fdeclareInit m t v
cppdeclareInit _ _ _ = Nothing
-- | Changed because we don't need any de-initialisation in C++, regardless of whether C does.
cppdeclareFree :: Meta -> A.Type -> A.Variable -> Maybe (CGen ())
@ -503,7 +501,7 @@ cppdeclareFree _ _ _ = Nothing
-- | Changed to work properly with declareFree to free channel arrays.
cppremoveSpec :: A.Specification -> CGen ()
cppremoveSpec (A.Specification m n (A.Declaration _ t _))
cppremoveSpec (A.Specification m n (A.Declaration _ t))
= do fdeclareFree <- fget declareFree
case fdeclareFree m t var of
Just p -> p

37
backends/GenerateCTest.hs
View File

@ -477,7 +477,6 @@ testDeclareInitFree = TestLabel "testDeclareInitFree" $ TestList
[
-- Plain type:
testAllSame 0 ("","") A.Int
,testAllSameInit 10 ("foo=3;","") A.Int (intLiteral 3)
-- Channel types:
,testAll 1 ("ChanInit(wptr,(&foo));","") ("","") $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int
@ -513,23 +512,20 @@ testDeclareInitFree = TestLabel "testDeclareInitFree" $ TestList
]
where
testAll :: Int -> (String,String) -> (String,String) -> A.Type -> Test
testAll n eC eCPP t = testAll' n eC eCPP t (defineName (simpleName "foo") $ simpleDefDecl "foo" t) Nothing
testAll n eC eCPP t = testAll' n eC eCPP t (defineName (simpleName "foo") $ simpleDefDecl "foo" t)
testAllInit :: Int -> (String,String) -> (String,String) -> A.Type -> Maybe A.Expression -> Test
testAllInit n eC eCPP t init = testAll' n eC eCPP t (defineName (simpleName "foo") $ simpleDefDeclInit "foo" t init) init
testAllR :: Int -> (String,String) -> (String,String) -> A.Type -> (A.Type -> A.Type) -> Test
testAllR n eC eCPP t f = testAll' n eC eCPP (f $ A.Record $ simpleName "REC") ((defRecord "REC" "bar" t) >> (defineName (simpleName "foo") $ simpleDefDecl "foo" $ A.Record (simpleName "REC"))) Nothing
testAllR n eC eCPP t f = testAll' n eC eCPP (f $ A.Record $ simpleName "REC") ((defRecord "REC" "bar" t) >> (defineName (simpleName "foo") $ simpleDefDecl "foo" $ A.Record (simpleName "REC")))
testAllRA :: Int -> (String,String) -> (String,String) -> A.Type -> (A.Type -> A.Type) -> Test
testAllRA n eC eCPP t f = testAll' n eC eCPP (A.Array [A.Dimension 5] $ f $ A.Record $ simpleName "REC") ((defRecord "REC" "bar" t) >> (defineName (simpleName "foo") $ simpleDefDecl "foo" $ A.Array [A.Dimension 5] $ A.Record (simpleName "REC"))) Nothing
testAllRA n eC eCPP t f = testAll' n eC eCPP (A.Array [A.Dimension 5] $ f $ A.Record $ simpleName "REC") ((defRecord "REC" "bar" t) >> (defineName (simpleName "foo") $ simpleDefDecl "foo" $ A.Array [A.Dimension 5] $ A.Record (simpleName "REC")))
testAll' :: Int -> (String,String) -> (String,String) -> A.Type -> State CompState () -> Maybe A.Expression -> Test
testAll' n (iC,fC) (iCPP,fCPP) t state init = 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) (over (tcall introduceSpec $ A.Specification emptyMeta foo (A.Declaration emptyMeta t init))) state
,testBothS ("testDeclareInitFree/b" ++ show n) iC iCPP (over $ ask >>= \ops -> (fromMaybe (return ())) (declareInit ops emptyMeta t (A.Variable emptyMeta foo) init)) state
,testBothS ("testDeclareInitFree/c" ++ show n) fC fCPP (over (tcall removeSpec $ A.Specification emptyMeta foo (A.Declaration emptyMeta t Nothing))) state
testBothS ("testDeclareInitFree/a" ++ show n) ("@" ++ iC) ("@" ++ iCPP) (over (tcall introduceSpec $ A.Specification emptyMeta foo (A.Declaration emptyMeta t))) state
,testBothS ("testDeclareInitFree/b" ++ show n) iC iCPP (over $ ask >>= \ops -> (fromMaybe (return ())) (declareInit ops emptyMeta t (A.Variable emptyMeta foo))) state
,testBothS ("testDeclareInitFree/c" ++ show n) fC fCPP (over (tcall removeSpec $ A.Specification emptyMeta foo (A.Declaration emptyMeta t))) state
,testBothS ("testDeclareInitFree/d" ++ show n) fC fCPP (over $ ask >>= \ops -> (fromMaybe (return ())) (declareFree ops emptyMeta t (A.Variable emptyMeta foo))) state
]
where
@ -542,9 +538,6 @@ testDeclareInitFree = TestLabel "testDeclareInitFree" $ TestList
testAllSame :: Int -> (String,String) -> A.Type -> Test
testAllSame n e t = testAll n e e t
testAllSameInit :: Int -> (String,String) -> A.Type -> A.Expression -> Test
testAllSameInit n e t init = testAllInit n e e t (Just init)
testRecord :: Test
testRecord = TestList
[
@ -562,7 +555,7 @@ testRecord = TestList
= testBothS ("testRecord " ++ show n) eCI eCPPI (local overFunc (tcall genRecordTypeSpec rn rb rts)) st
testAllSame n e s0 s1 s2 = testAll n e e s0 s1 s2
over ops = ops {genDeclaration = override2 (tell . (\x -> ["#ATION_",show x]))
,declareInit = (override4 (Just $ tell ["#INIT"])), declareFree = override3 (Just $ tell ["#FREE"])
,declareInit = (override3 (Just $ tell ["#INIT"])), declareFree = override3 (Just $ tell ["#FREE"])
,genType = (\x -> tell ["$(",show x,")"])
,genVariable = override1 at
}
@ -571,10 +564,10 @@ testSpec :: Test
testSpec = TestList
[
--Declaration:
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
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)
-- TODO test declarations with initialisers
@ -682,7 +675,7 @@ testSpec = TestList
testAllSame n e s = testAll n e e s
testAllSameS n e s st o = testAllS n e e s st o
over ops = ops {genDeclaration = override2 (tell . (\x -> ["#ATION_",show x]))
,declareInit = (override4 (Just $ tell ["#INIT"])), declareFree = override3 (Just $ tell ["#FREE"])
,declareInit = (override3 (Just $ tell ["#INIT"])), declareFree = override3 (Just $ tell ["#FREE"])
,genType = (\x -> tell ["$(",show x,")"])
,genVariable = override1 at
}
@ -799,7 +792,7 @@ testGenVariable = TestList
,testBothS ("testGenVariable/unchecked" ++ show n) eUC eUCPP (over (tcall genVariableUnchecked $ sub $ A.Variable emptyMeta foo)) state
]
where
state = do defineName (simpleName "foo") $ A.NameDef emptyMeta "foo" "foo" A.VariableName (A.Declaration emptyMeta t Nothing) am A.Unplaced
state = do defineName (simpleName "foo") $ A.NameDef emptyMeta "foo" "foo" A.VariableName (A.Declaration emptyMeta t) am A.Unplaced
defRecord "bar" "x" $ A.Array [A.Dimension 7] A.Int
defRecord "barbar" "y" $ A.Record bar
over :: Override

4
common/ShowCode.hs
View File

@ -367,10 +367,8 @@ 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 Nothing))
showOccamM (A.Specification _ n (A.Declaration _ t))
= 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))

6
common/TestUtils.hs
View File

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

2
common/Types.hs
View File

@ -72,7 +72,7 @@ typeOfName n
typeOfSpec :: (CSMR 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 _ _ t _ -> return $ Just t
A.IsExpr _ _ t _ -> return $ Just t
A.IsChannelArray _ t _ -> return $ Just t

4
data/AST.hs
View File

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

4
data/CompState.hs
View File

@ -272,7 +272,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 Nothing) A.VariableName A.ValAbbrev
= do (A.Specification _ n _) <- defineNonce m s (A.Declaration m A.Int) A.VariableName A.ValAbbrev
return n
-- | Generate and define a variable abbreviation.
@ -288,7 +288,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 Nothing) nt am
= defineNonce m s (A.Declaration m t) nt am
--}}}
diePC :: (CSMR m, Die m) => Meta -> m String -> m a

4
flow/FlowGraphTest.hs
View File

@ -622,8 +622,8 @@ genSpecification = nextIdT >>* makeMeta' >>= \m -> genElem3 A.Specification m (c
genSpecType :: GenL A.SpecType
genSpecType = nextIdT >>* makeMeta' >>= \m -> oneofL
[
genElem3 A.Declaration m (comb0 A.Int) (comb0 Nothing)
,genElem3 A.Declaration m (comb0 A.Int) (comb1 Just genExpression)
genElem2 A.Declaration m (comb0 A.Int)
,genElem2 A.Declaration m (comb0 A.Int)
,genElem2 (\m e -> A.IsExpr m A.ValAbbrev A.Int e) m genExpression
--TODO proc and function declaration
]

6
frontends/ParseOccam.hs
View File

@ -471,7 +471,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 Nothing) A.ValAbbrev
= do n' <- scopeIn n (A.Declaration m A.Int) A.ValAbbrev
return $ A.For m n' b c
scopeOutRep :: A.Replicator -> OccParser ()
@ -487,7 +487,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 Nothing) am
= do n' <- scopeIn n (A.Declaration (A.nameMeta n) t) am
return (A.Formal am t n')
scopeInFormals :: [A.Formal] -> OccParser [A.Formal]
@ -1267,7 +1267,7 @@ declOf spec newName
= do m <- md
(d, ns) <- tryVVX spec (sepBy1 newName sComma) sColon
eol
return (ns, A.Declaration m d Nothing)
return (ns, A.Declaration m d)
abbreviation :: OccParser A.Specification
abbreviation

2
frontends/ParseRain.hs
View File

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

30
frontends/ParseRainTest.hs
View File

@ -103,10 +103,6 @@ emptySeveralAST = emptySeveral
emptyBlock :: A.Process
emptyBlock = A.Seq m emptySeveral
-- | A handy, properly typed, synonym for Nothing to use with Declarations.
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)
--All arithmetic operators bind at the same level, which is a closer binding than all comparison operators.
@ -366,13 +362,13 @@ testPar =
--Rain only allows declarations at the beginning of a par block:
,passPar (2, "par {int:x; {} }", A.Par m A.PlainPar $
A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Int Nothing) $
A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Int) $
A.Several m [A.Only m $ A.Seq m $ A.Several m []] )
,passPar (3, "par {uint16:x; uint32:y; {} }", A.Par m A.PlainPar $
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.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.Several m [A.Only m $ A.Seq m $ A.Several m []] )
,fail ("par { {} int: x; }",RP.statement)
@ -391,21 +387,21 @@ testBlock =
A.Several m [A.Only m $ makeSimpleAssign "a" "b",A.Only m $ makeSimpleAssign "b" "c"])
,passBlock (2, "{ uint8: x; a = b; }", False,
A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Byte noInit) $
A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Byte) $
A.Several m [A.Only m $ makeSimpleAssign "a" "b"])
,passBlock (3, "{ uint8: x; a = b; b = c; }", False,
A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Byte noInit) $
A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Byte) $
A.Several m [A.Only m $ makeSimpleAssign "a" "b",A.Only m $ makeSimpleAssign "b" "c"])
,passBlock (4, "{ b = c; uint8: x; a = b; }", False,
A.Several m [A.Only m $ makeSimpleAssign "b" "c",
A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Byte noInit) $
A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Byte) $
A.Several m [A.Only m $ makeSimpleAssign "a" "b"]
])
,passBlock (5, "{ uint8: x; }", False,
A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Byte noInit) emptySeveral)
A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Byte) emptySeveral)
,fail("{b}",RP.innerBlock False Nothing)
]
@ -519,13 +515,13 @@ instance Data a => Show (A.Structured a -> A.Structured a) where
testDecl :: [ParseTest (Meta, A.AST -> A.AST)]
testDecl =
[
passd ("bool: b;",0,pat $ A.Specification m (simpleName "b") $ A.Declaration m A.Bool noInit)
,passd ("uint8: x;",1,pat $ A.Specification m (simpleName "x") $ A.Declaration m A.Byte noInit)
,passd ("?bool: bc;",2,pat $ A.Specification m (simpleName "bc") $ A.Declaration m (A.Chan A.DirInput nonShared A.Bool) noInit)
,passd ("a: b;",3,pat $ A.Specification m (simpleName "b") $ A.Declaration m (A.UserDataType $ A.Name m A.DataTypeName "a") noInit)
passd ("bool: b;",0,pat $ A.Specification m (simpleName "b") $ A.Declaration m A.Bool)
,passd ("uint8: x;",1,pat $ A.Specification m (simpleName "x") $ A.Declaration m A.Byte)
,passd ("?bool: bc;",2,pat $ A.Specification m (simpleName "bc") $ A.Declaration m (A.Chan A.DirInput nonShared A.Bool))
,passd ("a: b;",3,pat $ A.Specification m (simpleName "b") $ A.Declaration m (A.UserDataType $ A.Name m A.DataTypeName "a"))
,passd2 ("bool: b0,b1;",100,pat $ A.Specification m (simpleName "b0") $ A.Declaration m A.Bool noInit,
pat $ A.Specification m (simpleName "b1") $ A.Declaration m A.Bool noInit)
,passd2 ("bool: b0,b1;",100,pat $ A.Specification m (simpleName "b0") $ A.Declaration m A.Bool,
pat $ A.Specification m (simpleName "b1") $ A.Declaration m A.Bool)
,fail ("bool:;",RP.declaration)

2
frontends/RainPasses.hs
View File

@ -128,7 +128,7 @@ uniquifyAndResolveVars = everywhereM (mk1M 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 Nothing),
A.ndNameType = A.VariableName, A.ndType = (A.Declaration m t),
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

@ -64,7 +64,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 Nothing)
startState' = do defineName (simpleName "c") $ simpleDef "c" (A.Declaration m A.Byte)
orig = A.Seq m
(A.Rep m
@ -101,7 +101,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 (tag3 A.Declaration m A.Int64 (Nothing :: Maybe A.Expression)))
(simpleDefPattern (A.nameName indexVarName) A.Original (tag2 A.Declaration m A.Int64))
Nothing -> assertFailure "testEachPass0: Internal error, indexVar not found"
case castADI (Map.lookup "listVarName" items) of
Just listVarName -> assertVarDef "testEachPass0" st (A.nameName listVarName)
@ -112,8 +112,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 Nothing)
defineName (simpleName "d") $ simpleDef "d" (A.Declaration m (A.List A.Byte) Nothing)
startState' = do defineName (simpleName "c") $ simpleDef "c" (A.Declaration m A.Byte)
defineName (simpleName "d") $ simpleDef "d" (A.Declaration m (A.List A.Byte))
orig = A.Par m A.PlainPar
(A.Rep m
@ -141,7 +141,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 (tag3 A.Declaration m A.Int64 (Nothing :: Maybe A.Expression)))
(simpleDefPattern (A.nameName indexVarName) A.Original (tag2 A.Declaration m A.Int64))
Nothing -> assertFailure "testEachPass1: Internal error, indexVar not found"
testEachRangePass0 :: Test
@ -189,22 +189,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 Nothing) skipP
exp = mSpecP (tag3 A.Specification DontCare ("newc"@@DontCare) $ A.Declaration m A.Byte Nothing) skipP
orig = A.Spec m (A.Specification m (simpleName "c") $ A.Declaration m A.Byte) skipP
exp = mSpecP (tag3 A.Specification DontCare ("newc"@@DontCare) $ A.Declaration m A.Byte) 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 Nothing) A.Original A.Unplaced)
(tag7 A.NameDef DontCare (A.nameName newcName) "c" A.VariableName (A.Declaration m A.Byte) 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 Nothing) skipP,
A.Spec m (A.Specification m (simpleName "c") $ A.Declaration m A.Int64 Nothing) skipP]
exp = mSeveralP [mSpecP (tag3 A.Specification DontCare ("newc0"@@DontCare) $ A.Declaration m A.Byte Nothing) skipP,
mSpecP (tag3 A.Specification DontCare ("newc1"@@DontCare) $ A.Declaration m A.Int64 Nothing) skipP]
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 = mSeveralP [mSpecP (tag3 A.Specification DontCare ("newc0"@@DontCare) $ A.Declaration m A.Byte ) skipP,
mSpecP (tag3 A.Specification DontCare ("newc1"@@DontCare) $ A.Declaration m A.Int64 ) skipP]
check (items,state)
= do newc0Name <- castAssertADI (Map.lookup "newc0" items)
newc1Name <- castAssertADI (Map.lookup "newc1" items)
@ -212,16 +212,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 Nothing) A.Original A.Unplaced)
(tag7 A.NameDef DontCare (A.nameName newc0Name) "c" A.VariableName (A.Declaration m A.Byte ) 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 Nothing) A.Original A.Unplaced)
(tag7 A.NameDef DontCare (A.nameName newc1Name) "c" A.VariableName (A.Declaration m A.Int64 ) 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 Nothing) (A.Only m $ makeSimpleAssign "c" "d")
exp = mSpecP (tag3 A.Specification DontCare ("newc"@@DontCare) $ A.Declaration m A.Byte Nothing)
orig = A.Spec m (A.Specification m (simpleName "c") $ A.Declaration m A.Byte ) (A.Only m $ makeSimpleAssign "c" "d")
exp = mSpecP (tag3 A.Specification DontCare ("newc"@@DontCare) $ A.Declaration m A.Byte )
(mOnlyP' m $ tag3 A.Assign DontCare [tag2 A.Variable DontCare ("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)
@ -230,9 +230,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 Nothing) $
orig = A.Spec m (A.Specification m (simpleName "c") $ A.Declaration m A.Byte ) $
A.Several m [(A.Only m $ makeSimpleAssign "c" "d"),(A.Only m $ makeSimpleAssign "c" "e")]
exp = mSpecP (tag3 A.Specification DontCare ("newc"@@DontCare) $ A.Declaration m A.Byte Nothing) $
exp = mSpecP (tag3 A.Specification DontCare ("newc"@@DontCare) $ A.Declaration m A.Byte ) $
mSeveralP [
(mOnlyP' m $ tag3 A.Assign DontCare [tag2 A.Variable DontCare ("newc"@@DontCare)] (tag2 A.ExpressionList DontCare [(exprVariable "d")]))
,(mOnlyP' m $ tag3 A.Assign DontCare [tag2 A.Variable DontCare ("newc"@@DontCare)] (tag2 A.ExpressionList DontCare [(exprVariable "e")]))
@ -271,7 +271,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 Nothing) A.ValAbbrev A.Unplaced)
(tag7 A.NameDef DontCare (A.nameName newcName) "c" A.VariableName (A.Declaration m A.Byte ) 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)
@ -286,32 +286,32 @@ testRecordInfNames0 = TestCase $ testPassWithStateCheck "testRecordInfNames0" ex
orig = (A.Rep m (A.ForEach m (simpleName "c") (makeLiteralStringRain "hello")) skipP)
exp = orig
check state = assertVarDef "testRecordInfNames0" state "c"
(tag7 A.NameDef DontCare "c" "c" A.VariableName (A.Declaration m A.Byte Nothing) A.Original A.Unplaced)
(tag7 A.NameDef DontCare "c" "c" A.VariableName (A.Declaration m A.Byte ) 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.List A.Byte) Nothing)
startState' = do defineName (simpleName "str") $ simpleDef "str" (A.Declaration m (A.List A.Byte) )
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 Nothing) A.Original A.Unplaced)
(tag7 A.NameDef DontCare "c" "c" A.VariableName (A.Declaration m A.Byte ) 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.List $ A.List A.Byte) Nothing)
startState' = do defineName (simpleName "multi") $ simpleDef "multi" (A.Declaration m (A.List $ A.List A.Byte) )
orig = A.Rep m (A.ForEach m (simpleName "c") (exprVariable "multi")) $
A.Only 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.List A.Byte) Nothing) A.Original A.Unplaced)
(tag7 A.NameDef DontCare "c" "c" A.VariableName (A.Declaration m (A.List A.Byte) ) A.Original A.Unplaced)
assertVarDef "testRecordInfNames2" state "d"
(tag7 A.NameDef DontCare "d" "d" A.VariableName (A.Declaration m A.Byte Nothing) A.Original A.Unplaced)
(tag7 A.NameDef DontCare "d" "d" A.VariableName (A.Declaration m A.Byte ) A.Original A.Unplaced)
-- | checks that doing a foreach over a non-array type is barred:
testRecordInfNames3 :: Test
@ -503,18 +503,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 Nothing) (A.Several m [])
exp = A.Seq m $ A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Int Nothing) (A.Only m $ A.Par m A.PlainPar $ A.Several m [])
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.Only 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 Nothing) $
A.Spec m (A.Specification m (simpleName "y") $ A.Declaration m A.Byte Nothing) $
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.Several m [])
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)
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)
(A.Only m $ A.Par m A.PlainPar $ A.Several m [])
---Returns the list of tests:

2
frontends/RainTypes.hs
View File

@ -42,7 +42,7 @@ recordInfNameTypes = everywhereM (mkM recordInfNameTypes')
A.List t -> return t
_ -> diePC m $ formatCode "Cannot do a foreach loop over a non-list type: %" arrType
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 Nothing),
A.ndNameType = A.VariableName, A.ndType = (A.Declaration m innerT),
A.ndAbbrevMode = A.Original, A.ndPlacement = A.Unplaced}
return input
recordInfNameTypes' r = return r

36
transformations/PassTest.hs
View File

@ -38,10 +38,6 @@ import Utils
m :: Meta
m = emptyMeta
-- | A handy typed version of Nothing for use with A.Declaration
noInit :: Maybe A.Expression
noInit = Nothing
-- | An expression list containing a single value of 0.
valof0 :: A.Structured A.ExpressionList
valof0 = A.Only m $ A.ExpressionList m [intLiteral 0]
@ -86,7 +82,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 Nothing) A.Abbrev A.Unplaced
tag7 A.NameDef DontCare (A.nameName ret0) (A.nameName ret0) A.VariableName (A.Declaration m A.Int) 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
@ -112,9 +108,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 Nothing) A.Abbrev A.Unplaced
tag7 A.NameDef DontCare (A.nameName ret0) (A.nameName ret0) A.VariableName (A.Declaration m A.Int) 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 Nothing) A.Abbrev A.Unplaced
tag7 A.NameDef DontCare (A.nameName ret1) (A.nameName ret1) A.VariableName (A.Declaration m A.Real32) 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
@ -142,9 +138,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 Nothing) A.Abbrev A.Unplaced
tag7 A.NameDef DontCare (A.nameName ret0) (A.nameName ret0) A.VariableName (A.Declaration m A.Int) 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 Nothing) A.Abbrev A.Unplaced
tag7 A.NameDef DontCare (A.nameName retOuter0) (A.nameName retOuter0) A.VariableName (A.Declaration m A.Int) 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
@ -164,7 +160,7 @@ testFunctionsToProcs3 = TestCase $ testPassWithItemsStateCheck "testFunctionsToP
--check return parameters were defined:
check (items,state) = do ret0 <- ((assertGetItemCast "ret0" items) :: IO A.Name)
assertVarDef "testFunctionsToProcs3" state (A.nameName ret0) $
tag7 A.NameDef DontCare (A.nameName ret0) (A.nameName ret0) A.VariableName (A.Declaration m A.Int Nothing) A.Abbrev A.Unplaced
tag7 A.NameDef DontCare (A.nameName ret0) (A.nameName ret0) A.VariableName (A.Declaration m A.Int) A.Abbrev A.Unplaced
--check proc was defined:
assertVarDef "testFunctionsToProcs3" state "foo" $
tag7 A.NameDef DontCare ("foo") ("foo") A.ProcName procSpec A.Original A.Unplaced
@ -191,9 +187,9 @@ testFunctionsToProcs4 = TestCase $ testPassWithItemsStateCheck "testFunctionsToP
check (items,state) = do ret0 <- ((assertGetItemCast "ret0" items) :: IO A.Name)
ret1 <- ((assertGetItemCast "ret1" items) :: IO A.Name)
assertVarDef "testFunctionsToProcs4 B" state (A.nameName ret0) $
tag7 A.NameDef DontCare (A.nameName ret0) (A.nameName ret0) A.VariableName (A.Declaration m A.Int Nothing) A.Abbrev A.Unplaced
tag7 A.NameDef DontCare (A.nameName ret0) (A.nameName ret0) A.VariableName (A.Declaration m A.Int) A.Abbrev A.Unplaced
assertVarDef "testFunctionsToProcs4 C" state (A.nameName ret1) $
tag7 A.NameDef DontCare (A.nameName ret1) (A.nameName ret1) A.VariableName (A.Declaration m A.Real32 Nothing) A.Abbrev A.Unplaced
tag7 A.NameDef DontCare (A.nameName ret1) (A.nameName ret1) A.VariableName (A.Declaration m A.Real32) A.Abbrev A.Unplaced
--check proc was defined:
assertVarDef "testFunctionsToProcs4 D" state "foo" $
tag7 A.NameDef DontCare ("foo") ("foo") A.ProcName procBody A.Original A.Unplaced
@ -212,9 +208,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) Nothing)) $
exp' = A.Spec m (A.Specification m (simpleName "arr") (A.Declaration m (A.Array [A.Dimension 10] A.Int))) $
A.ProcThen m
(A.Seq m $ A.Spec m (A.Specification m (simpleName "i") (A.Declaration m A.Int Nothing)) $
(A.Seq m $ A.Spec m (A.Specification m (simpleName "i") (A.Declaration m A.Int)) $
A.Several m [A.Only m $ A.Assign m [variable "i"] $ A.ExpressionList m [intLiteral 0],
A.Rep m (A.For m (simpleName "x") (intLiteral 0) (intLiteral 10)) $ A.Only m $ A.Seq m $ A.Several m
[A.Only m $ A.Assign m [A.SubscriptedVariable m (A.Subscript m $ exprVariable "i") (variable "arr")] $ A.ExpressionList m [exprVariable "x"],
@ -338,7 +334,7 @@ testInputCase = TestList
-}
TestCase $ testPass "testInputCase 0"
(tag2 A.Seq DontCare $
mSpecP (tag3 A.Specification DontCare (Named "tag" DontCare) $ tag3 A.Declaration DontCare A.Int noInit) $
mSpecP (tag3 A.Specification DontCare (Named "tag" DontCare) $ mDeclaration A.Int) $
mSeveralP
[mOnlyP $ tag3 A.Input DontCare c $ tag2 A.InputSimple DontCare [tag2 A.InVariable DontCare $ tag2 A.Variable DontCare (Named "tag" DontCare)]
,mOnlyP $ tag3 A.Case DontCare (tag2 A.ExprVariable DontCare $ tag2 A.Variable DontCare (Named "tag" DontCare)) $
@ -379,7 +375,7 @@ testInputCase = TestList
-}
,TestCase $ testPass "testInputCase 1"
(tag2 A.Seq DontCare $
mSpecP (tag3 A.Specification DontCare (Named "tag" DontCare) $ tag3 A.Declaration DontCare A.Int noInit) $
mSpecP (tag3 A.Specification DontCare (Named "tag" DontCare) $ mDeclaration A.Int) $
mSeveralP
[mOnlyP $ tag3 A.Input DontCare c $ tag2 A.InputSimple DontCare [tag2 A.InVariable DontCare $ tag2 A.Variable DontCare (Named "tag" DontCare)]
,mOnlyP $ tag3 A.Case DontCare (tag2 A.ExprVariable DontCare $ tag2 A.Variable DontCare (Named "tag" DontCare)) $ mSeveralO
@ -437,7 +433,7 @@ testInputCase = TestList
-}
,TestCase $ testPass "testInputCase 2"
(tag2 A.Seq DontCare $
mSpecP (tag3 A.Specification DontCare (Named "tag" DontCare) $ tag3 A.Declaration DontCare A.Int noInit) $
mSpecP (tag3 A.Specification DontCare (Named "tag" DontCare) $ mDeclaration A.Int) $
mSeveralP
[mOnlyP $ tag3 A.Input DontCare c $ tag2 A.InputSimple DontCare [tag2 A.InVariable DontCare $ tag2 A.Variable DontCare (Named "tag" DontCare)]
,mOnlyP $ tag3 A.Case DontCare (tag2 A.ExprVariable DontCare $ tag2 A.Variable DontCare (Named "tag" DontCare)) $ mSeveralO
@ -479,7 +475,7 @@ testInputCase = TestList
-}
,TestCase $ testPass "testInputCase 100"
(tag3 A.Alt DontCare False $
mSpecA (tag3 A.Specification DontCare (Named "tag" DontCare) $ tag3 A.Declaration DontCare A.Int noInit) $
mSpecA (tag3 A.Specification DontCare (Named "tag" DontCare) $ mDeclaration A.Int) $
mOnlyA $ 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)) $
@ -512,8 +508,8 @@ testInputCase = TestList
defineC :: CSM m => m ()
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 Nothing)
specIntPatt s = mSpecA' emptyMeta (A.Specification emptyMeta (simpleName s) $ A.Declaration emptyMeta A.Int Nothing)
specInt s = A.Spec emptyMeta (A.Specification emptyMeta (simpleName s) $ A.Declaration emptyMeta A.Int)
specIntPatt s = mSpecA' emptyMeta (A.Specification emptyMeta (simpleName s) $ A.Declaration emptyMeta A.Int)
testTransformProtocolInput :: Test
testTransformProtocolInput = TestList

6
transformations/SimplifyComms.hs
View File

@ -141,7 +141,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 Nothing) A.VariableName A.Original
= do spec@(A.Specification _ n _) <- defineNonce m "input_tag" (A.Declaration m' A.Int) A.VariableName A.Original
s' <- doStructuredV v s
return $ A.Seq m $ A.Spec m' spec $ A.Several m'
[A.Only m $ A.Input m v (A.InputSimple m [A.InVariable m (A.Variable m n)])
@ -198,13 +198,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:
doStructuredA (A.Only m (A.Alternative m' v (A.InputCase m'' s) _))
= do spec@(A.Specification _ n _) <- defineNonce m "input_tag" (A.Declaration m' A.Int Nothing) A.VariableName A.Original
= do spec@(A.Specification _ n _) <- defineNonce m "input_tag" (A.Declaration m' A.Int) A.VariableName A.Original
s' <- doStructuredV v s
return $ A.Spec m' spec $ A.Only m $
A.Alternative m' v (A.InputSimple m [A.InVariable m (A.Variable m n)]) $
A.Case m'' (A.ExprVariable m'' $ A.Variable m n) s'
doStructuredA (A.Only m (A.AlternativeCond m' e v (A.InputCase m'' s) _))
= do spec@(A.Specification _ n _) <- defineNonce m "input_tag" (A.Declaration m' A.Int Nothing) A.VariableName A.Original
= do spec@(A.Specification _ n _) <- defineNonce m "input_tag" (A.Declaration m' A.Int) A.VariableName A.Original
s' <- doStructuredV v s
return $ A.Spec m' spec $ A.Only m $
A.AlternativeCond m' e v (A.InputSimple m [A.InVariable m (A.Variable m n)]) $

2
transformations/SimplifyExprs.hs
View File

@ -183,7 +183,7 @@ transformConstr = doGeneric `ext1M` 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 Nothing)) $ A.ProcThen m''
return $ A.Spec m (A.Specification m' n (A.Declaration m' t)) $ A.ProcThen m''
(A.Seq m'' $ A.Spec m'' (indexVarSpec) $ A.Several m'' [
A.Only 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.Only m'' $ A.Seq m'' $ A.Several m''