Merge pull request #5 from dinosaure/upgrade

Delete the fmt dependency
dinosaure · Mar 15, 2023 · f53c4a5 · f53c4a5
2 parents 41fca69 + a57c4fa
commit f53c4a5
Show file tree

Hide file tree

Showing 7 changed files with 69 additions and 64 deletions.
diff --git a/.ocamlformat b/.ocamlformat
@@ -1,4 +1,4 @@
-version=0.19.0
+version=0.25.1
 module-item-spacing=compact
 break-struct=natural
 break-infix=fit-or-vertical

diff --git a/lib/dune b/lib/dune
@@ -1,4 +1,4 @@
 (library
  (name prettym)
  (public_name prettym)
- (libraries bigarray-overlap fmt ke bigstringaf))
+ (libraries bigarray-overlap ke bigstringaf))
diff --git a/lib/enclosure.ml b/lib/enclosure.ml
@@ -3,7 +3,7 @@
 module type V = sig
   type t
 
-  val pp : t Fmt.t
+  val pp : Format.formatter -> t -> unit
   val sentinel : t
   val weight : t -> int
   val merge : t -> t -> t option
@@ -30,6 +30,14 @@ module RBQ (V : V) = struct
     let q, capacity = Queue.create ~capacity Bigarray.Int in
     { a = Array.make capacity V.sentinel; c = 0; m = capacity; q }
 
+  let pp_array pp_elt ppf arr =
+    Format.fprintf ppf "[";
+    for i = 0 to Array.length arr - 1 do
+      Format.fprintf ppf "@[%a@]" pp_elt arr.(i);
+      if i + 1 < Array.length arr then Format.fprintf ppf ";@ "
+    done;
+    Format.fprintf ppf "]"
+
   let pp ppf t =
     let a = Array.make (Queue.length t.q) V.sentinel in
     let x = ref 0 in
@@ -38,9 +46,10 @@ module RBQ (V : V) = struct
         a.(!x) <- t.a.(i);
         incr x)
       t.q;
-    Fmt.pf ppf "{ @[<hov>a = %a;@ c = %d;@ m = %d;@ q = %a;@] }"
-      Fmt.(Dump.array V.pp)
-      a t.c t.m (Queue.dump Fmt.int) t.q
+    Format.fprintf ppf "{ @[<hov>a = %a;@ c = %d;@ m = %d;@ q = %a;@] }"
+      (pp_array V.pp) a t.c t.m
+      (Queue.dump Format.pp_print_int)
+      t.q
 
   let available t = Queue.available t.q
   let is_empty t = Queue.is_empty t.q
@@ -77,33 +86,39 @@ module RBQ (V : V) = struct
     !res
 end
 
-let pp_chr =
-  Fmt.using (function '\032' .. '\126' as x -> x | _ -> '.') Fmt.char
+let pp_chr ppf = function
+  | '\032' .. '\126' as chr -> Format.pp_print_char ppf chr
+  | _ -> Format.pp_print_char ppf '.'
 
 let pp_scalar :
     type buffer.
-    get:(buffer -> int -> char) -> length:(buffer -> int) -> buffer Fmt.t =
+    get:(buffer -> int -> char) ->
+    length:(buffer -> int) ->
+    Format.formatter ->
+    buffer ->
+    unit =
  fun ~get ~length ppf b ->
   let l = length b in
   for i = 0 to l / 16 do
-    Fmt.pf ppf "%08x: " (i * 16);
+    Format.fprintf ppf "%08x: " (i * 16);
     let j = ref 0 in
     while !j < 16 do
       if (i * 16) + !j < l then
-        Fmt.pf ppf "%02x" (Char.code @@ get b ((i * 16) + !j))
-      else Fmt.pf ppf "  ";
-      if !j mod 2 <> 0 then Fmt.pf ppf " ";
+        Format.fprintf ppf "%02x" (Char.code @@ get b ((i * 16) + !j))
+      else Format.fprintf ppf "  ";
+      if !j mod 2 <> 0 then Format.fprintf ppf " ";
       incr j
     done;
-    Fmt.pf ppf "  ";
+    Format.fprintf ppf "  ";
     j := 0;
     while !j < 16 do
-      if (i * 16) + !j < l then Fmt.pf ppf "%a" pp_chr (get b ((i * 16) + !j))
-      else Fmt.pf ppf " ";
+      if (i * 16) + !j < l then
+        Format.fprintf ppf "%a" pp_chr (get b ((i * 16) + !j))
+      else Format.fprintf ppf " ";
       incr j
     done;
 
-    Fmt.pf ppf "@,"
+    Format.fprintf ppf "@,"
   done
 
 module RBA = Ke.Fke.Weighted
