simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2025-12-08 12:15:32 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions 2

merge from master

Browse source
This commit is contained in:
Simon Cruanes 2014-10-19 21:14:17 +02:00
commit 0e555bed6c
15 changed files with 198 additions and 50 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
Makefile
View file

@ -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

18
README.md
View file

@ -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

8
_oasis
View file

@ -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

20
core/CCMultiSet.ml
View file

@ -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

14
core/CCMultiSet.mli
View file

@ -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

4
core/CCOpt.ml
View file

@ -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"

4
core/CCOpt.mli
View file

@ -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] *)

37
core/CCSexp.ml
View file

@ -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

56
core/CCSexp.mli
View file

@ -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

4
sequence/CHANGELOG.md
View file

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

6
sequence/META
View file

@ -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"

4
sequence/_oasis
View file

@ -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)

46
sequence/sequence.ml
View file

@ -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

11
sequence/setup.ml
View file

@ -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 ();;

9
sequence/tests/test_sequence.ml
View file

@ -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
]