[sledge] Remove base dep from ppx_trace

Reviewed By: jvillard

Differential Revision: D20322875

fbshipit-source-id: 8e7f15eaf

sledge/ppx_trace.opam

@@ -10,7 +10,6 @@ build: [
 ]
 depends: [
   "ocaml"
-  "base" {>= "v0.12.0"}
   "dune" {>= "1.11.3" build}
   "ppxlib"
 ]

sledge/ppx_trace/trace/dune

@@ -5,5 +5,4 @@
 
 (library
  (name trace)
- (public_name ppx_trace.trace)
+ (public_name ppx_trace.trace))
- (libraries base))

sledge/ppx_trace/trace/trace.ml

@@ -5,45 +5,63 @@
  * LICENSE file in the root directory of this source tree.
  *)
 
-module Char = Base.Char
+module Char = struct
-module List = Base.List
+  include Char
-module Map = Base.Map
+
-module Option = Base.Option
+  let is_lowercase = function 'a' .. 'z' -> true | _ -> false
-module String = Base.String
+  let is_uppercase = function 'A' .. 'Z' -> true | _ -> false
+end
+
+module String = struct
+  include StringLabels
+
+  let is_empty str = length str = 0
+
+  let lsplit2 str ~on =
+    match index_opt str on with
+    | Some pos ->
+        Some
+          ( sub str ~pos:0 ~len:pos
+          , sub str ~pos:(pos + 1) ~len:(length str - pos - 1) )
+    | None -> None
+
+  let subo ?(pos = 0) ?len str =
+    let len = match len with Some i -> i | None -> length str - pos in
+    sub str ~pos ~len
+end
+
+module Map = Map.Make (String)
 
 (** Debug trace logging *)
 
-type 'a printf = ('a, Format.formatter, unit) format -> 'a
+type ('a, 'b) fmt = ('a, Format.formatter, unit, 'b) format4
+type 'a printf = ('a, unit) fmt -> 'a
 type pf = {pf: 'a. 'a printf}
 
 let fs = Format.err_formatter
 let flush = Format.pp_print_newline fs
 
-type trace_mod_funs =
+type trace_mod_funs = {trace_mod: bool option; trace_funs: bool Map.t}
-  {trace_mod: bool option; trace_funs: bool Map.M(String).t}
+type trace_mods_funs = trace_mod_funs Map.t
-
-type trace_mods_funs = trace_mod_funs Map.M(String).t
 
 type config =
   {trace_all: bool; trace_mods_funs: trace_mods_funs; colors: bool}
 
-let none =
+let none = {trace_all= false; trace_mods_funs= Map.empty; colors= false}
-  { trace_all= false
-  ; trace_mods_funs= Map.empty (module String)
-  ; colors= false }
-
 let all = {none with trace_all= true}
-let config : config ref = ref none
+let config = ref none
 
 let parse s =
   try
     if String.equal s "*" then Ok all
     else
-      let default = Map.empty (module String) in
+      let default = Map.empty in
       let index_from s i =
-        Option.merge ~f:min
+        match
-          (String.index_from s i '+')
+          (String.index_from_opt s i '+', String.index_from_opt s i '-')
-          (String.index_from s i '-')
+        with
+        | None, o | o, None -> o
+        | Some m, Some n -> Some (min m n)
       in
       let rec split s rev_parts i =
         match index_from s (i + 1) with
@@ -54,7 +72,8 @@ let parse s =
       in
       let parts = split s [] 0 in
       let trace_mods_funs =
-        List.fold parts ~init:default ~f:(fun m part ->
+        List.fold_left
+          (fun m part ->
             let parse_part part =
               let sign, rest =
                 match part.[0] with
@@ -73,18 +92,18 @@ let parse s =
             match parse_part part with
             | mod_name, Some fun_name, enabled ->
                 let {trace_mod; trace_funs} =
-                  match Map.find m mod_name with
+                  try Map.find mod_name m
-                  | Some c -> c
+                  with Not_found -> {trace_mod= None; trace_funs= default}
-                  | None -> {trace_mod= None; trace_funs= default}
                 in
-                Map.set m ~key:mod_name
+                Map.add mod_name
-                  ~data:
+                  { trace_mod
-                    { trace_mod
+                  ; trace_funs= Map.add fun_name enabled trace_funs }
-                    ; trace_funs=
+                  m
-                        Map.set trace_funs ~key:fun_name ~data:enabled }
             | mod_name, None, enabled ->
-                Map.set m ~key:mod_name
+                Map.add mod_name
-                  ~data:{trace_mod= Some enabled; trace_funs= default} )
+                  {trace_mod= Some enabled; trace_funs= default}
+                  m )
+          default parts
       in
       Ok {none with trace_mods_funs}
   with Assert_failure _ as exn -> Error exn
