Fix more display differences between ocamlnat/ocaml (#10849)

Unites the toplevels still further. Previously, the native toplevel
did not display output for:

  let _ : <type> = <expr>

and related cases. The `match` for wildcard bindings is now
shared between bytecode and native, so the native toplevel
should always display values when the bytecode would.

(cherry picked from commit c8730ee)

.depend

@@ -6270,6 +6270,7 @@ toplevel/genprintval.cmi : \
     typing/outcometree.cmi \
     typing/env.cmi
 toplevel/topcommon.cmo : \
+    typing/typedtree.cmi \
     parsing/printast.cmi \
     typing/predef.cmi \
     parsing/pprintast.cmi \
@@ -6292,9 +6293,11 @@ toplevel/topcommon.cmo : \
     driver/compmisc.cmi \
     driver/compenv.cmi \
     utils/clflags.cmi \
+    parsing/asttypes.cmi \
     parsing/ast_helper.cmi \
     toplevel/topcommon.cmi
 toplevel/topcommon.cmx : \
+    typing/typedtree.cmx \
     parsing/printast.cmx \
     typing/predef.cmx \
     parsing/pprintast.cmx \
@@ -6317,11 +6320,13 @@ toplevel/topcommon.cmx : \
     driver/compmisc.cmx \
     driver/compenv.cmx \
     utils/clflags.cmx \
+    parsing/asttypes.cmi \
     parsing/ast_helper.cmx \
     toplevel/topcommon.cmi
 toplevel/topcommon.cmi : \
     utils/warnings.cmi \
     typing/types.cmi \
+    typing/typedtree.cmi \
     typing/path.cmi \
     parsing/parsetree.cmi \
     typing/outcometree.cmi \
@@ -6468,7 +6473,6 @@ toplevel/byte/topeval.cmo : \
     file_formats/cmo_format.cmi \
     utils/clflags.cmi \
     bytecomp/bytegen.cmi \
-    parsing/asttypes.cmi \
     toplevel/byte/topeval.cmi
 toplevel/byte/topeval.cmx : \
     utils/warnings.cmx \
@@ -6504,7 +6508,6 @@ toplevel/byte/topeval.cmx : \
     file_formats/cmo_format.cmi \
     utils/clflags.cmx \
     bytecomp/bytegen.cmx \
-    parsing/asttypes.cmi \
     toplevel/byte/topeval.cmi
 toplevel/byte/topeval.cmi : \
     toplevel/topcommon.cmi \
@@ -6605,7 +6608,6 @@ toplevel/native/topeval.cmo : \
     driver/compmisc.cmi \
     middle_end/compilenv.cmi \
     utils/clflags.cmi \
-    parsing/asttypes.cmi \
     asmcomp/asmlink.cmi \
     toplevel/native/topeval.cmi
 toplevel/native/topeval.cmx : \
@@ -6636,7 +6638,6 @@ toplevel/native/topeval.cmx : \
     driver/compmisc.cmx \
     middle_end/compilenv.cmx \
     utils/clflags.cmx \
-    parsing/asttypes.cmi \
     asmcomp/asmlink.cmx \
     toplevel/native/topeval.cmi
 toplevel/native/topeval.cmi : \

Changes

@@ -424,6 +424,10 @@ OCaml 4.14.0
 - #10822, #10823: Bad interaction between ambivalent types and subtyping
   coercions (Jacques Garrigue, report and review by Frédéric Bour)
 
+- #10849: Display the result of `let _ : <type> = <expr>` in the native
+  toplevel, as in the bytecode toplevel.
+  (David Allsopp, report by Nathan Rebours, review by Gabriel Scherer)
+
 
 OCaml 4.13 maintenance branch
 -----------------------------

testsuite/tests/tool-toplevel/pr10712.compilers.reference → testsuite/tests/tool-toplevel/topeval.compilers.reference

@@ -2,4 +2,9 @@ module A :
   sig type ('foo, 'bar) t val get_foo : ('foo, 'a) t -> 'foo option end
 - : ('foo, 'a) A.t -> 'foo option = <fun>
 val _bar : ('a, 'b) A.t -> 'a option = <fun>
+- : int = 42
+- : bool = false
+- : string = ""
+- : char = 'd'
+- : float = 42.
 

testsuite/tests/tool-toplevel/pr10712.ml → testsuite/tests/tool-toplevel/topeval.ml

@@ -3,6 +3,10 @@
    * toplevel.opt
 *)
 
