Small polishing following PR #10124 (#10175)

- Toplevel factorisation: simplify MakePrinter functor
- Re-add a discrimination string to the native toplevel header

  It seemed cleaner and safer to add the string to the specific module
  used rather than trivially rely on `Sys.backend_type`. The string is
  left empty for the bytecode toplevel, to avoid a visible change from the
  current version.

testsuite/tests/tool-toplevel/pr6468.compilers.reference

@@ -10,5 +10,5 @@ Raised at f in file "//toplevel//", line 2, characters 11-26
 Called from g in file "//toplevel//", line 1, characters 11-15
 Called from Stdlib__fun.protect in file "fun.ml", line 33, characters 8-15
 Re-raised at Stdlib__fun.protect in file "fun.ml", line 38, characters 6-52
-Called from Topeval.load_lambda in file "toplevel/byte/topeval.ml", line 112, characters 4-150
+Called from Topeval.load_lambda in file "toplevel/byte/topeval.ml", line 114, characters 4-150
 

toplevel/byte/topeval.ml

@@ -37,6 +37,8 @@ let getvalue name =
 let setvalue name v =
   toplevel_value_bindings := String.Map.add name v !toplevel_value_bindings
 
+let implementation_label = ""
+
 (* Return the value referred to by a path *)
 
 let rec eval_address = function
@@ -81,7 +83,7 @@ module EvalPath = struct
   let same_value v1 v2 = (v1 == v2)
 end
 
-include Topcommon.MakePrinter(Obj)(Genprintval.Make(Obj)(EvalPath))
+include Topcommon.MakePrinter(Genprintval.Make(Obj)(EvalPath))
 
 
 (* Load in-core and execute a lambda term *)

toplevel/native/topeval.ml

@@ -32,6 +32,8 @@ let _dummy = (Ok (Obj.magic 0), Err "")
 external ndl_run_toplevel: string -> string -> res
   = "caml_natdynlink_run_toplevel"
 
+let implementation_label = "native toplevel"
+
 let global_symbol id =
   let sym = Compilenv.symbol_for_global id in
   match Dynlink.unsafe_get_global_value ~bytecode_or_asm_symbol:sym with
@@ -125,7 +127,7 @@ module EvalPath = struct
   let same_value v1 v2 = (v1 == v2)
 end
 
-include Topcommon.MakePrinter(Obj)(Genprintval.Make(Obj)(EvalPath))
+include Topcommon.MakePrinter(Genprintval.Make(Obj)(EvalPath))
 
 (* Load in-core and execute a lambda term *)
 

toplevel/topcommon.ml

@@ -75,7 +75,7 @@ let backtrace = ref None
 
 module type PRINTER = sig
 
-  module Printer: Genprintval.S
+  module Printer: Genprintval.S with type t = Obj.t
 
   val print_value: Env.t -> Printer.t -> formatter -> Types.type_expr -> unit
   val print_untyped_exception: formatter -> Printer.t -> unit
@@ -103,9 +103,8 @@ module type PRINTER = sig
 end
 
 module MakePrinter
-    (O: Genprintval.OBJ)
-    (Printer: Genprintval.S with type t = O.t)
-  : PRINTER with type Printer.t = O.t
+    (Printer: Genprintval.S with type t = Obj.t)
+  : PRINTER
 = struct
 
   module Printer = Printer
@@ -125,7 +124,7 @@ module MakePrinter
 
   let print_exception_outcome ppf exn =
     if exn = Out_of_memory then Gc.full_major ();
-    let outv = outval_of_value !toplevel_env (O.repr exn) Predef.type_exn in
+    let outv = outval_of_value !toplevel_env (Obj.repr exn) Predef.type_exn in
     print_out_exception ppf exn outv;
     if Printexc.backtrace_status ()
     then

toplevel/topcommon.mli

@@ -68,7 +68,7 @@ val print_out_phrase :
 
 module type PRINTER = sig
 
-  module Printer: Genprintval.S
+  module Printer: Genprintval.S with type t = Obj.t
 
   val print_value: Env.t -> Printer.t -> formatter -> Types.type_expr -> unit
 
@@ -97,9 +97,8 @@ module type PRINTER = sig
 
 end
 
-module MakePrinter (O : Genprintval.OBJ) (P : Genprintval.S with type t = O.t):
+module MakePrinter (P : Genprintval.S with type t = Obj.t):
   PRINTER with module Printer = P
-           and type Printer.t = O.t
 
 (* Interface with toplevel directives *)
 

toplevel/topeval.mli

@@ -32,6 +32,9 @@ open Format
 val getvalue : string -> Obj.t
 val setvalue : string -> Obj.t -> unit
 
+(* Label appended after [OCaml version XXX] when starting the toplevel. *)
+val implementation_label: string
+
 val execute_phrase : bool -> formatter -> Parsetree.toplevel_phrase -> bool
         (* Read and execute commands from a file.
            [use_file] prints the types and values of the results.

toplevel/toploop.ml

@@ -167,7 +167,10 @@ let loop ppf =
   Clflags.debug := true;
   Location.formatter_for_warnings := ppf;
   if not !Clflags.noversion then
-    fprintf ppf "        OCaml version %s@.@." Config.version;
+    fprintf ppf "        OCaml version %s%s%s@.@."
+      Config.version
+      (if Topeval.implementation_label = "" then "" else " - ")
+      Topeval.implementation_label;
   begin
     try initialize_toplevel_env ()
     with Env.Error _ | Typetexp.Error _ as exn ->