Merge branch 'master' into stable; oasis setup; 0.11

.merlin

@@ -32,4 +32,4 @@ PKG threads
 PKG threads.posix
 PKG lwt
 PKG bigarray
-FLG -w +a -w -4 -w -44
+FLG -w +a -w -4 -w -44 -w -32 -w -34

CHANGELOG.md

@@ -1,8 +1,32 @@
 # Changelog
 
+## 0.11
+
+- add `CCList.{remove,is_empty}`
+- add `CCOpt.is_none`
+- remove packs for `containers_string` and `containers_advanced`
+- add `Containers_string.Parse`, very simple monadic parser combinators
+- remove warning from `.merlin`
+- attempts of bugfix in PrintBox for unicode text (wip)
+- add `CCList.{find_pred,find_pred_exn}`
+- bugfix in `CCUnix.escape_str`
+- add methods and accessors to `CCUnix`
+- in `CCUnix`, use `Unix.environment` as the default environment
+- add `CCList.partition_map`
+- `RingBuffer.{of_array, to_array}` convenience functions
+- `containers.misc.RAL`: more efficient in memory (unfold list)
+- add `CCInt.pow` (thanks to bernardofpc)
+- add `CCList.group_succ`
+- `containers.data.CCMixset`, set of values indexed by poly keys
+- disable warning 32 (unused val) in .merlin
+- some infix operators for `CCUnix`
+- add `CCUnix.async_call` for spawning and communicating with subprocess
+- add `CCList.Set.{add,remove}`
+- fix doc of `CCstring.Split.list_`
+
 ## 0.10
 
-- add `containers_misc.Puf.iter`
+- add `containers.misc.Puf.iter`
 - add `CCString.{lines,unlines,concat_gen}`
 - `CCUnix` (with a small subprocess API)
 - add `CCList.{sorted_merge_uniq, uniq_succ}`
@@ -11,7 +35,7 @@
 - `CCIntMap` (big-endian patricia trees) in containers.data
 - bugfix in `CCFQueue.add_seq_front`
 - add `CCFQueue.{rev, --}`
-- add `App_parse` in `containers_string`, experimental applicative parser combinators
+- add `App_parse` in `containers.string`, experimental applicative parser combinators
 - remove `containers.pervasives`, add the module `Containers` to core
 - bugfix in `CCFormat.to_file`
 

README.md

@@ -26,6 +26,10 @@ What is _containers_?
     be able to deal with your favorite unicode library).
 - A sub-library with complicated abstractions, `containers.advanced` (with
   a LINQ-like query module, batch operations using GADTs, and others).
