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.
This commit is contained in:
parent
15a8f95647
commit
51ecf04a90
|
@ -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
|
||||
|
|
|
@ -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 _ ->
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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)
|
||||
:
|
||||
|
|
15
testcases/assign-record.occ
Normal file
15
testcases/assign-record.occ
Normal file
|
@ -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])
|
||||
:
|
Loading…
Reference in New Issue
Block a user