merge from master

Makefile

@@ -50,6 +50,7 @@ examples: all
 push_doc: doc
 	scp -r containers.docdir/* cedeela.fr:~/simon/root/software/containers/
 	scp -r containers_string.docdir/* cedeela.fr:~/simon/root/software/containers/string/
+	scp -r containers_advanced.docdir/* cedeela.fr:~/simon/root/software/containers/advanced
 	scp -r containers_misc.docdir/* cedeela.fr:~/simon/root/software/containers/misc/
 
 DONTTEST=myocamlbuild.ml setup.ml
@@ -102,4 +103,8 @@ update_next_tag:
 	sed -i "s/NEXT_VERSION/$(VERSION)/g" **/*.ml **/*.mli
 	sed -i "s/NEXT_RELEASE/$(VERSION)/g" **/*.ml **/*.mli
 
-.PHONY: examples push_doc tags qtest push-stable clean-generated
+udpate_sequence:
+	git subtree pull --prefix sequence sequence stable --squash
+
+.PHONY: examples push_doc tags qtest clean update_sequence push-stable clean-generated
+

README.md

@@ -15,7 +15,9 @@ ocaml-containers
 3. A drop-in replacement to the standard library, `containers.pervasives`,
     that defined a `CCPervasives` module intented to be opened to extend some
     modules of the stdlib.
-4. Random stuff, with *NO* *GUARANTEE* of even being barely usable or tested,
+4. A sub-library with complicated abstractions, `containers.advanced` (with
+   a LINQ-like query module, batch operations using GADTs, and others)
+5. Random stuff, with *NO* *GUARANTEE* of even being barely usable or tested,
     in other dirs (mostly `misc` but also `lwt` and `threads`). It's where I
     tend to write code when I want to test some idea, so half the modules (at
     least) are unfinished or don't really work.
@@ -60,7 +62,6 @@ structures comprise (some modules in `misc/`, some other in `core/`):
 - `CCKList`, a persistent iterator structure (akin to a lazy list)
 - `CCList`, functions on lists, including tail-recursive implementations of `map` and `append` and many other things
 - `CCArray`, utilities on arrays and slices
-- `CCLinq`, high-level query language over collections
 - `CCMultimap` and `CCMultiset`, functors defining persistent structures
 - `CCHashtbl`, an extension of the standard hashtbl module
 - `CCFlatHashtbl`, a flat (open-addressing) hashtable functorial implementation
@@ -80,12 +81,25 @@ structures comprise (some modules in `misc/`, some other in `core/`):
 
 ### String
 
+See [doc](http://cedeela.fr/~simon/software/containers/string).
+
 In the module `Containers_string`:
 - `Levenshtein`: edition distance between two strings
 - `KMP`: Knuth-Morris-Pratt substring algorithm
 
+### Advanced
+
+See [doc](http://cedeela.fr/~simon/software/containers/advanced).
+
+In the module `Containers_advanced`:
+- `CCLinq`, high-level query language over collections
+- `CCCat`, a few categorical structures
+- `CCBatch`, to combine operations on collections into one traversal
+
 ### Misc
 
+See [doc](http://cedeela.fr/~simon/software/containers/misc).
+
 - `PHashtbl`, a polymorphic hashtable (with open addressing)
 - `SplayTree`, a polymorphic splay heap implementation (not quite finished)
 - `SplayMap`, a polymorphic functional map based on splay trees

_oasis

@@ -142,6 +142,14 @@ Document containers_string
   XOCamlbuildPath:      .
   XOCamlbuildLibraries: containers.string
 
+Document containers_advanced
+  Title:                Containers_advanced docs
+  Type:                 ocamlbuild (0.3)
+  BuildTools+:          ocamldoc
+  Install:              true
+  XOCamlbuildPath:      .
+  XOCamlbuildLibraries: containers.advanced
+
 Executable benchs
   Path:             benchs/
   Install:          false

core/CCMultiSet.ml

@@ -51,6 +51,8 @@ module type S = sig
 
   val union : t -> t -> t
 
+  val meet : t -> t -> t
+
   val intersection : t -> t -> t
 
   val diff : t -> t -> t
@@ -117,11 +119,19 @@ module Make(O : Set.OrderedType) = struct
     M.merge
       (fun x n1 n2 -> match n1, n2 with
         | None, None -> assert false
-        | Some n1, None -> Some n1
+        | Some n, None
-        | None, Some n2 -> Some n2
+        | None, Some n -> Some n
         | Some n1, Some n2 -> Some (n1+n2))
       m1 m2
 
+  let meet m1 m2 =
+	M.merge
+	  (fun _ n1 n2 -> match n1, n2 with
+		| None, None -> assert false
+		| Some n, None | None, Some n -> Some n
+		| Some n1, Some n2 -> Some (Pervasives.max n1 n2))
+	  m1 m2
+
   let intersection m1 m2 =
     M.merge
       (fun x n1 n2 -> match n1, n2 with
@@ -138,16 +148,16 @@ module Make(O : Set.OrderedType) = struct
         | Some n1, None -> Some n1
         | None, Some n2 -> None
         | Some n1, Some n2 ->
-          if n1 > n2 
+          if n1 > n2
             then Some (n1 - n2)
             else None)
       m1 m2
 
   let contains m1 m2 =
-    try 
+    try
       M.for_all (fun x c -> M.find x m1 >= c) m2
     with Not_found -> false
-    
+
   let compare m1 m2 =
     M.compare (fun x y -> x - y) m1 m2
 

core/CCMultiSet.mli

@@ -46,23 +46,35 @@ module type S = sig
   val remove : t -> elt -> t
 
   val min : t -> elt
+  (** Minimal element w.r.t the total ordering on elements *)
 
   val max : t -> elt
 
   val union : t -> t -> t
+  (** [union a b] contains as many occurrences of an element [x]
+      as [count a x + count b x]. *)
+
+  val meet : t -> t -> t
+  (** [meet a b] is a multiset such that
+      [count (meet a b) x = max (count a x) (count b x)] *)
 
   val intersection : t -> t -> t
+  (** [intersection a b] is a multiset such that
+      [count (intersection a b) x = min (count a x) (count b x)] *)
 
   val diff : t -> t -> t
+  (** MultiSet difference.
+      [count (diff a b) x = max (count a x - count b x) 0] *)
 
   val contains : t -> t -> bool
+  (** [contains a x = (count m x > 0)] *)
 
   val compare : t -> t -> int
 
   val equal : t -> t -> bool
 
   val cardinal : t -> int
-    (** Number of distinct elements *)
+  (** Number of distinct elements *)
 
   val iter : t -> (int -> elt -> unit) -> unit
 

core/CCOpt.ml

@@ -92,6 +92,10 @@ let fold f acc o = match o with
   | None -> acc
   | Some x -> f acc x
 
+let get default x = match x with
+  | None -> default
+  | Some y -> y
+
 let get_exn = function
   | Some x -> x
   | None -> invalid_arg "CCOpt.get_exn"

core/CCOpt.mli

@@ -60,6 +60,10 @@ val iter : ('a -> unit) -> 'a t -> unit
 val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
 (** Fold on 0 or 1 elements *)
 
+val get : 'a -> 'a t -> 'a
+(** [get default x] unwraps [x], but if [x = None] it returns [default] instead.
+    @since NEXT_RELEASE *)
+
 val get_exn : 'a t -> 'a
 (** Open the option, possibly failing if it is [None]
     @raise Invalid_argument if the option is [None] *)

core/CCSexp.ml

@@ -583,6 +583,8 @@ end
 (** {6 Traversal of S-exp} *)
 
 module Traverse = struct
+  type 'a conv = t -> 'a option
+
   let return x = Some x
 
   let (>|=) e f = match e with
@@ -593,6 +595,15 @@ module Traverse = struct
     | None -> None
     | Some x -> f x
 
+  let map_opt f l =
+    let rec recurse acc l = match l with
+    | [] -> Some (List.rev acc)
+    | x::l' ->
+        match f x with
+        | None -> None
+        | Some y -> recurse (y::acc) l'
+    in recurse [] l
+
   let rec _list_any f l = match l with
     | [] -> None
     | x::tl ->
@@ -628,14 +639,31 @@ module Traverse = struct
     | `List [x;y] -> Some (x,y)
     | _ -> None
 
+  let to_pair_with f1 f2 e =
+    to_pair e >>= fun (x,y) ->
+    f1 x >>= fun x ->
+    f2 y >>= fun y ->
+    return (x,y)
+
   let to_triple e = match e with
     | `List [x;y;z] -> Some (x,y,z)
     | _ -> None
 
+  let to_triple_with f1 f2 f3 e =
+    to_triple e >>= fun (x,y,z) ->
+    f1 x >>= fun x ->
+    f2 y >>= fun y ->
+    f3 z >>= fun z ->
+    return (x,y,z)
+
   let to_list e = match e with
     | `List l -> Some l
     | `Atom _ -> None
 
+  let to_list_with f (e:t) = match e with
+    | `List l -> map_opt f l
+    | `Atom _ -> None
+
   let rec _get_field name l = match l with
     | `List [`Atom n; x] :: _ when name=n -> Some x
     | _ :: tl -> _get_field name tl
@@ -648,6 +676,15 @@ module Traverse = struct
   let field name f e =
     get_field name e >>= f
 
+  let rec _get_field_list name l = match l with
+    | `List (`Atom n :: tl) :: _ when name=n -> Some tl
+    | _ :: tl -> _get_field_list name tl
+    | [] -> None
+
+  let field_list name f e = match e with
+    | `List l -> _get_field_list name l >>= f
+    | `Atom _ -> None
+
   let rec _get_variant s args l = match l with
     | [] -> None
     | (s', f) :: _ when s=s' -> f args

core/CCSexp.mli

@@ -250,40 +250,72 @@ Sexp.Traverse.list_all pt_of_sexp sexp;;
 *)
 
 module Traverse : sig
-  val list_any : (t -> 'a option) -> t -> 'a option
+  type 'a conv = t -> 'a option
+  (** A converter from S-expressions to 'a is a function [sexp -> 'a option].
+      @since NEXT_RELEASE *)
+
+  val map_opt : ('a -> 'b option) -> 'a list -> 'b list option
+  (** Map over a list, failing as soon as the function fails on any element
+      @since NEXT_RELEASE *)
+
+  val list_any : 'a conv -> t -> 'a option
   (** [list_any f (List l)] tries [f x] for every element [x] in [List l],
       and returns the first non-None result (if any). *)
 
-  val list_all : (t -> 'a option) -> t -> 'a list
+  val list_all : 'a conv -> t -> 'a list
   (** [list_all f (List l)] returns the list of all [y] such that [x] in [l]
       and [f x = Some y] *)
 
-  val to_int : t -> int option
+  val to_int : int conv
+  (** Expect an integer *)
 
-  val to_string : t -> string option
+  val to_string : string conv
+  (** Expect a string (an atom) *)
 
-  val to_bool : t -> bool option
+  val to_bool : bool conv
+  (** Expect a boolean *)
 
-  val to_float : t -> float option
+  val to_float : float conv
+  (** Expect a float *)
 
-  val to_list : t -> t list option
+  val to_list : t list conv
+  (** Expect a list *)
 
-  val to_pair : t -> (t * t) option
+  val to_list_with : (t -> 'a option) -> 'a list conv
+  (** Expect a list, applies [f] to all the elements of the list, and succeeds
+      only if [f] succeeded on every element 
+      @since NEXT_RELEASE *)
 
-  val to_triple : t -> (t * t * t) option
+  val to_pair : (t * t) conv
+  (** Expect a list of two elements *)
 
-  val get_field : string -> t -> t option
+  val to_pair_with : 'a conv -> 'b conv -> ('a * 'b) conv
+  (** Same as {!to_pair} but applies conversion functions
+      @since NEXT_RELEASE *)
+
+  val to_triple : (t * t * t) conv
+
+  val to_triple_with : 'a conv -> 'b conv -> 'c conv -> ('a * 'b * 'c) conv
+      (* @since NEXT_RELEASE *)
+
+  val get_field : string -> t conv
   (** [get_field name e], when [e = List [(n1,x1); (n2,x2) ... ]], extracts
       the [xi] such that [name = ni], if it can find it. *)
 
-  val field : string -> (t -> 'a option) -> t -> 'a option
+  val field : string -> 'a conv -> 'a conv
   (** Enriched version of {!get_field}, with a converter as argument *)
 
-  val get_variant : (string * (t list -> 'a option)) list -> t -> 'a option
+  val get_variant : (string * (t list -> 'a option)) list -> 'a conv
   (** [get_variant l e] checks whether [e = List (Atom s :: args)], and
       if some pair of [l] is [s, f]. In this case, it calls [f args]
       and returns its result, otherwise it returns None. *)
 
+  val field_list : string -> (t list -> 'a option) -> 'a conv
+  (** [field_list name f  "(... (name a b c d) ...record)"]
+      will look for a field based on the given [name], and expect it to have a
+      list of arguments dealt with by [f] (here, "a b c d").
+      @since NEXT_RELEASE *)
+
   val (>>=) : 'a option -> ('a -> 'b option) -> 'b option
 
   val (>|=) : 'a option -> ('a -> 'b) -> 'b option

sequence/CHANGELOG.md

@@ -1,5 +1,9 @@
 # Changelog
 
+## 0.5.3
+
+- bugfix: interaction between `take` and `is_empty`
+
 ## 0.5.2
 
 - bugfix in `take`

sequence/META

@@ -1,6 +1,6 @@
 # OASIS_START
-# DO NOT EDIT (digest: f4f3ee8dc8cda763af26a927b88956e6)
+# DO NOT EDIT (digest: 99194977427ba82f5912e81125f6cac0)
-version = "0.5.2"
+version = "0.5.3"
 description = "Simple sequence (iterator) datatype and combinators"
 archive(byte) = "sequence.cma"
 archive(byte, plugin) = "sequence.cma"
@@ -8,7 +8,7 @@ archive(native) = "sequence.cmxa"
 archive(native, plugin) = "sequence.cmxs"
 exists_if = "sequence.cma"
 package "invert" (
- version = "0.5.2"
+ version = "0.5.3"
  description = "Simple sequence (iterator) datatype and combinators"
  requires = "sequence delimcc"
  archive(byte) = "invert.cma"

sequence/_oasis

@@ -1,6 +1,6 @@
 OASISFormat: 0.4
 Name:        sequence
-Version:     0.5.2
+Version:     0.5.3
 Homepage:    https://github.com/c-cube/sequence
 Authors:     Simon Cruanes
 License:     BSD-2-clause
@@ -45,7 +45,7 @@ Document sequence
   XOCamlbuildLibraries: sequence
 
 Test all
-  Type:         custom
+  Type:         custom (0.4)
   Command:      make run-tests
   TestTools:    run_tests
   Run$:         flag(tests)

sequence/sequence.ml

@@ -319,33 +319,37 @@ let min ?(lt=fun x y -> x < y) seq =
     | Some y -> if lt x y then ret := Some x);
   !ret
 
-exception ExitSequence
+exception ExitHead
 
 let head seq =
   let r = ref None in
   try
-    seq (fun x -> r := Some x; raise ExitSequence); None
+    seq (fun x -> r := Some x; raise ExitHead); None
-  with ExitSequence -> !r
+  with ExitHead -> !r
 
 let head_exn seq =
   match head seq with
   | None -> invalid_arg "Sequence.head_exn"
   | Some x -> x
 
+exception ExitTake
+
 let take n seq k =
   let count = ref 0 in
   try
     seq (fun x ->
-      if !count = n then raise ExitSequence;
+      if !count = n then raise ExitTake;
       incr count;
       k x;
     )
-  with ExitSequence -> ()
+  with ExitTake -> ()
+
+exception ExitTakeWhile
 
 let take_while p seq k =
   try
-    seq (fun x -> if p x then k x else raise ExitSequence)
+    seq (fun x -> if p x then k x else raise ExitTakeWhile)
-  with ExitSequence -> ()
+  with ExitTakeWhile -> ()
 
 let drop n seq k =
   let count = ref 0 in
@@ -362,29 +366,35 @@ let rev seq =
   let l = MList.of_seq seq in
   fun k -> MList.iter_rev k l
 
+exception ExitForall
+
 let for_all p seq =
   try
-    seq (fun x -> if not (p x) then raise ExitSequence);
+    seq (fun x -> if not (p x) then raise ExitForall);
     true
-  with ExitSequence -> false
+  with ExitForall -> false
+
+exception ExitExists
 
 (** Exists there some element satisfying the predicate? *)
 let exists p seq =
   try
-    seq (fun x -> if p x then raise ExitSequence);
+    seq (fun x -> if p x then raise ExitExists);
     false
-  with ExitSequence -> true
+  with ExitExists -> true
 
 let mem ?(eq=(=)) x seq = exists (eq x) seq
 
+exception ExitFind
+
 let find f seq =
   let r = ref None in
   begin try
     seq (fun x -> match f x with
       | None -> ()
-      | Some _ as res -> r := res
+      | Some _ as res -> r := res; raise ExitFind
     );
-  with ExitSequence -> ()
+  with ExitFind -> ()
   end;
   !r
 
@@ -393,17 +403,19 @@ let length seq =
   seq (fun _ -> incr r);
   !r
 
+exception ExitIsEmpty
+
 let is_empty seq =
-  try seq (fun _ -> raise ExitSequence); true
+  try seq (fun _ -> raise ExitIsEmpty); true
-  with ExitSequence -> false
+  with ExitIsEmpty -> false
 
 (** {2 Transform a sequence} *)
 
 let empty2 k = ()
 
 let is_empty2 seq2 =
-  try ignore (seq2 (fun _ _ -> raise ExitSequence)); true
+  try ignore (seq2 (fun _ _ -> raise ExitIsEmpty)); true
-  with ExitSequence -> false
+  with ExitIsEmpty -> false
 
 let length2 seq2 =
   let r = ref 0 in

sequence/setup.ml

@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.4.4 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 3e1599f233d66e02cd17bbb3a1c71d9e) *)
+(* DO NOT EDIT (digest: 1c260750474eb19b8e9212954217b6fd) *)
 (*
    Regenerated by OASIS v0.4.4
    Visit http://oasis.forge.ocamlcore.org for more information and
@@ -6826,7 +6826,7 @@ let setup_t =
           alpha_features = [];
           beta_features = [];
           name = "sequence";
-          version = "0.5.2";
+          version = "0.5.3";
           license =
             OASISLicense.DEP5License
               (OASISLicense.DEP5Unit
@@ -7044,7 +7044,7 @@ let setup_t =
                      cs_plugin_data = []
                   },
                    {
-                      test_type = (`Test, "custom", None);
+                      test_type = (`Test, "custom", Some "0.4");
                       test_command =
                         [(OASISExpr.EBool true, ("make", ["run-tests"]))];
                       test_custom =
@@ -7192,8 +7192,7 @@ let setup_t =
        };
      oasis_fn = Some "_oasis";
      oasis_version = "0.4.4";
-     oasis_digest =
+     oasis_digest = Some "\214\tqh\b\169>\243\237\213\012\180\162\155`L";
-       Some "\142\243\242-\024\139\245\030\1867\186\147D\175\251\192";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false
@@ -7201,6 +7200,6 @@ let setup_t =
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 7205 "setup.ml"
+# 7204 "setup.ml"
 (* OASIS_STOP *)
 let () = setup ();;

sequence/tests/test_sequence.ml

@@ -6,7 +6,8 @@ open Sequence.Infix
 
 let pp_ilist l =
   let b = Buffer.create 15 in
-  Format.bprintf b "@[<h>%a@]" (S.pp_seq Format.pp_print_int) (S.of_list l);
+  let fmt = Format.formatter_of_buffer b in
+  Format.fprintf fmt "@[<h>%a@]" (S.pp_seq Format.pp_print_int) (S.of_list l);
   Buffer.contents b
 
 let test_empty () =
@@ -197,6 +198,11 @@ let test_take () =
   OUnit.assert_equal ~printer:pp_ilist [1;2;3;4;5] l;
   ()
 
+let test_regression1 () =
+  let s = S.(take 10 (repeat 1)) in
+  OUnit.assert_bool "not empty" (not (S.is_empty s));
+  ()
+
 let suite =
   "test_sequence" >:::
     [ "test_empty" >:: test_empty;
@@ -225,4 +231,5 @@ let suite =
       "test_hashtbl" >:: test_hashtbl;
       "test_int_range" >:: test_int_range;
       "test_take" >:: test_take;
+      "test_regression1" >:: test_regression1
     ]