From f2cb0b7cced6297b38c170b027ef99a8087f1e9a Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Tue, 28 Aug 2007 11:02:17 +0000 Subject: [PATCH] Rain: added a pass for fixing the types of channel-end casts and appropriate tests --- RainPassTest.hs | 64 +++++++++++++++++++++++++++++++++++++++++++++++++ RainPasses.hs | 30 ++++++++++++++++++++++- 2 files changed, 93 insertions(+), 1 deletion(-) diff --git a/RainPassTest.hs b/RainPassTest.hs index 2c6370c..e264f72 100644 --- a/RainPassTest.hs +++ b/RainPassTest.hs @@ -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 ] diff --git a/RainPasses.hs b/RainPasses.hs index 7a684b2..994bc13 100644 --- a/RainPasses.hs +++ b/RainPasses.hs @@ -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