diff --git a/RainPassTest.hs b/RainPassTest.hs index d58b5bf..12a37cc 100644 --- a/RainPassTest.hs +++ b/RainPassTest.hs @@ -139,6 +139,47 @@ testEachPass1 = testPassWithItemsStateCheck "testEachPass0" exp (transformEach o (simpleDefPattern (A.nameName indexVarName) A.Original (tag2 A.Declaration DontCare A.Int64)) Nothing -> assertFailure "testEachPass1: Internal error, indexVar not found" +testEachRangePass0 :: Test +testEachRangePass0 = testPass "testEachRangePass0" exp (transformEachRange orig) (return ()) + where + orig = A.Par m A.PlainPar $ A.Rep m + (A.ForEach m (simpleName "x") (A.ExprConstr m (A.RangeConstr m (intLiteral 0) (intLiteral 9)))) + (A.OnlyP m (makeSimpleAssign "c" "x")) + exp = A.Par m A.PlainPar $ A.Rep m + (A.For m (simpleName "x") (intLiteral 0) (intLiteral 10)) + (A.OnlyP m (makeSimpleAssign "c" "x")) + +testEachRangePass1 :: Test +testEachRangePass1 = testPass "testEachRangePass1" exp (transformEachRange orig) (return ()) + where + orig = A.Par m A.PlainPar $ A.Rep m + (A.ForEach m (simpleName "x") (A.ExprConstr m (A.RangeConstr m (intLiteral (-5)) (intLiteral (-2))))) + (A.OnlyP m (makeSimpleAssign "c" "x")) + exp = A.Par m A.PlainPar $ A.Rep m + (A.For m (simpleName "x") (intLiteral (-5)) (intLiteral 4)) + (A.OnlyP m (makeSimpleAssign "c" "x")) + +testEachRangePass2 :: Test +testEachRangePass2 = testPass "testEachRangePass2" exp (transformEachRange orig) (return ()) + where + orig = A.Seq m $ A.Rep m + (A.ForEach m (simpleName "x") (A.ExprConstr m (A.RangeConstr m (intLiteral 6) (intLiteral 6)))) + (A.OnlyP m (makeSimpleAssign "c" "x")) + exp = A.Seq m $ A.Rep m + (A.For m (simpleName "x") (intLiteral 6) (intLiteral 1)) + (A.OnlyP m (makeSimpleAssign "c" "x")) + +testEachRangePass3 :: Test +testEachRangePass3 = testPass "testEachRangePass3" exp (transformEachRange orig) (return ()) + where + orig = A.Seq m $ A.Rep m + (A.ForEach m (simpleName "x") (A.ExprConstr m (A.RangeConstr m (intLiteral 6) (intLiteral 0)))) + (A.OnlyP m (makeSimpleAssign "c" "x")) + exp = A.Seq m $ A.Rep m + (A.For m (simpleName "x") (intLiteral 6) (intLiteral (-5))) + (A.OnlyP m (makeSimpleAssign "c" "x")) + + -- | Test variable is made unique in a declaration: testUnique0 :: Test testUnique0 = testPassWithItemsStateCheck "testUnique0" exp (uniquifyAndResolveVars orig) (return ()) check @@ -405,6 +446,10 @@ tests = TestList [ testEachPass0 ,testEachPass1 + ,testEachRangePass0 + ,testEachRangePass1 + ,testEachRangePass2 + ,testEachRangePass3 ,testUnique0 ,testUnique1 ,testUnique2 diff --git a/RainPasses.hs b/RainPasses.hs index 59bd2df..4b03664 100644 --- a/RainPasses.hs +++ b/RainPasses.hs @@ -24,11 +24,14 @@ import qualified AST as A import Pass import Data.Generics import qualified Data.Map as Map +import Data.Maybe import Control.Monad.State import Types import CompState import Errors import Metadata +import Pattern +import TreeUtil -- | An ordered list of the Rain-specific passes to be run. rainPasses :: [(String,Pass)] @@ -38,7 +41,10 @@ rainPasses = ,("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 - ,("Convert seqeach/pareach loops into classic replicated SEQ/PAR",transformEach) --depends on uniquifyAndResolveVars and recordInfNameTypes + ,("Convert seqeach/pareach loops over ranges into simple replicated SEQ/PAR",transformEachRange) + --depends on uniquifyAndResolveVars and recordInfNameTypes + ,("Convert seqeach/pareach loops into classic replicated SEQ/PAR",transformEach) + --depends on uniquifyAndResolveVars and recordInfNameTypes, and should be done after transformEachRange ] -- | A pass that transforms all instances of 'A.Int' into 'A.Int64' @@ -184,6 +190,45 @@ 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) +checkIntegral :: A.LiteralRepr -> Maybe Integer +checkIntegral (A.IntLiteral _ s) = Just $ read s +checkIntegral (A.HexLiteral _ s) = Nothing -- TODO support hex literals +checkIntegral (A.ByteLiteral _ s) = Nothing -- TODO support char literals +checkIntegral _ = Nothing + +-- | Transforms seqeach\/pareach loops over things like [0..99] into SEQ i = 0 FOR 100 loops +transformEachRange :: Data t => t -> PassM t +transformEachRange = everywhereM (mkM transformEachRange') + where + transformEachRange' :: A.Structured -> PassM A.Structured + transformEachRange' s@(A.Rep {}) + = case getMatchedItems patt s of + Left _ -> return s --Doesn't match, return the original + Right items -> + do repMeta <- castOrDie "repMeta" items + eachMeta <- castOrDie "eachMeta" items + loopVar <- castOrDie "loopVar" items + begin <- castOrDie "begin" items + end <- castOrDie "end" items + body <- castOrDie "body" items + if (isJust $ checkIntegral begin) && (isJust $ checkIntegral end) + then return $ A.Rep repMeta (A.For eachMeta loopVar (A.Literal eachMeta A.Int begin) + (A.Literal eachMeta A.Int $ A.IntLiteral eachMeta $ show ((fromJust $ checkIntegral end) - (fromJust $ checkIntegral begin) + 1)) + ) body + else dieP eachMeta "Items in range constructor (x..y) are not integer literals" + where + patt = tag3 A.Rep (Named "repMeta" DontCare) ( + tag3 A.ForEach (Named "eachMeta" DontCare) (Named "loopVar" DontCare) $ + tag2 A.ExprConstr DontCare $ + tag3 A.RangeConstr DontCare (tag3 A.Literal DontCare DontCare $ Named "begin" DontCare) + (tag3 A.Literal DontCare DontCare $ Named "end" DontCare) + ) (Named "body" DontCare) + castOrDie :: (Typeable b) => String -> Items -> PassM b + castOrDie key items = case castADI (Map.lookup key items) of + Just y -> return y + Nothing -> die "Internal error in transformEachRange" + transformEachRange' s = return s + -- | A pass that changes all the 'A.ForEach' replicators in the AST into 'A.For' replicators. transformEach :: Data t => t -> PassM t transformEach = everywhereM (mkM transformEach')