(base) extra clean to the base library of graphjs

src/base/config.ml

@@ -27,7 +27,7 @@ let set (config : 'a t) (value : 'a) : unit =
   | Constant -> failwith "invalid update to locked config"
 
 let ( ! ) (config : 'a t) : 'a = get config
-let ( $= ) (config : 'a t) (value : 'a) = set config value
+let ( := ) (config : 'a t) (value : 'a) = set config value
 
 (* Generic platform configurations *)
 let dflt_buf_sz : int t = constant 512

src/base/console.ml

@@ -39,8 +39,8 @@ let get_system () : system =
 module Config = struct
   include Config
 
-  let colored_requirement : int t = constant 256
-  let system : system t = constant (get_system ())
+  let colored_requirement = constant 256
+  let system = constant (get_system ())
 end
 
 let pwd () : string = Unix.getcwd ()

src/base/dune

@@ -10,13 +10,13 @@
   fun
   option
   result
-  json
   config
   generator
   console
   fmt
   writer
   font
   log
+  json
   time)
  (libraries unix fpath yojson))

src/base/font.ml

@@ -1,7 +1,7 @@
 module Config = struct
   include Config
 
-  let colored : bool t = static true
+  let colored = static true
 end
 
 module Attr = struct
@@ -78,71 +78,71 @@ module Attr = struct
     | `Reset -> 0
     | `Foreground fg -> to_code fg
     | `Background bg -> to_code bg + 10
-    | `Effect eff -> to_code eff
-    | `Style sty -> to_code sty
+    | `Effect effect -> to_code effect
+    | `Style style -> to_code style
 end
 
 type t = Attr.t list
 
 open struct
-  let make_foreground (fg : Attr.color option) (font : t) : t =
-    Option.fold ~none:font ~some:(fun fg -> `Foreground fg :: font) fg
+  let mk_foreground (fg : Attr.color option) (font : t) : t =
+    Option.fold ~none:font ~some:(fun fg' -> `Foreground fg' :: font) fg
 
-  let make_background (bg : Attr.color option) (font : t) : t =
+  let mk_background (bg : Attr.color option) (font : t) : t =
     Option.fold ~none:font ~some:(fun bg -> `Background bg :: font) bg
 
-  let make_effect (eff : Attr.effect option) (font : t) : t =
-    Option.fold ~none:font ~some:(fun eff -> `Effect eff :: font) eff
+  let mk_effect (effect : Attr.effect option) (font : t) : t =
+    Option.fold ~none:font ~some:(fun effect' -> `Effect effect' :: font) effect
 
-  let make_style ((sty, on) : Attr.style * bool option) (font : t) : t =
-    let style_f = function true -> `Style sty :: font | false -> font in
+  let mk_style ((style, on) : Attr.style * bool option) (font : t) : t =
+    let style_f = function true -> `Style style :: font | false -> font in
     Option.fold ~none:font ~some:style_f on
 
-  let make_font (fg : Attr.color option) (bg : Attr.color option)
-      (eff : Attr.effect option) (bold : bool option) (italic : bool option)
-      (underline : bool option) (strike : bool option) =
-    make_foreground fg []
-    |> make_background bg
-    |> make_effect eff
-    |> make_style (`Bold, bold)
-    |> make_style (`Italic, italic)
-    |> make_style (`Underline, underline)
-    |> make_style (`Strike, strike)
+  let mk_font (fg : Attr.color option) (bg : Attr.color option)
+      (effect : Attr.effect option) (bold : bool option) (italic : bool option)
+      (underline : bool option) (strike : bool option) : t =
+    mk_foreground fg []
+    |> mk_background bg
+    |> mk_effect effect
+    |> mk_style (`Bold, bold)
+    |> mk_style (`Italic, italic)
+    |> mk_style (`Underline, underline)
+    |> mk_style (`Strike, strike)
 end
 
 let colored (writer : Writer.t) : bool =
   Config.(!colored) && Writer.colored writer
 
-let foreground (font : t) : Attr.color option =
+let get_foreground (font : t) : Attr.color option =
   List.find_map (function `Foreground fg -> Some fg | _ -> None) font
 
-let background (font : t) : Attr.color option =
+let get_background (font : t) : Attr.color option =
   List.find_map (function `Background bg -> Some bg | _ -> None) font
 
-let effect (font : t) : Attr.effect option =
-  List.find_map (function `Effect eff -> Some eff | _ -> None) font
+let get_effect (font : t) : Attr.effect option =
+  List.find_map (function `Effect effect -> Some effect | _ -> None) font
 
-let style (sty : Attr.style) (font : t) : bool option =
+let get_style (style : Attr.style) (font : t) : bool option =
   Fun.flip List.find_map font (function
-    | `Style sty' when sty == sty' -> Some true
+    | `Style style' when style == style' -> Some true
     | _ -> None )
 
 let create ?(fg : Attr.color option) ?(bg : Attr.color option)
