IR: don't create unnecessary variable renaming for the sake of `NewOb…

…jE` (#4645)

This reapplies #4611 without changes (that were previously) necessary to the interpreter and IR checker. PR #4611 had to be backed out due to changed behaviour w.r.t. mutable variables: #4623.

### From #4611:

`NewObjE` wants variable names for field values. When the expression is _already a variable_ then just reuse its name!

Also, if we managed to eliminate all necessary variable (re-)bindings, then the enclosing new scope (`BlockE`) is redundant.

By generating less IR we speed up compilation, and potentially create opportunities for further simplifications.

Another positive is that reading the IR (`-dl` flag) becomes less convoluted.

_Note_: Since the IR recently has been taught to track whether the read is from an immutable or from a mutable variable, we can now observe renaming of immutable variables and eliminate only those.

src/ir_def/arrange_ir.ml

@@ -13,7 +13,7 @@ let prim_ty p = typ (Type.Prim p)
 let kind k = Atom (Type.string_of_kind k)
 
 let rec exp e = match e.it with
-  | VarE (_, i)         -> "VarE"    $$ [id i] (* FIXME: EXPOSE *)
+  | VarE (m, i)         -> (if m = Var then "VarE!" else "VarE") $$ [id i]
   | LitE l              -> "LitE"    $$ [lit l]
   | PrimE (p, es)       -> "PrimE"   $$ [prim p] @ List.map exp es
   | AssignE (le1, e2)   -> "AssignE" $$ [lexp le1; exp e2]

src/ir_def/construct.ml

@@ -670,7 +670,7 @@ let (-->*) xs exp =
   nary_funcE "$lambda" fun_ty xs exp
 
 let close_typ_binds cs tbs =
-  List.map (fun {it = {con; sort; bound}; _} -> {T.var = Cons.name con; sort=sort; bound = T.close cs bound}) tbs
+  List.map (fun {it = {con; sort; bound}; _} -> {T.var = Cons.name con; sort; bound = T.close cs bound}) tbs
 
 (* polymorphic, n-ary local lambda *)
 let forall tbs e =
@@ -766,23 +766,26 @@ let unreachableE () =
   loopE (unitE ())
 
 let objE sort typ_flds flds =
-  let rec go ds fields fld_tys flds =
-    match flds with
+  let rec go ds fields fld_tys = function
     | [] ->
       blockE
         (List.rev ds)
         (newObjE sort fields
            (T.obj sort
-              ((List.map (fun (id,c) -> (id, T.Typ c)) typ_flds)
+              (List.map (fun (id, c) -> (id, T.Typ c)) typ_flds
                @ fld_tys)))
     | (lab, exp)::flds ->
-      let v = fresh_var lab (typ exp) in
+      let v, ds = match exp.it with
+        | VarE (Const, v) -> var v (typ exp), ds
+        | _ ->
+          let v = fresh_var lab (typ exp) in
+          v, letD v exp :: ds in
       let field = {
         it = {name = lab; var = id_of_var v};
         at = no_region;
         note = typ exp
       } in
-      go ((letD v exp)::ds) (field::fields) ((lab, typ exp)::fld_tys) flds
+      go ds (field::fields) ((lab, typ exp)::fld_tys) flds
   in
   go [] [] [] flds
 

src/lowering/desugar.ml

@@ -661,17 +661,19 @@ and exp_field obj_typ ef =
     let id' = fresh_var id.it typ in
     let d = varD id' (exp e) in
     let f = { it = I.{ name = id.it; var = id_of_var id' }; at = no_region; note = typ } in
-    (d, f)
+    ([d], f)
   | S.Const ->
     let typ = match T.lookup_val_field_opt id.it fts with
       | Some typ -> typ
       | None -> e.note.S.note_typ
     in
     assert (not (T.is_mut typ));
-    let id' = fresh_var id.it typ in
-    let d = letD id' (exp e) in
+    let e = exp e in
+    let id', ds = match e.it with
+    | I.(VarE (Const, v)) -> var v typ, []
+    | _ -> let id' = fresh_var id.it typ in id', [letD id' e] in
     let f = { it = I.{ name = id.it; var = id_of_var id' }; at = no_region; note = typ } in
-    (d, f)
+    (ds, f)
 
 and obj obj_typ efs bases =
   let open List in
@@ -700,10 +702,11 @@ and obj obj_typ efs bases =
         let f = { it = I.{ name = lab; var = id_of_var id }; at = no_region; note = typ } in
         [d, f] in
 
-  let ds, fs = map (exp_field obj_typ) efs |> split in
+  let dss, fs = map (exp_field obj_typ) efs |> split in
   let ds', fs' = concat_map gap (T.as_obj obj_typ |> snd) |> split in
   let obj_e = newObjE T.Object (append fs fs') obj_typ in
-  I.BlockE(append base_decs (append ds ds'), obj_e)
+  let decs = append base_decs (append (flatten dss) ds') in
+  (blockE decs obj_e).it
 
 and typ_binds tbs = List.map typ_bind tbs