@@ -110,7 +129,7 @@ let init ?(colors = false) ?(margin = 240) ?config:(c = none) () =
   Format.pp_set_margin fs margin ;
   Format.pp_set_max_indent fs (margin - 1) ;
   Format.pp_open_vbox fs 0 ;
-  Caml.at_exit flush ;
+  at_exit flush ;
   config := {c with colors}
 
 let unwrap s =
@@ -126,15 +145,14 @@ let unwrap s =
 
 let enabled mod_name fun_name =
   let {trace_all; trace_mods_funs; _} = !config in
-  match Map.find trace_mods_funs (unwrap mod_name) with
+  match Map.find (unwrap mod_name) trace_mods_funs with
-  | Some {trace_mod; trace_funs} -> (
+  | {trace_mod; trace_funs} -> (
-    match Map.find trace_funs fun_name with
+    try Map.find fun_name trace_funs
-    | Some fun_enabled -> fun_enabled
+    with Not_found -> (
-    | None -> (
       match trace_mod with
       | Some mod_enabled -> mod_enabled
       | None -> trace_all ) )
-  | None -> trace_all
+  | exception Not_found -> trace_all
 
 let kprintf mod_name fun_name k fmt =
   if enabled mod_name fun_name then Format.kfprintf k fs fmt
@@ -174,10 +192,8 @@ let retn mod_name fun_name k result =
   k {pf= (fun fmt -> decf mod_name fun_name fmt)} result ;
   result
 
-type ('a, 'b) fmt = ('a, Base.Formatter.t, unit, 'b) format4
-
 let raisef ?margin exn fmt =
-  let bt = Caml.Printexc.get_raw_backtrace () in
+  let bt = Printexc.get_raw_backtrace () in
   let fs = Format.str_formatter in
   ( match margin with
   | Some m ->
@@ -190,7 +206,7 @@ let raisef ?margin exn fmt =
       Format.pp_close_box fs () ;
       let msg = Format.flush_str_formatter () in
       let exn = exn msg in
-      Caml.Printexc.raise_with_backtrace exn bt )
+      Printexc.raise_with_backtrace exn bt )
     fs fmt
 
 let fail fmt =

sledge/ppx_trace/trace/trace.mli

@@ -7,20 +7,7 @@
 
 (** Debug trace logging *)
 
-(** Tracing configuration for a toplevel module. *)
+type config
-type trace_mod_funs =
-  { trace_mod: bool option
-        (** Enable/disable tracing of all functions in module *)
-  ; trace_funs: bool Base.Map.M(Base.String).t
-        (** Enable/disable tracing of individual functions *) }
-
-type trace_mods_funs = trace_mod_funs Base.Map.M(Base.String).t
-
-type config =
-  { trace_all: bool  (** Enable all tracing *)
-  ; trace_mods_funs: trace_mods_funs
-        (** Specify tracing of individual toplevel modules *)
-  ; colors: bool  (** Enable color output *) }
 
 val none : config
 val all : config
@@ -29,14 +16,12 @@ val parse : string -> (config, exn) result
 val init : ?colors:bool -> ?margin:int -> ?config:config -> unit -> unit
 (** Initialize the configuration of debug tracing. *)
 
-type 'a printf = ('a, Format.formatter, unit) format -> 'a
+type ('a, 'b) fmt = ('a, Format.formatter, unit, 'b) format4
+type 'a printf = ('a, unit) fmt -> 'a
 type pf = {pf: 'a. 'a printf}
 
 val pp_styled :
-     [`Bold | `Cyan | `Magenta]
+  [`Bold | `Cyan | `Magenta] -> ('a, unit) fmt -> Format.formatter -> 'a
-  -> ('a, Format.formatter, unit, unit) format4
-  -> Format.formatter
-  -> 'a
 (** If config.colors is set to true, print in the specificed color *)
 
 val printf : string -> string -> 'a printf
@@ -63,9 +48,6 @@ val retn : string -> string -> (pf -> 'a -> unit) -> 'a -> 'a
 val flush : unit -> unit
 (** Flush the internal buffers. *)
 
-(** Format strings. *)
-type ('a, 'b) fmt = ('a, Format.formatter, unit, 'b) format4
-
 val raisef : ?margin:int -> (string -> exn) -> ('a, unit -> _) fmt -> 'a
 (** Take a function from a string message to an exception, and a format
     string with the additional arguments it specifies, and then call the