diff --git a/backends/GenerateCHP.hs b/backends/GenerateCHP.hs index be7078a..2a38186 100644 --- a/backends/GenerateCHP.hs +++ b/backends/GenerateCHP.hs @@ -198,7 +198,7 @@ seqComma :: [CGen ()] -> CGen () seqComma ps = sequence_ $ intersperse (tell [","]) ps genLiteralRepr :: A.LiteralRepr -> CGen () -genLiteralRepr (A.ArrayLiteral _ elems) +genLiteralRepr (A.ArrayListLiteral _ (A.Several _ elems)) = do tell ["newListArray (0," ++ show (length elems - 1) ++ ") ["] seqComma $ map genArrayElem elems tell ["]"] @@ -226,8 +226,8 @@ convByte c | otherwise = [c] where o = ord c -genArrayElem :: A.ArrayElem -> CGen () -genArrayElem (A.ArrayElemExpr e) = genExpression e +genArrayElem :: A.Structured A.Expression -> CGen () +genArrayElem (A.Only _ e) = genExpression e genArrayElem _ = genMissing "genArrayElem" genType :: A.Type -> CGen () diff --git a/common/ShowCode.hs b/common/ShowCode.hs index b731521..bbb80f3 100644 --- a/common/ShowCode.hs +++ b/common/ShowCode.hs @@ -241,6 +241,7 @@ instance ShowOccam A.Type where showOccamM A.Any = tell ["ANY"] showOccamM (A.Timer _) = tell ["TIMER"] showOccamM A.Time = tell ["TIME"] + showOccamM A.Infer = tell ["inferred-type"] showOccamM (A.UnknownVarType _ en) = do tell ["(inferred type for: "] either showName (tell . (:[]) . show) en diff --git a/frontends/OccamTypes.hs b/frontends/OccamTypes.hs index adffede..6f75e4a 100644 --- a/frontends/OccamTypes.hs +++ b/frontends/OccamTypes.hs @@ -643,7 +643,6 @@ type InferTypeOps `ExtOpMP` A.Expression `ExtOpMP` A.Dimension `ExtOpMP` A.Subscript - `ExtOpMP` A.ArrayConstr `ExtOpMP` A.Replicator `ExtOpMP` A.Alternative `ExtOpMP` A.InputMode @@ -658,6 +657,7 @@ inferTypes = occamOnlyPass "Infer types" [Prop.inferredTypesRecorded] recurse where + ops :: InferTypeOps ops = baseOp `extOp` doExpression `extOp` doDimension diff --git a/transformations/SimplifyExprs.hs b/transformations/SimplifyExprs.hs index 898a82d..446b35f 100644 --- a/transformations/SimplifyExprs.hs +++ b/transformations/SimplifyExprs.hs @@ -145,7 +145,7 @@ removeAfter = pass "Convert AFTER to MINUS" -- | For array literals that include other arrays, burst them into their -- elements. -expandArrayLiterals :: PassOn A.ArrayElem +expandArrayLiterals :: PassOn (A.Structured A.Expression) expandArrayLiterals = pass "Expand array literals" [Prop.expressionTypesChecked, Prop.processTypesChecked] [Prop.arrayLiteralsExpanded] @@ -189,7 +189,9 @@ expandArrayLiterals = pass "Expand array literals" -- Therefore, we only need to pull up the counts for SEQ, PAR and ALT -- -- TODO for simplification, we could avoid pulling up replication counts that are known to be constants -pullRepCounts :: Pass +-- +-- TODO we should also pull up the step counts +pullRepCounts :: PassOn2 (A.Structured A.Process) (A.Structured A.Alternative) pullRepCounts = pass "Pull up replicator counts for SEQs, PARs and ALTs" (Prop.agg_namesDone ++ Prop.agg_typesDone) [] @@ -271,7 +273,7 @@ transformConstr = pass "Transform array constructors into initialisation code" let body = specs $ A.Several m'' [ assignItem tInner indexVar repExp' , incIndex ] - body' <- applyDepthSM doStructured body + body' <- applyBottomUpMS doStructured body return $ declDest $ A.ProcThen m'' (A.Seq m'' $ A.Spec m'' indexVarSpec $ @@ -332,6 +334,7 @@ transformConstr = pass "Transform array constructors into initialisation code" type PullUpOps = ExtOpMSP BaseOp `ExtOpMP` A.Process + `ExtOpMP` A.Structured A.Expression `ExtOpMP` A.Specification `ExtOpMP` A.LiteralRepr `ExtOpMP` A.Expression @@ -348,17 +351,18 @@ pullUp pullUpArraysInsideRecords = pass "Pull up definitions" where ops :: PullUpOps ops = baseOp - `extOpS` doStructured - `extOp` doProcess - `extOp` doSpecification - `extOp` doLiteralRepr - `extOp` doExpression - `extOp` doVariable - `extOp` doExpressionList - recurse :: Recurse - recurse = makeRecurse ops - descend :: Descend - descend = makeDescend ops + `extOpMS` (ops, doStructured) + `extOpM` doProcess + `extOpM` doRepArray + `extOpM` doSpecification + `extOpM` doLiteralRepr + `extOpM` doExpression + `extOpM` doVariable + `extOpM` doExpressionList + recurse :: RecurseM PassM PullUpOps + recurse = makeRecurseM ops + descend :: DescendM PassM PullUpOps + descend = makeDescendM ops -- | When we encounter a Structured, create a new pulled items state, -- recurse over it, then apply whatever pulled items we found to it.