Rain: added a pass that transforms ForEach replicators over simple ranges directly into For replicators

This commit is contained in:
Neil Brown 2007-09-01 14:35:46 +00:00
parent e655c1412a
commit 0392036322
2 changed files with 91 additions and 1 deletions

View File

@ -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

View File

@ -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')