cleanup

Patch CBor round-trip QCheck test to hold for nan's too

.github/workflows/format.yml

@@ -0,0 +1,28 @@
+name: format
+
+on:
+  push:
+    branches:
+      - main
+  pull_request:
+
+jobs:
+  format:
+    name: format
+    strategy:
+      matrix:
+        ocaml-compiler:
+            - '5.3'
+    runs-on: 'ubuntu-latest'
+    steps:
+      - uses: actions/checkout@main
+      - name: Use OCaml ${{ matrix.ocaml-compiler }}
+        uses: ocaml/setup-ocaml@v3
+        with:
+          ocaml-compiler: ${{ matrix.ocaml-compiler }}
+          dune-cache: true
+          allow-prerelease-opam: true
+
+      - run: opam install ocamlformat.0.27.0
+      - run: opam exec -- make format-check
+

.github/workflows/main.yml

@@ -19,7 +19,7 @@ jobs:
             - '4.08'
             - '4.10'
             - '4.14'
-            - '5.2'
+            - '5.3'
             - 'ocaml-variants.5.0.0+options,ocaml-option-bytecode-only'
 
     runs-on: ${{ matrix.os }}
@@ -62,23 +62,3 @@ jobs:
           opam install containers-data --deps-only  # no test deps
       - run: opam exec -- dune build '@install'
       - run: opam exec -- dune runtest -j 1 -p containers --profile=release # test only core on non-ubuntu platform
-
-  format:
-    name: format
-    strategy:
-      matrix:
-        ocaml-compiler:
-            - '5.2'
-    runs-on: 'ubuntu-latest'
-    steps:
-      - uses: actions/checkout@main
-      - name: Use OCaml ${{ matrix.ocaml-compiler }}
-        uses: ocaml/setup-ocaml@v3
-        with:
-          ocaml-compiler: ${{ matrix.ocaml-compiler }}
-          dune-cache: true
-          allow-prerelease-opam: true
-
-      - run: opam install ocamlformat.0.26.2
-      - run: opam exec -- make format-check
-

.ocamlformat

@@ -1,4 +1,4 @@
-version = 0.26.2
+version = 0.27.0
 profile=conventional
 margin=80
 if-then-else=k-r
@@ -12,3 +12,4 @@ field-space=tight-decl
 leading-nested-match-parens=true
 module-item-spacing=compact
 quiet=true
+parse-docstrings=false

benchs/ref_impl.ml

@@ -128,8 +128,9 @@ module PersistentHashtbl (H : Hashtbl.HashedType) = struct
       t := Add (k, v', t');
       Table.remove tbl k;
       t'
-    with Not_found -> (* not member, nothing to do *)
+    with Not_found ->
-                      t
+      (* not member, nothing to do *)
+      t
 
   (*$R
     let h = H.of_seq my_seq in

benchs/run_benchs.ml

@@ -97,6 +97,14 @@ module L = struct
     else
       Sek.Persistent.of_list 0 [ x; x + 1; x + 2; x + 3 ]
 
+  let f_pvec x =
+    if x mod 10 = 0 then
+      Pvec.empty
+    else if x mod 5 = 1 then
+      Pvec.of_list [ x; x + 1 ]
+    else
+      Pvec.of_list [ x; x + 1; x + 2; x + 3 ]
+
   let flat_map_kont f l =
     let rec aux f l kont =
       match l with
@@ -118,6 +126,7 @@ module L = struct
     let l = CCList.(1 -- n) in
     let ral = CCRAL.of_list l in
     let sek = Sek.Persistent.of_list 0 l in
+    let pvec = Pvec.of_list l in
     let flatten_map_ l () =
       ignore @@ Sys.opaque_identity @@ List.flatten (CCList.map f_ l)
     and flatmap_kont l () = ignore @@ Sys.opaque_identity @@ flat_map_kont f_ l
@@ -128,6 +137,8 @@ module L = struct
       ignore @@ Sys.opaque_identity @@ CCRAL.flat_map f_ral_ l
     and flatmap_sek s () =
       ignore @@ Sys.opaque_identity @@ Sek.Persistent.flatten_map 0 f_sek_ s
+    and flat_map_pvec v () =
+      ignore @@ Sys.opaque_identity @@ Pvec.flat_map f_pvec v
     in
     B.throughputN time ~repeat
       [
@@ -137,6 +148,7 @@ module L = struct
         "flatten o map", flatten_map_ l, ();
         "ral_flatmap", flatmap_ral_ ral, ();
         "sek_flatmap", flatmap_sek sek, ();
+        "pvec.flatmap", flat_map_pvec pvec, ();
       ]
 
   (* APPEND *)
@@ -284,7 +296,7 @@ module L = struct
       for i = 0 to n - 1 do
         opaque_ignore (CCRAL.set l i (-i))
       done
-      (* TODO: implement set
+    (* TODO: implement set
          and bench_funvec l () =
            for _i = 0 to n-1 do opaque_ignore (CCFun_vec.set (* TODO *)) done
       *)
@@ -810,8 +822,8 @@ module Tbl = struct
     end in
     (module T)
 
-  let persistent_hashtbl_ref :
+  let persistent_hashtbl_ref : type a.
-      type a. a key_type -> (module MUT with type key = a) =
+      a key_type -> (module MUT with type key = a) =
    fun key ->
     let (module Key), name = arg_make key in
     let module T = Ref_impl.PersistentHashtbl (Key) in

src/codegen/containers_codegen.ml

@@ -108,7 +108,8 @@ module Bitfield = struct
     if self.emit_failure_if_too_wide then
       fpf out
         "(* check that int size is big enough *)@,\
-         @[let () = assert (Sys.int_size >= %d);;@]" (total_width self);
+         @[let () = assert (Sys.int_size >= %d);;@]"
+        (total_width self);
     fpf out "@]"
 
   let gen_mli self : code =

src/core/CCSeq.mli

@@ -183,7 +183,7 @@ val ( -- ) : int -> int -> int t
     [a] and [b] (therefore, never empty). *)
 
 val ( --^ ) : int -> int -> int t
-(** [a -- b] is the integer range from [a] to [b], where [b] is excluded. *)
+(** [a --^ b] is the integer range from [a] to [b], where [b] is excluded. *)
 
 (** {2 Operations on two Collections} *)
 

src/core/CCUtf8_string.ml

@@ -65,8 +65,10 @@ let next_ (type a) (st : Dec.t) ~(yield : uchar -> a) ~(stop : unit -> a) () : a
       (* except for first, each char gives 6 bits *)
       let next = (acc lsl 6) lor (c land 0b111111) in
       if j = n_bytes then
-        if (* done reading the codepoint *)
+        if
-           Uchar.is_valid next then (
+          (* done reading the codepoint *)
+          Uchar.is_valid next
+        then (
           st.i <- st.i + j + 1;
           (* +1 for first char *)
           yield (Uchar.unsafe_of_int next)

src/data/CCFQueue.ml

@@ -37,8 +37,7 @@ let _empty = Shallow Zero
 let _single x = Shallow (One x)
 let _double x y = Shallow (Two (x, y))
 
-let _deep :
+let _deep : type l0 l1.
-    type l0 l1.
     int ->
     ('a, l0 succ) digit ->
     ('a * 'a) t lazy_t ->

src/data/CCFQueue.mli

@@ -139,7 +139,7 @@ val ( -- ) : int -> int -> int t
     @since 0.10 *)
 
 val ( --^ ) : int -> int -> int t
-(** [a -- b] is the integer range from [a] to [b], where [b] is excluded.
+(** [a --^ b] is the integer range from [a] to [b], where [b] is excluded.
     @since 0.17 *)
 
 val pp : 'a printer -> 'a t printer

src/data/CCGraph.ml

@@ -221,8 +221,7 @@ module Traverse = struct
       ]
 
     type ('v, 'e) t =
-      [ `Enter of
+      [ `Enter of 'v * int * ('v, 'e) path
-        'v * int * ('v, 'e) path
         (* unique index in traversal, path from start *)
       | `Exit of 'v
       | `Edge of 'v * 'e * 'v * edge_kind

src/data/CCGraph.mli

@@ -150,8 +150,7 @@ module Traverse : sig
       ]
 
     type ('v, 'e) t =
-      [ `Enter of
+      [ `Enter of 'v * int * ('v, 'e) path
-        'v * int * ('v, 'e) path
         (* unique index in traversal, path from start *)
       | `Exit of 'v
       | `Edge of 'v * 'e * 'v * edge_kind

src/data/CCHashTrie.ml

@@ -202,8 +202,10 @@ module A_SPARSE = struct
          let open Stdlib in
          Array.blit a.arr real_idx arr (real_idx + 1) (n - real_idx));
       { a with bits; arr }
-    ) else if (* replace element at [real_idx] *)
+    ) else if
-              mut then (
+        (* replace element at [real_idx] *)
+        mut
+      then (
       a.arr.(real_idx) <- x;
       a
     ) else (

src/leb128/stubs.c

@@ -58,14 +58,14 @@ static inline void ix_leb128_varint(unsigned char *str, uint64_t i) {
 
 // write `i` starting at `idx`
 CAMLprim value caml_cc_leb128_varint(value _str, intnat idx, int64_t i) {
-  char *str = Bytes_val(_str);
+  unsigned char *str = Bytes_val(_str);
   ix_leb128_varint(str + idx, i);
   return Val_unit;
 }
 
 CAMLprim value caml_cc_leb128_varint_byte(value _str, value _idx, value _i) {
   CAMLparam3(_str, _idx, _i);
-  char *str = Bytes_val(_str);
+  unsigned char *str = Bytes_val(_str);
   int idx = Int_val(_idx);
   int64_t i = Int64_val(_i);
   ix_leb128_varint(str + idx, i);

src/pvec/containers_pvec.ml

@@ -352,6 +352,8 @@ let append a b =
   else
     fold_left push a b
 
+let flat_map f v : _ t = fold_left (fun acc x -> append acc (f x)) empty v
+
 let rec equal_tree eq t1 t2 =
   match t1, t2 with
   | Empty, Empty -> true

src/pvec/containers_pvec.mli

@@ -84,6 +84,11 @@ val append : 'a t -> 'a t -> 'a t
 
 val map : ('a -> 'b) -> 'a t -> 'b t
 
+val flat_map : ('a -> 'b t) -> 'a t -> 'b t
+(** A basic, fairly slow [flat_map] operation like {!CCList.flat_map}.
+    It exists for convenience but is not where this data structure shines.
+    @since NEXT_RELEASE *)
+
 val choose : 'a t -> 'a option
 (** Return an element. It is unspecified which one is returned. *)
 

tests/core/t_cbor.ml

@@ -99,12 +99,28 @@ let rec shrink (c : Cbor.t) : Cbor.t Q.Iter.t =
     let+ s = Q.Shrink.string s in
     `Bytes s
 
-let arb = Q.make ~shrink ~print:Cbor.to_string_diagnostic gen_c;;
+let arb = Q.make ~shrink ~print:Cbor.to_string_diagnostic gen_c
+
+let rec eq_c c c' =
+  match c, c' with
+  | `Null, `Null | `Undefined, `Undefined -> true
+  | `Simple i, `Simple i' -> Int.equal i i'
+  | `Bool b, `Bool b' -> Bool.equal b b'
+  | `Int i, `Int i' -> Int64.equal i i'
+  | `Float f, `Float f' -> Float.equal f f'
+  | `Bytes s, `Bytes s' -> String.equal s s'
+  | `Text t, `Text t' -> String.equal t t'
+  | `Array a, `Array a' -> CCList.equal eq_c a a'
+  | `Map m, `Map m' ->
+    CCList.equal (fun (t0, t1) (t0', t1') -> eq_c t0 t0' && eq_c t1 t1') m m'
+  | `Tag (i, t), `Tag (i', t') -> Int.equal i i' && eq_c t t'
+  | _ -> false
+;;
 
 q ~count:1_000 ~long_factor:10 arb @@ fun c ->
 let s = Cbor.encode c in
 let c' = Cbor.decode_exn s in
-if not (c = c') then
+if not (eq_c c c') then
   Q.Test.fail_reportf "@[<hv2>roundtrip failed:@ from %a@ to %a@]"
     Cbor.pp_diagnostic c Cbor.pp_diagnostic c';
 true

tests/pvec/t_pvec.ml

@@ -119,6 +119,8 @@ module Ref_impl = struct
   let to_list l = l
   let to_seq = CCSeq.of_list
   let add_list l l2 : _ t = List.append l l2
+  let append self l2 : _ t = List.append self l2
+  let flat_map sub l : _ t = CCList.flat_map (fun x -> sub @ [ x ]) l
 
   let to_list_via_reviter m =
     let l = ref [] in
@@ -159,7 +161,9 @@ module Op = struct
     | Push of 'a
     | Pop
     (* TODO: set *)
+    | Append of 'a list
     | Add_list of 'a list
+    | Flat_map of 'a list
     | Check_get of int
     | Check_choose
     | Check_is_empty
@@ -176,6 +180,8 @@ module Op = struct
       | Push _ :: tl -> loop (size + 1) tl
       | Pop :: tl -> size >= 0 && loop (size - 1) tl
       | Add_list l :: tl -> loop (size + List.length l) tl
+      | Append l :: tl -> loop (size + List.length l) tl
+      | Flat_map sub :: tl -> loop (size * (1 + List.length sub)) tl
       | Check_get x :: tl -> x < size && loop size tl
       | Check_choose :: tl
       | Check_is_empty :: tl
@@ -194,6 +200,8 @@ module Op = struct
     | Push x -> spf "push %s" (show_x x)
     | Pop -> "pop"
     | Add_list l -> spf "add_list [%s]" (String.concat ";" @@ List.map show_x l)
+    | Append l -> spf "append [%s]" (String.concat ";" @@ List.map show_x l)
+    | Flat_map l -> spf "flat_map [%s]" (String.concat ";" @@ List.map show_x l)
     | Check_get i -> spf "check_get %d" i
     | Check_choose -> "check_choose"
     | Check_is_empty -> "check_is_empty"
@@ -211,6 +219,8 @@ module Op = struct
     | Push x -> shrink_x x >|= fun x -> Push x
     | Pop -> empty
     | Add_list l -> list ~shrink:shrink_x l >|= fun x -> Add_list x
+    | Append l -> list ~shrink:shrink_x l >|= fun x -> Append x
+    | Flat_map l -> list ~shrink:shrink_x l >|= fun x -> Flat_map x
     | Check_get _ | Check_choose | Check_is_empty | Check_len | Check_to_list
     | Check_to_gen | Check_last | Check_rev_iter | Check_iter ->
       empty
@@ -252,6 +262,12 @@ module Op = struct
                    ( 1,
                      small_list gen_x >|= fun l ->
                      Add_list l, size + List.length l );
+                   ( 1,
+                     small_list gen_x >|= fun l ->
+                     Append l, size + List.length l );
+                   ( 1,
+                     list_size (0 -- 5) gen_x >|= fun l ->
+                     Flat_map l, size * (1 + List.length l) );
                  ];
                ]
         in
@@ -292,6 +308,12 @@ let check_ops ~show_x (ops : 'a Op.t list) : unit =
       | Op.Add_list l ->
         cur := add_list !cur l;
         cur_ref := Ref_impl.add_list !cur_ref l
+      | Op.Append l ->
+        cur := append !cur (of_list l);
+        cur_ref := Ref_impl.append !cur_ref l
+      | Op.Flat_map sub ->
+        cur := flat_map (fun x -> push (of_list sub) x) !cur;
+        cur_ref := Ref_impl.flat_map sub !cur_ref
       | Op.Check_get i -> if get !cur i <> Ref_impl.get i !cur_ref then fail ()
       | Op.Check_is_empty ->
         if is_empty !cur <> Ref_impl.is_empty !cur_ref then fail ()