From 51ecf04a901db77f6dfff6ee76153e95d927bb6f Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Wed, 22 Aug 2007 19:55:52 +0000 Subject: [PATCH] Move assignment simplification into a pass. This is the code that expands array and record assignments out into multiple assignments. Having it done as a pass means it can do a better job -- this fixes some problems with cgtest56 where the old version of the code couldn't handle record assignments from literals. This is the first pass that's had to add a replicator to the tree, so this also introduces a helper function for generating new replicator counters. --- CompState.hs | 6 ++++ GenerateC.hs | 7 ----- SimplifyProcs.hs | 63 +++++++++++++++++++++++++++++++++++++ testcases/assign-array.occ | 12 +++++-- testcases/assign-record.occ | 15 +++++++++ 5 files changed, 93 insertions(+), 10 deletions(-) create mode 100644 testcases/assign-record.occ diff --git a/CompState.hs b/CompState.hs index 34b5673..a1900a0 100644 --- a/CompState.hs +++ b/CompState.hs @@ -232,6 +232,12 @@ makeNonceProc :: CSM m => Meta -> A.Process -> m A.Specification makeNonceProc m p = defineNonce m "wrapper_proc" (A.Proc m A.PlainSpec [] p) A.ProcName A.Abbrev +-- | Generate and define a counter for a replicator. +makeNonceCounter :: CSM m => String -> Meta -> m A.Name +makeNonceCounter s m + = do (A.Specification _ n _) <- defineNonce m s (A.Declaration m A.Int) A.VariableName A.ValAbbrev + return n + -- | Generate and define a variable abbreviation. makeNonceIs :: CSM m => String -> Meta -> A.Type -> A.AbbrevMode -> A.Variable -> m A.Specification makeNonceIs s m t am v diff --git a/GenerateC.hs b/GenerateC.hs index bb7da21..dc66bf9 100644 --- a/GenerateC.hs +++ b/GenerateC.hs @@ -1438,13 +1438,6 @@ cgenAssign ops m [v] el doAssign t v e where doAssign :: A.Type -> A.Variable -> A.Expression -> CGen () - doAssign t@(A.Array _ subT) toV (A.ExprVariable m fromV) - = call genOverArray ops m fromV (\sub -> Just $ doAssign subT (sub toV) (A.ExprVariable m (sub fromV))) - doAssign rt@(A.Record _) toV (A.ExprVariable m fromV) - = do fs <- recordFields m rt - sequence_ [let subV v = A.SubscriptedVariable m (A.SubscriptField m n) v - in doAssign t (subV toV) (A.ExprVariable m $ subV fromV) - | (n, t) <- fs] doAssign t v e = case call getScalarType ops t of Just _ -> diff --git a/SimplifyProcs.hs b/SimplifyProcs.hs index 9a9682b..9bc7533 100644 --- a/SimplifyProcs.hs +++ b/SimplifyProcs.hs @@ -36,6 +36,7 @@ simplifyProcs = runPasses passes passes = [ ("Wrap PAR subprocesses in PROCs", parsToProcs) , ("Remove parallel assignment", removeParAssign) + , ("Flatten assignment", flattenAssign) ] -- | Wrap the subprocesses of PARs in no-arg PROCs. @@ -89,3 +90,65 @@ removeParAssign = doGeneric `extM` doProcess return $ A.Seq m $ foldl (\s spec -> A.Spec m spec s) (A.Several m (map (A.OnlyP m) (first ++ second))) specs doProcess p = doGeneric p +-- | Turn assignment of arrays and records into multiple assignments. +flattenAssign :: Data t => t -> PassM t +flattenAssign = doGeneric `extM` doProcess + where + doGeneric :: Data t => t -> PassM t + doGeneric = makeGeneric flattenAssign + + doProcess :: A.Process -> PassM A.Process + doProcess (A.Assign m [v] (A.ExpressionList m' [e])) + = do t <- typeOfVariable v + assign m t v m' e + doProcess p = doGeneric p + + assign :: Meta -> A.Type -> A.Variable -> Meta -> A.Expression -> PassM A.Process + assign m t@(A.Array _ _) v m' e = complexAssign m t v m' e + assign m t@(A.Record _) v m' e = complexAssign m t v m' e + assign m _ v m' e = return $ A.Assign m [v] (A.ExpressionList m' [e]) + + complexAssign :: Meta -> A.Type -> A.Variable -> Meta -> A.Expression -> PassM A.Process + complexAssign m t v m' e + = do -- Abbreviate the source and destination, to avoid doing the + -- subscript each time. + destAM <- liftM makeAbbrevAM $ abbrevModeOfVariable v + dest@(A.Specification _ destN _) <- + makeNonceIs "assign_dest" m t destAM v + let destV = A.Variable m destN + src@(A.Specification _ srcN _) <- + makeNonceIsExpr "assign_src" m' t e + let srcV = A.Variable m' srcN + + body <- case t of + A.Array _ _ -> + -- Array assignments become a loop with an assignment + -- inside. + do counter <- makeNonceCounter "i" m + let zero = A.Literal m A.Int $ A.IntLiteral m "0" + let rep = A.For m counter zero + (A.SizeVariable m srcV) + itemT <- trivialSubscriptType t + let sub = A.Subscript m (A.ExprVariable m + (A.Variable m counter)) + inner <- assign m itemT + (A.SubscriptedVariable m sub destV) m' + (A.ExprVariable m' + (A.SubscriptedVariable m' sub srcV)) + return $ A.Rep m rep $ A.OnlyP m inner + A.Record _ -> + -- Record assignments become a sequence of + -- assignments, one for each field. + do + fs <- recordFields m t + assigns <- + sequence [do let sub = A.SubscriptField m fName + assign m fType + (A.SubscriptedVariable m sub destV) m' + (A.ExprVariable m' + (A.SubscriptedVariable m' sub srcV)) + | (fName, fType) <- fs] + return $ A.Several m $ map (A.OnlyP m) assigns + + return $ A.Seq m $ A.Spec m src $ A.Spec m dest body + diff --git a/testcases/assign-array.occ b/testcases/assign-array.occ index afb682b..39a9271 100644 --- a/testcases/assign-array.occ +++ b/testcases/assign-array.occ @@ -1,6 +1,12 @@ PROC P () VAL size IS 32: - [100]BYTE src: - [32]BYTE dest: - dest := [src FROM 0 FOR size] + [100]INT src: + [32]INT dest: + SEQ + SEQ i = 0 FOR SIZE src + src[i] := i + dest := [src FROM 0 FOR size] + ASSERT ((SIZE dest) = size) + SEQ i = 0 FOR size + ASSERT (dest[i] = i) : diff --git a/testcases/assign-record.occ b/testcases/assign-record.occ new file mode 100644 index 0000000..0717f28 --- /dev/null +++ b/testcases/assign-record.occ @@ -0,0 +1,15 @@ +PROC P () + DATA TYPE FOO + RECORD + INT a: + BYTE b: + REAL32 c: + : + VAL FOO src IS [111, 222, 333.3]: + FOO dest: + SEQ + dest := src + ASSERT (dest[a] = src[a]) + ASSERT (dest[b] = src[b]) + ASSERT (dest[c] = src[c]) +: