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

@@ -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

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 _ ->

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
+

testcases/assign-array.occ

@@ -1,6 +1,12 @@
 PROC P ()
   VAL size IS 32:
-  [100]BYTE src:
-  [32]BYTE dest:
+  [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)
 :

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])
+: