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
|
makeNonceProc m p
|
||||||
= defineNonce m "wrapper_proc" (A.Proc m A.PlainSpec [] p) A.ProcName A.Abbrev
|
= 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.
|
-- | Generate and define a variable abbreviation.
|
||||||
makeNonceIs :: CSM m => String -> Meta -> A.Type -> A.AbbrevMode -> A.Variable -> m A.Specification
|
makeNonceIs :: CSM m => String -> Meta -> A.Type -> A.AbbrevMode -> A.Variable -> m A.Specification
|
||||||
makeNonceIs s m t am v
|
makeNonceIs s m t am v
|
||||||
|
|
|
@ -1438,13 +1438,6 @@ cgenAssign ops m [v] el
|
||||||
doAssign t v e
|
doAssign t v e
|
||||||
where
|
where
|
||||||
doAssign :: A.Type -> A.Variable -> A.Expression -> CGen ()
|
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
|
doAssign t v e
|
||||||
= case call getScalarType ops t of
|
= case call getScalarType ops t of
|
||||||
Just _ ->
|
Just _ ->
|
||||||
|
|
|
@ -36,6 +36,7 @@ simplifyProcs = runPasses passes
|
||||||
passes =
|
passes =
|
||||||
[ ("Wrap PAR subprocesses in PROCs", parsToProcs)
|
[ ("Wrap PAR subprocesses in PROCs", parsToProcs)
|
||||||
, ("Remove parallel assignment", removeParAssign)
|
, ("Remove parallel assignment", removeParAssign)
|
||||||
|
, ("Flatten assignment", flattenAssign)
|
||||||
]
|
]
|
||||||
|
|
||||||
-- | Wrap the subprocesses of PARs in no-arg PROCs.
|
-- | 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
|
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
|
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 ()
|
PROC P ()
|
||||||
VAL size IS 32:
|
VAL size IS 32:
|
||||||
[100]BYTE src:
|
[100]INT src:
|
||||||
[32]BYTE dest:
|
[32]INT dest:
|
||||||
dest := [src FROM 0 FOR size]
|
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