-    ?(eff : Attr.effect option) ?(bold : bool option) ?(italic : bool option)
+    ?(effect : Attr.effect option) ?(bold : bool option) ?(italic : bool option)
     ?(underline : bool option) ?(strike : bool option) () : t =
-  make_font fg bg eff bold italic underline strike
+  mk_font fg bg effect bold italic underline strike
 
 let update ?(fg : Attr.color option) ?(bg : Attr.color option)
-    ?(eff : Attr.effect option) ?(bold : bool option) ?(italic : bool option)
+    ?(effect : Attr.effect option) ?(bold : bool option) ?(italic : bool option)
     ?(underline : bool option) ?(strike : bool option) (font : t) : t =
-  let fg = Option.map_none ~value:(foreground font) fg in
-  let bg = Option.map_none ~value:(background font) bg in
-  let effect = Option.map_none ~value:(effect font) eff in
-  let bold = Option.map_none ~value:(style `Bold font) bold in
-  let italic = Option.map_none ~value:(style `Italic font) italic in
-  let underline = Option.map_none ~value:(style `Underline font) underline in
-  let strike = Option.map_none ~value:(style `Strike font) strike in
-  make_font fg bg effect bold italic underline strike
+  let fg = Option.map_none ~value:(get_foreground font) fg in
+  let bg = Option.map_none ~value:(get_background font) bg in
+  let effect = Option.map_none ~value:(get_effect font) effect in
+  let bold = Option.map_none ~value:(get_style `Bold font) bold in
+  let italic = Option.map_none ~value:(get_style `Italic font) italic in
+  let underline = Option.map_none ~value:(get_style `Underline font) underline in
+  let strike = Option.map_none ~value:(get_style `Strike font) strike in
+  mk_font fg bg effect bold italic underline strike
 
 let pp_font (ppf : Fmt.t) (font : t) : unit =
   let pp_attr ppf attr = Fmt.pp_int ppf (Attr.code attr) in
