diff --git a/frontends/RainPasses.hs b/frontends/RainPasses.hs index a89a710..0f0bde0 100644 --- a/frontends/RainPasses.hs +++ b/frontends/RainPasses.hs @@ -51,7 +51,6 @@ rainPasses = [ findMain , transformEachRange , pullUpForEach - , transformRangeRep , pullUpParDeclarations , mobiliseLists , implicitMobility @@ -186,33 +185,27 @@ transformEachRange = rainOnlyPass "Convert seqeach/pareach loops over ranges int (applyDepthM doSpec) where doSpec :: A.Specification -> PassM A.Specification - doSpec (A.Specification mspec loopVar (A.Rep repMeta (A.ForEach eachMeta (A.ExprConstr - _ (A.RangeConstr _ _ begin end))))) + doSpec + (A.Specification mspec loopVar + (A.Rep repMeta -- Outer replicator + (A.ForEach eachMeta -- goes through each itme + (A.Literal _ _ + (A.ArrayListLiteral _ -- in a list + (A.Spec _ + (A.Specification _ n r@(A.Rep {})) -- made from a replicator + (A.Only _ (A.ExprVariable _ (A.Variable _ n'))) + -- where the inner expression is just the replicator + ) + ) + ) + ) + ) + ) | A.nameName n' == A.nameName n = do -- Need to change the stored abbreviation mode to original: modifyName loopVar $ \nd -> nd { A.ndAbbrevMode = A.Original } - return $ A.Specification mspec loopVar $ A.Rep repMeta $ A.For eachMeta begin - (addOne $ subExprs end begin) (makeConstant eachMeta 1) + return $ A.Specification mspec loopVar r doSpec s = return s --- | A pass that changes all the Rain range constructor expressions into the more general array constructor expressions --- --- TODO make sure when the range has a bad order that an empty list is --- returned -transformRangeRep :: Pass -transformRangeRep = rainOnlyPass "Convert simple Rain range constructors into more general array constructors" - (Prop.agg_typesDone ++ [Prop.eachRangeTransformed]) - [Prop.rangeTransformed] - (applyDepthM doExpression) - where - doExpression :: A.Expression -> PassM A.Expression - doExpression (A.ExprConstr _ (A.RangeConstr m t begin end)) - = do A.Specification _ rep _ <- makeNonceVariable "rep_constr" m A.Int A.ValAbbrev - let count = addOne $ subExprs end begin - return $ A.ExprConstr m $ A.RepConstr m t rep - (A.For m begin count $ makeConstant m 1) - (A.ExprVariable m $ A.Variable m rep) - doExpression e = return e - -- TODO this is almost certainly better figured out from the CFG checkFunction :: PassType checkFunction = return -- applyDepthM checkFunction' diff --git a/frontends/RainTypes.hs b/frontends/RainTypes.hs index 877cba4..2209220 100644 --- a/frontends/RainTypes.hs +++ b/frontends/RainTypes.hs @@ -222,18 +222,16 @@ markExpressionTypes = checkDepthM checkExpression checkExpression :: RainTypeCheck A.Expression checkExpression (A.Dyadic _ _ lhs rhs) = markUnify lhs rhs - checkExpression (A.Literal _ t (A.ListLiteral _ es)) - = do ts <- mapM astTypeOf es - mapM_ (markUnify t . A.List) ts - checkExpression (A.ExprConstr _ con) - = case con of - A.RangeConstr _ t e e' -> - do astTypeOf e >>= markUnify t . A.List - astTypeOf e' >>= markUnify t . A.List - A.RepConstr _ t n _ e -> - astTypeOf e >>= markUnify t . A.List + checkExpression (A.Literal _ t (A.ArrayListLiteral _ es)) + = checkListElems (markUnify t) es checkExpression _ = return () + checkListElems :: RainTypeCheck A.Type -> RainTypeCheck (A.Structured A.Expression) + checkListElems ch (A.Only _ e) = astTypeOf e >>= ch + checkListElems ch (A.Several _ es) = mapM_ (checkListElems (ch . A.List)) es + checkListElems ch (A.Spec _ _ s) = checkListElems ch s + checkListElems ch (A.ProcThen _ _ s) = checkListElems ch s + -- | Checks the types in assignments markAssignmentTypes :: RainTypePassType markAssignmentTypes = checkDepthM checkAssignment