Adjusted the rain passes to use the new array constructor type, and weaned a few of them off everywhereM
This commit is contained in:
Neil Brown
parent
cb819d142a
commit
db0467f1ca
|
|
@ -29,7 +29,6 @@ import CompState
|
|||
import Errors
|
||||
import Metadata
|
||||
import Pass
|
||||
import Pattern
|
||||
import qualified Properties as Prop
|
||||
import RainTypes
|
||||
import TreeUtils
|
||||
|
|
@ -58,7 +57,8 @@ rainPasses = makePassesDep' ((== FrontendRain) . csFrontend)
|
|||
,("Check parameters in process calls", matchParamPass, typesDone, [Prop.processTypesChecked])
|
||||
|
||||
,("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 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], [])
|
||||
|
|
@ -170,37 +170,22 @@ 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 (mk1M transformEachRange')
|
||||
transformEachRange = doGeneric `ext1M` doStructured
|
||||
where
|
||||
transformEachRange' :: forall a. Data a => A.Structured a -> PassM (A.Structured a)
|
||||
transformEachRange' s@(A.Rep m _ _)
|
||||
= 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
|
||||
doGeneric :: Data t => t -> PassM t
|
||||
doGeneric = makeGeneric transformEachRange
|
||||
|
||||
doStructured :: Data a => A.Structured a -> PassM (A.Structured a)
|
||||
doStructured (A.Rep repMeta (A.ForEach eachMeta loopVar (A.ExprConstr
|
||||
_ (A.RangeConstr _ _ (A.Literal _ _ begin) (A.Literal _ _ end)))) body)
|
||||
= do body' <- doStructured body
|
||||
-- TODO should probably not do mini-constant-folding here:
|
||||
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
|
||||
) body'
|
||||
else dieP eachMeta "Items in range constructor (x..y) are not integer literals"
|
||||
where
|
||||
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
|
||||
doStructured s = doGeneric s
|
||||
|
||||
-- | A pass that changes all the 'A.ForEach' replicators in the AST into 'A.For' replicators.
|
||||
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
|
||||
transformRangeRep :: Data t => t -> PassM t
|
||||
transformRangeRep = everywhereM (mkM transformRangeRep')
|
||||
transformRangeRep = doGeneric `extM` doExpression
|
||||
where
|
||||
transformRangeRep' :: A.Expression -> PassM A.Expression
|
||||
transformRangeRep' (A.ExprConstr _ (A.RangeConstr m (A.Literal _ _ beginLit) (A.Literal _ _ endLit)))
|
||||
doGeneric :: Data t => t -> PassM t
|
||||
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)
|
||||
then transformRangeRep'' m (fromJust $ checkIntegral beginLit) (fromJust $ checkIntegral endLit)
|
||||
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
|
||||
else do A.Specification _ rep _ <- makeNonceVariable "rep_constr" m A.Int A.VariableName A.ValAbbrev
|
||||
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.Literal m A.Int (A.IntLiteral m $ show begin))
|
||||
(A.Literal m A.Int (A.IntLiteral m $ show count))
|
||||
) (A.ExprVariable m $ A.Variable m rep)
|
||||
transformRangeRep' s = return s
|
||||
doExpression e = doGeneric e
|
||||
|
||||
checkFunction :: Data t => t -> PassM t
|
||||
checkFunction = everywhereM (mkM checkFunction')
|
||||
|
|
|
|||
|
|
@ -148,7 +148,8 @@ testEachRangePass0 :: Test
|
|||
testEachRangePass0 = TestCase $ 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.ForEach m (simpleName "x") (A.ExprConstr m (A.RangeConstr m
|
||||
undefined (intLiteral 0) (intLiteral 9))))
|
||||
(A.Only m (makeSimpleAssign "c" "x"))
|
||||
exp = A.Par m A.PlainPar $ A.Rep m
|
||||
(A.For m (simpleName "x") (intLiteral 0) (intLiteral 10))
|
||||
|
|
@ -158,7 +159,8 @@ testEachRangePass1 :: Test
|
|||
testEachRangePass1 = TestCase $ 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.ForEach m (simpleName "x") (A.ExprConstr m (A.RangeConstr m undefined
|
||||
(intLiteral (-5)) (intLiteral (-2)))))
|
||||
(A.Only m (makeSimpleAssign "c" "x"))
|
||||
exp = A.Par m A.PlainPar $ A.Rep m
|
||||
(A.For m (simpleName "x") (intLiteral (-5)) (intLiteral 4))
|
||||
|
|
@ -168,7 +170,8 @@ testEachRangePass2 :: Test
|
|||
testEachRangePass2 = TestCase $ 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.ForEach m (simpleName "x") (A.ExprConstr m (A.RangeConstr m undefined
|
||||
(intLiteral 6) (intLiteral 6))))
|
||||
(A.Only m (makeSimpleAssign "c" "x"))
|
||||
exp = A.Seq m $ A.Rep m
|
||||
(A.For m (simpleName "x") (intLiteral 6) (intLiteral 1))
|
||||
|
|
@ -178,7 +181,8 @@ testEachRangePass3 :: Test
|
|||
testEachRangePass3 = TestCase $ 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.ForEach m (simpleName "x") (A.ExprConstr m (A.RangeConstr m undefined
|
||||
(intLiteral 6) (intLiteral 0))))
|
||||
(A.Only m (makeSimpleAssign "c" "x"))
|
||||
exp = A.Seq m $ A.Rep m
|
||||
(A.For m (simpleName "x") (intLiteral 6) (intLiteral (-5)))
|
||||
|
|
@ -466,15 +470,15 @@ testParamPass8 = TestList [TestCase $ testPassShouldFail "testParamPass8/process
|
|||
testRangeRepPass0 :: Test
|
||||
testRangeRepPass0 = TestCase $ testPass "testRangeRepPass0" exp (transformRangeRep orig) (return())
|
||||
where
|
||||
orig = A.ExprConstr m $ A.RangeConstr m (intLiteral 0) (intLiteral 1)
|
||||
exp = tag2 A.ExprConstr DontCare $ tag3 A.RepConstr DontCare (tag4 A.For DontCare ("repIndex"@@DontCare) (intLiteral 0) (intLiteral 2))
|
||||
orig = A.ExprConstr m $ A.RangeConstr m A.Byte (intLiteral 0) (intLiteral 1)
|
||||
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)
|
||||
|
||||
-- | Lists with negative counts should give an error
|
||||
testRangeRepPass1 :: Test
|
||||
testRangeRepPass1 = TestCase $ testPassShouldFail "testRangeRepPass1" (transformRangeRep orig) (return())
|
||||
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
|
||||
|
||||
|
|
|
|||
|
|
@ -208,7 +208,7 @@ testTransformConstr0 = TestCase $ testPass "transformConstr0" exp (transformCons
|
|||
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 $
|
||||
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
|
||||
exp = nameAndStopCaringPattern "indexVar" "i" $ mkPattern exp'
|
||||
exp' = A.Spec m (A.Specification m (simpleName "arr") (A.Declaration m (A.Array [dimension 10] A.Int))) $
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user