Fix type variable naming in native toplevel

This was written by @lpw25 . It makes the native toplevel preserve type variable
names in the same way as the bytecode toplevel.

This patch was originally submitted to flambda-backend

Signed-off-by: Nathan Rebours <nathan.p.rebours@gmail.com>

.depend

@@ -6547,7 +6547,6 @@ toplevel/native/topeval.cmo : \
     utils/clflags.cmi \
     middle_end/backend_intf.cmi \
     parsing/asttypes.cmi \
-    parsing/ast_helper.cmi \
     asmcomp/asmlink.cmi \
     asmcomp/asmgen.cmi \
     asmcomp/arch.cmo \
@@ -6584,7 +6583,6 @@ toplevel/native/topeval.cmx : \
     utils/clflags.cmx \
     middle_end/backend_intf.cmi \
     parsing/asttypes.cmi \
-    parsing/ast_helper.cmx \
     asmcomp/asmlink.cmx \
     asmcomp/asmgen.cmx \
     asmcomp/arch.cmx \

Changes

@@ -330,6 +330,8 @@ Working version
   implementation of stat
   (Antonin Décimo, review by David Allsopp)
 
+- #10712: Fix type variable naming in native toplevel
+  (Leo White, review by ???)
 
 
 OCaml 4.13 maintenance branch

tools/.depend

@@ -156,6 +156,8 @@ ocamlmklib.cmo : \
 ocamlmklib.cmx : \
     ../utils/misc.cmx \
     ../utils/config.cmx
+ocamlmklibconfig.cmo :
+ocamlmklibconfig.cmx :
 ocamlmktop.cmo : \
     ../utils/config.cmi \
     ../utils/ccomp.cmi

toplevel/native/topeval.ml

@@ -191,6 +191,44 @@ let pr_item =
 
 (* Execute a toplevel phrase *)
 
+let name_expression ~loc ~attrs exp =
+  let name = "_$" in
+  let id = Ident.create_local name in
+  let vd =
+    { val_type = exp.exp_type;
+      val_kind = Val_reg;
+      val_loc = loc;
+      val_attributes = attrs;
+      val_uid = Uid.internal_not_actually_unique; }
+   in
+   let sg = [Sig_value(id, vd, Exported)] in
+   let pat =
+     { pat_desc = Tpat_var(id, mknoloc name);
+       pat_loc = loc;
+       pat_extra = [];
+       pat_type = exp.exp_type;
+       pat_env = exp.exp_env;
+       pat_attributes = []; }
+   in
+   let vb =
+     { vb_pat = pat;
+       vb_expr = exp;
+       vb_attributes = attrs;
+       vb_loc = loc; }
+   in
+   let item =
+     { str_desc = Tstr_value(Nonrecursive, [vb]);
+       str_loc = loc;
+       str_env = exp.exp_env; }
+   in
+   let final_env = Env.add_value id vd exp.exp_env in
+   let str =
+     { str_items = [item];
+       str_type = sg;
+       str_final_env = final_env }
+   in
+   str, sg
+
 let execute_phrase print_outcome ppf phr =
   match phr with
   | Ptop_def sstr ->
@@ -199,26 +237,26 @@ let execute_phrase print_outcome ppf phr =
       phrase_name := Printf.sprintf "TOP%i" !phrase_seqid;
       Compilenv.reset ?packname:None !phrase_name;
       Typecore.reset_delayed_checks ();
-      let sstr, rewritten =
-        match sstr with
-        | [ { pstr_desc = Pstr_eval (e, attrs) ; pstr_loc = loc } ]
-        | [ { pstr_desc = Pstr_value (Asttypes.Nonrecursive,
-                                      [{ pvb_expr = e
-                                       ; pvb_pat = { ppat_desc = Ppat_any ; _ }
-                                       ; pvb_attributes = attrs
-                                       ; _ }])
-            ; pstr_loc = loc }
-          ] ->
-            let pat = Ast_helper.Pat.var (Location.mknoloc "_$") in
-            let vb = Ast_helper.Vb.mk ~loc ~attrs pat e in
-            [ Ast_helper.Str.value ~loc Asttypes.Nonrecursive [vb] ], true
-        | _ -> sstr, false
-      in
       let (str, sg, names, newenv) = Typemod.type_toplevel_phrase oldenv sstr in
       if !Clflags.dump_typedtree then Printtyped.implementation ppf str;
       let sg' = Typemod.Signature_names.simplify newenv names sg in
       ignore (Includemod.signatures oldenv ~mark:Mark_positive sg sg');
       Typecore.force_delayed_checks ();
+      let str, sg', rewritten =
+         match str.str_items with
+         | [ { str_desc = Tstr_eval (e, attrs) ; str_loc = loc } ]
+         | [ { str_desc = Tstr_value (Asttypes.Nonrecursive,
+                                       [{ vb_expr = e
+                                        ; vb_pat =
+                                            { pat_desc = Tpat_any;
+                                              pat_extra = []; _ }
+                                        ; vb_attributes = attrs }])
+             ; str_loc = loc }
+           ] ->
+             let str, sg' = name_expression ~loc ~attrs e in
+             str, sg', true
+         | _ -> str, sg', false
+      in
       let module_ident, res, required_globals, size =
         if Config.flambda then
           let { Lambda.module_ident; main_module_block_size = size;