Commits

ysulsky committed 9facc56 Merge

merge

  • Participants
  • Parent commits 2fc6648, c0e9df7

Comments (0)

Files changed (9)

.hgignore

File contents unchanged.

base/core/lib/error.ml

 
 let failwiths message a sexp_of_a = raise (create message a sexp_of_a)
 
+let pp ppf t = Format.fprintf ppf "\"%s\"" (to_string_hum t)
+let () = Pretty_printer.register "Core.Error.pp"
+
 TEST_MODULE "error" = struct
   TEST = to_string_hum (tag (of_string "b") "a") = "a: b"
   TEST = to_string_hum (of_list (List.map ~f:of_string [ "a"; "b"; "c" ])) = "a; b; c"

base/core/lib/error.mli

 
     [failwiths s a f] = [Error.raise (Error.create s a f)] *)
 val failwiths : string -> 'a -> ('a -> Sexp.t) -> _
+
+val pp : Format.formatter -> t -> unit

base/core/lib/exn.ml

 
 let protect ~f ~finally = protectx ~f () ~finally
 
-let pp ppf t = Sexp.pp_hum ppf (sexp_of_exn t)
+let pp ppf t =
+  match sexp_of_exn_opt t with
+  | Some sexp -> Sexp.pp_hum ppf sexp
+  | None -> Format.fprintf ppf "%s" (Printexc.to_string t)
 
 let backtrace = Printexc.get_backtrace
 

base/core/lib/zone.ml

 let digest zone = zone.file_digest
 
 let name zone = zone.name
+
+let pp ppf t = Format.fprintf ppf "%s" (name t)
+let () = Pretty_printer.register "Core.Zone.pp"
+

base/core/lib/zone.mli

    is not intended to be called by most client code.  Use the high level functions
    provided in Time instead. *)
 val shift_epoch_time : t -> [`Local | `UTC] -> float -> float
+
+val pp : Format.formatter -> t -> unit
+

base/core/oasis.sh

                       unix,
                       threads
 
+Library core_top
+  Path:               top
+  FindlibName:        top
+  FindlibParent:      core
+  Modules:            Install_printers
+  XMETARequires:      core
+  XMETADescription:   Toplevel printers for Core
+
 Executable test_runner
   Path:               lib_test
   MainIs:             test_runner.ml

base/core/top/core_top.mllib

+# OASIS_START
+# DO NOT EDIT (digest: c726c3185ff615847530490542668c8b)
+Install_printers
+# OASIS_STOP

base/core/top/install_printers.ml

+open Core.Std
+
+let printers = Pretty_printer.all ()
+
+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 () =
+  if not (install_printers printers) then
+    Format.eprintf "Problem installing Core-printers@."