+(* Various test-cases ensuring that the native and bytecode toplevels produce
+   the same output *)
+
+(* PR 10712 *)
 module A : sig
   type ('foo, 'bar) t
 
@@ -25,3 +29,19 @@ A.get_foo
 (* Type variables be 'a and 'b (original names lost in let-binding) *)
 let _bar = A.get_foo
 ;;
+
+(* PR 10849 *)
+let _ : int = 42
+;;
+
+let (_ : bool) : bool = false
+;;
+
+let List.(_) = ""
+;;
+
+let List.(String.(_)) = 'd'
+;;
+
+let List.(_) : float = 42.0
+;;

toplevel/byte/topeval.ml

@@ -135,23 +135,14 @@ let execute_phrase print_outcome ppf phr =
               if print_outcome then
                 Printtyp.wrap_printing_env ~error:false oldenv (fun () ->
                   match str.str_items with
-                  | [ { str_desc =
-                          (Tstr_eval (exp, _)
-                          |Tstr_value
-                              (Asttypes.Nonrecursive,
-                               [{vb_pat = {pat_desc=Tpat_any};
-                                 vb_expr = exp}
-                               ]
-                              )
-                          )
-                      }
-                    ] ->
-                      let outv = outval_of_value newenv v exp.exp_type in
-                      let ty = Printtyp.tree_of_type_scheme exp.exp_type in
-                      Ophr_eval (outv, ty)
-
                   | [] -> Ophr_signature []
-                  | _ -> Ophr_signature (pr_item oldenv sg'))
+                  | _ ->
+                      match find_eval_phrase str with
+                      | Some (exp, _, _) ->
+                        let outv = outval_of_value newenv v exp.exp_type in
+                        let ty = Printtyp.tree_of_type_scheme exp.exp_type in
+                        Ophr_eval (outv, ty)
+                      | None -> Ophr_signature (pr_item oldenv sg'))
               else Ophr_signature []
           | Exception exn ->
               toplevel_env := oldenv;

toplevel/native/topeval.ml

@@ -181,21 +181,13 @@ let execute_phrase print_outcome ppf phr =
          bytecode and native toplevels always type-check _exactly_ the same
          expression. Adding the binding at the parsetree level (before typing)
          can create observable differences (e.g. in type variable names, see
-         tool-toplevel/pr10712.ml in the testsuite) *)
+         tool-toplevel/topeval.ml in the testsuite) *)
       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 }
-           ] ->
+         match find_eval_phrase str with
+         | Some (e, attrs, loc) ->
              let str, sg' = name_expression ~loc ~attrs e in
              str, sg', true
-         | _ -> str, sg', false
+         | None -> str, sg', false
       in
       let module_ident, res, required_globals, size =
         if Config.flambda then

toplevel/topcommon.ml

@@ -64,6 +64,18 @@ let print_out_sig_item = Oprint.out_sig_item
 let print_out_signature = Oprint.out_signature
 let print_out_phrase = Oprint.out_phrase
 
+let find_eval_phrase str =
+  let open Typedtree in
+  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; _ }
+                                 ; vb_attributes = attrs }])
+      ; str_loc = loc }
+    ] ->
+      Some (e, attrs, loc)
+  | _ -> None
 
 (* The current typing environment for the toplevel *)
 

toplevel/topcommon.mli

@@ -46,6 +46,10 @@ val record_backtrace : unit -> unit
 
 (* Printing of values *)
 
+val find_eval_phrase :
+  Typedtree.structure ->
+    (Typedtree.expression * Typedtree.attributes * Location.t) option
+
 val max_printer_depth: int ref
 val max_printer_steps: int ref