Rain: added a pass for fixing the types of channel-end casts and appropriate tests
This commit is contained in:
Neil Brown
parent
baf28ce47c
commit
f2cb0b7cce
|
|
@ -386,6 +386,63 @@ testParamPass8 = testPassShouldFail "testParamPass6" (matchParamPass orig) (star
|
|||
|
||||
--TODO test passing in channel ends
|
||||
|
||||
sharedness :: Bool -> Bool -> A.ChanAttributes
|
||||
sharedness w r = A.ChanAttributes { A.caWritingShared = w, A.caReadingShared = r}
|
||||
|
||||
testFixChannelEndCasts0 :: Test
|
||||
testFixChannelEndCasts0 = testPass "testFixChannelEndCasts0" exp (fixChannelEndCasts orig) (startState')
|
||||
where
|
||||
startState' :: State CompState ()
|
||||
startState' = do defineName (simpleName "c") $ simpleDefDecl "c" (A.Chan A.DirUnknown (sharedness False False) A.Int16)
|
||||
orig = A.Conversion m A.DefaultConversion (A.Chan A.DirInput (sharedness False False) A.Any) (exprVariable "c")
|
||||
exp = A.Conversion m A.DefaultConversion (A.Chan A.DirInput (sharedness False False) A.Int16) (exprVariable "c")
|
||||
|
||||
testFixChannelEndCasts1 :: Test
|
||||
testFixChannelEndCasts1 = testPass "testFixChannelEndCasts1" exp (fixChannelEndCasts orig) (startState')
|
||||
where
|
||||
startState' :: State CompState ()
|
||||
startState' = do defineName (simpleName "c") $ simpleDefDecl "c" (A.Chan A.DirUnknown (sharedness True True) A.Int16)
|
||||
orig = A.Conversion m A.DefaultConversion (A.Chan A.DirInput (sharedness False False) A.Any) (exprVariable "c")
|
||||
exp = A.Conversion m A.DefaultConversion (A.Chan A.DirInput (sharedness False False) A.Int16) (exprVariable "c")
|
||||
|
||||
testFixChannelEndCasts2 :: Test
|
||||
testFixChannelEndCasts2 = testPass "testFixChannelEndCasts2" exp (fixChannelEndCasts orig) (startState')
|
||||
where
|
||||
startState' :: State CompState ()
|
||||
startState' = do defineName (simpleName "c") $ simpleDefDecl "c" (A.Chan A.DirUnknown (sharedness True True) A.Int16)
|
||||
orig = A.Conversion m A.DefaultConversion (A.Chan A.DirInput (sharedness False True) A.Any) (exprVariable "c")
|
||||
exp = A.Conversion m A.DefaultConversion (A.Chan A.DirInput (sharedness False True) A.Int16) (exprVariable "c")
|
||||
|
||||
testFixChannelEndCasts3 :: Test
|
||||
testFixChannelEndCasts3 = testPass "testFixChannelEndCasts3" exp (fixChannelEndCasts orig) (startState')
|
||||
where
|
||||
startState' :: State CompState ()
|
||||
startState' = do defineName (simpleName "c") $ simpleDefDecl "c" (A.Chan A.DirUnknown (sharedness True False) A.Int16)
|
||||
orig = A.Conversion m A.DefaultConversion (A.Chan A.DirOutput (sharedness True False) A.Any) (exprVariable "c")
|
||||
exp = A.Conversion m A.DefaultConversion (A.Chan A.DirOutput (sharedness True False) A.Int16) (exprVariable "c")
|
||||
|
||||
testFixChannelEndCasts4 :: Test
|
||||
testFixChannelEndCasts4 = testPassShouldFail "testFixChannelEndCasts4" (fixChannelEndCasts orig) (startState')
|
||||
where
|
||||
startState' :: State CompState ()
|
||||
startState' = do defineName (simpleName "c") $ simpleDefDecl "c" (A.Chan A.DirInput (sharedness False False) A.Int16)
|
||||
orig = A.Conversion m A.DefaultConversion (A.Chan A.DirInput (sharedness False False) A.Any) (exprVariable "c")
|
||||
|
||||
|
||||
testFixChannelEndCasts5 :: Test
|
||||
testFixChannelEndCasts5 = testPassShouldFail "testFixChannelEndCasts5" (fixChannelEndCasts orig) (startState')
|
||||
where
|
||||
startState' :: State CompState ()
|
||||
startState' = do defineName (simpleName "c") $ simpleDefDecl "c" (A.Chan A.DirOutput (sharedness False False) A.Int16)
|
||||
orig = A.Conversion m A.DefaultConversion (A.Chan A.DirInput (sharedness False False) A.Any) (exprVariable "c")
|
||||
|
||||
testFixChannelEndCasts6 :: Test
|
||||
testFixChannelEndCasts6 = testPassShouldFail "testFixChannelEndCasts6" (fixChannelEndCasts orig) (startState')
|
||||
where
|
||||
startState' :: State CompState ()
|
||||
startState' = do defineName (simpleName "c") $ simpleDefDecl "c" (A.Chan A.DirUnknown (sharedness False False) A.Int16)
|
||||
orig = A.Conversion m A.DefaultConversion (A.Chan A.DirOutput (sharedness True False) A.Any) (exprVariable "c")
|
||||
|
||||
---Returns the list of tests:
|
||||
tests :: Test
|
||||
tests = TestList
|
||||
|
|
@ -413,6 +470,13 @@ tests = TestList
|
|||
,testParamPass6
|
||||
,testParamPass7
|
||||
,testParamPass8
|
||||
,testFixChannelEndCasts0
|
||||
,testFixChannelEndCasts1
|
||||
,testFixChannelEndCasts2
|
||||
,testFixChannelEndCasts3
|
||||
,testFixChannelEndCasts4
|
||||
,testFixChannelEndCasts5
|
||||
,testFixChannelEndCasts6
|
||||
]
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -35,7 +35,8 @@ rainPasses =
|
|||
,("Uniquify variable declarations, record declared types and resolve variable names",uniquifyAndResolveVars)
|
||||
,("Record inferred name types in dictionary",recordInfNameTypes) --depends on uniquifyAndResolveVars
|
||||
,("Find and tag the main function",findMain) --depends on uniquifyAndResolveVars
|
||||
,("Check parameters in process calls",matchParamPass) --depends on uniquifyAndResolveVars and recordInfNameTypes
|
||||
,("Fix the types for channel-end casts",fixChannelEndCasts) --depends on uniquifyAndResolveVars and recordInfNameTypes
|
||||
,("Check parameters in process calls",matchParamPass) --depends on uniquifyAndResolveVars and recordInfNameTypes and fixChannelEndCasts
|
||||
,("Convert seqeach/pareach loops into classic replicated SEQ/PAR",transformEach)
|
||||
]
|
||||
|
||||
|
|
@ -173,6 +174,33 @@ matchParamPass = everywhereM (mkM matchParamPass')
|
|||
else dieP (findMeta item) $ "Could not perform implicit cast from supplied type: " ++ (show from) ++
|
||||
" to expected type: " ++ (show to) ++ " for parameter (zero-based): " ++ (show index)
|
||||
|
||||
-- | Finds all channel-end casts in the AST (that will have A.Any as the inner-type of the destination channel, and fix it accordingly)
|
||||
fixChannelEndCasts :: Data t => t -> PassM t
|
||||
fixChannelEndCasts = everywhereM (mkM fixChannelEndCasts')
|
||||
where
|
||||
fixChannelEndCasts' :: A.Expression -> PassM A.Expression
|
||||
fixChannelEndCasts' e@(A.Conversion m A.DefaultConversion (A.Chan dir shared A.Any) rhs)
|
||||
= if (dir == A.DirInput || dir == A.DirOutput)
|
||||
then
|
||||
do rhsT <- typeOfExpression rhs
|
||||
case (rhsT) of
|
||||
(A.Chan rhsDir rhsShared t) ->
|
||||
--Cannot use ? or ! on DirInput or DirOutput; it must be a DirUnknown:
|
||||
if (rhsDir == A.DirUnknown)
|
||||
then checkShared m shared rhsShared (A.Conversion m A.DefaultConversion (A.Chan dir shared t) rhs)
|
||||
else dieP m "Could not perform channel-end cast (operator ? or !) on something that is already a channel-end"
|
||||
_ -> dieP m "Could not perform channel-end cast (operator ? or !) on non-channel type"
|
||||
else return e
|
||||
fixChannelEndCasts' e = return e
|
||||
|
||||
checkShared :: Meta -> A.ChanAttributes -> A.ChanAttributes -> A.Expression -> PassM A.Expression
|
||||
checkShared m destAttr srcAttr exp
|
||||
= if ((A.caWritingShared destAttr) && (not $ A.caWritingShared srcAttr))
|
||||
then dieP m "Could not cast a channel that is not shared for writing into a shared writing channel-end"
|
||||
else if ((A.caReadingShared destAttr) && (not $ A.caReadingShared srcAttr))
|
||||
then dieP m "Could not cast a channel that is not shared for reading into a shared reading channel-end"
|
||||
else return exp
|
||||
|
||||
transformEach :: Data t => t -> PassM t
|
||||
transformEach = everywhereM (mkM transformEach')
|
||||
where
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user