Merge branch 'master' into stable for 1.2

AUTHORS.adoc

@@ -18,3 +18,6 @@
 - Roma Sokolov (@little-arhat)
 - Malcolm Matalka (`orbitz`)
 - David Sheets (@dsheets)
+- Glenn Slotte (glennsl)
+- @LemonBoy
+- Leonid Rozenberg (@rleonid)

CHANGELOG.adoc

@@ -1,5 +1,41 @@
 = Changelog
 
+== 1.2
+
+- make many modules extensions of stdlib (close #109)
+  the modules are: `String List ListLabels Array ArrayLabels Char Random`
+- add `CCString.{l,r}trim` (close #121)
+- add `CCInt.floor_div` and `CCInt.rem`
+- add test and bugfix for `CCBV`
+- add `CCList.take_drop_while` (close #120)
+- add `CCstring.equal_caseless` (close #112)
+- add alias `CCString.split` (close #115)
+- add `CCFormat.text` (close #111)
+- add `CCFormat.{newline,substring}`
+- add `CCList.combine_gen` (close #110)
+- add module `CCEqual`
+- add `CCResult.fold_ok` (closes #107)
+- add `CCFormat.with_color_ksf` for colored printing
+- add `CCInt.range{,',by}` for iterating on integer ranges
+- add `CCString.Sub.get`
+- add `CCResult.add_ctx{,f}` for replacing stack traces
+- add `CCString.split_on_char`
+- add `CCArray.{fold_map,scan_left}` (close #101)
+- add `CCList.scan_left`
+- add `CCList.{cartesian_product,map_product_l}`
+- add `CCUnix.with_file_lock` for locking whole files
+- add `CCFormat.of_chan`
+- add `CCFormat.flush`
+- Add `{map_lazy, or_, or_lazy, to_result, to_result_lazy, of_result}` to `CCOpt`
+
+- annotations in `CCEqual`, for optimization
+- Add a tail-recursive implementation of `List.combine`
+- fix too restrictive type in `CCResult`
+- build unix support by default
+- bugfix and test for `CCZipper.is_focused` (closes #102)
+- use boxes in `CCFormat.Dump` for tuples
+- update header, and use more `(==)` in `CCIntMap`
+
 == 1.1
 
 **bugfixes**:

Makefile

@@ -123,7 +123,7 @@ update_next_tag:
 
 devel:
 	./configure --enable-bench --enable-tests --enable-unix \
-		--enable-bigarray --enable-thread --enable-advanced
+		--enable-thread
 	make all
 
 watch:

README.adoc

@@ -12,7 +12,7 @@ map/fold_right/append, and additional functions on lists).
 Alternatively, `open Containers` will bring enhanced versions of the standard
 modules into scope.
 
-image:https://ci.cedeela.fr/buildStatus/icon?job=containers[alt="Build Status", link="http://ci.cedeela.fr/job/containers/"]
+image::https://ci.cedeela.fr/buildStatus/icon?job=containers[alt="Build Status", link="http://ci.cedeela.fr/job/containers/"]
 
 toc::[]
 
@@ -23,7 +23,7 @@ Containers is:
 - A usable, reasonably well-designed library that extends OCaml's standard
   library (in 'src/core/', packaged under `containers` in ocamlfind. Modules
   are totally independent and are prefixed with `CC` (for "containers-core"
-  or "companion-cube" because I'm megalomaniac). This part should be
+  or "companion-cube" because I'm a megalomaniac). This part should be
   usable and should work. For instance, `CCList` contains functions and
   lists including safe versions of `map` and `append`. It also
   provides a drop-in replacement to the standard library, in the module
@@ -143,6 +143,9 @@ A few guidelines:
 - add `@since` tags for new functions;
 - add tests if possible (using `qtest`).
 
+It is helpful to run `make devel` to enable everything. Some dependencies
+are required, you'll need `opam install benchmark qcheck qtest sequence`. 
+
 Powered by image:http://oasis.forge.ocamlcore.org/oasis-badge.png[alt="OASIS", style="border: none;", link="http://oasis.forge.ocamlcore.org/"]
 
 [[tutorial]]

_oasis

@@ -1,6 +1,6 @@
 OASISFormat: 0.4
 Name:        containers
-Version:     1.1
+Version:     1.2
 Homepage:    https://github.com/c-cube/ocaml-containers
 Authors:     Simon Cruanes
 License:     BSD-2-clause
@@ -26,7 +26,7 @@ Description:
 
 Flag "unix"
   Description:  Build the containers.unix library (depends on Unix)
-  Default:      false
+  Default:      true
 
 Flag "thread"
   Description:  Build modules that depend on threads
@@ -42,7 +42,7 @@ Library "containers"
                     CCFun, CCHash, CCInt, CCBool, CCFloat, CCArray, CCRef, CCSet,
                     CCOrd, CCRandom, CCString, CCHashtbl, CCMap, CCFormat, CCIO,
                     CCInt64, CCChar, CCResult, CCParse, CCArray_slice,
-                    CCListLabels, CCArrayLabels,
+                    CCListLabels, CCArrayLabels, CCEqual,
                     Containers
   BuildDepends:     bytes, result
   # BuildDepends:     bytes, bisect_ppx

benchs/run_benchs.ml

@@ -432,9 +432,7 @@ module Tbl = struct
   let arg_make : type a. a key_type -> (module KEY with type t = a) * string
   = function
     | Int -> (module CCInt), "int"
-    | Str ->
+    | Str -> (module CCString : KEY with type t = string), "string"
-        let module S = struct type t = string include CCString end in
-        (module S : KEY with type t = string), "string"
 
   let sprintf = Printf.sprintf
 

containers.odocl

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 00cb4b9b72c4140588c3e040b056e79e)
+# DO NOT EDIT (digest: 97e963a89adef885748c84195b76d95c)
 src/core/CCVector
 src/core/CCHeap
 src/core/CCList
@@ -27,6 +27,7 @@ src/core/CCParse
 src/core/CCArray_slice
 src/core/CCListLabels
 src/core/CCArrayLabels
+src/core/CCEqual
 src/core/Containers
 src/iter/CCKTree
 src/iter/CCKList

doc/intro.txt

@@ -30,6 +30,7 @@ CCArrayLabels
 CCArray_slice
 CCBool
 CCChar
+CCEqual
 CCFloat
 CCFormat
 CCFun

opam

@@ -1,6 +1,6 @@
 opam-version: "1.2"
 name: "containers"
-version: "1.1"
+version: "1.2"
 author: "Simon Cruanes"
 maintainer: "simon.cruanes@inria.fr"
 build: [

setup.ml

@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.4.4 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 03bc063e279594293a833a839f411843) *)
+(* DO NOT EDIT (digest: fdb4a0fff7e0145854a42105c9c8afcf) *)
 (*
    Regenerated by OASIS v0.4.8
    Visit http://oasis.forge.ocamlcore.org for more information and
@@ -7051,7 +7051,7 @@ let setup_t =
        {
           oasis_version = "0.4";
           ocaml_version = Some (OASISVersion.VGreaterEqual "4.00.1");
-          version = "1.1";
+          version = "1.2";
           license =
             OASISLicense.DEP5License
               (OASISLicense.DEP5Unit
@@ -7092,7 +7092,7 @@ let setup_t =
                       flag_description =
                         Some
                           "Build the containers.unix library (depends on Unix)";
-                      flag_default = [(OASISExpr.EBool true, false)]
+                      flag_default = [(OASISExpr.EBool true, true)]
                    });
                Flag
                  ({
@@ -7282,6 +7282,7 @@ let setup_t =
                            "CCArray_slice";
                            "CCListLabels";
                            "CCArrayLabels";
+                           "CCEqual";
                            "Containers"
                         ];
                       lib_pack = false;
@@ -8908,7 +8909,7 @@ let setup_t =
        };
      oasis_fn = Some "_oasis";
      oasis_version = "0.4.8";
-     oasis_digest = Some "L,\200\197\175g\230y\154\151\019\190-\138-\158";
+     oasis_digest = Some "\214\023V\1858'\142!X\\k\202\255w\167\213";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false
@@ -8916,7 +8917,7 @@ let setup_t =
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 8920 "setup.ml"
+# 8921 "setup.ml"
 let setup_t = BaseCompat.Compat_0_4.adapt_setup_t setup_t
 open BaseCompat.Compat_0_4
 (* OASIS_STOP *)

src/core/CCArray.ml

@@ -18,6 +18,8 @@ type 'a printer = Format.formatter -> 'a -> unit
 
 (** {2 Arrays} *)
 
+include Array
+
 type 'a t = 'a array
 
 let empty = [| |]
@@ -71,6 +73,48 @@ let fold_while f acc a =
   fold_while (fun acc b -> if b then acc+1, `Continue else acc, `Stop) 0 (Array.of_list [true;true;false;true]) = 2
 *)
 
+let fold_map f acc a =
+  let n = length a in
+  (* need special case for initializing the result *)
+  if n = 0 then acc, [||]
+  else (
+    let acc, b0 = f acc a.(0) in
+    let res = Array.make n b0 in
+    let acc = ref acc in
+    for i = 1 to n-1 do
+      let new_acc, b = f !acc a.(i) in
+      acc := new_acc;
+      res.(i) <- b;
+    done;
+    !acc, res
+  )
+
+(*$=
+  (6, [|"1"; "2"; "3"|]) \
+    (fold_map (fun acc x->acc+x, string_of_int x) 0 [|1;2;3|])
+*)
+
+(*$Q
+  Q.(array int) (fun a -> \
+    fold_map (fun acc x -> x::acc, x) [] a = (List.rev @@ Array.to_list a, a))
+*)
+
+let scan_left f acc a =
+  let n = length a in
+  let res = Array.make (n+1) acc in
+  Array.iteri
+    (fun i x ->
+       let new_acc = f res.(i) x in
+       res.(i+1) <- new_acc)
+    a;
+  res
+
+(*$= & ~printer:Q.Print.(array int)
+  [|0;1;3;6|] (scan_left (+) 0 [|1;2;3|])
+  [|0|] (scan_left (+) 0 [||])
+*)
+
+
 let iter = Array.iter
 
 let iteri = Array.iteri
@@ -141,7 +185,7 @@ let sort_ranking cmp a =
 *)
 
 (*$Q
-  Q.(array printable_string) (fun a -> \
+  Q.(array_of_size Gen.(0--50) printable_string) (fun a -> \
     let b = sort_ranking String.compare a in \
     let a_sorted = sorted String.compare a in \
     a = Array.map (Array.get a_sorted) b)

src/core/CCArray.mli

@@ -13,6 +13,8 @@ type 'a printer = Format.formatter -> 'a -> unit
 
 (** {2 Arrays} *)
 
+include module type of Array
+
 type 'a t = 'a array
 
 val empty : 'a t
@@ -41,6 +43,17 @@ val fold_while : ('a -> 'b -> 'a * [`Stop | `Continue]) -> 'a -> 'b t -> 'a
     indicated by the accumulator
     @since 0.8 *)
 
+val fold_map : ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a t -> 'acc * 'b t
+(** [fold_map f acc a] is a [fold_left]-like function, but it also maps the
+    array to another array.
+    @since 1.2 *)
+
+val scan_left : ('acc -> 'a -> 'acc) -> 'acc -> 'a t -> 'acc t
+(** [scan_left f acc a] returns the array
+    [ [|acc; f acc x0; f (f acc a.(0)) a.(1); …|] ]
+    @since 1.2 *)
+
+
 val iter : ('a -> unit) -> 'a t -> unit
 
 val iteri : (int -> 'a -> unit) -> 'a t -> unit

src/core/CCArrayLabels.ml

@@ -18,6 +18,8 @@ type 'a printer = Format.formatter -> 'a -> unit
 
 (** {2 Arrays} *)
 
+include ArrayLabels
+
 type 'a t = 'a array
 
 let empty = [| |]

src/core/CCArrayLabels.mli

@@ -13,6 +13,8 @@ type 'a printer = Format.formatter -> 'a -> unit
 
 (** {2 Arrays} *)
 
+include module type of ArrayLabels
+
 type 'a t = 'a array
 
 val empty : 'a t

src/core/CCArray_slice.ml

@@ -306,7 +306,7 @@ let sort_ranking cmp a =
 *)
 
 (*$Q
-  Q.(array printable_string) (fun a -> \
+  Q.(array_of_size Gen.(0--50) printable_string) (fun a -> \
   Array.length a > 10 ==> ( Array.length a > 10 && \
   let s = make a 5 ~len:5 in \
   let b = sort_indices String.compare s in \
@@ -325,7 +325,7 @@ let sort_indices cmp a = _sort_indices cmp a.arr a.i a.j
 *)
 
 (*$Q
-  Q.(array printable_string) (fun a -> \
+  Q.(array_of_size Gen.(0--60) printable_string) (fun a -> \
   Array.length a > 10 ==> ( Array.length a > 10 && \
   let s = make a 5 ~len:5 in \
   let b = sort_ranking String.compare s in \

src/core/CCChar.ml

@@ -4,10 +4,9 @@
 
     @since 0.14 *)
 
-type t = char
+include Char
 
 let equal (a:char) b = a=b
-let compare = Char.compare
 
 let pp = Buffer.add_char
 let print = Format.pp_print_char

src/core/CCChar.mli

@@ -4,7 +4,7 @@
 
     @since 0.14 *)
 
-type t = char
+include module type of Char
 
 val equal : t -> t -> bool
 val compare : t -> t -> int

src/core/CCEqual.ml

@@ -0,0 +1,50 @@
+
+(* This file is free software, part of containers. See file "license" for more details. *)
+
+(** {1 Equality Combinators} *)
+
+type 'a t = 'a -> 'a -> bool
+
+let poly = (=)
+
+let int : int t = (=)
+let string : string t = (=)
+let bool : bool t = (=)
+let float : float t = (=)
+let unit () () = true
+
+let rec list f l1 l2 = match l1, l2 with
+  | [], [] -> true
+  | [], _ | _, [] -> false
+  | x1::l1', x2::l2' -> f x1 x2 && list f l1' l2'
+
+let array eq a b =
+  let rec aux i =
+    if i = Array.length a then true
+    else eq a.(i) b.(i) && aux (i+1)
+  in
+  Array.length a = Array.length b
+  &&
+  aux 0
+
+let option f o1 o2 = match o1, o2 with
+  | None, None -> true
+  | Some _, None
+  | None, Some _ -> false
+  | Some x, Some y -> f x y
+
+let pair f g (x1,y1)(x2,y2) = f x1 x2 && g y1 y2
+let triple f g h (x1,y1,z1)(x2,y2,z2) = f x1 x2 && g y1 y2 && h z1 z2
+
+let map f eq x y = eq (f x) (f y)
+
+(*$Q
+  Q.(let p = small_list (pair small_int bool) in pair p p) (fun (l1,l2) -> \
+    CCEqual.(list (pair int bool)) l1 l2 = (l1=l2))
+*)
+
+module Infix = struct
+  let (>|=) x f = map f x
+end
+
+include Infix

src/core/CCEqual.mli

@@ -0,0 +1,40 @@
+
+(* This file is free software, part of containers. See file "license" for more details. *)
+
+(** {1 Equality Combinators} *)
+
+(** @since 1.2 *)
+
+type 'a t = 'a -> 'a -> bool
+(** Equality function. Must be transitive, symmetric, and reflexive. *)
+
+val poly : 'a t
+(** Standard polymorphic equality *)
+
+val int : int t
+val string : string t
+val bool : bool t
+val float : float t
+val unit : unit t
+
+val list : 'a t -> 'a list t
+val array : 'a t -> 'a array t
+
+val option : 'a t -> 'a option t
+val pair : 'a t -> 'b t -> ('a * 'b) t
+val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
+
+val map : ('a -> 'b) -> 'b t -> 'a t
+(** [map f eq] is the equality function that, given objects [x] and [y],
+    projects [x] and [y] using [f] (e.g. using a record field) and then
+    compares those projections with [eq].
+    Example:
+    [map fst int] compares values of type [(int * 'a)]  by their
+      first component. *)
+
+val (>|=) : 'b t -> ('a -> 'b) -> 'a t
+(** Infix equivalent of {!map} *)
+
+module Infix : sig
+  val (>|=) : 'b t -> ('a -> 'b) -> 'a t
+end

src/core/CCFloat.ml

@@ -73,6 +73,7 @@ let to_int (a:float) = Pervasives.int_of_float a
 let of_int (a:int) = Pervasives.float_of_int a
 
 let to_string (a:float) = Pervasives.string_of_float a
+let of_string_exn (a:string) = Pervasives.float_of_string a
 let of_string (a:string) = Pervasives.float_of_string a
 
 

src/core/CCFloat.mli

@@ -68,11 +68,23 @@ val sign_exn : t -> int
     @since 0.7 *)
 
 val to_int : t -> int
+(** Alias to {!int_of_float}.
+    Unspecified if outside of the range of integers. *)
+
 val of_int : int -> t
+(** Alias to {!float_of_int} *)
 
 val to_string : t -> string
-val of_string : string -> t
 
+val of_string_exn : string -> t
+(** Alias to {!float_of_string}
+    @raise Failure in case of failure
+    @since 1.2 *)
+
+val of_string : string -> t
+(** Alias to {!float_of_string}.
+    @deprecated since 1.2, use {!of_string_exn} instead
+    @raise Failure in case of failure *)
 
 val equal_precision : epsilon:t -> t -> t -> bool
 (** Equality with allowed error up to a non negative epsilon value *)

src/core/CCFormat.ml

@@ -37,6 +37,47 @@ let int32 fmt n = Format.fprintf fmt "%ld" n
 let int64 fmt n = Format.fprintf fmt "%Ld" n
 let nativeint fmt n = Format.fprintf fmt "%nd" n
 let string_quoted fmt s = Format.fprintf fmt "\"%s\"" s
+let flush = Format.pp_print_flush
+
+let newline = Format.pp_force_newline
+
+let substring out (s,i,len): unit =
+  string out (String.sub s i len)
+
+let text out (s:string): unit =
+  let len = String.length s in
+  let i = ref 0 in
+  let search_ c =
+    try Some (String.index_from s !i c) with Not_found -> None
+  in
+  while !i < len do
+    let j_newline = search_ '\n' in
+    let j_space = search_ ' ' in
+    let on_newline j =
+      substring out (s, !i, j - !i);
+      newline out ();
+      i := j + 1
+    and on_space j =
+      substring out (s, !i, j - !i);
+      Format.pp_print_space out ();
+      i := j + 1
+    in
+    begin match j_newline, j_space with
+      | None, None ->
+        (* done *)
+        substring out (s, !i, len - !i);
+        i := len
+      | Some j, None -> on_newline j
+      | None, Some j -> on_space j
+      | Some j1, Some j2 ->
+        if j1<j2 then on_newline j1 else on_space j2
+    end
+  done
+
+(*$= & ~printer:(fun s->CCFormat.sprintf "%S" s)
+  "a\nb\nc" (sprintf_no_color "@[<v>%a@]%!" text "a b c")
+  "a b\nc" (sprintf_no_color "@[<h>%a@]%!" text "a b\nc")
+  *)
 
 let list ?(sep=return ",@ ") pp fmt l =
   let rec pp_list l = match l with
@@ -134,6 +175,18 @@ let fprintf = Format.fprintf
 let stdout = Format.std_formatter
 let stderr = Format.err_formatter
 
+let of_chan = Format.formatter_of_out_channel
+
+let with_out_chan oc f =
+  let fmt = of_chan oc in
+  try
+    let x = f fmt in
+    Format.pp_print_flush fmt ();
+    x
+  with e ->
+    Format.pp_print_flush fmt ();
+    raise e
+
 let tee a b =
   let fa = Format.pp_get_formatter_out_functions a () in
   let fb = Format.pp_get_formatter_out_functions b () in
@@ -311,7 +364,7 @@ let sprintf_ c format =
     fmt
     format
 
-let with_color_sf s fmt =
+let with_color_ksf ~f s fmt =
   let buf = Buffer.create 64 in
   let out = Format.formatter_of_buffer buf in
   if !color_enabled then set_color_tag_handling out;
@@ -320,9 +373,11 @@ let with_color_sf s fmt =
     (fun out ->
        Format.pp_close_tag out ();
        Format.pp_print_flush out ();
-       Buffer.contents buf)
+       f (Buffer.contents buf))
     out fmt
 
+let with_color_sf s fmt = with_color_ksf ~f:(fun s->s) s fmt
+
 let sprintf fmt = sprintf_ true fmt
 let sprintf_no_color fmt = sprintf_ false fmt
 let sprintf_dyn_color ~colors fmt = sprintf_ colors fmt
@@ -371,12 +426,12 @@ module Dump = struct
   let option pp out x = match x with
     | None -> Format.pp_print_string out "None"
     | Some x -> Format.fprintf out "Some %a" pp x
-  let pair p1 p2 = within "(" ")" (pair p1 p2)
+  let pair p1 p2 = within "(" ")" (hovbox (pair p1 p2))
-  let triple p1 p2 p3 = within "(" ")" (triple p1 p2 p3)
+  let triple p1 p2 p3 = within "(" ")" (hovbox (triple p1 p2 p3))
-  let quad p1 p2 p3 p4 = within "(" ")" (quad p1 p2 p3 p4)
+  let quad p1 p2 p3 p4 = within "(" ")" (hovbox (quad p1 p2 p3 p4))
   let result' pok perror out = function
-    | Result.Ok x -> Format.fprintf out "(Ok %a)" pok x
+    | Result.Ok x -> Format.fprintf out "(@[Ok %a@])" pok x
-    | Result.Error e -> Format.fprintf out "(Error %a)" perror e
+    | Result.Error e -> Format.fprintf out "(@[Error %a@])" perror e
   let result pok = result' pok string
   let to_string = to_string
 end

src/core/CCFormat.mli

@@ -23,11 +23,32 @@ val bool : bool printer
 val float3 : float printer (* 3 digits after . *)
 val float : float printer
 
+val newline : unit printer
+(** Force newline (see {!Format.pp_force_newline})
+    @since 1.2 *)
+
+val substring : (string * int * int) printer
+(** Print the substring [(s,i,len)], where [i] is the offset
+    in [s] and [len] the number of bytes in the substring.
+    @raise Invalid_argument if the triple [(s,i,len)] does not
+    describe a proper substring.
+    @since 1.2 *)
+
+val text : string printer
+(** Print string, but replacing spaces with breaks and newlines
+    with {!newline}.
+    See [pp_print_text] on recent versions of OCaml.
+    @since 1.2 *)
+
 val char : char printer (** @since 0.14 *)
 val int32 : int32 printer (** @since 0.14 *)
 val int64 : int64 printer (** @since 0.14 *)
 val nativeint : nativeint printer (** @since 0.14 *)
 
+val flush : unit printer
+(** Alias to {!Format.pp_print_flush}.
+    @since 1.2 *)
+
 val string_quoted : string printer
 (** Similar to {!CCString.print}.
     @since 0.14 *)
@@ -175,11 +196,31 @@ val with_color_sf : string -> ('a, t, unit, string) format4 -> 'a
     {b status: experimental}
     @since 0.21 *)
 
+val with_color_ksf : f:(string -> 'b) -> string -> ('a, t, unit, 'b) format4 -> 'a
+(** [with_color_ksf "Blue" ~f "%s %d" "yolo" 42] will behave like
+    {!ksprintf}, but wrapping the content with the given style
+    Example:
+    the following with raise [Failure] with a colored message
+    {[
+      CCFormat.with_color_ksf "red" ~f:failwith "%a" CCFormat.Dump.(list int) [1;2;3];;
+    ]}
+    @since 1.2 *)
+
 (** {2 IO} *)
 
 val output : t -> 'a printer -> 'a -> unit
 val to_string : 'a printer -> 'a -> string
 
+val of_chan : out_channel -> t
+(** Alias to {!Format.formatter_of_out_channel}
+    @since 1.2 *)
+
+val with_out_chan : out_channel -> (t -> 'a) -> 'a
+(** [with_out_chan oc f] turns [oc] into a formatter [fmt], and call [f fmt].
+    Behaves like [f fmt] from then on, but whether the call to [f] fails
+    or returns, [fmt] is flushed before the call terminates.
+    @since 1.2 *)
+
 val stdout : t
 val stderr : t
 

src/core/CCInt.ml

@@ -37,8 +37,86 @@ let pow a b =
   pow 0 1 = 0
 *)
 
+let floor_div a n =
+  if a < 0 && n >= 0 then
+    (a + 1) / n - 1
+  else if a > 0 && n < 0 then
+    (a - 1) / n - 1
+  else
+    a / n
+
+(*$T
+  (floor_div 3 5 = 0)
+  (floor_div 5 5 = 1)
+  (floor_div 20 5 = 4)
+  (floor_div 12 5 = 2)
+  (floor_div 0 5 = 0)
+  (floor_div (-1) 5 = -1)
+  (floor_div (-5) 5 = -1)
+  (floor_div (-12) 5 = -3)
+
+  (floor_div 0 (-5) = 0)
+  (floor_div 3 (-5) = -1)
+  (floor_div 5 (-5) = -1)
+  (floor_div 9 (-5) = -2)
+  (floor_div 20 (-5) = -4)
+  (floor_div (-2) (-5) = 0)
+  (floor_div (-8) (-5) = 1)
+  (floor_div (-35) (-5) = 7)
+
+  try ignore (floor_div 12 0); false with Division_by_zero -> true
+  try ignore (floor_div (-12) 0); false with Division_by_zero -> true
+*)
+
+(*$Q
+  (Q.pair Q.small_signed_int Q.pos_int) \
+      (fun (n, m) -> floor_div n m = int_of_float @@ floor (float n /. float m))
+  (Q.pair Q.small_signed_int Q.pos_int) \
+      (fun (n, m) -> floor_div n (-m) = int_of_float @@ floor (float n /. float (-m)))
+*)
+
+let rem a n =
+  let y = a mod n in
+  if (y < 0) <> (n < 0) && y <> 0 then
+    y + n
+  else
+    y
+
+(*$T
+  (rem 3 5 = 3)
+  (rem 5 5 = 0)
+  (rem 9 5 = 4)
+  (rem (-1) 5 = 4)
+  (rem (-5) 5 = 0)
+  (rem (-20) 5 = 0)
+  (rem (-9) 5 = 1)
+  (rem 0 5 = 0)
+
+  (rem 0 (-5) = 0)
+  (rem 3 (-5) = -2)
+  (rem 5 (-5) = 0)
+  (rem 9 (-5) = -1)
+  (rem (-2) (-5) = -2)
+  (rem (-8) (-5) = -3)
+  (rem (-35) (-5) = 0)
+
+  try ignore (rem 12 0); false with Division_by_zero -> true
+  try ignore (rem (-12) 0); false with Division_by_zero -> true
+*)
+
+(*$Q
+  (Q.pair Q.int Q.pos_int) (fun (n, m) -> let y = rem n m in y >= 0 && y < m)
+  (Q.pair Q.int Q.pos_int) (fun (n, m) -> let y = rem n (-m) in y > (-m) && y <= 0)
+*)
+
+(*$Q
+  (Q.pair Q.int Q.pos_int) (fun (n, m) -> n = m * floor_div n m + rem n m)
+  (Q.pair Q.int Q.pos_int) (fun (n, m) -> n = (-m) * floor_div n (-m) + rem n (-m))
+*)
+
 type 'a printer = Format.formatter -> 'a -> unit
 type 'a random_gen = Random.State.t -> 'a
+type 'a sequence = ('a -> unit) -> unit
 
 let random n st = Random.State.int st n
 let random_small = random 100
@@ -96,6 +174,76 @@ let to_string_binary n =
   Q.int (fun n -> n = int_of_string (to_string_binary n))
 *)
 
+let range_by ~step i j yield =
+  let rec range i j yield =
+    if i=j then yield i
+    else (
+      yield i;
+      range (i+step) j yield
+    )
+  in
+  if step = 0 then
+    raise (Invalid_argument "CCList.range_by")
+  else if (if step > 0 then i>j else i<j) then ()
+  else range i ((j-i)/step*step + i) yield
+
+(* note: the last test checks that no error occurs due to overflows. *)
+(*$= & ~printer:Q.Print.(list int)
+  [0]     (range_by ~step:1   0 0     |> Sequence.to_list)
+  []      (range_by ~step:1   5 0     |> Sequence.to_list)
+  []      (range_by ~step:2   1 0     |> Sequence.to_list)
+  [0;2;4] (range_by ~step:2   0 4     |> Sequence.to_list)
+  [0;2;4] (range_by ~step:2   0 5     |> Sequence.to_list)
+  [0]     (range_by ~step:~-1 0 0     |> Sequence.to_list)
+  []      (range_by ~step:~-1 0 5     |> Sequence.to_list)
+  []      (range_by ~step:~-2 0 1     |> Sequence.to_list)
+  [5;3;1] (range_by ~step:~-2 5 1     |> Sequence.to_list)
+  [5;3;1] (range_by ~step:~-2 5 0     |> Sequence.to_list)
+  [0]     (range_by ~step:max_int 0 2 |> Sequence.to_list)
+*)
+
+(*$Q
+  Q.(pair small_int small_int) (fun (i,j) -> \
+    let i = min i j and j = max i j in \
+    CCList.equal CCInt.equal \
+      (CCInt.range_by ~step:1 i j |> Sequence.to_list) \
+      (CCInt.range i j |> Sequence.to_list) )
+*)
+
+let range i j yield =
+  let rec up i j yield =
+    if i=j then yield i
+    else (
+      yield i;
+      up (i+1) j yield
+    )
+  and down i j yield =
+    if i=j then yield i
+    else (
+      yield i;
+      down (i-1) j yield
+    )
+  in
+  if i<=j then up i j yield else down i j yield
+
+(*$= & ~printer:Q.Print.(list int)
+  [0;1;2;3;4;5] (range 0 5 |> Sequence.to_list)
+  [0]           (range 0 0 |> Sequence.to_list)
+  [5;4;3;2]     (range 5 2 |> Sequence.to_list)
+*)
+
+let range' i j yield =
+  if i<j then range i (j-1) yield
+  else if i=j then ()
+  else range i (j+1) yield
+
+(*$= & ~printer:Q.Print.(list int)
+  []          (range' 0 0 |> Sequence.to_list)
+  [0;1;2;3;4] (range' 0 5 |> Sequence.to_list)
+  [5;4;3]     (range' 5 2 |> Sequence.to_list)
+*)
+
+
 module Infix = struct
   let (=) = Pervasives.(=)
   let (<>) = Pervasives.(<>)
@@ -103,6 +251,8 @@ module Infix = struct
   let (>) = Pervasives.(>)
   let (<=) = Pervasives.(<=)
   let (>=) = Pervasives.(>=)
+  let (--) = range
+  let (--^) = range'
 end
 include Infix
 let min = min

src/core/CCInt.mli

@@ -23,8 +23,19 @@ val pow : t -> t -> t
     Raises [Invalid_argument] if [a = b = 0] or [b] < 0.
     @since 0.11 *)
 
+val floor_div : t -> t -> t
+(** [floor_div a n] is integer division rounding towards negative infinity.
+    It satisfies [a = m * floor_div a n + rem a n].
+    @since 1.2 *)
+
+val rem : t -> t -> t
+(** [rem a n] is the remainder of dividing [a] by [n], with the same
+    sign as [n].
+    @since 1.2 *)
+
 type 'a printer = Format.formatter -> 'a -> unit
 type 'a random_gen = Random.State.t -> 'a
+type 'a sequence = ('a -> unit) -> unit
 
 val random : int -> t random_gen
 val random_small : t random_gen
@@ -51,6 +62,23 @@ val min : t -> t -> t
 val max : t -> t -> t
 (** @since 0.17 *)
 
+val range_by : step:t -> t -> t -> t sequence
+(** [range_by ~step i j] iterates on integers from [i] to [j] included,
+    where the difference between successive elements is [step].
+    use a negative [step] for a decreasing list.
+    @raise Invalid_argument if [step=0]
+    @since 1.2 *)
+
+val range : t -> t -> t sequence
+(** [range i j] iterates on integers from [i] to [j] included . It works
+    both for decreasing and increasing ranges
+    @since 1.2 *)
+
+val range' : t -> t -> t sequence
+(** Same as {!range} but the second bound is excluded.
+    For instance [range' 0 5 = Sequence.of_list [0;1;2;3;4]]
+    @since 1.2 *)
+
 (** {2 Infix Operators}
 
     @since 0.17 *)
@@ -72,6 +100,14 @@ module Infix : sig
 
   val (>=) : t -> t -> bool
   (** @since 0.17 *)
+
+  val (--) : t -> t -> t sequence
+  (** Alias to {!range}
+      @since 1.2 *)
+
+  val (--^) : t -> t -> t sequence
+  (** Alias to {!range'}
+      @since 1.2 *)
 end
 
 include module type of Infix

src/core/CCInt64.mli

@@ -53,24 +53,32 @@ val to_int : t -> int
 val of_int : int -> t option
 
 val of_int_exn : int -> t
+(** Alias to {!Int64.of_int}
+    @raise Failure in case of failure *)
 
 val to_int32 : t -> int32
 
 val of_int32 : int32 -> t option
 
 val of_int32_exn : int32 -> t
+(** Alias to {!Int64.of_int32}
+    @raise Failure in case of failure *)
 
 val to_nativeint : t -> nativeint
 
 val of_nativeint : nativeint -> t option
 
 val of_nativeint_exn : nativeint -> t
+(** Alias to {!Int64.of_nativeint}
+    @raise Failure in case of failure *)
 
 val to_float : t -> float
 
 val of_float : float -> t option
 
 val of_float_exn : float -> t
+(** Alias to {!Int64.of_float}
+    @raise Failure in case of failure *)
 
 val to_string : t -> string
 

src/core/CCList.ml

@@ -9,6 +9,8 @@
 
 type 'a t = 'a list
 
+include List
+
 let empty = []
 
 let is_empty = function
@@ -152,6 +154,26 @@ let fold_map f acc l =
     fold_map (fun acc x -> x::acc, x) [] l = (List.rev l, l))
 *)
 
+let scan_left f acc l =
+  let rec aux f acc l_acc l = match l with
+    | [] -> List.rev l_acc
+    | x :: tail ->
+      let acc = f acc x in
+      let l_acc = acc :: l_acc in
+      aux f acc l_acc tail
+  in
+  aux f acc [acc] l
+
+(*$= & ~printer:Q.Print.(list int)
+  [0;1;3;6] (scan_left (+) 0 [1;2;3])
+  [0] (scan_left (+) 0 [])
+*)
+
+(*$Q
+  Q.(list int) (fun l -> \
+    List.length l + 1 = List.length (scan_left (+) 0 l))
+*)
+
 let fold_map2 f acc l1 l2 =
   let rec aux f acc map_acc l1 l2 = match l1, l2 with
     | [], [] -> acc, List.rev map_acc
@@ -277,8 +299,8 @@ let fold_product f acc l1 l2 =
     (fun acc x1 ->
        List.fold_left
          (fun acc x2 -> f acc x1 x2)
-         acc l2
+         acc l2)
-    ) acc l1
+    acc l1
 
 let diagonal l =
   let rec gen acc l = match l with
@@ -319,6 +341,52 @@ let partition_map f l =
   assert_equal [1;3] l2
 *)
 
+let combine l1 l2 =
+  let rec direct i l1 l2 = match l1, l2 with
+    | ([], []) -> []
+    | _ when i=0 -> safe l1 l2 []
+    | (x1::l1', x2::l2') -> (x1, x2) :: direct (i-1) l1' l2'
+    | (_, _) -> invalid_arg "CCList.combine"
+  and safe l1 l2 acc = match l1, l2 with
+    | ([], []) -> List.rev acc
+    | (x1::l1', x2::l2') -> safe l1' l2' @@ (x1, x2) :: acc
+    | (_, _) -> invalid_arg "CCList.combine"
+  in
+  direct direct_depth_default_ l1 l2
+
+(*$T
+  try ignore (combine [1] []); false with Invalid_argument _ -> true
+  try ignore (combine (1--1001) (1--1002)); false with Invalid_argument _ -> true
+  combine [1;2;3] [3;2;1] = List.combine [1;2;3] [3;2;1]
+  combine (1 -- 100_000) (1 -- 100_000) = List.combine (1 -- 100_000) (1 -- 100_000)
+*)
+
+(*$Q
+  Q.(let p = small_list int in pair p p)(fun (l1,l2) -> \
+    if List.length l1=List.length l2 \
+    then CCList.combine l1 l2 = List.combine l1 l2 \
+    else Q.assume_fail() )
+  *)
+
+let combine_gen l1 l2 =
+  let l1 = ref l1 in
+  let l2 = ref l2 in
+  fun () -> match !l1, !l2 with
+    | [], _
+    | _, [] -> None
+    | x1 :: tail1, x2 :: tail2 ->
+      l1 := tail1;
+      l2 := tail2;
+      Some (x1,x2)
+
+(*$Q
+  Q.(let p = small_list int in pair p p)(fun (l1,l2) -> \
+    let n = min (List.length l1) (List.length l2) in \
+    let res1 = combine (take n l1) (take n l2) in \
+    let res2 = combine_gen l1 l2 |> of_gen in \
+    res1 = res2)
+  *)
+
 let return x = [x]
 
 let (>>=) l f = flat_map f l
@@ -329,6 +397,44 @@ let pure = return
 
 let (<*>) funs l = product (fun f x -> f x) funs l
 
+let cartesian_product l =
+  (* [left]: elements picked so far
+     [right]: sets to pick elements from
+     [acc]: accumulator for the result, to pass to continuation
+     [k]: continuation *)
+  let rec prod_rec left right k acc = match right with
+    | [] -> k acc (List.rev left)
+    | l1 :: tail ->
+      List.fold_left
+        (fun acc x -> prod_rec (x::left) tail k acc)
+        acc l1
+  in
+  prod_rec [] l (fun acc l' -> l' :: acc) []
+
+(*$inject
+  let cmp_lii_unord l1 l2 : bool =
+    List.sort CCOrd.compare l1 = List.sort CCOrd.compare l2
+*)
+
+(*$= & ~printer:Q.Print.(list (list int)) ~cmp:cmp_lii_unord
+  [[1;3;4];[1;3;5];[1;3;6];[2;3;4];[2;3;5];[2;3;6]] \
+    (cartesian_product [[1;2];[3];[4;5;6]])
+  [] (cartesian_product [[1;2];[];[4;5;6]])
+  [[]] (cartesian_product [])
+  [[1;3;4;5;6];[2;3;4;5;6]] \
+    (cartesian_product [[1;2];[3];[4];[5];[6]])
+*)
+
+(* cartesian product of lists of lists *)
+let map_product_l f l =
+  let l = List.map f l in
+  cartesian_product l
+
+(*$Q
+  Q.(list_of_size Gen.(1--4) (list_of_size Gen.(0--4) small_int)) (fun l-> \
+    cmp_lii_unord (cartesian_product l) (map_product_l CCFun.id l))
+*)
+
 let sorted_merge ?(cmp=Pervasives.compare) l1 l2 =
   let rec recurse cmp acc l1 l2 = match l1,l2 with
     | [], _ -> List.rev_append acc l2
@@ -596,6 +702,29 @@ let rec drop_while p l = match l with
     take_while f l @ drop_while f l = l)
 *)
 
+let take_drop_while p l =
+  let rec direct i p l = match l with
+    | [] -> [], []
+    | _ when i=0 -> safe p [] l
+    | x :: tail ->
+      if p x
+      then
+        let l1, l2 = direct (i-1) p tail in
+        x :: l1, l2
+      else [], l
+  and safe p acc l = match l with
+    | [] -> List.rev acc, []
+    | x :: tail ->
+      if p x then safe p (x::acc) tail else List.rev acc, l
+  in
+  direct direct_depth_default_ p l
+
+(*$Q
+  Q.(pair (fun1 small_int bool) (list small_int)) (fun (f,l) -> \
+    let l1,l2 = take_drop_while f l in \
+    (l1 = take_while f l) && (l2 = drop_while f l))
+*)
+
 let last n l =
   let len = List.length l in
   if len < n then l else drop (len-n) l

src/core/CCList.mli

@@ -3,6 +3,14 @@
 
 (** {1 complements to list} *)
 
+type 'a sequence = ('a -> unit) -> unit
+type 'a gen = unit -> 'a option
+type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
+type 'a printer = Format.formatter -> 'a -> unit
+type 'a random_gen = Random.State.t -> 'a
+
+include module type of List
+
 type 'a t = 'a list
 
 val empty : 'a t
@@ -48,6 +56,11 @@ val fold_map : ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a list -> 'acc * 'b list
     list to another list.
     @since 0.14 *)
 
+val scan_left : ('acc -> 'a -> 'acc) -> 'acc -> 'a list -> 'acc list
+(** [scan_left f acc l] returns the list [[acc; f acc x0; f (f acc x0) x1; …]]
+    where [x0], [x1], etc. are the elements of [l]
+    @since 1.2 *)
+
 val fold_map2 : ('acc -> 'a -> 'b -> 'acc * 'c) -> 'acc -> 'a list -> 'b list -> 'acc * 'c list
 (** [fold_map2] is to [fold_map] what [List.map2] is to [List.map].
     @raise Invalid_argument if the lists do not have the same length
@@ -67,6 +80,18 @@ val init : int -> (int -> 'a) -> 'a t
 (** Similar to {!Array.init}
     @since 0.6 *)
 
+val combine : 'a list -> 'b list -> ('a * 'b) list
+(** Similar to {!List.combine} but tail-recursive.
+    @raise Invalid_argument if the lists have distinct lengths.
+    @since 1.2 *)
+
+val combine_gen : 'a list -> 'b list -> ('a * 'b) gen
+(** Lazy version of {!combine}.
+    Unlike {!combine}, it does not fail if the lists have different
+    lengths;
+    instead, the output has as many pairs as the smallest input list.
+    @since 1.2 *)
+
 val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
 
 val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
@@ -83,6 +108,26 @@ val product : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
 val fold_product : ('c -> 'a -> 'b -> 'c) -> 'c -> 'a t -> 'b t -> 'c
 (** Fold on the cartesian product *)
 
+val cartesian_product : 'a t t -> 'a t t
+(**
+    For example:
+    {[
+      # cartesian_product [[1;2];[3];[4;5;6]] =
+          [[1;3;4];[1;3;5];[1;3;6];[2;3;4];[2;3;5];[2;3;6]];;
+      # cartesian_product [[1;2];[];[4;5;6]] = [];;
+      # cartesian_product [[1;2];[3];[4];[5];[6]] =
+          [[1;3;4;5;6];[2;3;4;5;6]];;
+    ]}
+    invariant: [cartesian_product l = map_product id l].
+    @since 1.2 *)
+
+val map_product_l : ('a -> 'b list) -> 'a list -> 'b list list
+(** [map_product_l f l] maps each element of [l] to a list of
+    objects of type ['b] using [f].
+    We obtain [[l1;l2;…;ln]] where [length l=n] and [li : 'b list].
+    Then, it returns all the ways of picking exactly one element per [li].
+    @since 1.2 *)
+
 val diagonal : 'a t -> ('a * 'a) t
 (** All pairs of distinct positions of the list. [list_diagonal l] will
     return the list of [List.nth i l, List.nth j l] if [i < j]. *)
@@ -154,6 +199,10 @@ val take_while : ('a -> bool) -> 'a t -> 'a t
 val drop_while : ('a -> bool) -> 'a t -> 'a t
 (** @since 0.13 *)
 
+val take_drop_while : ('a -> bool) -> 'a t -> 'a t * 'a t
+(** [take_drop_while p l = take_while p l, drop_while p l]
+    @since 1.2 *)
+
 val last : int -> 'a t -> 'a t
 (** [last n l] takes the last [n] elements of [l] (or less if
     [l] doesn't have that many elements *)
@@ -408,12 +457,6 @@ end
 
 (** {2 Conversions} *)
 
-type 'a sequence = ('a -> unit) -> unit
-type 'a gen = unit -> 'a option
-type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
-type 'a printer = Format.formatter -> 'a -> unit
-type 'a random_gen = Random.State.t -> 'a
-
 val random : 'a random_gen -> 'a t random_gen
 val random_non_empty : 'a random_gen -> 'a t random_gen
 val random_len : int -> 'a random_gen -> 'a t random_gen

src/core/CCListLabels.ml

@@ -7,6 +7,8 @@
   let lsort l = List.sort Pervasives.compare l
 *)
 
+include ListLabels
+
 type 'a t = 'a list
 
 let empty = []

src/core/CCListLabels.mli

@@ -3,6 +3,8 @@
 
 (** {1 complements to list} *)
 
+include module type of ListLabels
+
 type 'a t = 'a list
 
 val empty : 'a t

src/core/CCOpt.ml

@@ -13,6 +13,10 @@ let map_or ~default f = function
   | None -> default
   | Some x -> f x
 
+let map_lazy default_fn f = function
+  | None -> default_fn ()
+  | Some x -> f x
+
 let is_some = function
   | None -> false
   | Some _ -> true
@@ -54,10 +58,16 @@ let (<*>) f x = match f, x with
 
 let (<$>) = map
 
-let (<+>) a b = match a with
+let or_ ~else_ a = match a with
-  | None -> b
+  | None -> else_
   | Some _ -> a
 
+let or_lazy ~else_ a = match a with
+  | None -> else_ ()
+  | Some _ -> a
+
+let (<+>) a b = or_ ~else_:b a
+
 let choice l = List.fold_left (<+>) None l
 
 let map2 f o1 o2 = match o1, o2 with
@@ -137,6 +147,18 @@ let of_list = function
   | x::_ -> Some x
   | [] -> None
 
+let to_result err = function
+  | None -> Result.Error err
+  | Some x -> Result.Ok x
+
+let to_result_lazy err_fn = function
+  | None -> Result.Error (err_fn ())
+  | Some x -> Result.Ok x
+
+let of_result = function
+  | Result.Error _ -> None
+  | Result.Ok x -> Some x
+
 module Infix = struct
   let (>|=) = (>|=)
   let (>>=) = (>>=)

src/core/CCOpt.mli

@@ -9,9 +9,13 @@ val map : ('a -> 'b) -> 'a t -> 'b t
 (** Transform the element inside, if any *)
 
 val map_or : default:'b -> ('a -> 'b) -> 'a t -> 'b
-(** [map_or ~default f o] is [f x] if [o = Some x], [default otherwise]
+(** [map_or ~default f o] is [f x] if [o = Some x], [default] otherwise
     @since 0.16 *)
 
+val map_lazy : (unit -> 'b) -> ('a -> 'b) -> 'a t -> 'b
+(** [map_lazy default_fn f o] if [f o] if [o = Some x], [default_fn ()] otherwise 
+    @since 1.2 *)
+
 val is_some : _ t -> bool
 
 val is_none : _ t -> bool
@@ -94,6 +98,14 @@ val (<$>) : ('a -> 'b) -> 'a t -> 'b t
 
 (** {2 Alternatives} *)
 
+val or_ : else_:('a t) -> 'a t -> 'a t
+(** [or_ ~else_ a] is [a] if [a] is [Some _], [else_] otherwise
+    @since 1.2 *)
+
+val or_lazy : else_:(unit -> 'a t) -> 'a t -> 'a t
+(** [or_lazy else_ a] is [a] if [a] is [Some _], [else_ ()] otherwise
+    @since 1.2 *)
+
 val (<+>) : 'a t -> 'a t -> 'a t
 (** [a <+> b] is [a] if [a] is [Some _], [b] otherwise *)
 
@@ -118,6 +130,15 @@ val to_list : 'a t -> 'a list
 val of_list : 'a list -> 'a t
 (** Head of list, or [None] *)
 
+val to_result : 'e -> 'a t -> ('a, 'e) Result.result
+(** @since 1.2 *)
+
+val to_result_lazy : (unit -> 'e) -> 'a t -> ('a, 'e) Result.result
+(** @since 1.2 *)
+
+val of_result : ('a, _) Result.result -> 'a t
+(** @since 1.2 *)
+
 type 'a sequence = ('a -> unit) -> unit
 type 'a gen = unit -> 'a option
 type 'a printer = Format.formatter -> 'a -> unit

src/core/CCRandom.ml

@@ -3,6 +3,8 @@
 
 (** {1 Random Generators} *)
 
+include Random
+
 type state = Random.State.t
 
 type 'a t = state -> 'a

src/core/CCRandom.mli

@@ -3,6 +3,8 @@
 
 (** {1 Random Generators} *)
 
+include module type of Random
+
 type state = Random.State.t
 
 type 'a t = state -> 'a

src/core/CCResult.ml

@@ -24,6 +24,10 @@ let fail_printf format =
     (fun buf -> fail (Buffer.contents buf))
     buf format
 
+(*$T
+  (Error "ohno 42") = (fail_printf "ohno %d" 42)
+*)
+
 let fail_fprintf format =
   let buf = Buffer.create 64 in
   let out = Format.formatter_of_buffer buf in
@@ -31,6 +35,26 @@ let fail_fprintf format =
     (fun out -> Format.pp_print_flush out (); fail (Buffer.contents buf))
     out format
 
+(*$T
+  (Error "ohno 42") = (fail_fprintf "ohno %d" 42)
+*)
+
+let add_ctx msg x = match x with
+  | Error e -> Error (e ^ "\ncontext:" ^ msg)
+  | Ok x -> Ok x
+
+let add_ctxf msg =
+  let buf = Buffer.create 64 in
+  let out = Format.formatter_of_buffer buf in
+  Format.kfprintf
+    (fun out e -> Format.pp_print_flush out (); add_ctx (Buffer.contents buf) e)
+    out msg
+
+(*$=
+   (Error "error\ncontext:message(number 42, foo: true)") \
+     (add_ctxf "message(number %d, foo: %B)" 42 true (Error "error"))
+*)
+
 let of_exn e =
   let msg = Printexc.to_string e in
   Error msg
@@ -98,6 +122,15 @@ let fold ~ok ~error x = match x with
   | Ok x -> ok x
   | Error s -> error s
 
+let fold_ok f acc r = match r with
+  | Ok x -> f acc x
+  | Error _ -> acc
+
+(*$=
+  42 (fold_ok (+) 2 (Ok 40))
+  40 (fold_ok (+) 40 (Error "foo"))
+  *)
+
 let is_ok = function
   | Ok _ -> true
   | Error _ -> false

src/core/CCResult.mli

@@ -34,14 +34,28 @@ val of_exn_trace : exn -> ('a, string) t
     Remember to call [Printexc.record_backtrace true] and compile with the
     debug flag for this to work. *)
 
-val fail_printf : ('a, Buffer.t, unit, ('a, string) t) format4 -> 'a
+val fail_printf : ('a, Buffer.t, unit, ('b, string) t) format4 -> 'a
 (** [fail_printf format] uses [format] to obtain an error message
     and then returns [Error msg] *)
 
-val fail_fprintf : ('a, Format.formatter, unit, ('a, string) t) format4 -> 'a
+val fail_fprintf : ('a, Format.formatter, unit, ('b, string) t) format4 -> 'a
 (** [fail_printf format] uses [format] to obtain an error message
     and then returns [Error msg] *)
 
+val add_ctx : string -> ('a, string) t -> ('a, string) t
+(** [add_ctx msg] leaves [Ok x] untouched, but transforms
+    [Error s] into [Error s'] where [s'] contains the additional
+    context given by [msg]
+    @since 1.2 *)
+
+val add_ctxf : ('a, Format.formatter, unit, ('b, string) t -> ('b, string) t) format4 -> 'a
+(** [add_ctxf format_message] is similar to {!add_ctx} but with
+    {!Format} for printing the message (eagerly).
+    Example: {[
+      add_ctxf "message(number %d, foo: %B)" 42 true (Error "error)"
+    ]}
+    @since 1.2 *)
+
 val map : ('a -> 'b) -> ('a, 'err) t -> ('b, 'err) t
 (** Map on success *)
 
@@ -87,9 +101,13 @@ val fold : ok:('a -> 'b) -> error:('err -> 'b) -> ('a, 'err) t -> 'b
 (** [fold ~ok ~error e] opens [e] and, if [e = Ok x], returns
     [ok x], otherwise [e = Error s] and it returns [error s]. *)
 
-val is_ok : ('a, 'err) t -> bool
+val fold_ok : ('a -> 'b -> 'a) -> 'a -> ('b, _) t -> 'a
-(** Return true if Ok/
+(** [fold_ok f acc r] will compute [f acc x] if [r=Ok x],
+    and return [acc] otherwise, as if the result were a mere option.
+    @since 1.2 *)
 
+val is_ok : ('a, 'err) t -> bool
+(** Return true if Ok
     @since 1.0 *)
 
 val is_error : ('a, 'err) t -> bool

src/core/CCString.cppo.ml

@@ -7,6 +7,8 @@ type 'a gen = unit -> 'a option
 type 'a sequence = ('a -> unit) -> unit
 type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
 
+include String
+
 module type S = sig
   type t
 
@@ -388,6 +390,11 @@ module Split = struct
   let right ~by s = try Some (right_exn ~by s) with Not_found -> None
 end
 
+let split_on_char c s: _ list =
+  Split.list_cpy ~by:(String.make 1 c) s
+
+let split = Split.list_cpy
+
 let compare_versions a b =
   let of_int s = try Some (int_of_string s) with _ -> None in
   let rec cmp_rec a b = match a(), b() with
@@ -645,6 +652,21 @@ let exists p s =
   try iter (fun c -> if p c then raise MyExit) s; false
   with MyExit -> true
 
+(* notion of whitespace for trim *)
+let is_space_ = function
+  | ' ' | '\012' | '\n' | '\r' | '\t' -> true
+  | _ -> false
+
+let ltrim s =
+  let i = ref 0 in
+  while !i < length s && is_space_ (unsafe_get s !i) do incr i done;
+  if !i > 0 then sub s !i (length s - !i) else s
+
+let rtrim s =
+  let i = ref (length s-1) in
+  while !i >= 0 && is_space_ (unsafe_get s !i) do decr i done;
+  if !i < length s-1 then sub s 0 (!i+1) else s
+
 let map2 f s1 s2 =
   if length s1 <> length s2 then invalid_arg "CCString.map2";
   init (String.length s1) (fun i -> f s1.[i] s2.[i])
@@ -705,7 +727,16 @@ let lowercase_ascii = map CCChar.lowercase_ascii
 
     #endif
 
-
+let equal_caseless s1 s2: bool =
+  let char_lower c =
+    if c >= 'A' && c <= 'Z'
+    then Char.unsafe_chr (Char. code c + 32)
+    else c
+  in
+  String.length s1 = String.length s2 &&
+  for_all2
+    (fun c1 c2 -> char_lower c1 = char_lower c2)
+    s1 s2
 
 let pp buf s =
   Buffer.add_char buf '"';
@@ -734,6 +765,10 @@ module Sub = struct
 
   let length (_,_,l) = l
 
+  let get (s,i,l) j =
+    if j<0 || j>= l then invalid_arg "CCString.Sub.get";
+    String.unsafe_get s (i+j)
+
   let blit (a1,i1,len1) o1 a2 o2 len =
     if o1+len>len1 then invalid_arg "CCString.Sub.blit";
     blit a1 (i1+o1) a2 o2 len

src/core/CCString.mli

@@ -48,6 +48,8 @@ end
 
 (** {2 Strings} *)
 
+include module type of String
+
 val equal : string -> string -> bool
 
 val compare : string -> string -> int
@@ -112,8 +114,7 @@ val of_array : char array -> string
 val to_array : string -> char array
 
 val find : ?start:int -> sub:string -> string -> int
-(** Find [sub] in string, returns its first index or [-1].
+(** Find [sub] in string, returns its first index or [-1]. *)
-    Should only be used with very small [sub] *)
 
 (*$= & ~printer:string_of_int
   1 (find ~sub:"bc" "abcd")
@@ -350,6 +351,32 @@ val exists : (char -> bool) -> string -> bool
 
 include S with type t := string
 
+val ltrim : t -> t
+(** trim space on the left (see {!String.trim} for more details)
+    @since 1.2 *)
+
+val rtrim : t -> t
+(** trim space on the right (see {!String.trim} for more details)
+    @since 1.2 *)
+
+(*$= & ~printer:id
+  "abc " (ltrim " abc ")
+  " abc" (rtrim " abc ")
+*)
+
+(*$Q
+  Q.(printable_string) (fun s -> \
+    String.trim s = (s |> ltrim |> rtrim))
+  Q.(printable_string) (fun s -> ltrim s = ltrim (ltrim s))
+  Q.(printable_string) (fun s -> rtrim s = rtrim (rtrim s))
+  Q.(printable_string) (fun s -> \
+    let s' = ltrim s in \
+    if s'="" then Q.assume_fail() else s'.[0] <> ' ')
+  Q.(printable_string) (fun s -> \
+    let s' = rtrim s in \
+    if s'="" then Q.assume_fail() else s'.[String.length s'-1] <> ' ')
+  *)
+
 (** {2 Operations on 2 strings} *)
 
 val map2 : (char -> char -> char) -> string -> string -> string
@@ -399,6 +426,22 @@ val uppercase_ascii : string -> string
 val lowercase_ascii : string -> string
 (** See {!String}. @since 0.18 *)
 
+val equal_caseless : string -> string -> bool
+(** Comparison without respect to {b ascii} lowercase.
+    @since 1.2 *)
+
+(*$T
+  equal_caseless "foo" "FoO"
+  equal_caseless "helLo" "HEllO"
+*)
+
+(*$Q
+  Q.(pair printable_string printable_string) (fun (s1,s2) -> \
+    equal_caseless s1 s2 = (lowercase_ascii s1=lowercase_ascii s2))
+  Q.(printable_string) (fun s -> equal_caseless s s)
+  Q.(printable_string) (fun s -> equal_caseless (uppercase_ascii s) s)
+*)
+
 (** {2 Finding}
 
     A relatively efficient algorithm for finding sub-strings
@@ -495,6 +538,25 @@ module Split : sig
   *)
 end
 
+val split_on_char : char -> string -> string list
+(** Split the string along the given char
+    @since 1.2 *)
+
+(*$= & ~printer:Q.Print.(list string)
+  ["a"; "few"; "words"; "from"; "our"; "sponsors"] \
+    (split_on_char ' ' "a few words from our sponsors")
+*)
+
+(*$Q
+  Q.(printable_string) (fun s -> \
+    let s = split_on_char ' ' s |> String.concat " " in \
+    s = (split_on_char ' ' s |> String.concat " "))
+*)
+
+val split : by:string -> string -> string list
+(** Alias to {!Split.list_cpy}
+    @since 1.2 *)
+
 (** {2 Utils} *)
 
 val compare_versions : string -> string -> int
@@ -570,6 +632,11 @@ module Sub : sig
   val sub : t -> int -> int -> t
   (** Sub-slice *)
 
+  val get : t -> int -> char
+  (** [get s i] gets the [i]-th element, or fails
+      @raise Invalid_argument if the index is not within [0... length -1]
+      @since 1.2 *)
+
   include S with type t := t
 
   (*$T
@@ -583,4 +650,22 @@ module Sub : sig
     let sub = Sub.make " abc " 1 ~len:3 in \
     "\"abc\"" = (CCFormat.to_string Sub.print sub)
   *)
+
+  (*$= & ~printer:(String.make 1)
+    'b' Sub.(get (make "abc" 1 ~len:2) 0)
+    'c' Sub.(get (make "abc" 1 ~len:2) 1)
+    *)
+
+  (*$QR
+    Q.(printable_string_of_size Gen.(3--10)) (fun s ->
+      let open Sequence.Infix in
+      begin
+        (0 -- (length s-2)
+          >|= fun i -> i, Sub.make s i ~len:(length s-i))
+        >>= fun (i,sub) ->
+        (0 -- (Sub.length sub-1) >|= fun j -> i,j,sub)
+      end
+      |> Sequence.for_all
+        (fun (i,j,sub) -> Sub.get sub j = s.[i+j]))
+  *)
 end

src/core/META

@@ -1,6 +1,6 @@
 # OASIS_START
-# DO NOT EDIT (digest: c529dc854829cb4d385547c46987defa)
+# DO NOT EDIT (digest: 1e93f21c6208d4f0718882bfffe34612)
-version = "1.1"
+version = "1.2"
 description = "A modular standard library focused on data structures."
 requires = "bytes result"
 archive(byte) = "containers.cma"
@@ -9,7 +9,7 @@ archive(native) = "containers.cmxa"
 archive(native, plugin) = "containers.cmxs"
 exists_if = "containers.cma"
 package "unix" (
- version = "1.1"
+ version = "1.2"
  description = "A modular standard library focused on data structures."
  requires = "bytes result unix"
  archive(byte) = "containers_unix.cma"
@@ -20,7 +20,7 @@ package "unix" (
 )
 
 package "top" (
- version = "1.1"
+ version = "1.2"
  description = "A modular standard library focused on data structures."
  requires =
  "compiler-libs.common containers containers.data containers.unix containers.sexp containers.iter"
@@ -32,7 +32,7 @@ package "top" (
 )
 
 package "thread" (
- version = "1.1"
+ version = "1.2"
  description = "A modular standard library focused on data structures."
  requires = "containers threads"
  archive(byte) = "containers_thread.cma"
@@ -43,7 +43,7 @@ package "thread" (
 )
 
 package "sexp" (
- version = "1.1"
+ version = "1.2"
  description = "A modular standard library focused on data structures."
  requires = "bytes result"
  archive(byte) = "containers_sexp.cma"
@@ -54,7 +54,7 @@ package "sexp" (
 )
 
 package "iter" (
- version = "1.1"
+ version = "1.2"
  description = "A modular standard library focused on data structures."
  archive(byte) = "containers_iter.cma"
  archive(byte, plugin) = "containers_iter.cma"
@@ -64,7 +64,7 @@ package "iter" (
 )
 
 package "data" (
- version = "1.1"
+ version = "1.2"
  description = "A modular standard library focused on data structures."
  requires = "bytes"
  archive(byte) = "containers_data.cma"

src/core/containers.ml

@@ -1,31 +1,17 @@
 
 (* This file is free software, part of containers. See file "license" for more details. *)
 
-(** {1 Drop-In replacement to Stdlib}
+(** {1 Drop-In replacement to Stdlib} *)
 
-    This module is meant to be opened if one doesn't want to use both, say,
+module Array = CCArray
-    [List] and [CCList]. Instead, [List] is now an alias to
+module ArrayLabels = CCArrayLabels
-    {[struct
-      include List
-      include CCList
-    end
-    ]}
-*)
-
-module Array = struct
-  include Array
-  include CCArray
-end
-module ArrayLabels = struct
-  include ArrayLabels
-  include CCArrayLabels
-end
 module Array_slice = CCArray_slice
 module Bool = CCBool
 module Char = struct
   include Char
   include (CCChar : module type of CCChar with type t := t)
 end
+module Equal = CCEqual
 module Float = CCFloat
 module Format = struct
   include Format
@@ -49,14 +35,8 @@ module Hashtbl = struct
   module Make' = CCHashtbl.Make
 end
 module Heap = CCHeap
-module List = struct
+module List = CCList
-  include List
+module ListLabels = CCListLabels
-  include CCList
-end
-module ListLabels = struct
-  include ListLabels
-  include CCListLabels
-end
 module Map = struct
   module type OrderedType = Map.OrderedType
   include CCMap
@@ -65,10 +45,7 @@ module Option = CCOpt
 module Ord = CCOrd
 module Pair = CCPair
 module Parse = CCParse
-module Random = struct
+module Random = CCRandom
-  include Random
-  include CCRandom
-end
 module Ref = CCRef
 module Result = struct
   include Result
@@ -78,8 +55,5 @@ module Set = struct
   module type OrderedType = Set.OrderedType
   include CCSet
 end
-module String = struct
+module String = CCString
-  include String
-  include CCString
-end
 module Vector = CCVector

src/core/containers.mldylib

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: dbfe65c79fab2a752c0ce01bf92e9b0d)
+# DO NOT EDIT (digest: c777330f5cf164f02058ae02e3afa987)
 CCVector
 CCHeap
 CCList
@@ -27,5 +27,6 @@ CCParse
 CCArray_slice
 CCListLabels
 CCArrayLabels
+CCEqual
 Containers
 # OASIS_STOP

src/core/containers.mllib

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: dbfe65c79fab2a752c0ce01bf92e9b0d)
+# DO NOT EDIT (digest: c777330f5cf164f02058ae02e3afa987)
 CCVector
 CCHeap
 CCList
@@ -27,5 +27,6 @@ CCParse
 CCArray_slice
 CCListLabels
 CCArrayLabels
+CCEqual
 Containers
 # OASIS_STOP

src/data/CCBV.ml

@@ -1,79 +1,124 @@
 
-(* This file is free software, part of containers. See file "license" for more details. *)
-
 (** {2 Imperative Bitvectors} *)
 
-let __width = Sys.word_size - 2
+let width_ = Sys.word_size - 1
 
-(* int with [n] ones *)
+(** We use OCamls ints to store the bits. We index them from the
-let rec __shift bv n =
+    least significant bit. We create masks to zero out the most significant
-  if n = 0
+    bits that aren't used to store values. This is necessary when we are
-  then bv
+    constructing or negating a bit vector. *)
-  else __shift ((bv lsl 1) lor 1) (n-1)
+let lsb_masks_ =
+  let a = Array.make (width_ + 1) 0 in
+  for i = 1 to width_ do
+    a.(i) <- a.(i-1) lor (1 lsl (i - 1))
+  done;
+  a
 
-(* only ones *)
+let all_ones_ = lsb_masks_.(width_)
-let __all_ones = __shift 0 __width
+
+(* count the 1 bits in [n]. See https://en.wikipedia.org/wiki/Hamming_weight *)
+let count_bits_ n =
+  let rec recurse count n =
+    if n = 0 then count else recurse (count+1) (n land (n-1))
+  in
+  recurse 0 n
+
+(*  Can I access the "private" members in testing? $Q
+    (Q.int_bound (Sys.word_size - 1)) (fun i -> count_bits_ lsb_masks_.(i) = i)
+*)
 
 type t = {
   mutable a : int array;
+  mutable size : int;
 }
 
-let empty () = { a = [| |] }
+let length t = t.size
+
+let empty () = { a = [| |] ; size = 0 }
+
+let array_length_of_size size =
+  if size mod width_ = 0 then size / width_ else (size / width_) + 1
 
 let create ~size default =
-  if size = 0 then { a = [| |] }
+  if size = 0 then { a = [| |]; size }
-  else begin
+  else (
-    let n = if size mod __width = 0 then size / __width else (size / __width) + 1 in
+    let n = array_length_of_size size in
-    let arr = if default
+    let a = if default
-      then Array.make n __all_ones
+      then Array.make n all_ones_
       else Array.make n 0
     in
     (* adjust last bits *)
-    if default && (size mod __width) <> 0
+    let r = size mod width_ in
-    then arr.(n-1) <- __shift 0 (size - (n-1) * __width);
+    if default && r <> 0 then (
-    { a = arr }
+      Array.unsafe_set a (n-1) lsb_masks_.(r);
-  end
+    );
+    { a; size }
+  )
+
+(*$Q
+  (Q.pair Q.small_int Q.bool) (fun (size, b) -> create ~size b |> length = size)
+*)
 
 (*$T
   create ~size:17 true |> cardinal = 17
-  create ~size:32 true |> cardinal= 32
+  create ~size:32 true |> cardinal = 32
   create ~size:132 true |> cardinal = 132
   create ~size:200 false |> cardinal = 0
   create ~size:29 true |> to_sorted_list = CCList.range 0 28
 *)
 
-let copy bv = { a=Array.copy bv.a; }
+let copy bv = { bv with a = Array.copy bv.a }
 
 (*$Q
   (Q.list Q.small_int) (fun l -> \
     let bv = of_list l in to_list bv = to_list (copy bv))
 *)
 
-let length bv = Array.length bv.a
+let capacity bv = width_ * Array.length bv.a
-
-let resize bv len =
-  if len > Array.length bv.a
-  then begin
-    let a' = Array.make len 0 in
-    Array.blit bv.a 0 a' 0 (Array.length bv.a);
-    bv.a <- a'
-  end
-
-(* count the 1 bits in [n]. See https://en.wikipedia.org/wiki/Hamming_weight *)
-let __count_bits n =
-  let rec recurse count n =
-    if n = 0 then count else recurse (count+1) (n land (n-1))
-  in
-  if n < 0
-  then recurse 1 (n lsr 1)   (* only on unsigned *)
-  else recurse 0 n
 
 let cardinal bv =
+  if bv.size = 0 then 0
+  else (
     let n = ref 0 in
-  for i = 0 to length bv - 1 do
+    for i = 0 to Array.length bv.a - 1 do
-    n := !n + __count_bits bv.a.(i)
+      n := !n + count_bits_ bv.a.(i) (* MSB of last element are all 0 *)
     done;
     !n
+  )
+
+(*$Q
+  Q.small_int (fun size -> create ~size true |> cardinal = size)
+*)
+
+let really_resize_ bv ~desired ~current size =
+  let a' = Array.make desired 0 in
+  Array.blit bv.a 0 a' 0 current;
+  bv.a <- a';
+  bv.size <- size
+
+let grow_ bv size =
+  if size <= capacity bv (* within capacity *)
+  then bv.size <- size
+  else (
+    (* beyond capacity *)
+    let desired = array_length_of_size size in
+    let current = Array.length bv.a in
+    assert (desired > current);
+    really_resize_ bv ~desired ~current size
+  )
+
+let shrink_ bv size =
+  let desired = array_length_of_size size in
+  let current = Array.length bv.a in
+  really_resize_ bv ~desired ~current size
+
+let resize bv size =
+  if size < 0 then invalid_arg "resize: negative size";
+  if size < bv.size (* shrink *)
+  then shrink_ bv size
+  else if size = bv.size
+  then ()
+  else grow_ bv size
 
 (*$R
   let bv1 = CCBV.create ~size:87 true in
@@ -87,18 +132,18 @@ let cardinal bv =
 let is_empty bv =
   try
     for i = 0 to Array.length bv.a - 1 do
-      if bv.a.(i) <> 0 then raise Exit
+      if bv.a.(i) <> 0 then raise Exit       (* MSB of last element are all 0 *)
     done;
     true
   with Exit ->
     false
 
 let get bv i =
-  let n = i / __width in
+  if i < 0 then invalid_arg "get: negative index";
+  let n = i / width_ in
+  let i = i mod width_ in
   if n < Array.length bv.a
-  then
+  then (Array.unsafe_get bv.a n) land (1 lsl i) <> 0
-    let i = i - n * __width in
-    bv.a.(n) land (1 lsl i) <> 0
   else false
 
 (*$R
@@ -118,11 +163,13 @@ let get bv i =
 *)
 
 let set bv i =
-  let n = i / __width in
+  if i < 0 then invalid_arg "set: negative index"
-  if n >= Array.length bv.a
+  else (
-  then resize bv (n+1);
+    let n = i / width_ in
-  let i = i - n * __width in
+    let j = i mod width_ in
-  bv.a.(n) <- bv.a.(n) lor (1 lsl i)
+    if i >= bv.size then grow_ bv (i+1);
+    Array.unsafe_set bv.a n ((Array.unsafe_get bv.a n) lor (1 lsl j))
+  )
 
 (*$T
   let bv = create ~size:3 false in set bv 0; get bv 0
@@ -130,40 +177,44 @@ let set bv i =
 *)
 
 let reset bv i =
-  let n = i / __width in
+  if i < 0 then invalid_arg "reset: negative index"
-  if n >= Array.length bv.a
+  else (
-  then resize bv (n+1);
+    let n = i / width_ in
-  let i = i - n * __width in
+    let j = i mod width_ in
-  bv.a.(n) <- bv.a.(n) land (lnot (1 lsl i))
+    if i >= bv.size then grow_ bv (i+1);
+    Array.unsafe_set bv.a n ((Array.unsafe_get bv.a n) land (lnot (1 lsl j)))
+  )
 
 (*$T
   let bv = create ~size:3 false in set bv 0; reset bv 0; not (get bv 0)
 *)
 
 let flip bv i =
-  let n = i / __width in
+  if i < 0 then invalid_arg "reset: negative index"
-  if n >= Array.length bv.a
+  else (
-  then resize bv (n+1);
+    let n = i / width_ in
-  let i = i - n * __width in
+    let j = i mod width_ in
-  bv.a.(n) <- bv.a.(n) lxor (1 lsl i)
+    if i >= bv.size then grow_ bv (i+1);
+    Array.unsafe_set bv.a n ((Array.unsafe_get bv.a n) lxor (1 lsl j))
+  )
 
 (*$R
   let bv = of_list [1;10; 11; 30] in
   flip bv 10;
-  assert_equal [1;11;30] (to_sorted_list bv);
+  assert_equal ~printer:Q.Print.(list int) [1;11;30] (to_sorted_list bv);
-  assert_equal false (get bv 10);
+  assert_equal ~printer:Q.Print.bool false (get bv 10);
   flip bv 10;
-  assert_equal true (get bv 10);
+  assert_equal ~printer:Q.Print.bool true (get bv 10);
   flip bv 5;
-  assert_equal [1;5;10;11;30] (to_sorted_list bv);
+  assert_equal ~printer:Q.Print.(list int) [1;5;10;11;30] (to_sorted_list bv);
-  assert_equal true (get bv 5);
+  assert_equal ~printer:Q.Print.bool true (get bv 5);
   flip bv 100;
-  assert_equal [1;5;10;11;30;100] (to_sorted_list bv);
+  assert_equal ~printer:Q.Print.(list int) [1;5;10;11;30;100] (to_sorted_list bv);
-  assert_equal true (get bv 100);
+  assert_equal ~printer:Q.Print.bool true (get bv 100);
 *)
 
 let clear bv =
-  Array.iteri (fun i _ -> bv.a.(i) <- 0) bv.a
+  Array.fill bv.a 0 (Array.length bv.a) 0
 
 (*$T
   let bv = create ~size:37 true in cardinal bv = 37 && (clear bv; cardinal bv= 0)
@@ -178,31 +229,50 @@ let clear bv =
 *)
 
 let iter bv f =
-  let len = Array.length bv.a in
+  let len = array_length_of_size bv.size in
-  for n = 0 to len - 1 do
+  assert (len <= Array.length bv.a);
-    let j = __width * n in
+  for n = 0 to len - 2 do
-    for i = 0 to __width - 1 do
+    let j = width_ * n in
+    for i = 0 to width_ - 1 do
       f (j+i) (bv.a.(n) land (1 lsl i) <> 0)
     done
+  done;
+  if bv.size > 0 then (
+    let j = width_ * (len - 1) in
+    let r = bv.size mod width_ in
+    let final_length = if r = 0 then width_ else r in
+    for i = 0 to final_length - 1 do
+      f (j + i) (bv.a.(len - 1) land (1 lsl i) <> 0)
     done
+  )
 
 (*$R
-  let bv = create ~size:30 false in
+  List.iter
+    (fun size ->
+      let bv = create ~size false in
       set bv 5;
       let n = ref 0 in
       iter bv (fun i b -> incr n; assert_equal b (i=5));
-  assert_bool "at least 30" (!n >= 30)
+      assert_bool "exactly size" (!n = size))
+    [30; 100; 255; 256;10_000]
 *)
 
+(*$= & ~printer:Q.Print.(list (pair int bool))
+  [] (iter (create ~size:0 false) |> Sequence.zip |> Sequence.to_list)
+  [0, false; 1, true; 2, false] \
+    (iter (let bv = create ~size:3 false in set bv 1; bv) |> Sequence.zip |> Sequence.to_list)
+*)
+
+(*$Q
+  Q.(small_int) (fun n -> \
+    assert (n >= 0); \
+    let bv = create ~size:n true in \
+    let l = iter bv |> Sequence.zip |> Sequence.to_list in \
+    List.length l = n && List.for_all (fun (_,b) -> b) l)
+  *)
+
 let iter_true bv f =
-  let len = Array.length bv.a in
+  iter bv (fun i b -> if b then f i else ())
-  for n = 0 to len - 1 do
-    let j = __width * n in
-    for i = 0 to __width - 1 do
-      if bv.a.(n) land (1 lsl i) <> 0
-      then f (j+i)
-    done
-  done
 
 (*$T
   of_list [1;5;7] |> iter_true |> Sequence.to_list |> List.sort CCOrd.compare = [1;5;7]
@@ -242,8 +312,9 @@ let to_list bv =
 let to_sorted_list bv =
   List.rev (to_list bv)
 
+(* Interpret these as indices. *)
 let of_list l =
-  let size = List.fold_left max 0 l in
+  let size = (List.fold_left max 0 l) + 1 in
   let bv = create ~size false in
   List.iter (fun i -> set bv i) l;
   bv
@@ -256,15 +327,19 @@ let of_list l =
 
 exception FoundFirst of int
 
-let first bv =
+let first_exn bv =
   try
     iter_true bv (fun i -> raise (FoundFirst i));
     raise Not_found
   with FoundFirst i ->
     i
 
+let first bv =
+  try Some (first_exn bv)
+  with Not_found -> None
+
 (*$T
-  of_list [50; 10; 17; 22; 3; 12] |> first = 3
+  of_list [50; 10; 17; 22; 3; 12] |> first = Some 3
 *)
 
 let filter bv p =
@@ -276,18 +351,62 @@ let filter bv p =
     to_sorted_list bv = [2;4;6]
 *)
 
+let negate_self b =
+  let len = Array.length b.a in
+  for n = 0 to len - 1 do
+    Array.unsafe_set b.a n (lnot (Array.unsafe_get b.a n))
+  done;
+  let r = b.size mod width_ in
+  if r <> 0 then
+    let l = Array.length b.a - 1 in
+    Array.unsafe_set b.a l (lsb_masks_.(r) land (Array.unsafe_get b.a l))
+
+(*$T
+  let v = of_list [1;2;5;7;] in negate_self v; \
+    cardinal v = (List.length [0;3;4;6])
+*)
+
+let negate b =
+  let a =  Array.map (lnot) b.a in
+  let r = b.size mod width_ in
+  if r <> 0 then (
+    let l = Array.length b.a - 1 in
+    Array.unsafe_set a l (lsb_masks_.(r) land (Array.unsafe_get a l))
+  );
+  { a ; size = b.size }
+
+(*$Q
+  Q.small_int (fun size -> create ~size false |> negate |> cardinal = size)
+*)
+
+(* Underlying size grows for union. *)
 let union_into ~into bv =
-  if length into < length bv
+  if into.size < bv.size then (
-  then resize into (length bv);
+    grow_ into bv.size;
-  let len = Array.length bv.a in
+  );
-  for i = 0 to len - 1 do
+  for i = 0 to (Array.length into.a) - 1 do
-    into.a.(i) <- into.a.(i) lor bv.a.(i)
+    Array.unsafe_set into.a i
+      ((Array.unsafe_get into.a i) lor (Array.unsafe_get bv.a i))
   done
 
-let union bv1 bv2 =
+(* To avoid potentially 2 passes, figure out what we need to copy. *)
-  let bv = copy bv1 in
+let union b1 b2 =
-  union_into ~into:bv bv2;
+  if b1.size <= b2.size
-  bv
+  then (
+    let into = copy b2 in
+    for i = 0 to (Array.length b1.a) - 1 do
+      Array.unsafe_set into.a i
+        ((Array.unsafe_get into.a i) lor (Array.unsafe_get b1.a i))
+    done;
+    into
+  ) else (
+    let into = copy b1 in
+    for i = 0 to (Array.length b1.a) - 1 do
+      Array.unsafe_set into.a i
+        ((Array.unsafe_get into.a i) lor (Array.unsafe_get b2.a i))
+    done;
+    into
+  )
 
 (*$R
   let bv1 = CCBV.of_list [1;2;3;4] in
@@ -302,22 +421,33 @@ let union bv1 bv2 =
   union (of_list [1;2;3;4;5]) (of_list [7;3;5;6]) |> to_sorted_list = CCList.range 1 7
 *)
 
+(* Underlying size shrinks for inter. *)
 let inter_into ~into bv =
-  let n = min (length into) (length bv) in
+  if into.size > bv.size then (
-  for i = 0 to n - 1 do
+    shrink_ into bv.size;
-    into.a.(i) <- into.a.(i) land bv.a.(i)
+  );
+  for i = 0 to (Array.length into.a) - 1 do
+    Array.unsafe_set into.a i
+      ((Array.unsafe_get into.a i) land (Array.unsafe_get bv.a i))
   done
 
-let inter bv1 bv2 =
+let inter b1 b2 =
-  if length bv1 < length bv2
+  if b1.size <= b2.size
-  then
+  then (
-    let bv = copy bv1 in
+    let into = copy b1 in
-    let () = inter_into ~into:bv bv2 in
+    for i = 0 to (Array.length b1.a) - 1 do
-    bv
+      Array.unsafe_set into.a i
-  else
+        ((Array.unsafe_get into.a i) land (Array.unsafe_get b2.a i))
-    let bv = copy bv2 in
+    done;
-    let () = inter_into ~into:bv bv1 in
+    into
-    bv
+  ) else (
+    let into = copy b2 in
+    for i = 0 to (Array.length b2.a) - 1 do
+      Array.unsafe_set into.a i
+        ((Array.unsafe_get into.a i) land (Array.unsafe_get b1.a i))
+    done;
+    into
+  )
 
 (*$T
   inter (of_list [1;2;3;4]) (of_list [2;4;6;1]) |> to_sorted_list = [1;2;4]
@@ -331,6 +461,28 @@ let inter bv1 bv2 =
   assert_equal [3;4] l;
 *)
 
+(* Underlying size depends on the 'in_' set for diff, so we don't change
+   it's size! *)
+let diff_into ~into bv =
+  let n = min (Array.length into.a) (Array.length bv.a) in
+  for i = 0 to n - 1 do
+    Array.unsafe_set into.a i
+      ((Array.unsafe_get into.a i) land (lnot (Array.unsafe_get bv.a i)))
+  done
+
+let diff in_ not_in =
+  let into = copy in_ in
+  diff_into ~into not_in;
+  into
+
+(*$T
+  diff (of_list [1;2;3])    (of_list [1;2;3])   |> to_list = [];
+  diff (of_list [1;2;3])    (of_list [1;2;3;4]) |> to_list = [];
+  diff (of_list [1;2;3;4])  (of_list [1;2;3])   |> to_list = [4];
+  diff (of_list [1;2;3])      (of_list [1;2;3;400]) |> to_list = [];
+  diff (of_list [1;2;3;400])  (of_list [1;2;3])     |> to_list = [400];
+*)
+
 let select bv arr =
   let l = ref [] in
   begin try
@@ -369,15 +521,22 @@ let selecti bv arr =
   assert_equal [("b",1); ("c",2); ("f",5)] l;
 *)
 
-(*$T
+(*$= & ~printer:Q.Print.(list (pair int int))
-  selecti (of_list [1;4;3]) [| 0;1;2;3;4;5;6;7;8 |] \
+  [1,1; 3,3; 4,4] (selecti (of_list [1;4;3]) [| 0;1;2;3;4;5;6;7;8 |] \
-    |> List.sort CCOrd.compare = [1, 1; 3,3; 4,4]
+    |> List.sort CCOrd.compare)
 *)
 
 type 'a sequence = ('a -> unit) -> unit
 
 let to_seq bv k = iter_true bv k
 
+(*$Q
+  Q.(small_int) (fun i -> \
+      let i = max 1 i in \
+      let bv = create ~size:i true in \
+      i = (to_seq bv |> Sequence.length))
+*)
+
 let of_seq seq =
   let l = ref [] and maxi = ref 0 in
   seq (fun x -> l := x :: !l; maxi := max !maxi x);

src/data/CCBV.mli

@@ -3,9 +3,13 @@
 
 (** {2 Imperative Bitvectors}
 
-    The size of the bitvector is rounded up to the multiple of 30 or  62.
+    {b BREAKING CHANGES} since 1.2:
-    In other words some functions such as {!iter} might iterate on more
+    size is now stored along with the bitvector. Some functions have
-    bits than what was originally asked for.
+    a new signature.
+
+    The size of the bitvector used to be rounded up to the multiple of 30 or 62.
+    In other words some functions such as {!iter} would iterate on more
+    bits than what was originally asked for. This is not the case anymore.
 *)
 
 type t
@@ -21,29 +25,39 @@ val copy : t -> t
 (** Copy of bitvector *)
 
 val cardinal : t -> int
-(** Number of bits set *)
+(** Number of bits set to one, seen as a set of bits. *)
 
 val length : t -> int
-(** Length of underlying array *)
+(** Size of underlying bitvector.
+    This is not related to the underlying implementation.
+    Changed at 1.2
+*)
+
+val capacity : t -> int
+(** The number of bits this bitvector can store without resizing.
+
+    @since 1.2 *)
 
 val resize : t -> int -> unit
-(** Resize the BV so that it has at least the given physical length
+(** Resize the BV so that it has the specified length. This can grow or shrink
-    [resize bv n] should make [bv] able to store [(Sys.word_size - 2)* n] bits *)
+    the underlying bitvector.
+
+    @raise Invalid_arg on negative sizes. *)
 
 val is_empty : t -> bool
-(** Any bit set? *)
+(** Are there any true bits? *)
 
 val set : t -> int -> unit
-(** Set i-th bit. *)
+(** Set i-th bit, extending the bitvector if needed. *)
 
 val get : t -> int -> bool
 (** Is the i-th bit true? Returns false if the index is too high*)
 
 val reset : t -> int -> unit
-(** Set i-th bit to 0 *)
+(** Set i-th bit to 0, extending the bitvector if needed. *)
 
 val flip : t -> int -> unit
-(** Flip i-th bit *)
+(** Flip i-th bit, extending the bitvector if needed. *)
 
 val clear : t -> unit
 (** Set every bit to 0 *)
@@ -62,21 +76,41 @@ val to_sorted_list : t -> int list
     increasing order *)
 
 val of_list : int list -> t
-(** From a list of true bits *)
+(** From a list of true bits.
 
-val first : t -> int
+    The bits are interpreted as indices into the returned bitvector, so the final
-(** First set bit, or
+    bitvector will have [length t] equal to 1 more than max of list indices. *)
-    @raise Not_found if all bits are 0 *)
+
+val first : t -> int option
+(** First set bit, or return None.
+    changed type at 1.2 *)
+
+val first_exn : t -> int
+ (** First set bit, or
+     @raise Not_found if all bits are 0
+     @since 1.2 *)
 
 val filter : t -> (int -> bool) -> unit
 (** [filter bv p] only keeps the true bits of [bv] whose [index]
     satisfies [p index] *)
 
+val negate_self : t -> unit
+(** [negate_self t] flips all of the bits in [t].
+
+    @since 1.2 *)
+
+val negate : t -> t
+(** [negate t] returns a copy of [t] with all of the bits flipped. *)
+
 val union_into : into:t -> t -> unit
-(** [union ~into bv] sets [into] to the union of itself and [bv]. *)
+(** [union ~into bv] sets [into] to the union of itself and [bv].
+
+    Also updates the length of [into] to be at least [length bv]. *)
 
 val inter_into : into:t -> t -> unit
-(** [inter ~into bv] sets [into] to the intersection of itself and [bv] *)
+(** [inter ~into bv] sets [into] to the intersection of itself and [bv]
+
+    Also updates the length of [into] to be at most [length bv]. *)
 
 val union : t -> t -> t
 (** [union bv1 bv2] returns the union of the two sets *)
@@ -84,6 +118,16 @@ val union : t -> t -> t
 val inter : t -> t -> t
 (** [inter bv1 bv2] returns the intersection of the two sets *)
 
+val diff_into : into:t -> t -> unit
+(** [diff ~into t] Modify [into] with only the bits set but not in [t].
+
+    @since 1.2 *)
+
+val diff : t -> t -> t
+(** [diff t1 t2] Return those bits found [t1] but not in [t2].
+
+    @since 1.2 *)
+
 val select : t -> 'a array -> 'a list
 (** [select arr bv] selects the elements of [arr] whose index
     corresponds to a true bit in [bv]. If [bv] is too short, elements of [arr]

src/data/CCIntMap.ml

@@ -1,27 +1,5 @@
-(*
-copyright (c) 2013-2015, simon cruanes
-all rights reserved.
 
-redistribution and use in source and binary forms, with or without
+(* This file is free software, part of containers. See file "license" for more details. *)
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
 
 (** {1 Map specialized for Int keys} *)
 
@@ -259,7 +237,7 @@ let update k f t =
 
 let doubleton k1 v1 k2 v2 = add k1 v1 (singleton k2 v2)
 
-let rec equal ~eq a b = match a, b with
+let rec equal ~eq a b = a==b || match a, b with
   | E, E -> true
   | L (ka, va), L (kb, vb) -> ka = kb && eq va vb
   | N (pa, sa, la, ra), N (pb, sb, lb, rb) ->
@@ -308,7 +286,9 @@ let choose t =
   try Some (choose_exn t)
   with Not_found -> None
 
-let rec union f t1 t2 = match t1, t2 with
+let rec union f t1 t2 =
+  if t1==t2 then t1
+  else match t1, t2 with
   | E, o | o, E -> o
   | L (k, v), o
   | o, L (k, v) ->
@@ -361,7 +341,9 @@ let rec union f t1 t2 = match t1, t2 with
     equal ~eq:(=) (of_list l) (union (fun _ a _ -> a) (of_list l)(of_list l)))
 *)
 
-let rec inter f a b = match a, b with
+let rec inter f a b =
+  if a==b then a
+  else match a, b with
   | E, _ | _, E -> E
   | L (k, v), o
   | o, L (k, v) ->

src/data/CCIntMap.mli

@@ -1,27 +1,5 @@
-(*
-copyright (c) 2013-2015, simon cruanes
-all rights reserved.
 
-redistribution and use in source and binary forms, with or without
+(* This file is free software, part of containers. See file "license" for more details. *)
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
 
 (** {1 Map specialized for Int keys}
 

src/data/CCZipper.ml

@@ -15,8 +15,12 @@ let to_list (l,r) = List.rev_append l r
 
 let to_rev_list (l,r) = List.rev_append r l
 
+(*$inject
+  let zip_gen = Q.(pair (small_list int)(small_list int))
+  *)
+
 (*$Q
-  Q.(pair (list small_int)(list small_int)) (fun z -> \
+  zip_gen (fun z -> \
     to_list z = List.rev (to_rev_list z))
 *)
 
@@ -51,13 +55,18 @@ let modify f z = match z with
     end
 
 let is_focused = function
-  | _, [] -> true
+  | _, _::_ -> true
-  | _ -> false
+  | _, [] -> false
 
 let focused = function
   | _, x::_ -> Some x
   | _, [] -> None
 
+(*$Q
+  zip_gen (fun g -> \
+    is_focused g = (focused g |> CCOpt.is_some))
+*)
+
 let focused_exn = function
   | _, x::_ -> x
   | _, [] -> raise Not_found

src/threads/CCPool.ml

@@ -503,7 +503,7 @@ module Make(P : PARAM) = struct
       let l =
         CCList.(1--10_000)
         |> List.rev_map
-          (fun x-> Fut.make (fun () -> Thread.yield(); fib (x mod 30)))
+          (fun x-> Fut.make (fun () -> Thread.yield(); fib (x mod 20)))
         |> Fut.(map_l (fun x->x>|= fun x->x+1))
       in
       OUnit.assert_bool "not done" (Fut.state l = Waiting);

src/unix/CCUnix.ml

@@ -224,6 +224,49 @@ let establish_server sockaddr ~f =
       continue := false
   done
 
+
+(** {6 Locking} *)
+
+let with_file_lock ~kind filename f =
+  let lock_file = Unix.openfile filename [Unix.O_CREAT; Unix.O_WRONLY] 0o644 in
+  let lock_action = match kind with
+    | `Read -> Unix.F_RLOCK
+    | `Write -> Unix.F_LOCK
+  in
+  Unix.lockf lock_file lock_action 0;
+  try
+    let x = f () in
+    Unix.lockf lock_file Unix.F_ULOCK 0;
+    Unix.close lock_file;
+    x
+  with e ->
+    Unix.lockf lock_file Unix.F_ULOCK 0;
+    Unix.close lock_file;
+    raise e
+
+(*$R
+  let m = 200 in
+  let n = 50 in
+  let write_atom filename s =
+    with_file_lock ~kind:`Write filename
+      (fun () ->
+        CCIO.with_out ~flags:[Open_append; Open_creat]
+          filename (fun oc -> output_string oc s; flush oc))
+  in
+  let f filename =
+    for j=1 to m do
+      write_atom filename "foo\n"
+    done
+  in
+  CCIO.File.with_temp ~prefix:"containers_" ~suffix:".txt"
+    (fun filename ->
+        let a = Array.init n (fun _ -> Thread.create f filename) in
+        Array.iter Thread.join a;
+        let lines = CCIO.with_in filename CCIO.read_lines_l in
+        assert_equal ~printer:string_of_int (n * m) (List.length lines);
+        assert_bool "all valid" (List.for_all ((=) "foo") lines))
+*)
+
 module Infix = struct
   let (?|) fmt = call_full fmt
 

src/unix/CCUnix.mli

@@ -161,6 +161,15 @@ val establish_server : Unix.sockaddr -> f:(in_channel -> out_channel -> _) -> un
     The callback should raise {!ExitServer} to stop the loop.
     @since 0.16 *)
 
+val with_file_lock : kind:[`Read|`Write] -> string -> (unit -> 'a) -> 'a
+(** [with_file_lock ~kind filename f] puts a lock on the offset 0
+    of the file named [filename], calls [f] and returns its result after
+    the file is unlocked. If [f ()] raises an exception the exception is
+    re-raised after the file is unlocked.
+
+    @param kind specifies whether the lock is read-only or read-write.
+    @since 1.2 *)
+
 (** {2 Infix Functions} *)
 
 module Infix : sig