@@ -135,8 +150,8 @@ module IOVec = struct
   let weight { len; _ } = len
 
   let pp ppf t =
-    Fmt.pf ppf "{ @[<hov>buffer= @[<hov>%a@];@ off= %d;@ len= %d;@] }" Buffer.pp
-      t.buffer t.off t.len
+    Format.fprintf ppf "{ @[<hov>buffer= @[<hov>%a@];@ off= %d;@ len= %d;@] }"
+      Buffer.pp t.buffer t.off t.len
 
   let sentinel =
     let deadbeef = "\222\173\190\239" in
@@ -184,10 +199,10 @@ type encoder = {
   emitter : emitter;
 }
 
-let pp_flush ppf _ = Fmt.string ppf "#flush"
+let pp_flush ppf _ = Format.fprintf ppf "#flush"
 
 let pp ppf t =
-  Fmt.pf ppf
+  Format.fprintf ppf
     "{ @[<hov>sched= @[<hov>%a@];@ write= @[<hov>%a@];@ flush= @[<hov>%a@];@ \
      written= %d;@ received= %d;@ emitter= #emitter;@] }"
     RBS.pp t.sched (RBA.pp pp_chr) t.write (Ke.Fke.pp pp_flush) t.flush
@@ -252,8 +267,8 @@ let shift_buffers written t =
               sched = RBS.cons_exn shifted rest;
               write =
                 (if check iovec t then
-                 RBA.N.shift_exn t.write (IOVec.length last)
-                else t.write);
+                   RBA.N.shift_exn t.write (IOVec.length last)
+                 else t.write);
             } )
         else (List.rev acc, t)
     | exception RBS.Queue.Empty -> (List.rev acc, t)

diff --git a/lib/enclosure.mli b/lib/enclosure.mli
@@ -49,7 +49,7 @@ val is_empty : encoder -> bool
 (** [is_empty t] returns [true] if nothing is under [t]. This case appear
    afterwards a {!flush}. *)
 
-val pp : encoder Fmt.t
+val pp : Format.formatter -> encoder -> unit
 (** Pretty-printer of {!encoder}. *)
 
 val schedule_flush : (int -> encoder -> unit) -> encoder -> encoder

diff --git a/lib/pretty.ml b/lib/pretty.ml
@@ -1,23 +1,22 @@
-[@@@warning "-32"] (* pretty-printers *)
+let pp_list ?sep:(pp_sep = Format.pp_print_cut) pp_elt ppf lst =
+  let rec go = function
+    | [] -> ()
+    | [ x ] -> pp_elt ppf x
+    | x :: r ->
+        pp_elt ppf x;
+        pp_sep ppf ();
+        go r
+  in
+  go lst
 
 type vec = { off : int; len : int }
 type box = Box | TBox of int | BBox
 
-let pp_box ppf = function
-  | Box -> Fmt.string ppf "box"
-  | TBox tab -> Fmt.pf ppf "(TBox %d)" tab
-  | BBox -> Fmt.string ppf "bbox"
-
 type value =
   | String of vec * string
   | Bytes of vec * bytes
   | Bigstring of vec * Bigstringaf.t
 
-let pp_value ppf = function
-  | String (vec, v) -> Fmt.pf ppf "%S" (String.sub v vec.off vec.len)
-  | Bytes (vec, v) -> Fmt.pf ppf "%S" (Bytes.sub_string v vec.off vec.len)
-  | Bigstring _ -> Fmt.pf ppf "#bigstring"
-
 let split_value len x =
   assert (len > 0);
 
@@ -47,14 +46,6 @@ type atom =
   | Open of box
   | Close
 
-let pp_atom ppf = function
-  | Breakable v -> Fmt.pf ppf "<breakable:%a>" pp_value v
-  | Unbreakable v -> Fmt.pf ppf "<unbreakable:%a>" pp_value v
-  | Break { len; indent } -> Fmt.pf ppf "<break:len= %d, indent= %d>" len indent
-  | New_line -> Fmt.pf ppf "<new-line>"
-  | Open box -> Fmt.pf ppf "(box %a" pp_box box
-  | Close -> Fmt.pf ppf ")"
-
 let box = Box
 let tbox indent = TBox indent
 let bbox = BBox
@@ -113,7 +104,7 @@ module Stack : sig
   val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
   val tail_exn : 'a t -> 'a t
   val map : ('a -> 'b) -> 'a t -> 'b t
-  val pp : 'a Fmt.t -> 'a t Fmt.t
+  val pp : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit
 end = struct
   type 'a t = 'a list
 
@@ -127,7 +118,7 @@ end = struct
   let fold = List.fold_left
   let tail_exn = function _ :: r -> r | [] -> raise Empty
   let map f l = List.map f l
-  let pp = Fmt.Dump.list
+  let pp pp_elt = pp_list pp_elt
 end
 
 module Queue = Ke.Fke
@@ -144,33 +135,34 @@ type t = {
 }
 
 let pp_box ppf = function
-  | `Root -> Fmt.string ppf "`Root"
-  | `Box -> Fmt.string ppf "`Box"
-  | `Indent n -> Fmt.pf ppf "(`Indent %d)" n
+  | `Root -> Format.pp_print_string ppf "`Root"
+  | `Box -> Format.pp_print_string ppf "`Box"
+  | `Indent n -> Format.fprintf ppf "(`Indent %d)" n
 
-let pp_break ppf (`Indent n) = Fmt.pf ppf "(`Indent %d)" n
+let pp_break ppf (`Indent n) = Format.fprintf ppf "(`Indent %d)" n
 
 let pp_token ppf = function
-  | TValue (String ({ off; len }, x)) -> Fmt.pf ppf "%S" (String.sub x off len)
+  | TValue (String ({ off; len }, x)) ->
+      Format.fprintf ppf "%S" (String.sub x off len)
   | TValue (Bytes ({ off; len }, x)) ->
-      Fmt.pf ppf "%S" (Bytes.sub_string x off len)
+      Format.fprintf ppf "%S" (Bytes.sub_string x off len)
   | TValue (Bigstring ({ off; len }, x)) ->
-      Fmt.pf ppf "%S" (Bigstringaf.substring x ~off ~len)
-  | TBreak len -> Fmt.pf ppf "<%S>" (String.make len ' ')
-  | TBox `Box -> Fmt.pf ppf "["
-  | TBox (`Indent n) -> Fmt.pf ppf "[<%d>" n
-  | TBox `Root -> Fmt.pf ppf "[<root>"
-  | TClose -> Fmt.pf ppf "]"
+      Format.fprintf ppf "%S" (Bigstringaf.substring x ~off ~len)
+  | TBreak len -> Format.fprintf ppf "<%S>" (String.make len ' ')
+  | TBox `Box -> Format.fprintf ppf "["
+  | TBox (`Indent n) -> Format.fprintf ppf "[<%d>" n
+  | TBox `Root -> Format.fprintf ppf "[<root>"
+  | TClose -> Format.fprintf ppf "]"
 
 let pp ppf t =
-  Fmt.pf ppf
+  Format.fprintf ppf
     "{ @[<hov>boxes= @[<hov>%a@];@ breaks= @[<hov>%a@];@ inner= @[<hov>%a@];@ \
      indent= %d;@ margin= %d;@ new_line= %S;@ queue= @[<hov>%a@];@ encoder= \
      @[<hov>%a@];@] }"
     (Stack.pp pp_box) t.boxes
-    (Stack.pp (Fmt.Dump.list pp_break))
+    (Stack.pp (pp_list pp_break))
     t.breaks
-    (Stack.pp Fmt.(Dump.list int))
+    (Stack.pp (pp_list Format.pp_print_int))
     t.inner t.indent t.margin t.new_line (Queue.pp pp_token) t.queue
     Enclosure.pp t.encoder
 

diff --git a/lib/prettym.ml b/lib/prettym.ml
@@ -32,8 +32,7 @@ let to_string ?(margin = 78) ?(new_line = "\r\n") gen value =
   in
   let encoder = Pretty.create ~emitter ~margin ~new_line 0x100 in
   let kend encoder =
-    if Pretty.is_empty encoder then ()
-    else Fmt.failwith "Leave a non-empty encoder"
+    if Pretty.is_empty encoder then () else failwith "Leave a non-empty encoder"
   in
   let encoder = eval encoder Fancy.[ !!gen ] value in
   let () = Pretty.kflush kend encoder in
@@ -70,7 +69,7 @@ let to_stream ?(margin = 78) ?(new_line = "\r\n") gen value =
   let encoder = Pretty.create ~emitter ~margin ~new_line 4096 in
   let kend encoder =
     if Pretty.is_empty encoder then ()
-    else Fmt.failwith "Leave with a non-empty encoder"
+    else failwith "Leave with a non-empty encoder"
   in
   let () = keval (Pretty.kflush kend) encoder Fancy.[ !!gen ] value in
   consumer

diff --git a/prettym.opam b/prettym.opam
@@ -18,7 +18,6 @@ depends: [
   "ocaml"            {>= "4.08.0"}
   "dune"             {>= "2.8"}
   "bigarray-overlap"
-  "fmt"              {>= "0.8.7"}
   "ke"               {>= "0.4"}
   "bigstringaf"      {>= "0.2"}
   "ptime"            {with-test}