@@ -152,18 +152,18 @@ let pp (font : t) (pp_v : Fmt.t -> 'a -> unit) (ppf : Fmt.t) (v : 'a) : unit =
   if not (colored (Writer.find ppf)) then pp_v ppf v
   else Fmt.fmt ppf "%a%a%a" pp_font font pp_v v pp_font [ `Reset ]
 
-let kfmt (font : t) (k : Fmt.t -> 'a) (ppf : Fmt.t) :
-    ('b, Fmt.t, unit, 'a) format4 -> 'b =
+let kfmt (font : t) (k : Fmt.t -> 'a) (ppf : Fmt.t)
+    (fmt : ('b, Fmt.t, unit, 'a) format4) : 'b =
   let pp_fmt ppf = Fmt.fmt ppf "%t" in
-  Fmt.kdly (fun acc -> pp font pp_fmt ppf acc |> fun () -> k ppf)
+  Fmt.kdly (fun acc -> pp font pp_fmt ppf acc |> fun () -> k ppf) fmt
 
-let kdly (font : t) (k : (Fmt.t -> unit) -> 'a) :
-    ('b, Fmt.t, unit, 'a) format4 -> 'b =
+let kdly (font : t) (k : (Fmt.t -> unit) -> 'a)
+    (fmt : ('b, Fmt.t, unit, 'a) format4) : 'b =
   let pp_fmt ppf = Fmt.fmt ppf "%t" in
-  Fmt.kdly (fun acc -> k (fun ppf -> pp font pp_fmt ppf acc))
+  Fmt.kdly (fun acc -> k (fun ppf -> pp font pp_fmt ppf acc)) fmt
 
-let fmt (font : t) (ppf : Fmt.t) : ('a, Fmt.t, unit, unit) format4 -> 'a =
-  kfmt font ignore ppf
+let fmt (font : t) (ppf : Fmt.t) (fmt : ('a, Fmt.t, unit, unit) format4) : 'a =
+  kfmt font ignore ppf fmt
 
-let dly (font : t) : ('a, Fmt.t, unit, Fmt.t -> unit) format4 -> 'a =
-  kdly font Fun.id
+let dly (font : t) (fmt : ('a, Fmt.t, unit, Fmt.t -> unit) format4) : 'a =
+  kdly font Fun.id fmt

src/base/generator.ml

@@ -4,12 +4,12 @@ type 'a t =
   }
 
 open struct
-  let next (gen : int ref) (step : int) () =
+  let next (gen : int ref) (step : int) () : int =
     let counter = !gen in
     gen := counter + step;
     counter
 
-  let reset (counter : int ref) (init : int) () = counter := init
+  let reset (counter : int ref) (init : int) () : unit = counter := init
 end
 
 let of_numbers ?(init : int = 0) ?(step : int = 1) () : int t =

src/base/log.ml

@@ -1,32 +1,22 @@
 module Config = struct
   include Config
 
-  let log_warns : bool t = static true
-  let log_infos : bool t = static false
-  let log_debugs : bool t = static false
-  let log_verbose : bool t = static false
-
-  let app : ((Fmt.t -> unit) * Font.t) t =
-    constant (Fmt.dly "graphjs", Font.create ~fg:`White ())
-
-  let error : ((Fmt.t -> unit) * Font.t) t =
-    constant (Fmt.dly "error", Font.create ~fg:`LightRed ())
-
-  let warn : ((Fmt.t -> unit) * Font.t) t =
-    constant (Fmt.dly "warn", Font.create ~fg:`Yellow ())
-
-  let info : ((Fmt.t -> unit) * Font.t) t =
-    constant (Fmt.dly "info", Font.create ~fg:`LightCyan ())
-
-  let debug : ((Fmt.t -> unit) * Font.t) t =
-    constant (Fmt.dly "debug", Font.create ~fg:`Cyan ())
+  let log_warns = static true
+  let log_infos = static false
+  let log_debugs = static false
+  let log_verbose = static false
+  let app = constant (Fmt.dly "graphjs", Font.create ~fg:`White ())
+  let error = constant (Fmt.dly "error", Font.create ~fg:`LightRed ())
+  let warn = constant (Fmt.dly "warn", Font.create ~fg:`Yellow ())
+  let info = constant (Fmt.dly "info", Font.create ~fg:`LightCyan ())
+  let debug = constant (Fmt.dly "debug", Font.create ~fg:`Cyan ())
 end
 
 open struct
-  let create_log ((header, font) : (Fmt.t -> unit) * Font.t) (ppf : Fmt.t) :
-      ('a, Fmt.t, unit, 'b) format4 -> 'a =
+  let create_log ((header, font) : (Fmt.t -> unit) * Font.t) (ppf : Fmt.t)
+      (fmt : ('a, Fmt.t, unit, 'b) format4) : 'a =
     let pp_content ppf fmt = Font.fmt font ppf "[%t] %t" header fmt in
-    Fmt.kdly (Fmt.fmt ppf "%a@." pp_content)
+    Fmt.kdly (Fmt.fmt ppf "%a@." pp_content) fmt
 end
 
 let fmt_app (ppf : Fmt.t) (fmt : ('a, Fmt.t, unit, unit) format4) : 'a =
@@ -96,7 +86,7 @@ module Redirect = struct
     }
 
   let capture (old : Writer.t Config.t) (buf : Buffer.t) : Buffer.t =
-    Writer.Config.(old $= Writer.to_buffer buf);
+    Writer.Config.(old := Writer.to_buffer buf);
     buf
 
   let capture_to ~(out : Buffer.t option) ~(err : Buffer.t option) : t =
@@ -115,7 +105,7 @@ module Redirect = struct
     | Shared ->
       let streams = capture_to ~out:(buffer ()) ~err:None in
       let new_out = Writer.Config.(!stdout) in
-      Writer.Config.(stderr $= new_out);
+      Writer.Config.(stderr := new_out);
       streams
 
   let pp_captured (ppf : Fmt.t) (streams : t) : unit =
@@ -133,6 +123,6 @@ module Redirect = struct
     let new_err = Writer.Config.(!stderr) in
     Option.fold ~none:() ~some:(close new_out old_out.ppf) streams.new_out;
     Option.fold ~none:() ~some:(close new_err old_err.ppf) streams.new_err;
-    Writer.Config.(stdout $= old_out);
-    Writer.Config.(stderr $= old_err)
+    Writer.Config.(stdout := old_out);
+    Writer.Config.(stderr := old_err)
 end

src/base/stdlib/option.ml

@@ -1,16 +1,13 @@
 include Stdlib.Option
 
-let ( let* ) (v : 'a t) (f : 'a -> 'b t) : 'b t = bind v f
-let ( let+ ) (f : 'a -> 'b) (v : 'a t) : 'b t = map f v
+let ( let* ) (o : 'a t) (f : 'a -> 'b t) : 'b t = bind o f
+let ( let+ ) (f : 'a -> 'b) (o : 'a t) : 'b t = map f o
 
-let value_lazy ~(default : 'a lazy_t) : 'a t -> 'a = function
-  | None -> Lazy.force default
-  | Some v -> v
+let value_lazy ~(default : 'a lazy_t) (o : 'a t) : 'a =
+  match o with None -> Lazy.force default | Some v -> v
 
-let map_none ~(value : 'a t) : 'a t -> 'a t = function
-  | None -> value
-  | Some _ as v -> v
+let map_none ~(value : 'a t) (o : 'a t) : 'a t =
+  match o with None -> value | Some _ as v -> v
 
-let fold_lazy ~(none : 'b lazy_t) ~(some : 'a -> 'b) : 'a t -> 'b = function
-  | None -> Lazy.force none
-  | Some v -> some v
+let fold_lazy ~(none : 'b lazy_t) ~(some : 'a -> 'b) (o : 'a t) : 'b =
+  match o with None -> Lazy.force none | Some v -> some v

src/base/stdlib/result.ml

@@ -1,11 +1,11 @@
 include Stdlib.Result
 
-let ( let* ) (v : ('a, 'e) t) (f : 'a -> ('b, 'e) t) : ('b, 'e) t = bind v f
-let ( let+ ) (f : 'a -> 'b) (v : ('a, 'e) t) : ('b, 'e) t = map f v
+let ( let* ) (r : ('a, 'e) t) (f : 'a -> ('b, 'e) t) : ('b, 'e) t = bind r f
+let ( let+ ) (f : 'a -> 'b) (r : ('a, 'e) t) : ('b, 'e) t = map f r
 
-let extract (vs : ('a, 'b) t list) : ('a list, 'b) t =
-  Fun.flip2 List.fold_right vs (Ok []) (fun v acc ->
-      match (acc, v) with
+let extract (rs : ('a, 'b) t list) : ('a list, 'b) t =
+  Fun.flip2 List.fold_right rs (Ok []) (fun r acc ->
+      match (acc, r) with
       | ((Error _ as err), _) -> err
       | (Ok _, (Error _ as err)) -> err
       | (Ok vs, Ok v) -> Ok (v :: vs) )

src/client/bulk.ml

@@ -3,7 +3,7 @@ open Graphjs_base
 module Config = struct
   include Config
 
-  let time_font_f font = Font.update font ~eff:`Faint
+  let time_font_f font = Font.update font ~effect:`Faint
   let main_font : Font.t t = constant (Font.create ~fg:`White ())
   let path_font : Font.t t = constant (Font.create ~fg:`DarkGray ())
   let success_font : Font.t t = constant (Font.create ~fg:`LightGreen ())

