diff --git a/frontends/RainPasses.hs b/frontends/RainPasses.hs index 6870cd7..3da7773 100644 --- a/frontends/RainPasses.hs +++ b/frontends/RainPasses.hs @@ -50,6 +50,7 @@ rainPasses = --must be done after transformEachRange ,("Transform Rain functions into the occam form",transformFunction) --must be done after transformEach, depends on uniquifyAndResolveVars and recordInfNameTypes + ,("Pull up par declarations", pullUpParDeclarations) --doesn't depend on anything ,("AST Validity check, Rain #2", (\x -> excludeNonRainFeatures x >>= excludeTransformedRainFeatures)) ] @@ -324,6 +325,23 @@ transformFunction = everywhereM (mkM transformFunction') _ -> dieP m "Functions must have seq[uential] bodies" transformFunction' s = return s +pullUpParDeclarations :: Data t => t -> PassM t +pullUpParDeclarations = everywhereM (mkM pullUpParDeclarations') + where + pullUpParDeclarations' :: A.Process -> PassM A.Process + pullUpParDeclarations' p@(A.Par m mode inside) + = case chaseSpecs inside of + Just (specs, innerCode) -> return $ A.Seq m $ specs $ A.OnlyP m $ A.Par m mode innerCode + Nothing -> return p + pullUpParDeclarations' p = return p + + chaseSpecs :: A.Structured -> Maybe (A.Structured -> A.Structured, A.Structured) + chaseSpecs (A.Spec m spec inner) + = case chaseSpecs inner of + Nothing -> Just (A.Spec m spec,inner) + Just (trans,inner') -> Just ( (A.Spec m spec) . trans,inner') + chaseSpecs _ = Nothing + -- | All the items that should have been removed at the end of the Rain passes. excludeTransformedRainFeatures :: Data t => t -> PassM t excludeTransformedRainFeatures = excludeConstr diff --git a/frontends/RainPassesTest.hs b/frontends/RainPassesTest.hs index 9574e20..ee04f81 100644 --- a/frontends/RainPassesTest.hs +++ b/frontends/RainPassesTest.hs @@ -494,6 +494,29 @@ testTransformFunction1 = testPassShouldFail "testTransformFunction1" (transformF A.Function m A.PlainSpec [A.Byte] [A.Formal A.ValAbbrev A.Byte (simpleName "x")] $ (A.OnlyP m $ A.Seq m $ A.Several m []) +testPullUpParDecl0 :: Test +testPullUpParDecl0 = testPass "testPullUpParDecl0" orig (pullUpParDeclarations orig) (return ()) + where + orig = A.Par m A.PlainPar (A.Several m []) + +testPullUpParDecl1 :: Test +testPullUpParDecl1 = testPass "testPullUpParDecl1" exp (pullUpParDeclarations orig) (return ()) + where + orig = A.Par m A.PlainPar $ + A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Int) (A.Several m []) + exp = A.Seq m $ A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Int) (A.OnlyP m $ A.Par m A.PlainPar $ A.Several m []) + +testPullUpParDecl2 :: Test +testPullUpParDecl2 = testPass "testPullUpParDecl2" exp (pullUpParDeclarations orig) (return ()) + where + orig = A.Par m A.PlainPar $ + A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Int) $ + A.Spec m (A.Specification m (simpleName "y") $ A.Declaration m A.Byte) $ + (A.Several m []) + exp = A.Seq m $ A.Spec m (A.Specification m (simpleName "x") $ A.Declaration m A.Int) + $ A.Spec m (A.Specification m (simpleName "y") $ A.Declaration m A.Byte) + (A.OnlyP m $ A.Par m A.PlainPar $ A.Several m []) + ---Returns the list of tests: tests :: Test tests = TestList @@ -530,6 +553,9 @@ tests = TestList ,testRangeRepPass1 ,testTransformFunction0 ,testTransformFunction1 + ,testPullUpParDecl0 + ,testPullUpParDecl1 + ,testPullUpParDecl2 ]