1 files changed, 179 insertions, 0 deletions
diff --git a/compiler/Logging.ml b/compiler/Logging.ml
new file mode 100644
index 00000000..e83f25f8
--- /dev/null
+++ b/compiler/Logging.ml
@@ -0,0 +1,179 @@
+module H = Easy_logging.Handlers
+module L = Easy_logging.Logging
+
+let _ = L.make_logger "MainLogger" Debug [ Cli Debug ]
+
+(** The main logger *)
+let main_log = L.get_logger "MainLogger"
+
+(** Below, we create subgloggers for various submodules, so that we can precisely
+    toggle logging on/off, depending on which information we need *)
+
+(** Logger for LlbcOfJson *)
+let llbc_of_json_logger = L.get_logger "MainLogger.LlbcOfJson"
+
+(** Logger for PrePasses *)
+let pre_passes_log = L.get_logger "MainLogger.PrePasses"
+
+(** Logger for Translate *)
+let translate_log = L.get_logger "MainLogger.Translate"
+
+(** Logger for PureUtils *)
+let pure_utils_log = L.get_logger "MainLogger.PureUtils"
+
+(** Logger for SymbolicToPure *)
+let symbolic_to_pure_log = L.get_logger "MainLogger.SymbolicToPure"
+
+(** Logger for PureMicroPasses *)
+let pure_micro_passes_log = L.get_logger "MainLogger.PureMicroPasses"
+
+(** Logger for PureToExtract *)
+let pure_to_extract_log = L.get_logger "MainLogger.PureToExtract"
+
+(** Logger for Interpreter *)
+let interpreter_log = L.get_logger "MainLogger.Interpreter"
+
+(** Logger for InterpreterStatements *)
+let statements_log = L.get_logger "MainLogger.Interpreter.Statements"
+
+(** Logger for InterpreterExpressions *)
+let expressions_log = L.get_logger "MainLogger.Interpreter.Expressions"
+
+(** Logger for InterpreterPaths *)
+let paths_log = L.get_logger "MainLogger.Interpreter.Paths"
+
+(** Logger for InterpreterExpansion *)
+let expansion_log = L.get_logger "MainLogger.Interpreter.Expansion"
+
+(** Logger for InterpreterBorrows *)
+let borrows_log = L.get_logger "MainLogger.Interpreter.Borrows"
+
+(** Logger for Invariants *)
+let invariants_log = L.get_logger "MainLogger.Interpreter.Invariants"
+
+(** Terminal colors - TODO: comes from easy_logging (did not manage to reuse the module directly) *)
+type color =
+  | Default
+  | Black
+  | Red
+  | Green
+  | Yellow
+  | Blue
+  | Magenta
+  | Cyan
+  | Gray
+  | White
+  | LRed
+  | LGreen
+  | LYellow
+  | LBlue
+  | LMagenta
+  | LCyan
+  | LGray
+
+(** Terminal styles - TODO: comes from easy_logging (did not manage to reuse the module directly) *)
+type format = Bold | Underline | Invert | Fg of color | Bg of color
+
+(** TODO: comes from easy_logging (did not manage to reuse the module directly) *)
+let to_fg_code c =
+  match c with
+  | Default -> 39
+  | Black -> 30
+  | Red -> 31
+  | Green -> 32
+  | Yellow -> 33
+  | Blue -> 34
+  | Magenta -> 35
+  | Cyan -> 36
+  | Gray -> 90
+  | White -> 97
+  | LRed -> 91
+  | LGreen -> 92
+  | LYellow -> 93
+  | LBlue -> 94
+  | LMagenta -> 95
+  | LCyan -> 96
+  | LGray -> 37
+
+(** TODO: comes from easy_logging (did not manage to reuse the module directly) *)
+let to_bg_code c =
+  match c with
+  | Default -> 49
+  | Black -> 40
+  | Red -> 41
+  | Green -> 42
+  | Yellow -> 43
+  | Blue -> 44
+  | Magenta -> 45
+  | Cyan -> 46
+  | Gray -> 100
+  | White -> 107
+  | LRed -> 101
+  | LGreen -> 102
+  | LYellow -> 103
+  | LBlue -> 104
+  | LMagenta -> 105
+  | LCyan -> 106
+  | LGray -> 47
+
+(** TODO: comes from easy_logging (did not manage to reuse the module directly) *)
+let style_to_codes s =
+  match s with
+  | Bold -> (1, 21)
+  | Underline -> (4, 24)
+  | Invert -> (7, 27)
+  | Fg c -> (to_fg_code c, to_fg_code Default)
+  | Bg c -> (to_bg_code c, to_bg_code Default)
+
+(** TODO: comes from easy_logging (did not manage to reuse the module directly)
+    I made a minor modifications, though. *)
+let level_to_color (lvl : L.level) =
+  match lvl with
+  | L.Flash -> LMagenta
+  | Error -> LRed
+  | Warning -> LYellow
+  | Info -> LGreen
+  | Trace -> Cyan
+  | Debug -> LBlue
+  | NoLevel -> Default
+
+(** [format styles str] formats [str] to the given [styles] -
+    TODO: comes from {{: http://ocamlverse.net/content/documentation_guidelines.html}[easy_logging]}
+    (did not manage to reuse the module directly)
+*)
+let rec format styles str =
+  match styles with
+  | (_ as s) :: styles' ->
+      let set, reset = style_to_codes s in
+      Printf.sprintf "\027[%dm%s\027[%dm" set (format styles' str) reset
+  | [] -> str
+
+(** TODO: comes from {{: http://ocamlverse.net/content/documentation_guidelines.html}[easy_logging]}
+    (did not manage to reuse the module directly) *)
+let format_tags (tags : string list) =
+  match tags with
+  | [] -> ""
+  | _ ->
+      let elems_str = String.concat " | " tags in
+      "[" ^ elems_str ^ "] "
+
+(* Change the formatters *)
+let main_logger_handler =
+  (* TODO: comes from easy_logging *)
+  let formatter (item : L.log_item) : string =
+    let item_level_fmt =
+      format [ Fg (level_to_color item.level) ] (L.show_level item.level)
+    and item_msg_fmt =
+      match item.level with
+      | Flash -> format [ Fg Black; Bg LMagenta ] item.msg
+      | _ -> item.msg
+    in
+
+    Format.pp_set_max_indent Format.str_formatter 200;
+    Format.sprintf "@[[%-15s] %s%s@]" item_level_fmt (format_tags item.tags)
+      item_msg_fmt
+  in
+  (* There should be exactly one handler *)
+  let handlers = main_log#get_handlers in
+  List.iter (fun h -> H.set_formatter h formatter) handlers;
+  match handlers with [ handler ] -> handler | _ -> failwith "Unexpected"