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

Adjusted the rain passes to use the new array constructor type, and weaned a few of them off everywhereM

Browse Source
This commit is contained in:
Neil Brown 2008-03-19 13:24:15 +00:00
parent cb819d142a
commit db0467f1ca
3 changed files with 33 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
frontends/RainPasses.hs
View File

@ -29,7 +29,6 @@ import CompState
import Errors import Errors
import Metadata import Metadata
import Pass import Pass
import Pattern
import qualified Properties as Prop import qualified Properties as Prop
import RainTypes import RainTypes
import TreeUtils import TreeUtils
@ -58,7 +57,8 @@ rainPasses = makePassesDep' ((== FrontendRain) . csFrontend)
,("Check parameters in process calls", matchParamPass, typesDone, [Prop.processTypesChecked]) ,("Check parameters in process calls", matchParamPass, typesDone, [Prop.processTypesChecked])
,("Find and tag the main function", findMain, namesDone, [Prop.mainTagged]) ,("Find and tag the main function", findMain, namesDone, [Prop.mainTagged])
,("Convert seqeach/pareach loops over ranges into simple replicated SEQ/PAR",transformEachRange, typesDone, [Prop.eachRangeTransformed]) ,("Convert seqeach/pareach loops over ranges into simple replicated SEQ/PAR",
transformEachRange, typesDone ++ [Prop.constantsFolded], [Prop.eachRangeTransformed])
,("Convert seqeach/pareach loops into classic replicated SEQ/PAR",transformEach, typesDone ++ [Prop.eachRangeTransformed], [Prop.eachTransformed]) ,("Convert seqeach/pareach loops into classic replicated SEQ/PAR",transformEach, typesDone ++ [Prop.eachRangeTransformed], [Prop.eachTransformed])
,("Convert simple Rain range constructors into more general array constructors",transformRangeRep, typesDone ++ [Prop.eachRangeTransformed], [Prop.rangeTransformed]) ,("Convert simple Rain range constructors into more general array constructors",transformRangeRep, typesDone ++ [Prop.eachRangeTransformed], [Prop.rangeTransformed])
,("Transform Rain functions into the occam form",checkFunction, typesDone ++ [Prop.eachTransformed], []) ,("Transform Rain functions into the occam form",checkFunction, typesDone ++ [Prop.eachTransformed], [])
@ -170,37 +170,22 @@ checkIntegral _ = Nothing
-- | Transforms seqeach\/pareach loops over things like [0..99] into SEQ i = 0 FOR 100 loops -- | Transforms seqeach\/pareach loops over things like [0..99] into SEQ i = 0 FOR 100 loops
transformEachRange :: Data t => t -> PassM t transformEachRange :: Data t => t -> PassM t
transformEachRange = everywhereM (mk1M transformEachRange') transformEachRange = doGeneric `ext1M` doStructured
where where
transformEachRange' :: forall a. Data a => A.Structured a -> PassM (A.Structured a) doGeneric :: Data t => t -> PassM t
transformEachRange' s@(A.Rep m _ _) doGeneric = makeGeneric transformEachRange
= case getMatchedItems patt s of
Left _ -> return s --Doesn't match, return the original doStructured :: Data a => A.Structured a -> PassM (A.Structured a)
Right items -> doStructured (A.Rep repMeta (A.ForEach eachMeta loopVar (A.ExprConstr
do repMeta <- castOrDie "repMeta" items _ (A.RangeConstr _ _ (A.Literal _ _ begin) (A.Literal _ _ end)))) body)
eachMeta <- castOrDie "eachMeta" items = do body' <- doStructured body
loopVar <- castOrDie "loopVar" items -- TODO should probably not do mini-constant-folding here:
begin <- castOrDie "begin" items
end <- castOrDie "end" items
body <- castOrDie "body" items
if (isJust $ checkIntegral begin) && (isJust $ checkIntegral end) if (isJust $ checkIntegral begin) && (isJust $ checkIntegral end)
then return $ A.Rep repMeta (A.For eachMeta loopVar (A.Literal eachMeta A.Int begin) 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)) (A.Literal eachMeta A.Int $ A.IntLiteral eachMeta $ show ((fromJust $ checkIntegral end) - (fromJust $ checkIntegral begin) + 1))
) body ) body'
else dieP eachMeta "Items in range constructor (x..y) are not integer literals" else dieP eachMeta "Items in range constructor (x..y) are not integer literals"
where doStructured s = doGeneric s
patt :: Pattern
patt = tag3 (A.Rep :: Meta -> A.Replicator -> A.Structured a -> A.Structured a) (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 -> dieP m "Internal error in transformEachRange"
transformEachRange' s = return s
-- | A pass that changes all the 'A.ForEach' replicators in the AST into 'A.For' replicators. -- | A pass that changes all the 'A.ForEach' replicators in the AST into 'A.For' replicators.
transformEach :: Data t => t -> PassM t transformEach :: Data t => t -> PassM t
@ -231,10 +216,13 @@ transformEach = everywhereM (mk1M transformEach')
-- | A pass that changes all the Rain range constructor expressions into the more general array constructor expressions -- | A pass that changes all the Rain range constructor expressions into the more general array constructor expressions
transformRangeRep :: Data t => t -> PassM t transformRangeRep :: Data t => t -> PassM t
transformRangeRep = everywhereM (mkM transformRangeRep') transformRangeRep = doGeneric `extM` doExpression
where where
transformRangeRep' :: A.Expression -> PassM A.Expression doGeneric :: Data t => t -> PassM t
transformRangeRep' (A.ExprConstr _ (A.RangeConstr m (A.Literal _ _ beginLit) (A.Literal _ _ endLit))) doGeneric = makeGeneric transformRangeRep
doExpression :: A.Expression -> PassM A.Expression
doExpression (A.ExprConstr _ (A.RangeConstr m t (A.Literal _ _ beginLit) (A.Literal _ _ endLit)))
= if (isJust $ checkIntegral beginLit) && (isJust $ checkIntegral endLit) = if (isJust $ checkIntegral beginLit) && (isJust $ checkIntegral endLit)
then transformRangeRep'' m (fromJust $ checkIntegral beginLit) (fromJust $ checkIntegral endLit) then transformRangeRep'' m (fromJust $ checkIntegral beginLit) (fromJust $ checkIntegral endLit)
else dieP m "Items in range constructor (x..y) are not integer literals" else dieP m "Items in range constructor (x..y) are not integer literals"
@ -245,12 +233,12 @@ transformRangeRep = everywhereM (mkM transformRangeRep')
then dieP m $ "End of range is before beginning: " ++ show begin ++ " > " ++ show end then dieP m $ "End of range is before beginning: " ++ show begin ++ " > " ++ show end
else do A.Specification _ rep _ <- makeNonceVariable "rep_constr" m A.Int A.VariableName A.ValAbbrev else do A.Specification _ rep _ <- makeNonceVariable "rep_constr" m A.Int A.VariableName A.ValAbbrev
let count = end - begin + 1 let count = end - begin + 1
return $ A.ExprConstr m $ A.RepConstr m return $ A.ExprConstr m $ A.RepConstr m t
(A.For m rep (A.For m rep
(A.Literal m A.Int (A.IntLiteral m $ show begin)) (A.Literal m A.Int (A.IntLiteral m $ show begin))
(A.Literal m A.Int (A.IntLiteral m $ show count)) (A.Literal m A.Int (A.IntLiteral m $ show count))
) (A.ExprVariable m $ A.Variable m rep) ) (A.ExprVariable m $ A.Variable m rep)
transformRangeRep' s = return s doExpression e = doGeneric e
checkFunction :: Data t => t -> PassM t checkFunction :: Data t => t -> PassM t
checkFunction = everywhereM (mkM checkFunction') checkFunction = everywhereM (mkM checkFunction')

18
frontends/RainPassesTest.hs
View File

@ -148,7 +148,8 @@ testEachRangePass0 :: Test
testEachRangePass0 = TestCase $ testPass "testEachRangePass0" exp (transformEachRange orig) (return ()) testEachRangePass0 = TestCase $ testPass "testEachRangePass0" exp (transformEachRange orig) (return ())
where where
orig = A.Par m A.PlainPar $ A.Rep m 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.ForEach m (simpleName "x") (A.ExprConstr m (A.RangeConstr m
undefined (intLiteral 0) (intLiteral 9))))
(A.Only m (makeSimpleAssign "c" "x")) (A.Only m (makeSimpleAssign "c" "x"))
exp = A.Par m A.PlainPar $ A.Rep m exp = A.Par m A.PlainPar $ A.Rep m
(A.For m (simpleName "x") (intLiteral 0) (intLiteral 10)) (A.For m (simpleName "x") (intLiteral 0) (intLiteral 10))
@ -158,7 +159,8 @@ testEachRangePass1 :: Test
testEachRangePass1 = TestCase $ testPass "testEachRangePass1" exp (transformEachRange orig) (return ()) testEachRangePass1 = TestCase $ testPass "testEachRangePass1" exp (transformEachRange orig) (return ())
where where
orig = A.Par m A.PlainPar $ A.Rep m 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.ForEach m (simpleName "x") (A.ExprConstr m (A.RangeConstr m undefined
(intLiteral (-5)) (intLiteral (-2)))))
(A.Only m (makeSimpleAssign "c" "x")) (A.Only m (makeSimpleAssign "c" "x"))
exp = A.Par m A.PlainPar $ A.Rep m exp = A.Par m A.PlainPar $ A.Rep m
(A.For m (simpleName "x") (intLiteral (-5)) (intLiteral 4)) (A.For m (simpleName "x") (intLiteral (-5)) (intLiteral 4))
@ -168,7 +170,8 @@ testEachRangePass2 :: Test
testEachRangePass2 = TestCase $ testPass "testEachRangePass2" exp (transformEachRange orig) (return ()) testEachRangePass2 = TestCase $ testPass "testEachRangePass2" exp (transformEachRange orig) (return ())
where where
orig = A.Seq m $ A.Rep m orig = A.Seq m $ A.Rep m
(A.ForEach m (simpleName "x") (A.ExprConstr m (A.RangeConstr m (intLiteral 6) (intLiteral 6)))) (A.ForEach m (simpleName "x") (A.ExprConstr m (A.RangeConstr m undefined
(intLiteral 6) (intLiteral 6))))
(A.Only m (makeSimpleAssign "c" "x")) (A.Only m (makeSimpleAssign "c" "x"))
exp = A.Seq m $ A.Rep m exp = A.Seq m $ A.Rep m
(A.For m (simpleName "x") (intLiteral 6) (intLiteral 1)) (A.For m (simpleName "x") (intLiteral 6) (intLiteral 1))
@ -178,7 +181,8 @@ testEachRangePass3 :: Test
testEachRangePass3 = TestCase $ testPass "testEachRangePass3" exp (transformEachRange orig) (return ()) testEachRangePass3 = TestCase $ testPass "testEachRangePass3" exp (transformEachRange orig) (return ())
where where
orig = A.Seq m $ A.Rep m orig = A.Seq m $ A.Rep m
(A.ForEach m (simpleName "x") (A.ExprConstr m (A.RangeConstr m (intLiteral 6) (intLiteral 0)))) (A.ForEach m (simpleName "x") (A.ExprConstr m (A.RangeConstr m undefined
(intLiteral 6) (intLiteral 0))))
(A.Only m (makeSimpleAssign "c" "x")) (A.Only m (makeSimpleAssign "c" "x"))
exp = A.Seq m $ A.Rep m exp = A.Seq m $ A.Rep m
(A.For m (simpleName "x") (intLiteral 6) (intLiteral (-5))) (A.For m (simpleName "x") (intLiteral 6) (intLiteral (-5)))
@ -466,15 +470,15 @@ testParamPass8 = TestList [TestCase $ testPassShouldFail "testParamPass8/process
testRangeRepPass0 :: Test testRangeRepPass0 :: Test
testRangeRepPass0 = TestCase $ testPass "testRangeRepPass0" exp (transformRangeRep orig) (return()) testRangeRepPass0 = TestCase $ testPass "testRangeRepPass0" exp (transformRangeRep orig) (return())
where where
orig = A.ExprConstr m $ A.RangeConstr m (intLiteral 0) (intLiteral 1) orig = A.ExprConstr m $ A.RangeConstr m A.Byte (intLiteral 0) (intLiteral 1)
exp = tag2 A.ExprConstr DontCare $ tag3 A.RepConstr DontCare (tag4 A.For DontCare ("repIndex"@@DontCare) (intLiteral 0) (intLiteral 2)) exp = tag2 A.ExprConstr DontCare $ mRepConstr A.Byte (tag4 A.For DontCare ("repIndex"@@DontCare) (intLiteral 0) (intLiteral 2))
(tag2 A.ExprVariable DontCare $ tag2 A.Variable DontCare $ "repIndex"@@DontCare) (tag2 A.ExprVariable DontCare $ tag2 A.Variable DontCare $ "repIndex"@@DontCare)
-- | Lists with negative counts should give an error -- | Lists with negative counts should give an error
testRangeRepPass1 :: Test testRangeRepPass1 :: Test
testRangeRepPass1 = TestCase $ testPassShouldFail "testRangeRepPass1" (transformRangeRep orig) (return()) testRangeRepPass1 = TestCase $ testPassShouldFail "testRangeRepPass1" (transformRangeRep orig) (return())
where where
orig = A.ExprConstr m $ A.RangeConstr m (intLiteral 1) (intLiteral 0) orig = A.ExprConstr m $ A.RangeConstr m A.Byte (intLiteral 1) (intLiteral 0)
--TODO consider/test pulling up the definitions of variables involved in return statements in functions --TODO consider/test pulling up the definitions of variables involved in return statements in functions

2
transformations/PassTest.hs
View File

@ -208,7 +208,7 @@ testTransformConstr0 = TestCase $ testPass "transformConstr0" exp (transformCons
startState = defineConst "x" A.Int (intLiteral 42) startState = defineConst "x" A.Int (intLiteral 42)
orig = A.Spec m (A.Specification m (simpleName "arr") $ A.IsExpr m A.ValAbbrev (A.Array [dimension 10] A.Int) $ A.ExprConstr m $ orig = A.Spec m (A.Specification m (simpleName "arr") $ A.IsExpr m A.ValAbbrev (A.Array [dimension 10] A.Int) $ A.ExprConstr m $
A.RepConstr m (A.For m (simpleName "x") (intLiteral 0) (intLiteral 10)) (exprVariable "x") A.RepConstr m undefined (A.For m (simpleName "x") (intLiteral 0) (intLiteral 10)) (exprVariable "x")
) skipP ) skipP
exp = nameAndStopCaringPattern "indexVar" "i" $ mkPattern exp' exp = nameAndStopCaringPattern "indexVar" "i" $ mkPattern exp'
exp' = A.Spec m (A.Specification m (simpleName "arr") (A.Declaration m (A.Array [dimension 10] A.Int))) $ exp' = A.Spec m (A.Specification m (simpleName "arr") (A.Declaration m (A.Array [dimension 10] A.Int))) $