diff --git a/Makefile b/Makefile index 2efb352f..aa13af6c 100644 --- a/Makefile +++ b/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 + diff --git a/README.md b/README.md index 6ea9202d..075edce4 100644 --- a/README.md +++ b/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 diff --git a/_oasis b/_oasis index fb490cbd..03044811 100644 --- a/_oasis +++ b/_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 diff --git a/core/CCMultiSet.ml b/core/CCMultiSet.ml index 60640411..2a0b2747 100644 --- a/core/CCMultiSet.ml +++ b/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 - | None, Some n2 -> Some n2 + | Some n, None + | 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 diff --git a/core/CCMultiSet.mli b/core/CCMultiSet.mli index 4c994901..89d32f83 100644 --- a/core/CCMultiSet.mli +++ b/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 diff --git a/core/CCOpt.ml b/core/CCOpt.ml index cc087ca2..40bd8e58 100644 --- a/core/CCOpt.ml +++ b/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" diff --git a/core/CCOpt.mli b/core/CCOpt.mli index cd783f77..48b7ec4a 100644 --- a/core/CCOpt.mli +++ b/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] *) diff --git a/core/CCSexp.ml b/core/CCSexp.ml index 4ef41483..c446b374 100644 --- a/core/CCSexp.ml +++ b/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 diff --git a/core/CCSexp.mli b/core/CCSexp.mli index 7ed78c57..152b4b8e 100644 --- a/core/CCSexp.mli +++ b/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 diff --git a/sequence/CHANGELOG.md b/sequence/CHANGELOG.md index 09b514c1..c21ef641 100644 --- a/sequence/CHANGELOG.md +++ b/sequence/CHANGELOG.md @@ -1,5 +1,9 @@ # Changelog +## 0.5.3 + +- bugfix: interaction between `take` and `is_empty` + ## 0.5.2 - bugfix in `take` diff --git a/sequence/META b/sequence/META index ffd12c91..246e94fa 100644 --- a/sequence/META +++ b/sequence/META @@ -1,6 +1,6 @@ # OASIS_START -# DO NOT EDIT (digest: f4f3ee8dc8cda763af26a927b88956e6) -version = "0.5.2" +# DO NOT EDIT (digest: 99194977427ba82f5912e81125f6cac0) +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" diff --git a/sequence/_oasis b/sequence/_oasis index 7c5a8e43..39a59224 100644 --- a/sequence/_oasis +++ b/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) diff --git a/sequence/sequence.ml b/sequence/sequence.ml index 54ed7e85..00dd7cd0 100644 --- a/sequence/sequence.ml +++ b/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 - with ExitSequence -> !r + seq (fun x -> r := Some x; raise ExitHead); None + 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) - with ExitSequence -> () + seq (fun x -> if p x then k x else raise ExitTakeWhile) + 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 - with ExitSequence -> false + try seq (fun _ -> raise ExitIsEmpty); true + with ExitIsEmpty -> false (** {2 Transform a sequence} *) let empty2 k = () let is_empty2 seq2 = - try ignore (seq2 (fun _ _ -> raise ExitSequence)); true - with ExitSequence -> false + try ignore (seq2 (fun _ _ -> raise ExitIsEmpty)); true + with ExitIsEmpty -> false let length2 seq2 = let r = ref 0 in diff --git a/sequence/setup.ml b/sequence/setup.ml index 72507e21..51aae2fc 100644 --- a/sequence/setup.ml +++ b/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 = - Some "\142\243\242-\024\139\245\030\1867\186\147D\175\251\192"; + oasis_digest = Some "\214\tqh\b\169>\243\237\213\012\180\162\155`L"; 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 ();; diff --git a/sequence/tests/test_sequence.ml b/sequence/tests/test_sequence.ml index 1b6c8623..549fc859 100644 --- a/sequence/tests/test_sequence.ml +++ b/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 "@[%a@]" (S.pp_seq Format.pp_print_int) (S.of_list l); + let fmt = Format.formatter_of_buffer b in + Format.fprintf fmt "@[%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 ]