src/client/commands/cmd_mdg.ml

@@ -13,8 +13,8 @@ module Options = struct
     }
 
   let set (no_svg : bool) (no_literal_wrapping : bool) () : unit =
-    Builder_config.(export_svg $= not no_svg);
-    Builder_config.(wrap_literal_property_updates $= not no_literal_wrapping)
+    Builder_config.(export_svg := not no_svg);
+    Builder_config.(wrap_literal_property_updates := not no_literal_wrapping)
 
   let set_cmd (inputs : Fpath.t list) (output : Fpath.t option)
       (taint_config' : Fpath.t option) () : t =

src/client/commands/cmd_parse.ml

@@ -10,7 +10,7 @@ module Options = struct
     }
 
   let set (test262_conform_hoisted' : bool) : unit =
-    Parser_config.(test262_conform_hoisted $= test262_conform_hoisted')
+    Parser_config.(test262_conform_hoisted := test262_conform_hoisted')
 
   let set_cmd (inputs : Fpath.t list) (output : Fpath.t option) () : t =
     { inputs; output }

src/graphjs.ml

@@ -6,12 +6,12 @@ type status = (unit Exec.status Cmd.eval_ok, Cmd.eval_error) Result.t
 
 let set_copts (colorless : bool) (lvl : Enums.DebugLvl.t) (verbose : bool)
     (override' : bool) : unit =
-  Font.Config.(colored $= not colorless);
-  Log.Config.(log_warns $= (lvl >= Warn));
-  Log.Config.(log_infos $= (verbose || lvl >= Info));
-  Log.Config.(log_debugs $= (lvl >= All));
-  Log.Config.(log_verbose $= verbose);
-  Workspace.Config.(override $= override')
+  Font.Config.(colored := not colorless);
+  Log.Config.(log_warns := (lvl >= Warn));
+  Log.Config.(log_infos := (verbose || lvl >= Info));
+  Log.Config.(log_debugs := (lvl >= All));
+  Log.Config.(log_verbose := verbose);
+  Workspace.Config.(override := override')
 
 let copts : unit Term.t =
   let open Term in
@@ -23,7 +23,7 @@ let copts : unit Term.t =
 
 let set_shared_opts (mode' : Enums.AnalysisMode.t) () : unit =
   let open Graphjs_share in
-  Share_config.(mode $= Enums.AnalysisMode.conv mode')
+  Share_config.(mode := Enums.AnalysisMode.conv mode')
 
 let shared_opts : unit Term.t =
   Term.(const set_shared_opts $ Docs.SharedOpts.mode $ copts)