From 98961c933588a7e9f8330c184336cad9fecb5982 Mon Sep 17 00:00:00 2001
From: James Deikun <james.deikun@obsidian.systems>
Date: Mon, 11 Jun 2018 15:05:33 -0400
Subject: [PATCH] semantic logging in lib_base

AMENDED: Syn has always been DSL, Semantic has always been
Make_semantic.
---
 src/lib_base/base_logging.ml  | 11 ++++++++++-
 src/lib_base/base_logging.mli |  5 ++++-
 src/lib_base/lwt_exit.ml      | 21 +++++++--------------
 3 files changed, 21 insertions(+), 16 deletions(-)

diff --git a/src/lib_base/base_logging.ml b/src/lib_base/base_logging.ml
index 6fe5143f1..758c521de 100644
--- a/src/lib_base/base_logging.ml
+++ b/src/lib_base/base_logging.ml
@@ -7,4 +7,13 @@
 (*                                                                        *)
 (**************************************************************************)
 
-include Tezos_stdlib.Logging.Make(struct let name = "base" end)
+include Tezos_stdlib.Logging.Make_semantic(struct let name = "base" end)
+
+let pp_exn_trace ppf backtrace =
+  if String.length backtrace <> 0 then
+    Format.fprintf ppf
+      "@,Backtrace:@,  @[<h>%a@]"
+      Format.pp_print_text backtrace
+
+let pid = Tag.def ~doc:"unix process ID where problem occurred" "pid" Format.pp_print_int
+let exn_trace = Tag.def ~doc:"backtrace from native Ocaml exception" "exn_trace" pp_exn_trace
diff --git a/src/lib_base/base_logging.mli b/src/lib_base/base_logging.mli
index 79bef502a..52a68790c 100644
--- a/src/lib_base/base_logging.mli
+++ b/src/lib_base/base_logging.mli
@@ -7,4 +7,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
-include Tezos_stdlib.Logging.LOG
+include Tezos_stdlib.Logging.SEMLOG
+
+val pid : int Tag.def
+val exn_trace : string Tag.def
diff --git a/src/lib_base/lwt_exit.ml b/src/lib_base/lwt_exit.ml
index f6974881c..fdb08ebaf 100644
--- a/src/lib_base/lwt_exit.ml
+++ b/src/lib_base/lwt_exit.ml
@@ -16,19 +16,12 @@ let () =
   Lwt.async_exception_hook :=
     (function
       | Exit -> ()
-      | exn ->
+      | e ->
           let backtrace = Printexc.get_backtrace () in
-          Base_logging.fatal_error "@[<v 2>%a%a@]"
-            (fun ppf exn ->
-               Format.fprintf ppf
-                 "@[Uncaught (asynchronous) exception (%d):@ %a@]"
-                 (Unix.getpid ())
-                 Error_monad.pp_exn exn)
-            exn
-            (fun ppf backtrace ->
-               if String.length backtrace <> 0 then
-                 Format.fprintf ppf
-                   "@,Backtrace:@,  @[<h>%a@]"
-                   Format.pp_print_text backtrace)
-            backtrace ;
+          Base_logging.(fatal_error Tag.DSL.(fun f ->
+              f "@[<v 2>@[Uncaught (asynchronous) exception (%d):@ %a@]%a@]"
+              -% t event "uncaught_async_exception"
+              -% s pid (Unix.getpid ())
+              -% a exn e
+              -% a exn_trace backtrace)) ;
           Lwt.wakeup exit_wakener 1)