Fix printer installation for non-utop toplevels

src/unsigned.mli

@@ -136,7 +136,7 @@ module type S = sig
   (** Convert the given string to an unsigned integer. Returns [None] if the
       given string is not a valid representation of an unsigned integer. *)
 
-  val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer]
+  val pp : Format.formatter -> t -> unit
   (** Output the result of {!to_string} on a formatter. *)
 
   val pp_hex : Format.formatter -> t -> unit

top/dune

@@ -2,7 +2,5 @@
  (name integers_top)
  (public_name integers.top)
  (modes byte)
- (modules Integer_printers)
- (wrapped false)
  (synopsis "toplevel pretty printers")
  (libraries integers compiler-libs))

top/install_integer_printers.ml

@@ -1,32 +1,40 @@
 (* Adapted from Anil Madhavapeddy's ocaml-uri package. *)
 
-let _ = Integer_printers.format_sint
-
-let printers = [ "Integer_printers.format_sint";
-                 "Integer_printers.format_long";
-                 "Integer_printers.format_llong";
-                 "Integer_printers.format_uchar";
-                 "Integer_printers.format_uint8";
-                 "Integer_printers.format_uint16";
-                 "Integer_printers.format_uint32";
-                 "Integer_printers.format_uint64";
-                 "Integer_printers.format_ushort";
-                 "Integer_printers.format_uint";
-                 "Integer_printers.format_ulong";
-                 "Integer_printers.format_ullong";]
+let printers = [ "fun fmt v -> Format.fprintf fmt \"<sint %s>\" (Signed.SInt.to_string v)";
+                 "fun fmt v -> Format.fprintf fmt \"<long %s>\" (Signed.Long.to_string v)";
+                 "fun fmt v -> Format.fprintf fmt \"<llong %s>\" (Signed.LLong.to_string v)";
+                 "fun fmt v -> Format.fprintf fmt \"<uchar %s>\" (Unsigned.UChar.to_string v)";
+                 "fun fmt v -> Format.fprintf fmt \"<uint8 %s>\" (Unsigned.UInt8.to_string v)";
+                 "fun fmt v -> Format.fprintf fmt \"<uint16 %s>\" (Unsigned.UInt16.to_string v)";
+                 "fun fmt v -> Format.fprintf fmt \"<uint32 %s>\" (Unsigned.UInt32.to_string v)";
+                 "fun fmt v -> Format.fprintf fmt \"<uint64 %s>\" (Unsigned.UInt64.to_string v)";
+                 "fun fmt v -> Format.fprintf fmt \"<ushort %s>\" (Unsigned.UShort.to_string v)";
+                 "fun fmt v -> Format.fprintf fmt \"<uint %s>\" (Unsigned.UInt.to_string v)";
+                 "fun fmt v -> Format.fprintf fmt \"<ulong %s>\" (Unsigned.ULong.to_string v)";
+                 "fun fmt v -> Format.fprintf fmt \"<ullong %s>\" (Unsigned.ULLong.to_string v)";]
 
 let eval_string
       ?(print_outcome = false) ?(err_formatter = Format.err_formatter) str =
   let lexbuf = Lexing.from_string str in
   let phrase = !Toploop.parse_toplevel_phrase lexbuf in
   Toploop.execute_phrase print_outcome err_formatter phrase
 
-let rec install_printers = function
-  | [] -> true
-  | printer :: printers ->
-      let cmd = Printf.sprintf "#install_printer %s;;" printer in
-      eval_string cmd && install_printers printers
+let install_printer printer =
+  begin
+    ignore (eval_string (Printf.sprintf "let _printer = %s;;" printer));
+    ignore (eval_string (Printf.sprintf "#install_printer _printer;;"));
+  end
+
+let is_utop () =
+  Hashtbl.mem Toploop.directive_table "utop_help" [@@ocaml.warning "-3"]
 
 let () =
-  if not (install_printers printers) then
-    Format.eprintf "Problem installing integer-printers@."
+  (* Preload the toplevel environment and integers library if we are in utop.
+     This is done to ensure the required modules are in scope before the
+     printers are installed, as dune will not do this automatically. *)
+  if is_utop () then begin
+    Toploop.initialize_toplevel_env ();
+    ignore (eval_string "#require \"integers\";;");
+  end;
+
+  List.iter install_printer printers