diff --git a/pass/Properties.hs b/pass/Properties.hs index a24b649..b35b6ef 100644 --- a/pass/Properties.hs +++ b/pass/Properties.hs @@ -47,6 +47,7 @@ module Properties , processTypesChecked , rainParDeclarationsPulledUp , rangeTransformed + , seqInputsFlattened , subscriptsPulledUp , typesResolvedInAST , typesResolvedInState @@ -325,3 +326,10 @@ mainTagged :: Property mainTagged = Property "mainTagged" nocheck -- We don't check this because not having a main process may be valid in the future -- so there's no easy way to check if the main process has been looked for or not + +seqInputsFlattened :: Property +seqInputsFlattened = Property "seqInputsFlattened" $ checkNull "seqInputsFlattened" . listify findMultipleInputs + where + findMultipleInputs :: A.InputMode -> Bool + findMultipleInputs (A.InputSimple _ (_:_:_)) = True + findMultipleInputs _ = False diff --git a/transformations/PassTest.hs b/transformations/PassTest.hs index cecaaa5..15872ed 100644 --- a/transformations/PassTest.hs +++ b/transformations/PassTest.hs @@ -33,6 +33,7 @@ import SimplifyExprs import TagAST import TestUtils import TreeUtils +import Utils m :: Meta m = emptyMeta @@ -513,6 +514,26 @@ testInputCase = TestList specInt s = A.Spec emptyMeta (A.Specification emptyMeta (simpleName s) $ A.Declaration emptyMeta A.Int Nothing) specIntPatt s = mSpecA' emptyMeta (A.Specification emptyMeta (simpleName s) $ A.Declaration emptyMeta A.Int Nothing) + +testTransformProtocolInput :: Test +testTransformProtocolInput = TestList + [ + TestCase $ testPass "testTransformProtocolInput0" + (A.Seq emptyMeta $ A.Several emptyMeta [onlySingle ii0]) + (transformProtocolInput $ seqItems [ii0]) + (return ()) + ,TestCase $ testPass "testTransformProtocolInput1" + (A.Seq emptyMeta $ A.Several emptyMeta $ map onlySingle [ii0, ii1, ii2]) + (transformProtocolInput $ seqItems [ii0, ii1, ii2]) + (return ()) + ] + where + ii0 = A.InVariable emptyMeta (variable "x") + ii1 = A.InCounted emptyMeta (variable "y") (variable "z") + ii2 = A.InVariable emptyMeta (variable "a") + + onlySingle = A.Only emptyMeta . A.Input emptyMeta (variable "c") . A.InputSimple emptyMeta . singleton + seqItems = A.Input emptyMeta (variable "c") . A.InputSimple emptyMeta --Returns the list of tests: tests :: Test @@ -526,6 +547,7 @@ tests = TestList ,testInputCase ,testOutExprs ,testTransformConstr0 + ,testTransformProtocolInput ] diff --git a/transformations/SimplifyComms.hs b/transformations/SimplifyComms.hs index d63b1a6..0b30189 100644 --- a/transformations/SimplifyComms.hs +++ b/transformations/SimplifyComms.hs @@ -35,6 +35,7 @@ simplifyComms :: [Pass] simplifyComms = makePassesDep [ ("Define temporary variables for outputting expressions", outExprs, Prop.agg_namesDone ++ Prop.agg_typesDone, [Prop.outExpressionRemoved]) ,("Transform ? CASE statements/guards into plain CASE", transformInputCase, Prop.agg_namesDone ++ Prop.agg_typesDone, [Prop.inputCaseRemoved]) + ,("Flatten sequential protocol inputs into multiple inputs", transformProtocolInput, Prop.agg_namesDone ++ Prop.agg_typesDone ++ [Prop.inputCaseRemoved], [Prop.seqInputsFlattened]) ] outExprs :: Data t => t -> PassM t @@ -211,3 +212,15 @@ transformInputCase = doGeneric `extM` doProcess -- Leave other guards (and parts of Structured) untouched: doStructuredA s = return s +transformProtocolInput :: Data t => t -> PassM t +transformProtocolInput = doGeneric `extM` doProcess + where + doGeneric :: Data t => t -> PassM t + doGeneric = makeGeneric transformProtocolInput + + doProcess :: A.Process -> PassM A.Process + doProcess (A.Input m v (A.InputSimple m' iis)) + = return $ A.Seq m $ A.Several m $ + map (A.Only m . A.Input m v . A.InputSimple m' . singleton) iis + doProcess p = doGeneric p +