+- Utilities aroud the `unix` library in `containers.unix` (mainly to spawn
+  sub-processes)
+- A bigstring module using `bigarray` in `containers.bigarray`
+- A lightweight S-expression printer and streaming parser in `containers.sexp`
 - A library using [Lwt](https://github.com/ocsigen/lwt/), `containers.lwt`.
   Currently only contains experimental, unstable stuff.
 - Random stuff, with *NO* *GUARANTEE* of even being barely usable or tested,
@@ -104,6 +108,7 @@ Documentation [here](http://cedeela.fr/~simon/software/containers).
 - `CCFQueue`, a purely functional double-ended queue structure
 - `CCBV`, mutable bitvectors
 - `CCPersistentHashtbl`, a semi-persistent hashtable (similar to [persistent arrays](https://www.lri.fr/~filliatr/ftp/ocaml/ds/parray.ml.html))
+- `CCMixmap`, `CCMixtbl`, `CCMixset`, containers of universal types (heterogenous containers)
 
 ### Containers.io
 

_oasis

@@ -1,6 +1,6 @@
 OASISFormat: 0.4
 Name:        containers
-Version:     0.10
+Version:     0.11
 Homepage:    https://github.com/c-cube/ocaml-containers
 Authors:     Simon Cruanes
 License:     BSD-2-clause
@@ -82,7 +82,8 @@ Library "containers_data"
   Path:             src/data
   Modules:          CCMultiMap, CCMultiSet, CCTrie, CCFlatHashtbl, CCCache,
                     CCPersistentHashtbl, CCDeque, CCFQueue, CCBV, CCMixtbl,
-                    CCMixmap, CCRingBuffer, CCIntMap, CCPersistentArray
+                    CCMixmap, CCRingBuffer, CCIntMap, CCPersistentArray,
+                    CCMixset
   BuildDepends:     bytes
   FindlibParent:    containers
   FindlibName:      data
@@ -95,16 +96,14 @@ Library "containers_iter"
 
 Library "containers_string"
   Path:             src/string
-  Pack:             true
+  Modules:          Containers_string, CCKMP, CCLevenshtein, CCApp_parse, CCParse
-  Modules:          KMP, Levenshtein, App_parse
   BuildDepends:     bytes
   FindlibName:      string
   FindlibParent:    containers
 
 Library "containers_advanced"
   Path:             src/advanced
-  Pack:             true
+  Modules:          Containers_advanced, CCLinq, CCBatch, CCCat, CCMonadIO
-  Modules:          CCLinq, CCBatch, CCCat, CCMonadIO
   Build$:           flag(advanced)
   Install$:         flag(advanced)
   FindlibName:      advanced

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 2d4ff427096956a049556073cd9b4191)
+# DO NOT EDIT (digest: 8abfb70ea9625c4528141fdd459e8114)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
@@ -34,16 +34,9 @@ true: annot, bin_annot
 "src/iter/containers_iter.cmxs": use_containers_iter
 # Library containers_string
 "src/string/containers_string.cmxs": use_containers_string
-"src/string/KMP.cmx": for-pack(Containers_string)
-"src/string/levenshtein.cmx": for-pack(Containers_string)
-"src/string/app_parse.cmx": for-pack(Containers_string)
 <src/string/*.ml{,i,y}>: package(bytes)
 # Library containers_advanced
 "src/advanced/containers_advanced.cmxs": use_containers_advanced
-"src/advanced/CCLinq.cmx": for-pack(Containers_advanced)
-"src/advanced/CCBatch.cmx": for-pack(Containers_advanced)
-"src/advanced/CCCat.cmx": for-pack(Containers_advanced)
-"src/advanced/CCMonadIO.cmx": for-pack(Containers_advanced)
 <src/advanced/*.ml{,i,y}>: package(bytes)
 <src/advanced/*.ml{,i,y}>: package(sequence)
 <src/advanced/*.ml{,i,y}>: use_containers

containers.odocl

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 463813d3e54d45bc5b6a9d7d4eb17cd0)
+# DO NOT EDIT (digest: 7f7259458c1636ee0279e4fb677f4e2b)
 src/core/CCVector
 src/core/CCPrint
 src/core/CCError
@@ -53,10 +53,14 @@ src/data/CCMixmap
 src/data/CCRingBuffer
 src/data/CCIntMap
 src/data/CCPersistentArray
-src/string/KMP
+src/data/CCMixset
-src/string/Levenshtein
+src/string/Containers_string
-src/string/App_parse
+src/string/CCKMP
+src/string/CCLevenshtein
+src/string/CCApp_parse
+src/string/CCParse
 src/bigarray/CCBigstring
+src/advanced/Containers_advanced
 src/advanced/CCLinq
 src/advanced/CCBatch
 src/advanced/CCCat

doc/intro.txt

@@ -68,6 +68,7 @@ CCFQueue
 CCFlatHashtbl
 CCIntMap
 CCMixmap
+CCMixset
 CCMixtbl
 CCMultiMap
 CCMultiSet

setup.ml

@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.4.4 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: bc1fcdeddb836af6942617417a65ae05) *)
+(* DO NOT EDIT (digest: ee9a9724a7939bfbe9c154b61dba7eeb) *)
 (*
    Regenerated by OASIS v0.4.5
    Visit http://oasis.forge.ocamlcore.org for more information and
@@ -6965,7 +6965,7 @@ let setup_t =
           alpha_features = ["ocamlbuild_more_args"];
           beta_features = [];
           name = "containers";
-          version = "0.10";
+          version = "0.11";
           license =
             OASISLicense.DEP5License
               (OASISLicense.DEP5Unit
@@ -7294,7 +7294,8 @@ let setup_t =
                            "CCMixmap";
                            "CCRingBuffer";
                            "CCIntMap";
-                           "CCPersistentArray"
+                           "CCPersistentArray";
+                           "CCMixset"
                         ];
                       lib_pack = false;
                       lib_internal_modules = [];
@@ -7355,8 +7356,15 @@ let setup_t =
                       bs_nativeopt = [(OASISExpr.EBool true, [])]
                    },
                    {
-                      lib_modules = ["KMP"; "Levenshtein"; "App_parse"];
+                      lib_modules =
-                      lib_pack = true;
+                        [
+                           "Containers_string";
+                           "CCKMP";
+                           "CCLevenshtein";
+                           "CCApp_parse";
+                           "CCParse"
+                        ];
+                      lib_pack = false;
                       lib_internal_modules = [];
                       lib_findlib_parent = Some "containers";
                       lib_findlib_name = Some "string";
@@ -7398,8 +7406,14 @@ let setup_t =
                    },
                    {
                       lib_modules =
-                        ["CCLinq"; "CCBatch"; "CCCat"; "CCMonadIO"];
+                        [
-                      lib_pack = true;
+                           "Containers_advanced";
+                           "CCLinq";
+                           "CCBatch";
+                           "CCCat";
+                           "CCMonadIO"
+                        ];
+                      lib_pack = false;
                       lib_internal_modules = [];
                       lib_findlib_parent = Some "containers";
                       lib_findlib_name = Some "advanced";
@@ -8100,8 +8114,7 @@ let setup_t =
        };
      oasis_fn = Some "_oasis";
      oasis_version = "0.4.5";
-     oasis_digest =
+     oasis_digest = Some "\005\024\210\198~B\127\141$\2177\196Z573";
-       Some "Q\133\224\006'\239^\194\020\007 \247\168\220\142\188";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false
@@ -8109,6 +8122,6 @@ let setup_t =
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 8113 "setup.ml"
+# 8126 "setup.ml"
 (* OASIS_STOP *)
 let () = setup ();;

src/advanced/containers_advanced.ml

@@ -0,0 +1,30 @@
+
+(*
+copyright (c) 2013-2015, simon cruanes
+all rights reserved.
+
+redistribution and use in source and binary forms, with or without
+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.
+*)
+
+module Batch = CCBatch
+module Cat = CCCat
+module Linq = CCLinq
+module MonadIO = CCMonadIO

src/advanced/containers_advanced.mldylib

@@ -1,4 +1,8 @@
 # OASIS_START
-# DO NOT EDIT (digest: 0f1ca0e2b031ae1710e26abf02cca256)
+# DO NOT EDIT (digest: b0f5a3a0b7428f165d73d9e621998219)
 Containers_advanced
+CCLinq
+CCBatch
+CCCat
+CCMonadIO
 # OASIS_STOP

src/advanced/containers_advanced.mllib

@@ -1,4 +1,8 @@
 # OASIS_START
-# DO NOT EDIT (digest: 0f1ca0e2b031ae1710e26abf02cca256)
+# DO NOT EDIT (digest: b0f5a3a0b7428f165d73d9e621998219)
 Containers_advanced
+CCLinq
+CCBatch
+CCCat
+CCMonadIO
 # OASIS_STOP

src/advanced/containers_advanced.mlpack

@@ -1,7 +0,0 @@
-# OASIS_START
-# DO NOT EDIT (digest: 5a399cd532edb84596f3034081578694)
-CCLinq
-CCBatch
-CCCat
-CCMonadIO
-# OASIS_STOP

src/core/CCInt.ml

@@ -39,6 +39,27 @@ let sign i =
 
 let neg i = -i
 
+let pow a b =
+  let rec aux acc = function
+    | 1 -> acc
+    | n ->
+       if n mod 2 = 0
+       then aux (acc*acc) (n/2)
+       else acc * (aux (acc*acc) (n/2))
+  in
+  match b with
+  | 0 -> if a = 0 then raise (Invalid_argument "Undefined value 0^0") else 1
+  | b when b < 0 -> raise (Invalid_argument "pow: can't raise int to negative power")
+  | b -> aux a b
+
+(*$T
+  pow 2 10 = 1024
+  pow 2 15 = 32768
+  pow 10 5 = 100000
+  pow 1 0 = 1
+  pow 0 1 = 0
+*)
+
 type 'a printer = Buffer.t -> 'a -> unit
 type 'a formatter = Format.formatter -> 'a -> unit
 type 'a random_gen = Random.State.t -> 'a

src/core/CCInt.mli

@@ -41,6 +41,11 @@ val neg : t -> t
 (** [neg i = - i]
     @since 0.5 *)
 
+val pow : t -> t -> t
+(** [pow a b = a^b] for positive integers [a] and [b].
+    raises [Invalid_argument] if [a = b = 0] or [b] < 0.
+    @since 0.11 *)
+
 type 'a printer = Buffer.t -> 'a -> unit
 type 'a formatter = Format.formatter -> 'a -> unit
 type 'a random_gen = Random.State.t -> 'a

src/core/CCList.ml

@@ -30,6 +30,10 @@ type 'a t = 'a list
 
 let empty = []
 
+let is_empty = function
+  | [] -> true
+  | _::_ -> false
+
 (* max depth for direct recursion *)
 let direct_depth_default_ = 1000
 
@@ -206,6 +210,29 @@ let diagonal l =
   in
   gen [] l
 
+let partition_map f l =
+  let rec iter f l1 l2 l = match l with
+  | [] -> List.rev l1, List.rev l2
+  | x :: tl ->
+    match f x with
+    | `Left y -> iter f (y :: l1) l2 tl
+    | `Right y -> iter f l1 (y :: l2) tl
+    | `Drop -> iter f l1 l2 tl
+  in
+  iter f [] [] l
+
+(*$R
+  let l1, l2 =
+    partition_map (function
+      | n when n = 0 -> `Drop
+      | n when n mod 2 = 0 -> `Left n
+      | n -> `Right n
+    ) [0;1;2;3;4]
+  in
+  assert_equal [2;4] l1;
+  assert_equal [1;3] l2
+*)
+
 let return x = [x]
 
 let (>>=) l f = flat_map f l
@@ -266,6 +293,25 @@ let uniq_succ ?(eq=(=)) l =
   uniq_succ [1;1;2;3;1;6;6;4;6;1] = [1;2;3;1;6;4;6;1]
 *)
 
+let group_succ ?(eq=(=)) l =
+  let rec f ~eq acc cur l = match cur, l with
+    | [], [] -> List.rev acc
+    | _::_, [] -> List.rev (List.rev cur :: acc)
+    | [], x::tl -> f ~eq acc [x] tl
+    | (y :: _), x :: tl when eq x y -> f ~eq acc (x::cur) tl
+    | _, x :: tl -> f ~eq (List.rev cur :: acc) [x] tl
+  in
+  f ~eq [] [] l
+
+(*$T
+  group_succ [1;2;3;1;1;2;4] = [[1]; [2]; [3]; [1;1]; [2]; [4]]
+  group_succ [] = []
+  group_succ [1;1;1] = [[1;1;1]]
+  group_succ [1;2;2;2] = [[1]; [2;2;2]]
+  group_succ ~eq:(fun (x,_)(y,_)-> x=y) [1, 1; 1, 2; 1, 3; 2, 0] \
+    = [[1, 1; 1, 2; 1, 3]; [2, 0]]
+*)
+
 let sorted_merge_uniq ?(cmp=Pervasives.compare) l1 l2 =
   let push ~cmp acc x = match acc with
     | [] -> [x]
@@ -343,7 +389,23 @@ let last n l =
   let len = List.length l in
   if len < n then l else drop (len-n) l
 
-let findi f l =
+let rec find_pred p l = match l with
+  | [] -> None
+  | x :: _ when p x -> Some x
+  | _ :: tl -> find_pred p tl
+
+let find_pred_exn p l = match find_pred p l with
+  | None -> raise Not_found
+  | Some x -> x
+
+(*$T
+  find_pred ((=) 4) [1;2;5;4;3;0] = Some 4
+  find_pred (fun _ -> true) [] = None
+  find_pred (fun _ -> false) (1 -- 10) = None
+  find_pred (fun x -> x < 10) (1 -- 9) = Some 1
+*)
+
+let find_mapi f l =
   let rec aux f i = function
     | [] -> None
     | x::l' ->
@@ -352,15 +414,31 @@ let findi f l =
           | None -> aux f (i+1) l'
   in aux f 0 l
 
-let find f l = findi (fun _ -> f) l
+let find_map f l = find_mapi (fun _ -> f) l
 
-let find_idx p l = findi (fun i x -> if p x then Some (i, x) else None) l
+let find = find_map
+let findi = find_mapi
+
+let find_idx p l = find_mapi (fun i x -> if p x then Some (i, x) else None) l
 
 (*$T
   find (fun x -> if x=3 then Some "a" else None) [1;2;3;4] = Some "a"
   find (fun x -> if x=3 then Some "a" else None) [1;2;4;5] = None
 *)
 
+let remove ?(eq=(=)) ~x l =
+  let rec remove' eq x acc l = match l with
+    | [] -> List.rev acc
+    | y :: tail when eq x y -> remove' eq x acc tail
+    | y :: tail -> remove' eq x (y::acc) tail
+  in
+  remove' eq x [] l
+
+(*$T
+  remove ~x:1 [2;1;3;3;2;1] = [2;3;3;2]
+  remove ~x:10 [1;2;3] = [1;2;3]
+*)
+
 let filter_map f l =
   let rec recurse acc l = match l with
   | [] -> List.rev acc
@@ -376,6 +454,26 @@ module Set = struct
       | y::l' -> eq x y || search eq x l'
     in search eq x l
 
+  let add ?(eq=(=)) x l =
+    if mem ~eq x l then l else x::l
+
+  let remove ?(eq=(=)) x l =
+    let rec remove_one ~eq x acc l = match l with
+      | [] -> assert false
+      | y :: tl when eq x y -> List.rev_append acc tl
+      | y :: tl -> remove_one ~eq x (y::acc) tl
+    in
+    if mem ~eq x l then remove_one ~eq x [] l else l
+
+  (*$Q
+    Q.(pair int (list int)) (fun (x,l) -> \
+      Set.remove x (Set.add x l) = l)
+    Q.(pair int (list int)) (fun (x,l) -> \
+      Set.mem x l || List.length (Set.add x l) = List.length l + 1)
+    Q.(pair int (list int)) (fun (x,l) -> \
+      not (Set.mem x l) || List.length (Set.remove x l) = List.length l - 1)
+  *)
+
   let subset ?(eq=(=)) l1 l2 =
     List.for_all
       (fun t -> mem ~eq t l2)

src/core/CCList.mli

@@ -30,6 +30,10 @@ type 'a t = 'a list
 
 val empty : 'a t
 
+val is_empty : _ t -> bool
+(** [is_empty l] returns [true] iff [l = []]
+    @since 0.11 *)
+
 val map : ('a -> 'b) -> 'a t -> 'b t
 (** Safe version of map *)
 
@@ -54,7 +58,7 @@ val fold_while : ('a -> 'b -> 'a * [`Stop | `Continue]) -> 'a -> 'b t -> 'a
     @since 0.8 *)
 
 val init : int -> (int -> 'a) -> 'a t
-(** Same as [Array.init]
+(** Similar to {!Array.init}
     @since 0.6 *)
 
 val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
@@ -77,6 +81,14 @@ 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]. *)
 
+val partition_map : ('a -> [<`Left of 'b | `Right of 'c | `Drop]) ->
+                    'a list -> 'b list * 'c list
+(** [partition_map f l] maps [f] on [l] and gather results in lists:
+    - if [f x = `Left y], adds [y] to the first list
+    - if [f x = `Right z], adds [z] to the second list
+    - if [f x = `Drop], ignores [x]
+    @since 0.11 *)
+
 val pure : 'a -> 'a t
 
 val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
@@ -101,19 +113,42 @@ 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 *)
 
-val find : ('a -> 'b option) -> 'a t -> 'b option
+val find_pred : ('a -> bool) -> 'a t -> 'a option
+(** [find_pred p l] finds the first element of [l] that satisfies [p],
+    or returns [None] if no element satisfies [p]
+    @since 0.11 *)
+
+val find_pred_exn : ('a -> bool) -> 'a t -> 'a
+(** Unsafe version of {!find_pred}
+    @raise Not_found if no such element is found
+    @since 0.11 *)
+
+val find_map : ('a -> 'b option) -> 'a t -> 'b option
 (** [find f l] traverses [l], applying [f] to each element. If for
     some element [x], [f x = Some y], then [Some y] is returned. Otherwise
-    the call returns [None] *)
+    the call returns [None]
+    @since 0.11 *)
+
+val find : ('a -> 'b option) -> 'a list -> 'b option
+(** @deprecated in favor of {!find_map}, for the name is too confusing *)
+
+val find_mapi : (int -> 'a -> 'b option) -> 'a t -> 'b option
+(** Like {!find_map}, but also pass the index to the predicate function.
+    @since 0.11 *)
 
 val findi : (int -> 'a -> 'b option) -> 'a t -> 'b option
-(** Like {!find}, but also pass the index to the predicate function.
+(** @deprecated in favor of {!find_mapi}, name is too confusing
     @since 0.3.4 *)
 
 val find_idx : ('a -> bool) -> 'a t -> (int * 'a) option
 (** [find p x] returns [Some (i,x)] where [x] is the [i]-th element of [l],
     and [p x] holds. Otherwise returns [None] *)
 
+val remove : ?eq:('a -> 'a -> bool) -> x:'a -> 'a t -> 'a t
+(** [remove ~x l] removes every instance of [x] from [l]. Tailrec.
+    @param eq equality function
+    @since 0.11 *)
+
 val filter_map : ('a -> 'b option) -> 'a t -> 'b t
 (** Map and remove elements at the same time *)
 
@@ -135,6 +170,11 @@ val uniq_succ : ?eq:('a -> 'a -> bool) -> 'a list -> 'a list
     [uniq_succ [1;1;2] = [1;2]]
     @since 0.10 *)
 
+val group_succ : ?eq:('a -> 'a -> bool) -> 'a list -> 'a list list
+(** [group_succ ~eq l] groups together consecutive elements that are equal
+    according to [eq]
+    @since 0.11 *)
+
 (** {2 Indices} *)
 
 module Idx : sig
@@ -167,6 +207,14 @@ end
 (** {2 Set Operators} *)
 
 module Set : sig
+  val add : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t
+  (** [add x set] adds [x] to [set] if it was not already present
+      @since 0.11 *)
+
+  val remove : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t
+  (** [remove x set] removes one occurrence of [x] from [set]
+      @since 0.11 *)
+
   val mem : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool
   (** membership to the list *)
 

src/core/CCOpt.ml

@@ -40,6 +40,10 @@ let is_some = function
   | None -> false
   | Some _ -> true
 
+let is_none = function
+  | None -> true
+  | Some _ -> false
+
 let compare f o1 o2 = match o1, o2 with
   | None, None -> 0
   | Some _, None -> 1

src/core/CCOpt.mli

@@ -36,6 +36,9 @@ val maybe : ('a -> 'b) -> 'b -> 'a t -> 'b
 
 val is_some : _ t -> bool
 
+val is_none : _ t -> bool
+(** @since 0.11 *)
+
 val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
 
 val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
@@ -62,7 +65,6 @@ val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
 
 val filter : ('a -> bool) -> 'a t -> 'a t
 (** Filter on 0 or 1 elements
-
     @since 0.5 *)
 
 val get : 'a -> 'a t -> 'a

src/core/CCString.mli

@@ -146,9 +146,9 @@ module Split : sig
   (** split the given string along the given separator [by]. Should only
       be used with very small separators, otherwise
       use {!Containers_string.KMP}.
-      @return a list of (index,length) of substrings of [s] that are
+      @return a list of slices [(s,index,length)] that are
       separated by [by]. {!String.sub} can then be used to actually extract
-      the slice.
+      a string from the slice.
       @raise Failure if [by = ""] *)
 
   val gen : by:string -> string -> (string*int*int) gen

src/core/META

@@ -1,6 +1,6 @@
 # OASIS_START
-# DO NOT EDIT (digest: 09a66d8274446aebd1544537d064203d)
+# DO NOT EDIT (digest: 21a795d293af857176fa2c97f6316578)
-version = "0.10"
+version = "0.11"
 description = "A modular standard library focused on data structures."
 requires = "bytes"
 archive(byte) = "containers.cma"
@@ -9,7 +9,7 @@ archive(native) = "containers.cmxa"
 archive(native, plugin) = "containers.cmxs"
 exists_if = "containers.cma"
 package "unix" (
- version = "0.10"
+ version = "0.11"
  description = "A modular standard library focused on data structures."
  requires = "bytes unix"
  archive(byte) = "containers_unix.cma"
@@ -20,7 +20,7 @@ package "unix" (
 )
 
 package "thread" (
- version = "0.10"
+ version = "0.11"
  description = "A modular standard library focused on data structures."
  requires = "containers threads"
  archive(byte) = "containers_thread.cma"
@@ -31,7 +31,7 @@ package "thread" (
 )
 
 package "string" (
- version = "0.10"
+ version = "0.11"
  description = "A modular standard library focused on data structures."
  requires = "bytes"
  archive(byte) = "containers_string.cma"
@@ -42,7 +42,7 @@ package "string" (
 )
 
 package "sexp" (
- version = "0.10"
+ version = "0.11"
  description = "A modular standard library focused on data structures."
  requires = "bytes"
  archive(byte) = "containers_sexp.cma"
@@ -53,7 +53,7 @@ package "sexp" (
 )
 
 package "misc" (
- version = "0.10"
+ version = "0.11"
  description = "A modular standard library focused on data structures."
  requires = "containers containers.data"
  archive(byte) = "containers_misc.cma"
@@ -64,7 +64,7 @@ package "misc" (
 )
 
 package "lwt" (
- version = "0.10"
+ version = "0.11"
  description = "A modular standard library focused on data structures."
  requires = "containers lwt containers.misc"
  archive(byte) = "containers_lwt.cma"
@@ -75,7 +75,7 @@ package "lwt" (
 )
 
 package "iter" (
- version = "0.10"
+ version = "0.11"
  description = "A modular standard library focused on data structures."
  archive(byte) = "containers_iter.cma"
  archive(byte, plugin) = "containers_iter.cma"
@@ -85,7 +85,7 @@ package "iter" (
 )
 
 package "io" (
- version = "0.10"
+ version = "0.11"
  description = "A modular standard library focused on data structures."
  requires = "bytes"
  archive(byte) = "containers_io.cma"
@@ -96,7 +96,7 @@ package "io" (
 )
 
 package "data" (
- version = "0.10"
+ version = "0.11"
  description = "A modular standard library focused on data structures."
  requires = "bytes"
  archive(byte) = "containers_data.cma"
@@ -107,7 +107,7 @@ package "data" (
 )
 
 package "bigarray" (
- version = "0.10"
+ version = "0.11"
  description = "A modular standard library focused on data structures."
  requires = "containers bigarray bytes"
  archive(byte) = "containers_bigarray.cma"
@@ -118,7 +118,7 @@ package "bigarray" (
 )
 
 package "advanced" (
- version = "0.10"
+ version = "0.11"
  description = "A modular standard library focused on data structures."
  requires = "containers sequence"
  archive(byte) = "containers_advanced.cma"

src/data/CCMixset.ml

@@ -0,0 +1,79 @@
+
+(*
+copyright (c) 2013-2015, simon cruanes
+all rights reserved.
+
+redistribution and use in source and binary forms, with or without
+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 Set of Heterogeneous Values} *)
+
+module IMap = Map.Make(struct
+  type t = int
+  let compare : int -> int -> int = compare
+end)
+
+(*$R
+  let k1 : int key = newkey () in
+  let k2 : int key = newkey () in
+  let k3 : string key = newkey () in
+  let set =
+    empty
+    |> set ~key:k1 1
+    |> set ~key:k2 2
+    |> set ~key:k3 "3"
+  in
+  assert (get ~key:k1 set = Some 1);
+  assert (get ~key:k2 set = Some 2);
+  assert (get ~key:k3 set = Some "3");
+  ()
+*)
+
+type t = (unit -> unit) IMap.t
+and 'a key = {
+  id: int;
+  mutable opt : 'a option;
+};;
+
+let newkey_n_ = ref 0
+
+let newkey () =
+  let id = !newkey_n_ in
+  incr newkey_n_;
+  { id; opt=None; }
+
+let empty = IMap.empty
+
+let get ~key set =
+  key.opt <- None;
+  try
+    (IMap.find key.id set) ();
+    key.opt
+  with Not_found -> None
+
+let get_exn ~key set = match get ~key set with
+  | None -> raise Not_found
+  | Some v -> v
+
+let set ~key v set =
+  IMap.add key.id (fun () -> key.opt <- Some v) set
+
+let cardinal set = IMap.cardinal set

src/data/CCMixset.mli

@@ -0,0 +1,77 @@
+
+(*
+copyright (c) 2013-2015, simon cruanes
+all rights reserved.
+
+redistribution and use in source and binary forms, with or without
+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 Set of Heterogeneous Values}
+
+    {[
+      let k1 : int key = newkey () in
+      let k2 : int key = newkey () in
+      let k3 : string key = newkey () in
+      let set =
+        empty
+        |> set ~key:k1 1
+        |> set ~key:k2 2
+        |> set ~key:k3 "3"
+      in
+      assert (get ~key:k1 set = Some 1);
+      assert (get ~key:k2 set = Some 2);
+      assert (get ~key:k3 set = Some "3");
+      ()
+    ]}
+
+    @since 0.11 *)
+
+type t
+(** A set of values of heterogeneous types *)
+
+type 'a key
+(** A unique "key" to access a value of type ['a] in a [set] *)
+
+val newkey : unit -> 'a key
+(** [newkey ()] creates a new unique key that can be used to access
+    a ['a] value in a set. Each key created with [newkey] is distinct
+    from any other key, even if they have the same type.
+
+    Not thread-safe. *)
+
+val empty : t
+(** Empty set *)
+
+val set : key:'a key -> 'a -> t -> t
+(** [set ~key v set] maps [key] to [v] in [set]. It means that
+    for every [set], [get ~key (set ~key v set) = Some v]. *)
+
+val get : key:'a key -> t -> 'a option
+(** [get ~key set] obtains the value for [key] in [set], if any. *)
+
+val get_exn : key:'a key -> t -> 'a
+(** Same as {!get}, but can fail
+    @raise Not_found if the key is not present *)
+
+val cardinal : t -> int
+(** Number of mappings *)
+
+

src/data/CCMixtbl.mli

@@ -25,7 +25,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 (** {1 Hash Table with Heterogeneous Keys}
 
-From https://github.com/mjambon/mixtbl , thanks to him.
+From https://github.com/mjambon/mixtbl (thanks to him).
 Example:
 
 {[

src/data/CCRingBuffer.ml

@@ -193,6 +193,14 @@ module type S = sig
   val take_front_exn : t -> Array.elt
   (** Take the first value from front of [t].
       @raise Empty if buffer is already empty. *)
+
+  val of_array : Array.t -> t
+  (** Create a buffer from an initial array, but doesn't take ownership
+      of it (stills allocates a new internal array) *)
+
+  val to_array : t -> Array.t
+  (** Create an array from the elements, in order.
+      @since 0.11 *)
 end
 
 module MakeFromArray(Array:Array.S) = struct
@@ -228,6 +236,13 @@ module MakeFromArray(Array:Array.S) = struct
     try Byte.iteri b (fun i c -> if Byte.get_front b' i <> c then raise Exit); true with Exit -> false)
   *)
 
+  (*$T
+    let b = Byte.of_array "abc" in \
+    let b' = Byte.copy b in \
+    Byte.clear b; \
+    Byte.to_array b' = "abc" && Byte.to_array b = ""
+  *)
+
   let capacity b =
     let len = Array.length b.buf in
     match len with 0 -> 0 | l -> l - 1
@@ -664,6 +679,26 @@ module MakeFromArray(Array:Array.S) = struct
     try let back = Byte.peek_back b in \
     back = Bytes.get s (s_len - 1) with Byte.Empty -> s_len = 0)
   *)
+
+  let of_array a =
+    let b = create (max (Array.length a) 16) in
+    blit_from b a 0 (Array.length a);
+    b
+
+  let to_array b =
+    if is_empty b then Array.empty
+    else (
+      let a = Array.make (length b) (peek_front b) in
+      let n = blit_into b a 0 (length b) in
+      assert (n = length b);
+      a
+    )
+
+  (*$Q
+    Q.printable_string (fun s -> \
+      let b = Byte.of_array s in let s' = Byte.to_array b in \
+      s = s')
+  *)
 end
 
 module Byte = MakeFromArray(Array.Byte)

src/data/CCRingBuffer.mli

@@ -192,6 +192,14 @@ module type S = sig
   val take_front_exn : t -> Array.elt
   (** Take the first value from front of [t].
       @raise Empty if buffer is already empty. *)
+
+  val of_array : Array.t -> t
+  (** Create a buffer from an initial array, but doesn't take ownership
+      of it (stills allocates a new internal array) *)
+
+  val to_array : t -> Array.t
+  (** Create an array from the elements, in order.
+      @since 0.11 *)
 end
 
 (** An efficient byte based ring buffer *)

src/data/containers_data.mldylib

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: b83e1a21d44ea00373b0dde5cda9eedd)
+# DO NOT EDIT (digest: 423faeb80b3829590072ca8f5414955c)
 CCMultiMap
 CCMultiSet
 CCTrie
@@ -14,4 +14,5 @@ CCMixmap
 CCRingBuffer
 CCIntMap
 CCPersistentArray
+CCMixset
 # OASIS_STOP

src/data/containers_data.mllib

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: b83e1a21d44ea00373b0dde5cda9eedd)
+# DO NOT EDIT (digest: 423faeb80b3829590072ca8f5414955c)
 CCMultiMap
 CCMultiSet
 CCTrie
@@ -14,4 +14,5 @@ CCMixmap
 CCRingBuffer
 CCIntMap
 CCPersistentArray
+CCMixset
 # OASIS_STOP

src/misc/RAL.ml

@@ -30,13 +30,11 @@ type +'a tree =
   | Leaf of 'a
   | Node of 'a * 'a tree * 'a tree
 
-and +'a t = (int * 'a tree) list
+and +'a t =
+  | Nil
+  | Cons of int * 'a tree * 'a t
   (** Functional array of complete trees *)
 
-(* TODO: inline list's nodes
-  TODO: encode "complete binary tree" into types *)
-
-
 (** {2 Functions on trees} *)
 
 (* lookup [i]-th element in the tree [t], which has size [size] *)
@@ -63,56 +61,67 @@ let rec tree_update size t i v =match t, i with
 
 (** {2 Functions on lists of trees} *)
 
-let empty = []
+let empty = Nil
 
-let return x = [1, Leaf x]
+let return x = Cons (1, Leaf x, Nil)
 
 let is_empty = function
-  | [] -> true
+  | Nil -> true
-  | _ -> false
+  | Cons _ -> false
 
 let rec get l i = match l with
-  | [] -> raise (Invalid_argument "RAL.get: wrong index")
+  | Nil -> raise (Invalid_argument "RAL.get: wrong index")
-  | (size,t) :: _ when i < size -> tree_lookup size t i
+  | Cons (size,t, _) when i < size -> tree_lookup size t i
-  | (size,_) :: l' -> get l' (i - size)
+  | Cons (size,_, l') -> get l' (i - size)
 
 let rec set l i v = match l with
-  | [] -> raise (Invalid_argument "RAL.set: wrong index")
+  | Nil -> raise (Invalid_argument "RAL.set: wrong index")
-  | (size,t) :: l' when i < size -> (size, tree_update size t i v) :: l'
+  | Cons (size,t, l') when i < size -> Cons (size, tree_update size t i v, l')
-  | (size,t) :: l' -> (size, t) :: set l' (i - size) v
+  | Cons (size,t, l') -> Cons (size, t, set l' (i - size) v)
+
+(*$Q
+   Q.(pair (pair int int) (list int)) (fun ((i,v),l) -> \
+    let ral = of_list l in let ral = set ral i v in \
+    get ral i = v)
+*)
 
 let cons x l = match l with
-  | (size1, t1) :: (size2, t2) :: l' ->
+  | Cons (size1, t1, Cons (size2, t2, l')) ->
     if size1 = size2
-      then (1 + size1 + size2, Node (x, t1, t2)) :: l'
+      then Cons (1 + size1 + size2, Node (x, t1, t2), l')
-      else (1, Leaf x) :: l
+      else Cons (1, Leaf x, l)
-  | _ -> (1, Leaf x) :: l
+  | _ -> Cons (1, Leaf x, l)
 
 let hd l = match l with
-  | [] -> raise (Invalid_argument "RAL.hd: empty list")
+  | Nil -> raise (Invalid_argument "RAL.hd: empty list")
-  | (_, Leaf x) :: _ -> x
+  | Cons (_, Leaf x, _) -> x
-  | (_, Node (x, _, _)) :: _ -> x
+  | Cons (_, Node (x, _, _), _) -> x
 
 let tl l = match l with
-  | [] -> raise (Invalid_argument "RAL.tl: empty list")
+  | Nil -> raise (Invalid_argument "RAL.tl: empty list")
-  | (_, Leaf _) :: l' -> l'
+  | Cons (_, Leaf _, l') -> l'
-  | (size, Node (_, t1, t2)) :: l' ->
+  | Cons (size, Node (_, t1, t2), l') ->
     let size' = size / 2 in
-    (size', t1) :: (size', t2) :: l'
+    Cons (size', t1, Cons (size', t2, l'))
+
+(*$T
+  let l = of_list[1;2;3] in hd l = 1
+  let l = of_list[1;2;3] in tl l |> to_list = [2;3]
+*)
 
 let front l = match l with
-  | [] -> None
+  | Nil -> None
-  | (_, Leaf x) :: tl -> Some (x, tl)
+  | Cons (_, Leaf x, tl) -> Some (x, tl)
-  | (size, Node (x, t1, t2)) :: l' ->
+  | Cons (size, Node (x, t1, t2), l') ->
     let size' = size / 2 in
-    Some (x, (size', t1) :: (size', t2) :: l')
+    Some (x, Cons (size', t1, Cons (size', t2, l')))
 
 let front_exn l = match l with
-  | [] -> raise (Invalid_argument "RAL.front")
+  | Nil -> raise (Invalid_argument "RAL.front")
-  | (_, Leaf x) :: tl -> x, tl
+  | Cons (_, Leaf x, tl) -> x, tl
-  | (size, Node (x, t1, t2)) :: l' ->
+  | Cons (size, Node (x, t1, t2), l') ->
     let size' = size / 2 in
-    x, (size', t1) :: (size', t2) :: l'
+    x, Cons (size', t1, Cons (size', t2, l'))
 
 let rec _remove prefix l i =
   let x, l' = front_exn l in
@@ -126,24 +135,26 @@ let rec _map_tree f t = match t with
   | Leaf x -> Leaf (f x)
   | Node (x, l, r) -> Node (f x, _map_tree f l, _map_tree f r)
 
-let map f l = List.map (fun (i,t) -> i, _map_tree f t) l
+let rec map f l = match l with
+  | Nil -> Nil
+  | Cons (i, t, tl) -> Cons (i, _map_tree f t, map f tl)
 
 let rec length l = match l with
-  | [] -> 0
+  | Nil -> 0
-  | (size,_) :: l' -> size + length l'
+  | Cons (size,_, l') -> size + length l'
 
 let rec iter f l = match l with
-  | [] -> ()
+  | Nil -> ()
-  | (_, Leaf x) :: l' -> f x; iter f l'
+  | Cons (_, Leaf x, l') -> f x; iter f l'
-  | (_, t) :: l' -> iter_tree t f; iter f l'
+  | Cons (_, t, l') -> iter_tree t f; iter f l'
 and iter_tree t f = match t with
   | Leaf x -> f x
   | Node (x, t1, t2) -> f x; iter_tree t1 f; iter_tree t2 f
 
 let rec fold f acc l = match l with
-  | [] -> acc
+  | Nil -> acc
-  | (_, Leaf x) :: l' -> fold f (f acc x) l'
+  | Cons (_, Leaf x, l') -> fold f (f acc x) l'
-  | (_, t) :: l' ->
+  | Cons (_, t, l') ->
     let acc' = fold_tree t acc f in
     fold f acc' l'
 and fold_tree t acc f = match t with
@@ -154,9 +165,9 @@ and fold_tree t acc f = match t with
     fold_tree t2 acc f
 
 let rec fold_rev f acc l = match l with
-  | [] -> acc
+  | Nil -> acc
-  | (_, Leaf x) :: l' -> f (fold f acc l') x
+  | Cons (_, Leaf x, l') -> f (fold f acc l') x
-  | (_, t) :: l' ->
+  | Cons (_, t, l') ->
     let acc = fold_rev f acc l' in
     fold_tree_rev t acc f
 and fold_tree_rev t acc f = match t with

src/misc/printBox.ml

@@ -76,7 +76,7 @@ module Output = struct
     )
 
   let _ensure_line line i =
-    if i >= !_string_len line.bl_str
+    if i >= Bytes.length line.bl_str
     then (
       let str' = Bytes.make (2 * i + 5) ' ' in
       Bytes.blit line.bl_str 0 str' 0 line.bl_len;
@@ -100,7 +100,7 @@ module Output = struct
     line.bl_len <- max line.bl_len (pos.x+s_len)
 
   let _buf_put_string buf pos s =
-    _buf_put_sub_string buf pos s 0 (!_string_len (Bytes.unsafe_of_string s))
+    _buf_put_sub_string buf pos s 0 (String.length s)
 
   (* create a new buffer *)
   let make_buffer () =
@@ -119,7 +119,7 @@ module Output = struct
   let buf_to_lines ?(indent=0) buf =
     let buffer = Buffer.create (5 + buf.buf_len * 32) in
     for i = 0 to buf.buf_len - 1 do
-      for k = 1 to indent do Buffer.add_char buffer ' ' done;
+      for _k = 1 to indent do Buffer.add_char buffer ' ' done;
       let line = buf.buf_lines.(i) in
       Buffer.add_substring buffer (Bytes.unsafe_to_string line.bl_str) 0 line.bl_len;
       Buffer.add_char buffer '\n';
@@ -128,7 +128,7 @@ module Output = struct
 
   let buf_output ?(indent=0) oc buf =
     for i = 0 to buf.buf_len - 1 do
-      for k = 1 to indent do output_char oc ' '; done;
+      for _k = 1 to indent do output_char oc ' '; done;
       let line = buf.buf_lines.(i) in
       output oc line.bl_str 0 line.bl_len;
       output_char oc '\n';
@@ -141,6 +141,7 @@ let rec _find s c i =
   else if s.[i] = c then Some i
   else _find s c (i+1)
 
+(* sequence of lines *)
 let rec _lines s i k = match _find s '\n' i with
   | None ->
       if i<String.length s then k (String.sub s i (String.length s-i))

src/string/CCParse.ml

@@ -0,0 +1,220 @@
+
+(*
+copyright (c) 2013-2015, simon cruanes
+all rights reserved.
+
+redistribution and use in source and binary forms, with or without
+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 Very Simple Parser Combinators} *)
+
+type 'a or_error = [`Ok of 'a | `Error of string]
+
+type input = {
+  is_done : unit -> bool; (** End of input? *)
+  cur : unit -> char;  (** Current char *)
+  next : unit -> char; (** if not {!is_done}, move to next char *)
+  pos : unit -> int;   (** Current pos *)
+  backtrack : int -> unit;  (** Restore to previous pos *)
+  sub : int -> int -> string; (** Extract slice from [pos] with [len] *)
+}
+
+exception ParseError of int * string (** position * message *)
+
+let input_of_string s =
+  let i = ref 0 in
+  { is_done=(fun () -> !i = String.length s);
+    cur=(fun () -> s.[!i]);
+    next=(fun () ->
+        if !i = String.length s
+        then raise (ParseError (!i, "unexpected EOI"))
+        else (
+          let c = s.[!i] in
+          incr i;
+          c
+        )
+    );
+    pos=(fun () -> !i);
+    backtrack=(fun j -> assert (0 <= j && j <= !i); i := j);
+    sub=(fun j len -> assert (j + len <= !i); String.sub s j len);
+  }
+
+type 'a t = input -> 'a
+
+let return x _ = x
+let pure = return
+let (>|=) p f st = f (p st)
+let (>>=) p f st =
+  let x = p st in
+  f x st
+let (<*>) x y st =
+  let f = x st in
+  let g = y st in
+  f g
+let (<* ) x y st =
+  let res = x st in
+  let _ = y st in
+  res
+let ( *>) x y st =
+  let _ = x st in
+  let res = y st in
+  res
+
+let junk_ st = ignore (st.next ())
+let fail_ st fmt =
+  Printf.ksprintf
+    (fun msg -> raise (ParseError (st.pos (), msg))) fmt
+
+let eoi st = if st.is_done() then () else fail_ st "expected EOI"
+let fail msg st = fail_ st "%s" msg
+let nop _ = ()
+
+let char c st =
+  if st.next () = c then c else fail_ st "expected '%c'" c
+
+let char_if p st =
+  let c = st.next () in
+  if p c then c else fail_ st "unexpected char '%c'" c
+
+let chars_if p st =
+  let i = st.pos () in
+  let len = ref 0 in
+  while not (st.is_done ()) && p (st.cur ()) do junk_ st; incr len done;
+  st.sub i !len
+
+let chars1_if p st =
+  let s = chars_if p st in
+  if s = "" then fail_ st "unexpected sequence of chars";
+  s
+
+let rec skip_chars p st =
+  if not (st.is_done ()) && p (st.cur ()) then (
+    junk_ st;
+    skip_chars p st
+  )
+
+let is_alpha = function
+  | 'a' .. 'z' | 'A' .. 'Z' -> true
+  | _ -> false
+let is_num = function '0' .. '9' -> true | _ -> false
+let is_alpha_num = function
+  | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' -> true
+  | _ -> false
+let is_space = function ' ' | '\t' -> true | _ -> false
+let is_white = function ' ' | '\t' | '\n' -> true | _ -> false
+let (~~~) p c = not (p c)
+let (|||) p1 p2 c = p1 c || p2 c
+let (&&&) p1 p2 c = p1 c && p2 c
+
+let endline = char '\n'
+let space = char_if is_space
+let white = char_if is_white
+
+let skip_space = skip_chars is_space
+let skip_white = skip_chars is_white
+
+let (<|>) x y st =
+  let i = st.pos () in
+  try
+    x st
+  with ParseError _ ->
+    st.backtrack i; (* restore pos *)
+    y st
+
+let string s st =
+  let rec check i =
+    i = String.length s ||
+    (s.[i] = st.next () && check (i+1))
+  in
+  if check 0 then s else fail_ st "expected \"%s\"" s
+
+let rec many_rec p st acc =
+  if st.is_done () then List.rev acc
+  else
+    let i = st.pos () in
+    try
+      let x = p st in
+      many_rec p st (x :: acc)
+    with ParseError _ ->
+      st.backtrack i;
+      List.rev acc
+
+let many p st = many_rec p st []
+
+let many1 p st =
+  let x = p st in
+  many_rec p st [x]
+
+let rec skip p st =
+  let i = st.pos () in
+  let matched =
+    try
+      let _ = p st in
+      true
+    with ParseError _ ->
+      false
+  in
+  if matched then skip p st else st.backtrack i
+
+let rec sep1 ~by p =
+  p >>= fun x ->
+  let cont = by *> sep ~by p >|= fun tl -> x :: tl in
+  cont <|> return [x]
+and sep ~by p =
+  sep1 ~by p <|> return []
+
+let fix f =
+  let rec p st = f p st in
+  p
+
+let parse_exn ~input p = p input
+
+let parse ~input p =
+  try `Ok (parse_exn ~input p)
+  with ParseError (i, msg) ->
+    `Error (Printf.sprintf "at position %d: error %s" i msg)
+
+let parse_string s p = parse ~input:(input_of_string s) p
+let parse_string_exn s p = parse_exn ~input:(input_of_string s) p
+
+module U = struct
+  let sep_ = sep
+
+  let list ?(start="[") ?(stop="]") ?(sep=";") p =
+    string start *> skip_space *>
+    sep_ ~by:(skip_space *> string sep *> skip_space) p <*
+    skip_space <* string stop
+
+  let int =
+    chars1_if (is_num ||| (=) '-')
+    >>= fun s ->
+    try return (int_of_string s)
+    with Failure _ -> fail "expected an int"
+
+  let map f x = x >|= f
+  let map2 f x y = pure f <*> x <*> y
+  let map3 f x y z = pure f <*> x <*> y <*> z
+
+  let prepend_str c s = String.make 1 c ^ s
+
+  let word =
+    map2 prepend_str (char_if is_alpha) (chars_if is_alpha_num)
+end

src/string/CCParse.mli

@@ -0,0 +1,149 @@
+
+(*
+copyright (c) 2013-2015, simon cruanes
+all rights reserved.
+
+redistribution and use in source and binary forms, with or without
+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 Very Simple Parser Combinators}
+
+Examples:
+
+{6 parse recursive structures}
+
+{[
+open Containers_string.Parse;;
+
+type tree = L of int | N of tree * tree;;
+
+let mk_leaf x = L x
+let mk_node x y = N(x,y)
+
+let ptree = fix @@ fun self ->
+  skip_space *>
+  ( (char '(' *> (pure mk_node <*> self <*> self) <* char ')')
+    <|>
+    (U.int >|= mk_leaf) )
+;;
+
+parse_string_exn "(1 (2 3))" ptree;;
+parse_string_exn "((1 2) (3 (4 5)))" ptree;;
+
+]}
+
+{6 Parse a list of words}
+
+{[
+open Containers_string.Parse;;
+let p = U.list ~sep:"," U.word;;
+parse_string_exn "[abc , de, hello ,world  ]" p;;
+]}
+
+@since 0.11
+*)
+
+type 'a or_error = [`Ok of 'a | `Error of string]
+exception ParseError of int * string (** position * message *)
+
+(** {2 Input} *)
+
+type input = {
+  is_done : unit -> bool; (** End of input? *)
+  cur : unit -> char;  (** Current char *)
+  next : unit -> char; (** if not {!is_done}, move to next char *)
+  pos : unit -> int;   (** Current pos *)
+  backtrack : int -> unit;  (** Restore to previous pos *)
+  sub : int -> int -> string; (** [sub pos len] extracts slice from [pos] with [len] *)
+}
+
+val input_of_string : string -> input
+
+(** {2 Combinators} *)
+
+type 'a t = input -> 'a (** @raise ParseError in case of failure *)
+
+val return : 'a -> 'a t
+val pure : 'a -> 'a t (** synonym to {!return} *)
+val (>|=) : 'a t -> ('a -> 'b) -> 'b t
+val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
+val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
+val (<* ) : 'a t -> _ t -> 'a t
+val ( *>) : _ t -> 'a t -> 'a t
+
+val fail : string -> 'a t
+val eoi : unit t (** end of string *)
+val nop : unit t (** do nothing *)
+
+val char : char -> char t
+val char_if : (char -> bool) -> char t
+val chars_if : (char -> bool) -> string t
+val chars1_if : (char -> bool) -> string t (** non empty *)
+val endline : char t
+val space : char t (** tab or space *)
+val white : char t (** tab or space or newline *)
+
+val skip_chars : (char -> bool) -> unit t (** Skip 0 or more chars *)
+val skip_space : unit t
+val skip_white : unit t
+
+val is_alpha : char -> bool
+val is_num : char -> bool
+val is_alpha_num : char -> bool
+val is_space : char -> bool
+val (~~~) : (char -> bool) -> char -> bool
+val (|||) : (char -> bool) -> (char -> bool) -> char -> bool
+val (&&&) : (char -> bool) -> (char -> bool) -> char -> bool
+
+val (<|>) : 'a t -> 'a t -> 'a t  (* succeeds if either succeeds *)
+
+val string : string -> string t
+
+val many : 'a t -> 'a list t
+val many1 : 'a t -> 'a list t (** non empty *)
+val skip : _ t -> unit t
+
+val sep : by:_ t -> 'a t -> 'a list t
+val sep1 : by:_ t -> 'a t -> 'a list t (** non empty *)
+
+val fix : ('a t -> 'a t) -> 'a t
+(** Fixpoint combinator *)
+
+(** {2 Parse} *)
+
+val parse : input:input -> 'a t -> 'a or_error
+val parse_exn : input:input -> 'a t -> 'a (** @raise ParseError if it fails *)
+
+val parse_string : string -> 'a t -> 'a or_error
+val parse_string_exn : string -> 'a t -> 'a (** @raise ParseError if it fails *)
+
+
+(** {2 Utils} *)
+
+module U : sig
+  val list : ?start:string -> ?stop:string -> ?sep:string -> 'a t -> 'a list t
+  val int : int t
+  val word : string t (** alpha num, start with alpha *)
+  val map : ('a -> 'b) -> 'a t -> 'b t
+  val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
+  val map3 : ('a -> 'b -> 'c -> 'd) -> 'a t -> 'b t -> 'c t -> 'd t
+end

src/string/containers_string.ml

@@ -0,0 +1,31 @@
+
+(*
+copyright (c) 2013-2015, simon cruanes
+all rights reserved.
+
+redistribution and use in source and binary forms, with or without
+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.
+*)
+
+module App_parse = CCApp_parse
+module Parse = CCParse
+module KMP = CCKMP
+module Levenshtein = CCLevenshtein
+

src/string/containers_string.mldylib

@@ -1,4 +1,8 @@
 # OASIS_START
-# DO NOT EDIT (digest: c89cc456e050edff914368d7fbea4eca)
+# DO NOT EDIT (digest: b0d9848489c9eaabded92f7c9fec3073)
 Containers_string
+CCKMP
+CCLevenshtein
+CCApp_parse
+CCParse
 # OASIS_STOP

src/string/containers_string.mllib

@@ -1,4 +1,8 @@
 # OASIS_START
-# DO NOT EDIT (digest: c89cc456e050edff914368d7fbea4eca)
+# DO NOT EDIT (digest: b0d9848489c9eaabded92f7c9fec3073)
 Containers_string
+CCKMP
+CCLevenshtein
+CCApp_parse
+CCParse
 # OASIS_STOP

src/string/containers_string.mlpack

@@ -1,6 +0,0 @@
-# OASIS_START
-# DO NOT EDIT (digest: 200ff8feb7cb7b8d5e2aea5b7c63241a)
-KMP
-Levenshtein
-App_parse
-# OASIS_STOP

src/unix/CCUnix.ml

@@ -55,7 +55,7 @@ let escape_str buf s =
     Buffer.add_char buf '\'';
     String.iter
       (function
-        | '\'' -> Buffer.add_string buf "''"
+        | '\'' -> Buffer.add_string buf "'\\''"
         | c -> Buffer.add_char buf c
       ) s;
     Buffer.add_char buf '\'';
@@ -88,7 +88,7 @@ type call_result =
 
 let kbprintf' buf fmt k = Printf.kbprintf k buf fmt
 
-let call ?(bufsize=2048) ?(stdin=`Str "") ?(env=[||]) cmd =
+let call ?(bufsize=2048) ?(stdin=`Str "") ?(env=Unix.environment()) cmd =
   (* render the command *)
   let buf = Buffer.create 256 in
   kbprintf' buf cmd
@@ -113,3 +113,53 @@ let call ?(bufsize=2048) ?(stdin=`Str "") ?(env=[||]) cmd =
         end
     )
 
+type line = string
+
+type async_call_result =
+  < stdout:line gen;
+    stderr:line gen;
+    stdin:line -> unit; (* send a line *)
+    close_in:unit; (* close stdin *)
+    close_err:unit;
+    close_out:unit;
+    close_all:unit;  (* close all 3 channels *)
+    wait:Unix.process_status;  (* block until the process ends *)
+    wait_errcode:int; (* block until the process ends, then extract errcode *)
+  >
+
+let async_call ?(env=Unix.environment()) cmd =
+  (* render the command *)
+  let buf = Buffer.create 256 in
+  kbprintf' buf cmd
+    (fun buf ->
+       let cmd = Buffer.contents buf in
+       let oc, ic, errc = Unix.open_process_full cmd env in
+       object (self)
+         method stdout () =
+           try Some (input_line oc)
+           with End_of_file -> None
+         method stderr () =
+           try Some (input_line errc)
+           with End_of_file -> None
+         method stdin l = output_string ic l; output_char ic '\n'
+         method close_in = close_out ic
+         method close_out = close_in oc
+         method close_err = close_in errc
+         method close_all = close_out ic; close_in oc; close_in errc; ()
+         method wait = Unix.close_process_full (oc, ic, errc)
+         method wait_errcode = int_of_process_status self#wait
+       end
+    )
+
+let stdout x = x#stdout
+let stderr x = x#stderr
+let status x = x#status
+let errcode x = x#errcode
+
+module Infix = struct
+  let (?|) fmt = call fmt
+
+  let (?|&) fmt = async_call fmt
+end
+
+include Infix

src/unix/CCUnix.mli

@@ -43,7 +43,7 @@ val escape_str : Buffer.t -> string -> unit
 (*$T
   CCPrint.sprintf "%a" escape_str "foo" = "foo"
   CCPrint.sprintf "%a" escape_str "foo bar" = "'foo bar'"
-  CCPrint.sprintf "%a" escape_str "fo'o b'ar" = "'fo''o b''ar'"
+  CCPrint.sprintf "%a" escape_str "fo'o b'ar" = "'fo'\\''o b'\\''ar'"
 *)
 
 type call_result =
@@ -69,9 +69,57 @@ val call : ?bufsize:int ->
 
 (*$T
   (call ~stdin:(`Str "abc") "cat")#stdout = "abc"
-  (call "echo %a" escape_str "a'b'c")#stdout = "abc\n"
+  (call "echo %a" escape_str "a'b'c")#stdout = "a'b'c\n"
   (call "echo %s" "a'b'c")#stdout = "abc\n"
 *)
 
+type line = string
+
+type async_call_result =
+  < stdout:line gen;
+    stderr:line gen;
+    stdin:line -> unit; (* send a line *)
+    close_in:unit; (* close stdin *)
+    close_err:unit;
+    close_out:unit;
+    close_all:unit;  (* close all 3 channels *) (** @since 0.11 *)
+    wait:Unix.process_status;  (* block until the process ends *)
+    wait_errcode:int; (* block until the process ends, then extract errcode *)
+       (** @since 0.11 *)
+  >
+(** A subprocess for interactive usage (read/write channels line by line)
+    @since 0.11 *)
+
+val async_call : ?env:string array ->
+                 ('a, Buffer.t, unit, async_call_result) format4 ->
+                 'a
+(** Spawns a subprocess, like {!call}, but the subprocess's channels are
+    line generators and line sinks (for stdin).
+    if [p] is [async_call "cmd"], then [p#wait] waits for the subprocess
+    to die. Channels can be closed independently.
+    @since 0.11 *)
+
+(** {2 Accessors}
+
+@since 0.11 *)
+
+val stdout : < stdout : 'a; .. > -> 'a
+val stderr : < stderr : 'a; .. > -> 'a
+val status : < status : 'a; .. > -> 'a
+val errcode : < errcode : 'a; .. > -> 'a
+
+(** {2 Infix Functions} *)
+
+module Infix : sig
+  val (?|) : ('a, Buffer.t, unit, call_result) format4 -> 'a
+  (** Infix version of {!call}
+      @since 0.11 *)
+
+  val (?|&) : ('a, Buffer.t, unit, async_call_result) format4 -> 'a
+  (** Infix version of {!async_call}
+      @since 0.11 *)
+end
+
+include module type of Infix