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

continue removal of CCGen/CCsequence

Browse source
This commit is contained in:
Simon Cruanes 2014-12-13 03:11:16 +01:00
parent d1c00657b2
commit d0c3af5492
48 changed files with 415 additions and 417 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
_oasis
View file

@ -86,12 +86,12 @@ Library "containers_advanced"
Modules: CCLinq, CCBatch, CCCat, CCMonadIO
FindlibName: advanced
FindlibParent: containers
BuildDepends: containers
BuildDepends: containers, sequence
Library "containers_pervasives"
Path: pervasives
Modules: CCPervasives
BuildDepends: containers,
BuildDepends: containers
FindlibName: pervasives
FindlibParent: containers
@ -185,7 +185,7 @@ Executable run_benchs
Build$: flag(bench) && flag(misc)
MainIs: run_benchs.ml
BuildDepends: containers, containers.misc, containers.advanced,
containers.string, benchmark
containers.string, sequence, gen, benchmark
Executable bench_hash
Path: benchs/
@ -201,7 +201,7 @@ Executable bench_conv
CompiledObject: native
Build$: flag(bench)
MainIs: bench_conv.ml
BuildDepends: containers,benchmark
BuildDepends: containers,benchmark,gen
Executable test_levenshtein
Path: tests/
@ -236,7 +236,7 @@ Executable run_qtest
MainIs: run_qtest.ml
Build$: flag(tests)
BuildDepends: containers, containers.misc, containers.string,
oUnit, QTest2Lib
sequence, gen, oUnit, QTest2Lib
Executable run_tests
Path: tests/
@ -244,7 +244,7 @@ Executable run_tests
CompiledObject: native
MainIs: run_tests.ml
Build$: flag(tests) && flag(misc)
BuildDepends: containers, oUnit, qcheck, containers.misc
BuildDepends: containers, oUnit, sequence, gen, qcheck, containers.misc
Test all
Command: make test-all

104
advanced/CCLinq.ml
View file

@ -43,7 +43,7 @@ let _error_of_exn f = try `Ok (f ()) with ExitWithError s -> `Error
type 'a collection =
| Seq : 'a sequence -> 'a collection
| List : 'a list -> 'a collection
| Set : (module CCSequence.Set.S
| Set : (module Sequence.Set.S
with type elt = 'a and type t = 'b) * 'b -> 'a collection
module PMap = struct
@ -103,7 +103,7 @@ module PMap = struct
}
let make_cmp (type key) ?(cmp=Pervasives.compare) () =
let module M = CCSequence.Map.Make(struct
let module M = Sequence.Map.Make(struct
type t = key
let compare = cmp
end) in
@ -167,26 +167,26 @@ module PMap = struct
| None -> None
| Some v -> Some (f v)
);
to_seq = CCSequence.map (fun (x,y) -> x, f y) m.to_seq;
to_seq = Sequence.map (fun (x,y) -> x, f y) m.to_seq;
fold = (fun f' acc ->
m.fold (fun acc x y -> f' acc x (f y)) acc
);
}
let to_list m = CCSequence.to_rev_list m.to_seq
let to_list m = Sequence.to_rev_list m.to_seq
let to_coll m = Seq m.to_seq
let reverse ~build m =
let build = make ~build () in
let seq = CCSequence.map (fun (x,y) -> y,x) (to_seq m) in
let seq = Sequence.map (fun (x,y) -> y,x) (to_seq m) in
multimap_of_seq ~build seq
let reverse_multimap ~build m =
let build = make ~build () in
let seq = to_seq m in
let seq = CCSequence.flat_map
(fun (x,l) -> CCSequence.map (fun y -> y,x) (CCSequence.of_list l)
let seq = Sequence.flat_map
(fun (x,l) -> Sequence.map (fun y -> y,x) (Sequence.of_list l)
) seq
in
multimap_of_seq ~build seq
@ -211,10 +211,10 @@ type ('a,'b) group_join_descr = {
module Coll = struct
let of_seq s = Seq s
let of_list l = List l
let of_array a = Seq (CCSequence.of_array a)
let of_array a = Seq (Sequence.of_array a)
let set_of_seq (type elt) ?(cmp=Pervasives.compare) seq =
let module S = CCSequence.Set.Make(struct
let module S = Sequence.Set.Make(struct
type t = elt
let compare = cmp
end) in
@ -225,15 +225,15 @@ module Coll = struct
| Seq s -> s
| List l -> (fun k -> List.iter k l)
| Set (m, set) ->
let module S = (val m : CCSequence.Set.S
let module S = (val m : Sequence.Set.S
with type elt = elt and type t = 'b) in
S.to_seq set
let to_list (type elt) = function
| Seq s -> CCSequence.to_list s
| Seq s -> Sequence.to_list s
| List l -> l
| Set (m, set) ->
let module S = (val m : CCSequence.Set.S
let module S = (val m : Sequence.Set.S
with type elt = elt and type t = 'b) in
S.elements set
@ -245,30 +245,30 @@ module Coll = struct
let fold (type elt) f acc c = match c with
| List l -> List.fold_left f acc l
| Seq s -> CCSequence.fold f acc s
| Seq s -> Sequence.fold f acc s
| Set (m, set) ->
let module S = (val m : CCSequence.Set.S
let module S = (val m : Sequence.Set.S
with type elt = elt and type t = 'b) in
S.fold (fun x acc -> f acc x) set acc
let map f c =
_fmap ~lst:(List.map f) ~seq:(CCSequence.map f) c
_fmap ~lst:(List.map f) ~seq:(Sequence.map f) c
let filter p c =
_fmap ~lst:(List.filter p) ~seq:(CCSequence.filter p) c
_fmap ~lst:(List.filter p) ~seq:(Sequence.filter p) c
let flat_map f c =
let c' = to_seq c in
Seq (CCSequence.flatMap (fun x -> to_seq (f x)) c')
Seq (Sequence.flatMap (fun x -> to_seq (f x)) c')
let filter_map f c =
_fmap ~lst:(CCList.filter_map f) ~seq:(CCSequence.fmap f) c
_fmap ~lst:(CCList.filter_map f) ~seq:(Sequence.fmap f) c
let size (type elt) = function
| List l -> List.length l
| Seq s -> CCSequence.length s
| Seq s -> Sequence.length s
| Set (m, set) ->
let module S = (val m : CCSequence.Set.S
let module S = (val m : Sequence.Set.S
with type elt = elt and type t = 'b) in
S.cardinal set
@ -278,12 +278,12 @@ module Coll = struct
| List [] -> fail ()
| List (x::_) -> x
| Seq s ->
begin match CCSequence.to_list (CCSequence.take 1 s) with
begin match Sequence.to_list (Sequence.take 1 s) with
| [x] -> x
| _ -> fail ()
end
| Set (m, set) ->
let module S = (val m : CCSequence.Set.S
let module S = (val m : Sequence.Set.S
with type elt = elt and type t = 'b) in
try S.choose set with Not_found -> fail ()
@ -292,7 +292,7 @@ module Coll = struct
with ExitWithError s -> `Error s
let take n c =
_fmap ~lst:(CCList.take n) ~seq:(CCSequence.take n) c
_fmap ~lst:(CCList.take n) ~seq:(Sequence.take n) c
exception MySurpriseExit
@ -308,7 +308,7 @@ module Coll = struct
let sort cmp c = match c with
| List l -> List (List.sort cmp l)
| Seq s -> List (List.sort cmp (CCSequence.to_rev_list s))
| Seq s -> List (List.sort cmp (Sequence.to_rev_list s))
| _ -> set_of_seq ~cmp (to_seq c)
let search obj c =
@ -328,9 +328,9 @@ module Coll = struct
let contains (type elt) ~eq x c = match c with
| List l -> List.exists (eq x) l
| Seq s -> CCSequence.exists (eq x) s
| Seq s -> Sequence.exists (eq x) s
| Set (m, set) ->
let module S = (val m : CCSequence.Set.S
let module S = (val m : Sequence.Set.S
with type elt = elt and type t = 'b) in
(* XXX: here we don't use the equality relation *)
S.mem x set
@ -338,10 +338,10 @@ module Coll = struct
let do_join ~join c1 c2 =
let build1 =
let seq = to_seq c1 in
let seq = CCSequence.map (fun x -> join.join_key1 x, x) seq in
let seq = Sequence.map (fun x -> join.join_key1 x, x) seq in
PMap.multimap_of_seq ~build:(PMap.make ~build:join.join_build ()) seq
in
let l = CCSequence.fold
let l = Sequence.fold
(fun acc y ->
let key = join.join_key2 y in
match PMap.get build1 key with
@ -373,14 +373,14 @@ module Coll = struct
let do_product c1 c2 =
let s1 = to_seq c1 and s2 = to_seq c2 in
of_seq (CCSequence.product s1 s2)
of_seq (Sequence.product s1 s2)
let do_union ~build c1 c2 =
let build = PMap.make ~build () in
to_seq c1 (fun x -> PMap.add build x ());
to_seq c2 (fun x -> PMap.add build x ());
let seq = PMap.to_seq (PMap.build_get build) in
of_seq (CCSequence.map fst seq)
of_seq (Sequence.map fst seq)
type inter_status =
| InterLeft
@ -408,7 +408,7 @@ module Coll = struct
let map = PMap.build_get build in
(* output elements of [c1] not in [map] *)
let seq = to_seq c1 in
of_seq (CCSequence.filter (fun x -> not (PMap.mem map x)) seq)
of_seq (Sequence.filter (fun x -> not (PMap.mem map x)) seq)
end
(** {2 Query operators} *)
@ -478,22 +478,22 @@ let of_array a =
Start (Coll.of_array a)
let of_array_i a =
Start (Coll.of_seq (CCSequence.of_array_i a))
Start (Coll.of_seq (Sequence.of_array_i a))
let of_hashtbl h =
Start (Coll.of_seq (CCSequence.of_hashtbl h))
Start (Coll.of_seq (Sequence.of_hashtbl h))
let of_seq seq =
Start (Coll.of_seq seq)
let of_queue q =
Start (Coll.of_seq (CCSequence.of_queue q))
Start (Coll.of_seq (Sequence.of_queue q))
let of_stack s =
Start (Coll.of_seq (CCSequence.of_stack s))
Start (Coll.of_seq (Sequence.of_stack s))
let of_string s =
Start (Coll.of_seq (CCSequence.of_str s))
Start (Coll.of_seq (Sequence.of_str s))
(** {6 Execution} *)
@ -553,7 +553,7 @@ let _do_unary : type a b. (a,b) unary -> a -> b
| Fold (f, acc) -> Coll.fold f acc c
| FoldMap (f, acc) -> PMap.fold f acc c
| Reduce (safety, start, mix, stop) ->
let acc = CCSequence.fold
let acc = Sequence.fold
(fun acc x -> match acc with
| None -> Some (start x)
| Some acc -> Some (mix x acc)
@ -578,7 +578,7 @@ let _do_unary : type a b. (a,b) unary -> a -> b
| Get (Implicit, k) -> PMap.get_exn c k
| Get (Explicit, k) -> PMap.get_err c k
| GroupBy (build,f) ->
let seq = CCSequence.map (fun x -> f x, x) (Coll.to_seq c) in
let seq = Sequence.map (fun x -> f x, x) (Coll.to_seq c) in
PMap.multimap_of_seq ~build:(PMap.make ~build ()) seq
| Contains (eq, x) -> Coll.contains ~eq x c
| Count build ->
@ -591,7 +591,7 @@ let _do_binary : type a b c. (a, b, c) binary -> a -> b -> c
| GroupJoin gjoin -> Coll.do_group_join ~gjoin c1 c2
| Product -> Coll.do_product c1 c2
| Append ->
Coll.of_seq (CCSequence.append (Coll.to_seq c1) (Coll.to_seq c2))
Coll.of_seq (Sequence.append (Coll.to_seq c1) (Coll.to_seq c2))
| SetOp (Inter,build) -> Coll.do_inter ~build c1 c2
| SetOp (Union,build) -> Coll.do_union ~build c1 c2
| SetOp (Diff,build) -> Coll.do_diff ~build c1 c2
@ -695,8 +695,8 @@ module M = struct
let flatten q =
let f m =
let seq = CCSequence.flat_map
(fun (k,v) -> CCSequence.map (fun v' -> k,v') (Coll.to_seq v))
let seq = Sequence.flat_map
(fun (k,v) -> Sequence.map (fun v' -> k,v') (Coll.to_seq v))
m.PMap.to_seq
in Coll.of_seq seq
in
@ -704,8 +704,8 @@ module M = struct
let flatten' q =
let f m =
let seq = CCSequence.flatMap
(fun (k,v) -> CCSequence.map (fun v' -> k,v') (CCSequence.of_list v))
let seq = Sequence.flatMap
(fun (k,v) -> Sequence.map (fun v' -> k,v') (Sequence.of_list v))
m.PMap.to_seq
in Coll.of_seq seq
in
@ -885,16 +885,16 @@ let to_array q =
QueryMap ((fun c -> Array.of_list (Coll.to_list c)), q)
let to_seq q =
QueryMap ((fun c -> CCSequence.persistent (Coll.to_seq c)), q)
QueryMap ((fun c -> Sequence.persistent (Coll.to_seq c)), q)
let to_hashtbl q =
QueryMap ((fun c -> CCSequence.to_hashtbl (Coll.to_seq c)), q)
QueryMap ((fun c -> Sequence.to_hashtbl (Coll.to_seq c)), q)
let to_queue q =
QueryMap ((fun c q -> CCSequence.to_queue q (Coll.to_seq c)), q)
QueryMap ((fun c q -> Sequence.to_queue q (Coll.to_seq c)), q)
let to_stack q =
QueryMap ((fun c s -> CCSequence.to_stack s (Coll.to_seq c)), q)
QueryMap ((fun c s -> Sequence.to_stack s (Coll.to_seq c)), q)
module L = struct
let of_list l = Start (Coll.of_list l)
@ -909,7 +909,7 @@ module AdaptSet(S : Set.S) = struct
return (Coll.of_seq (fun k -> S.iter k set))
let to_set q =
let f c = CCSequence.fold (fun set x -> S.add x set) S.empty (Coll.to_seq c) in
let f c = Sequence.fold (fun set x -> S.add x set) S.empty (Coll.to_seq c) in
query_map f q
let run q = run (to_set q)
@ -932,7 +932,7 @@ module AdaptMap(M : Map.S) = struct
let to_map q =
let f c =
CCSequence.fold (fun m (x,y) -> M.add x y m) M.empty (Coll.to_seq c)
Sequence.fold (fun m (x,y) -> M.add x y m) M.empty (Coll.to_seq c)
in
query_map f q
@ -1008,13 +1008,13 @@ module IO = struct
query_map f q
let lines' q =
let f s = lazy (CCSequence.to_list (_lines s 0)) in
let f s = lazy (Sequence.to_list (_lines s 0)) in
lazy_ (query_map f q)
let _join ~sep ?(stop="") l =
let buf = Buffer.create 128 in
let seq = Coll.to_seq l in
CCSequence.iteri
Sequence.iteri
(fun i x ->
if i>0 then Buffer.add_string buf sep;
Buffer.add_string buf x)
@ -1035,7 +1035,7 @@ module IO = struct
let out_lines oc q =
let x = run_exn q in
CCSequence.iter (fun l -> output_string oc l; output_char oc '\n') (Coll.to_seq x)
Sequence.iter (fun l -> output_string oc l; output_char oc '\n') (Coll.to_seq x)
let to_file_exn filename q =
_with_file_out filename (fun oc -> out oc q)

4
benchs/bench_conv.ml
View file

@ -79,11 +79,11 @@ let () =
bench_list [1,2; 3,4; 5,6; 7,8; 9,10];
let open CCFun in
let l = CCGen.(1 -- 100 |> map (fun x->x,x) |> to_rev_list) in
let l = Gen.(1 -- 100 |> map (fun x->x,x) |> to_rev_list) in
Printf.printf "list of %d elements...\n" (List.length l);
bench_list l;
let l = CCGen.(repeat Point.p |> take 10 |> to_rev_list) in
let l = Gen.(repeat Point.p |> take 10 |> to_rev_list) in
Printf.printf "list of %d points...\n" (List.length l);
bench_point_list l;

12
benchs/run_benchs.ml
View file

@ -480,8 +480,8 @@ module Iter = struct
(** {2 Sequence/Gen} *)
let bench_fold n =
let seq () = CCSequence.fold (+) 0 CCSequence.(0 --n) in
let gen () = CCGen.fold (+) 0 CCGen.(0 -- n) in
let seq () = Sequence.fold (+) 0 Sequence.(0 --n) in
let gen () = Gen.fold (+) 0 Gen.(0 -- n) in
let klist () = CCKList.fold (+) 0 CCKList.(0 -- n) in
CCBench.throughputN 3
[ "sequence.fold", seq, ();
@ -490,10 +490,10 @@ module Iter = struct
]
let bench_flat_map n =
let seq () = CCSequence.(
let seq () = Sequence.(
0 -- n |> flat_map (fun x -> x-- (x+10)) |> fold (+) 0
)
and gen () = CCGen.(
and gen () = Gen.(
0 -- n |> flat_map (fun x -> x-- (x+10)) |> fold (+) 0
)
and klist () = CCKList.(
@ -509,12 +509,12 @@ module Iter = struct
let bench_iter n =
let seq () =
let i = ref 2 in
CCSequence.(
Sequence.(
1 -- n |> iter (fun x -> i := !i * x)
)
and gen () =
let i = ref 2 in
CCGen.(
Gen.(
1 -- n |> iter (fun x -> i := !i * x)
)
and klist () =

2
core/CCBV.ml
View file

@ -172,7 +172,7 @@ let iter_true bv f =
done
(*$T
of_list [1;5;7] |> iter_true |> CCSequence.to_list |> List.sort CCOrd.compare = [1;5;7]
of_list [1;5;7] |> iter_true |> Sequence.to_list |> List.sort CCOrd.compare = [1;5;7]
*)
let to_list bv =

56
core/CCIO.ml
View file

@ -28,6 +28,50 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
type 'a gen = unit -> 'a option (** See {!CCGen} *)
let gen_singleton x =
let done_ = ref false in
fun () -> if !done_ then None else (done_ := true; Some x)
let gen_filter_map f gen =
(* tailrec *)
let rec next () =
match gen() with
| None -> None
| Some x ->
match f x with
| None -> next()
| (Some _) as res -> res
in next
let gen_of_array arr =
let r = ref 0 in
fun () ->
if !r = Array.length arr then None
else (
let x = arr.(!r) in
incr r;
Some x
)
let gen_flat_map f next_elem =
let state = ref `Init in
let rec next() =
match !state with
| `Init -> get_next_gen()
| `Run gen ->
begin match gen () with
| None -> get_next_gen ()
| (Some _) as x -> x
end
| `Stop -> None
and get_next_gen() = match next_elem() with
| None -> state:=`Stop; None
| Some x ->
try state := `Run (f x); next()
with e -> state := `Stop; raise e
in
next
let with_in ?(mode=0o644) ?(flags=[]) filename f =
let ic = open_in_gen flags mode filename in
try
@ -165,8 +209,8 @@ module File = struct
if Sys.is_directory d
then
let arr = Sys.readdir d in
CCGen.of_array arr
else CCGen.empty
gen_of_array arr
else fun () -> None
let cons_ x tl =
let first=ref true in
@ -180,19 +224,19 @@ module File = struct
if Sys.is_directory d
then
let arr = Sys.readdir d in
let tail = CCGen.of_array arr in
let tail = CCGen.flat_map
let tail = gen_of_array arr in
let tail = gen_flat_map
(fun s -> walk (Filename.concat d s))
tail
in cons_ (`Dir,d) tail
else CCGen.singleton (`File, d)
else gen_singleton (`File, d)
type walk_item = [`File | `Dir] * t
let read_dir ?(recurse=false) d =
if recurse
then
CCGen.filter_map
gen_filter_map
(function
| `File, f -> Some f
| `Dir, _ -> None

4
core/CCVector.ml
View file

@ -451,7 +451,7 @@ let of_seq ?(init=create ()) seq =
init
(*$T
of_seq CCSequence.(1 -- 10) |> to_list = CCList.(1 -- 10)
of_seq Sequence.(1 -- 10) |> to_list = CCList.(1 -- 10)
*)
let to_seq v k = iter k v
@ -524,7 +524,7 @@ let to_gen v =
) else None
(*$T
let v = (1--10) in to_list v = CCGen.to_list (to_gen v)
let v = (1--10) in to_list v = Gen.to_list (to_gen v)
*)
let of_klist ?(init=create ()) l =

2
examples/mem_size.ml
View file

@ -1,7 +1,7 @@
(** Compute the memory footprint of a value (and its subvalues). Reference is
http://rwmj.wordpress.com/2009/08/05/ocaml-internals-part-2-strings-and-other-types/ *)
module Sequence = CCSequence
(** A graph vertex is an Obj.t value *)
let graph =

16
misc/absSet.ml
View file

@ -25,6 +25,8 @@ for any direct, indirect, incidental, special, exemplary, or consequential
(** {1 Abstract set/relation} *)
type 'a sequence = ('a -> unit) -> unit
type 'a t = {
mem : 'a -> bool;
iter : ('a -> unit) -> unit;
@ -102,8 +104,7 @@ let product s1 s2 =
let cardinal () = s1.cardinal () * s2.cardinal () in
{ mem; iter; cardinal; }
let to_seq set =
CCSequence.from_iter (fun k -> set.iter k)
let to_seq set k = set.iter k
let to_list set =
let l = ref [] in
@ -154,7 +155,7 @@ let builder_cmp (type k) ?(cmp=Pervasives.compare) () =
mk_builder ~add ~get
let of_seq_builder ~builder seq =
CCSequence.iter builder.add seq;
seq builder.add;
builder.get ()
let of_seq_hash ?eq ?hash seq =
@ -165,7 +166,7 @@ let of_seq_cmp ?cmp seq =
let b = builder_cmp ?cmp () in
of_seq_builder b seq
let of_list l = of_seq_hash (CCSequence.of_list l)
let of_list l = of_seq_hash (fun k -> List.iter k l)
let map ?(builder=builder_hash ()) set ~f =
set.iter
@ -202,7 +203,7 @@ module MakeHash(X : Hashtbl.HashedType) = struct
let of_seq ?(size=5) seq =
let h = Hashtbl.create size in
CCSequence.iter (fun x -> Hashtbl.add h x ()) seq;
seq (fun x -> Hashtbl.add h x ());
let mem x = Hashtbl.mem h x in
let iter k = Hashtbl.iter (fun x () -> k x) h in
let cardinal () = Hashtbl.length h in
@ -220,8 +221,9 @@ module MakeSet(S : Set.S) = struct
mk_generic ~cardinal ~mem ~iter
let of_seq ?(init=S.empty) seq =
let set = CCSequence.fold (fun s x -> S.add x s) init seq in
of_set set
let set = ref init in
seq (fun x -> set := S.add x !set);
of_set !set
let to_set set =
fold set S.empty (fun set x -> S.add x set)

14
misc/absSet.mli
View file

@ -25,6 +25,8 @@ for any direct, indirect, incidental, special, exemplary, or consequential
(** {1 Abstract set/relation} *)
type 'a sequence = ('a -> unit) -> unit
type 'a t
val empty : 'a t
@ -67,7 +69,7 @@ val intersection : 'a t -> 'a t -> 'a t
val product : 'a t -> 'b t -> ('a * 'b) t
(** Cartesian product *)
val to_seq : 'a t -> 'a CCSequence.t
val to_seq : 'a t -> 'a sequence
val to_list : 'a t -> 'a list
@ -93,13 +95,13 @@ val builder_hash : ?size:int ->
val builder_cmp : ?cmp:('a -> 'a -> int) -> unit -> 'a builder
val of_seq_builder : builder:'a builder -> 'a CCSequence.t -> 'a t
val of_seq_builder : builder:'a builder -> 'a sequence -> 'a t
(** Uses the given builder to construct a set from a sequence of elements *)
val of_seq_hash : ?eq:('a -> 'a -> bool) -> ?hash:('a -> int) -> 'a CCSequence.t -> 'a t
val of_seq_hash : ?eq:('a -> 'a -> bool) -> ?hash:('a -> int) -> 'a sequence -> 'a t
(** Construction of a set from a sequence of hashable elements *)
val of_seq_cmp : ?cmp:('a -> 'a -> int) -> 'a CCSequence.t -> 'a t
val of_seq_cmp : ?cmp:('a -> 'a -> int) -> 'a sequence -> 'a t
(** Construction of a set from a sequence of comparable elements *)
val of_list : 'a list -> 'a t
@ -133,7 +135,7 @@ module MakeHash(X : Hashtbl.HashedType) : sig
type elt = X.t
(** Elements of the set are hashable *)
val of_seq : ?size:int -> elt CCSequence.t -> elt t
val of_seq : ?size:int -> elt sequence -> elt t
(** Build a set from a sequence *)
end
@ -141,7 +143,7 @@ end
module MakeSet(S : Set.S) : sig
type elt = S.elt
val of_seq : ?init:S.t -> elt CCSequence.t -> elt t
val of_seq : ?init:S.t -> elt sequence -> elt t
(** Build a set from a sequence *)
val of_set : S.t -> elt t

2
misc/circList.ml
View file

@ -124,7 +124,7 @@ let gen l =
(*$Q
(Q.list Q.small_int) (fun l -> \
l = [] || let q = of_list l in \
gen q |> CCGen.take (List.length l) |> CCGen.to_list = l)
gen q |> Gen.take (List.length l) |> Gen.to_list = l)
*)
let seq l k =

24
misc/fHashtbl.ml
View file

@ -25,6 +25,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(** {1 Functional (persistent) hashtable} *)
type 'a sequence = ('a -> unit) -> unit
(** {2 Signatures} *)
module type HASH = sig
@ -64,9 +66,9 @@ module type S = sig
val size : 'a t -> int
(** Number of bindings *)
val to_seq : 'a t -> (key * 'a) CCSequence.t
val to_seq : 'a t -> (key * 'a) sequence
val of_seq : ?size:int -> (key * 'a) CCSequence.t -> 'a t
val of_seq : ?size:int -> (key * 'a) sequence -> 'a t
end
(** {2 Persistent array} *)
@ -336,13 +338,13 @@ module Tree(X : HASH) = struct
let size t =
fold (fun n _ _ -> n + 1) 0 t
let to_seq t =
CCSequence.from_iter (fun k -> iter (fun key value -> k (key, value)) t)
let to_seq t k =
iter (fun key value -> k (key, value)) t
let of_seq ?(size=32) seq =
CCSequence.fold
(fun t (k,v) -> replace t k v)
(empty size) seq
let cur = ref (empty size) in
seq (fun (k,v) -> cur := replace !cur k v);
!cur
end
(** {2 Flat hashtable} *)
@ -492,10 +494,10 @@ module Flat(X : HASH) = struct
| _ -> acc)
acc t.buckets
let to_seq t =
CCSequence.from_iter
(fun k -> iter (fun key value -> k (key, value)) t)
let to_seq t k = iter (fun key value -> k (key, value)) t
let of_seq ?(size=32) seq =
CCSequence.fold (fun t (k,v) -> replace t k v) (empty size) seq
let t = ref (empty size) in
seq (fun (k,v) -> t := replace !t k v);
!t
end

6
misc/fHashtbl.mli
View file

@ -25,6 +25,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(** {1 Functional (persistent) hashtable} *)
type 'a sequence = ('a -> unit) -> unit
(** {2 Signatures} *)
module type HASH = sig
@ -64,9 +66,9 @@ module type S = sig
val size : 'a t -> int
(** Number of bindings *)
val to_seq : 'a t -> (key * 'a) CCSequence.t
val to_seq : 'a t -> (key * 'a) sequence
val of_seq : ?size:int -> (key * 'a) CCSequence.t -> 'a t
val of_seq : ?size:int -> (key * 'a) sequence -> 'a t
end
(** {2 Persistent array} *)

13
misc/flatHashtbl.ml
View file

@ -25,6 +25,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(** Open addressing hashtable, with linear probing. *)
type 'a sequence = ('a -> unit) -> unit
module type S =
sig
type key
@ -61,9 +63,9 @@ module type S =
val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
(** Fold on bindings *)
val to_seq : 'a t -> (key * 'a) CCSequence.t
val to_seq : 'a t -> (key * 'a) sequence
val of_seq : 'a t -> (key * 'a) CCSequence.t -> unit
val of_seq : 'a t -> (key * 'a) sequence -> unit
val stats : 'a t -> int * int * int * int * int * int
(** Cf Weak.S *)
@ -218,12 +220,11 @@ module Make(H : Hashtbl.HashedType) =
| _ -> fold acc (i+1)
in fold acc 0
let to_seq t =
CCSequence.from_iter
(fun k -> iter (fun key value -> k (key, value)) t)
let to_seq t k =
iter (fun key value -> k (key, value)) t
let of_seq t seq =
CCSequence.iter (fun (k,v) -> replace t k v) seq
seq (fun (k,v) -> replace t k v)
(** Statistics on the table *)
let stats t = (Array.length t.buckets, t.size, t.size, 0, 0, 1)

6
misc/flatHashtbl.mli
View file

@ -25,6 +25,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(** Open addressing hashtable, with linear probing. *)
type 'a sequence = ('a -> unit) -> unit
module type S =
sig
type key
@ -61,9 +63,9 @@ module type S =
val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
(** Fold on bindings *)
val to_seq : 'a t -> (key * 'a) CCSequence.t
val to_seq : 'a t -> (key * 'a) sequence
val of_seq : 'a t -> (key * 'a) CCSequence.t -> unit
val of_seq : 'a t -> (key * 'a) sequence -> unit
val stats : 'a t -> int * int * int * int * int * int
(** Cf Weak.S *)

12
misc/hashset.ml
View file

@ -25,6 +25,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(** {1 Mutable polymorphic hash-set} *)
type 'a sequence = ('a -> unit) -> unit
type 'a t = ('a, unit) PHashtbl.t
(** A set is a hashtable, with trivial values *)
@ -49,11 +51,10 @@ let fold f acc set = PHashtbl.fold (fun acc x () -> f acc x) acc set
let filter p set = PHashtbl.filter (fun x () -> p x) set
let to_seq set =
CCSequence.from_iter (fun k -> iter k set)
let to_seq set k = iter k set
let of_seq set seq =
CCSequence.iter (fun x -> add set x) seq
seq (fun x -> add set x)
let union ?into (s1 : 'a t) (s2 : 'a t) =
let into = match into with
@ -62,10 +63,13 @@ let union ?into (s1 : 'a t) (s2 : 'a t) =
of_seq into (to_seq s2);
into
let seq_filter p seq k =
seq (fun x -> if p x then k x)
let inter ?into (s1 : 'a t) (s2 : 'a t) =
let into = match into with
| Some s -> s
| None -> empty ~eq:s1.PHashtbl.eq ~hash:s1.PHashtbl.hash (cardinal s1) in
(* add to [into] elements of [s1] that also belong to [s2] *)
of_seq into (CCSequence.filter (fun x -> mem s2 x) (to_seq s1));
of_seq into (seq_filter (fun x -> mem s2 x) (to_seq s1));
into

6
misc/hashset.mli
View file

@ -25,6 +25,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(** {1 Mutable polymorphic hash-set} *)
type 'a sequence = ('a -> unit) -> unit
type 'a t = ('a, unit) PHashtbl.t
(** A set is a hashtable, with trivial values *)
@ -51,9 +53,9 @@ val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
val filter : ('a -> bool) -> 'a t -> unit
(** destructive filter (remove elements that do not satisfy the predicate) *)
val to_seq : 'a t -> 'a CCSequence.t
val to_seq : 'a t -> 'a sequence
val of_seq : 'a t -> 'a CCSequence.t -> unit
val of_seq : 'a t -> 'a sequence -> unit
val union : ?into:'a t -> 'a t -> 'a t -> 'a t
(** Set union. The result is stored in [into] *)

2
misc/heap.ml
View file

@ -25,6 +25,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(** {1 Imperative priority queue} *)
type 'a sequence = ('a -> unit) -> unit
type 'a t = {
mutable tree : 'a tree;
cmp : 'a -> 'a -> int;

6
misc/heap.mli
View file

@ -25,6 +25,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(** {1 Imperative priority queue} *)
type 'a sequence = ('a -> unit) -> unit
type 'a t
(** A heap containing values of type 'a *)
@ -51,6 +53,6 @@ val iter : 'a t -> ('a -> unit) -> unit
val size : _ t -> int
val to_seq : 'a t -> 'a CCSequence.t
val to_seq : 'a t -> 'a sequence
val of_seq : 'a t -> 'a CCSequence.t -> unit
val of_seq : 'a t -> 'a sequence -> unit

146
misc/lazyGraph.ml
View file

@ -29,6 +29,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
a graph is always accessed from a given initial node (so only connected
components can be represented by a single value of type ('v,'e) t). *)
type 'a sequence = ('a -> unit) -> unit
(** {2 Type definitions} *)
type ('id, 'v, 'e) t = {
@ -41,7 +43,7 @@ type ('id, 'v, 'e) t = {
other vertices, or to Empty if the identifier is not part of the graph. *)
and ('id, 'v, 'e) node =
| Empty
| Node of 'id * 'v * ('e * 'id) CCSequence.t
| Node of 'id * 'v * ('e * 'id) sequence
(** A single node of the graph, with outgoing edges *)
and ('id, 'e) path = ('id * 'e * 'id) list
(** A reverse path (from the last element of the path to the first). *)
@ -56,7 +58,7 @@ let empty =
let singleton ?(eq=(=)) ?(hash=Hashtbl.hash) v label =
let force v' =
if eq v v' then Node (v, label, CCSequence.empty) else Empty in
if eq v v' then Node (v, label, fun _ -> ()) else Empty in
{ force; eq; hash; }
let make ?(eq=(=)) ?(hash=Hashtbl.hash) force =
@ -66,7 +68,7 @@ let from_fun ?(eq=(=)) ?(hash=Hashtbl.hash) f =
let force v =
match f v with
| None -> Empty
| Some (l, edges) -> Node (v, l, CCSequence.of_list edges) in
| Some (l, edges) -> Node (v, l, fun k -> List.iter k edges) in
{ eq; hash; force; }
(** {2 Polymorphic map} *)
@ -110,7 +112,7 @@ module Mutable = struct
let map = mk_map ~eq ~hash in
let force v =
try let node = map.map_get v in
Node (v, node.mut_v, CCSequence.of_list node.mut_outgoing)
Node (v, node.mut_v, fun k -> List.iter k node.mut_outgoing)
with Not_found -> Empty in
let graph = { eq; hash; force; } in
map, graph
@ -129,12 +131,10 @@ end
let from_enum ?(eq=(=)) ?(hash=Hashtbl.hash) ~vertices ~edges =
let g, lazy_g = Mutable.create ~eq ~hash () in
CCSequence.iter
(fun (v,label_v) -> Mutable.add_vertex g v label_v;)
vertices;
CCSequence.iter
(fun (v1, e, v2) -> Mutable.add_edge g v1 e v2)
edges;
vertices
(fun (v,label_v) -> Mutable.add_vertex g v label_v;);
edges
(fun (v1, e, v2) -> Mutable.add_edge g v1 e v2);
lazy_g
let from_list ?(eq=(=)) ?(hash=Hashtbl.hash) l =
@ -174,11 +174,11 @@ module Full = struct
| [] -> false
let bfs_full graph vertices =
CCSequence.from_iter (fun k ->
fun k ->
let explored = mk_map ~eq:graph.eq ~hash:graph.hash in
let id = ref 0 in
let q = Queue.create () in (* queue of nodes to explore *)
CCSequence.iter (fun v -> Queue.push (FullEnter (v,[])) q) vertices;
vertices (fun v -> Queue.push (FullEnter (v,[])) q);
while not (Queue.is_empty q) do
match Queue.pop q with
| FullEnter (v', path) ->
@ -188,11 +188,11 @@ module Full = struct
| Node (_, label, edges) ->
explored.map_add v' ();
(* explore neighbors *)
CCSequence.iter
edges
(fun (e,v'') ->
let path' = (v'',e,v') :: path in
Queue.push (FullFollowEdge path') q)
edges;
Queue.push (FullFollowEdge path') q
);
(* exit node afterward *)
Queue.push (FullExit v') q;
(* return this vertex *)
@ -213,17 +213,17 @@ module Full = struct
Queue.push (FullEnter (v'', path')) q;
k (MeetEdge (v'', e, v', EdgeForward))
end
done)
done
(* TODO: use a set of nodes currently being explored, rather than
checking whether the node is in the path (should be faster) *)
let dfs_full graph vertices =
CCSequence.from_iter (fun k ->
fun k ->
let explored = mk_map ~eq:graph.eq ~hash:graph.hash in
let id = ref 0 in
let s = Stack.create () in (* stack of nodes to explore *)
CCSequence.iter (fun v -> Stack.push (FullEnter (v,[])) s) vertices;
vertices (fun v -> Stack.push (FullEnter (v,[])) s);
while not (Stack.is_empty s) do
match Stack.pop s with
| FullExit v' -> k (ExitVertex v')
@ -237,10 +237,10 @@ module Full = struct
(* prepare to exit later *)
Stack.push (FullExit v') s;
(* explore neighbors *)
CCSequence.iter
edges
(fun (e,v'') ->
Stack.push (FullFollowEdge ((v'', e, v') :: path)) s)
edges;
Stack.push (FullFollowEdge ((v'', e, v') :: path)) s
);
(* return this vertex *)
let i = !id in
incr id;
@ -258,22 +258,28 @@ module Full = struct
Stack.push (FullEnter (v'', path')) s;
k (MeetEdge (v'', e, v', EdgeForward))
end
done)
done
end
let seq_filter_map f seq k =
seq (fun x -> match f x with
| None -> ()
| Some y -> k y
)
let bfs graph v =
CCSequence.fmap
seq_filter_map
(function
| Full.EnterVertex (v, l, i, _) -> Some (v, l, i)
| _ -> None)
(Full.bfs_full graph (CCSequence.singleton v))
(Full.bfs_full graph (fun k -> k v))
let dfs graph v =
CCSequence.fmap
seq_filter_map
(function
| Full.EnterVertex (v, l, i, _) -> Some (v, l, i)
| _ -> None)
(Full.dfs_full graph (CCSequence.singleton v))
(Full.dfs_full graph (fun k -> k v))
(** {3 Mutable heap} *)
module Heap = struct
@ -342,7 +348,7 @@ let a_star graph
?(distance=(fun v1 e v2 -> 1.))
~goal
start =
CCSequence.from_iter (fun k ->
fun k ->
(* map node -> 'came_from' cell *)
let nodes = mk_map ~eq:graph.eq ~hash:graph.hash in
(* priority queue for nodes to explore *)
@ -376,7 +382,7 @@ let a_star graph
| Empty -> ()
| Node (_, label, edges) ->
(* explore neighbors *)
CCSequence.iter
edges
(fun (e,v'') ->
let cost = dist +. distance v' e v'' +. heuristic v'' in
let cell' =
@ -395,14 +401,20 @@ let a_star graph
Heap.insert h (cost, v'');
cell'.cf_cost <- cost; (* update best cost/path *)
cell'.cf_prev <- CFEdge (e, cell);
end)
edges;
end);
(* check whether the node we just explored is a goal node *)
if goal v'
(* found a goal node! yield it *)
then k (dist, mk_path nodes [] v')
end
done)
done
exception ExitHead
let seq_head seq =
let r = ref None in
try
seq (fun x -> r := Some x; raise ExitHead); None
with ExitHead -> !r
(** Shortest path from the first node to the second one, according
to the given (positive!) distance function. The path is reversed,
@ -413,22 +425,29 @@ let dijkstra graph ?on_explore ?(ignore=fun v -> false)
a_star graph ?on_explore ~ignore ~distance ~heuristic:(fun _ -> 0.)
~goal:(fun v -> graph.eq v v2) v1
in
match CCSequence.to_list (CCSequence.take 1 paths) with
| [] -> raise Not_found
| [x] -> x
| _ -> assert false
match seq_head paths with
| None -> raise Not_found
| Some x -> x
exception ExitForall
let seq_for_all p seq =
try
seq (fun x -> if not (p x) then raise ExitForall);
true
with ExitForall -> false
(** Is the subgraph explorable from the given vertex, a Directed
Acyclic Graph? *)
let is_dag graph v =
CCSequence.for_all
seq_for_all
(function
| Full.MeetEdge (_, _, _, Full.EdgeBackward) -> false
| _ -> true)
(Full.dfs_full graph (CCSequence.singleton v))
(Full.dfs_full graph (fun k -> k v))
let is_dag_full graph vs =
CCSequence.for_all
seq_for_all
(function
| Full.MeetEdge (_, _, _, Full.EdgeBackward) -> false
| _ -> true)
@ -443,9 +462,8 @@ let find_cycle graph v =
let cycle = ref [] in
try
let path_stack = Stack.create () in
let seq = Full.dfs_full graph (CCSequence.singleton v) in
CCSequence.iter
(function
let seq = Full.dfs_full graph (fun k -> k v) in
seq (function
| Full.EnterVertex (_, _, _, path) ->
Stack.push path path_stack
| Full.ExitVertex _ ->
@ -456,8 +474,8 @@ let find_cycle graph v =
let path = (v1, e, v2) :: path in
cycle := path;
raise Exit
| Full.MeetEdge _ -> ())
seq;
| Full.MeetEdge _ -> ()
);
raise Not_found
with Exit ->
!cycle
@ -471,6 +489,9 @@ let rev_path p =
(** {2 Lazy transformations} *)
let seq_map f seq k = seq (fun x -> k (f x))
let seq_append s1 s2 k = s1 k; s2 k
let union ?(combine=fun x y -> x) g1 g2 =
let force v =
match g1.force v, g2.force v with
@ -478,7 +499,7 @@ let union ?(combine=fun x y -> x) g1 g2 =
| ((Node _) as n), Empty -> n
| Empty, ((Node _) as n) -> n
| Node (_, l1, e1), Node (_, l2, e2) ->
Node (v, combine l1 l2, CCSequence.append e1 e2)
Node (v, combine l1 l2, seq_append e1 e2)
in { eq=g1.eq; hash=g1.hash; force; }
let map ~vertices ~edges g =
@ -486,10 +507,12 @@ let map ~vertices ~edges g =
match g.force v with
| Empty -> Empty
| Node (_, l, edges_enum) ->
let edges_enum' = CCSequence.map (fun (e,v') -> (edges e), v') edges_enum in
let edges_enum' = seq_map (fun (e,v') -> (edges e), v') edges_enum in
Node (v, vertices l, edges_enum')
in { eq=g.eq; hash=g.hash; force; }
let seq_flat_map f seq k = seq (fun x -> f x k)
(** Replace each vertex by some vertices. By mapping [v'] to [f v'=v1,...,vn],
whenever [v] ---e---> [v'], then [v --e--> vi] for i=1,...,n. *)
let flatMap f g =
@ -497,24 +520,29 @@ let flatMap f g =
match g.force v with
| Empty -> Empty
| Node (_, l, edges_enum) ->
let edges_enum' = CCSequence.flatMap
let edges_enum' = seq_flat_map
(fun (e, v') ->
CCSequence.map (fun v'' -> e, v'') (f v'))
seq_map (fun v'' -> e, v'') (f v'))
edges_enum in
Node (v, l, edges_enum')
in { eq=g.eq; hash=g.hash; force; }
let seq_filter p seq k = seq (fun x -> if p x then k x)
let filter ?(vertices=(fun v l -> true)) ?(edges=fun v1 e v2 -> true) g =
let force v =
match g.force v with
| Empty -> Empty
| Node (_, l, edges_enum) when vertices v l ->
(* filter out edges *)
let edges_enum' = CCSequence.filter (fun (e,v') -> edges v e v') edges_enum in
let edges_enum' = seq_filter (fun (e,v') -> edges v e v') edges_enum in
Node (v, l, edges_enum')
| Node _ -> Empty (* filter out this vertex *)
in { eq=g.eq; hash=g.hash; force; }
let seq_product s1 s2 k =
s1 (fun x -> s2 (fun y -> k(x,y)))
let product g1 g2 =
let force (v1,v2) =
match g1.force v1, g2.force v2 with
@ -522,8 +550,8 @@ let product g1 g2 =
| _, Empty -> Empty
| Node (_, l1, edges1), Node (_, l2, edges2) ->
(* product of edges *)
let edges = CCSequence.product edges1 edges2 in
let edges = CCSequence.map (fun ((e1,v1'),(e2,v2')) -> ((e1,e2),(v1',v2'))) edges in
let edges = seq_product edges1 edges2 in
let edges = seq_map (fun ((e1,v1'),(e2,v2')) -> ((e1,e2),(v1',v2'))) edges in
Node ((v1,v2), (l1,l2), edges)
and eq (v1,v2) (v1',v2') =
g1.eq v1 v1' && g2.eq v2 v2'
@ -574,7 +602,7 @@ module Dot = struct
(* print preamble *)
Format.fprintf formatter "@[<v2>digraph %s {@;" name;
(* traverse *)
CCSequence.iter
events
(function
| Full.EnterVertex (v, attrs, _, _) ->
Format.fprintf formatter " @[<h>%a %a;@]@." pp_vertex v
@ -584,8 +612,8 @@ module Dot = struct
Format.fprintf formatter " @[<h>%a -> %a %a;@]@."
pp_vertex v1 pp_vertex v2
(CCList.print ~start:"[" ~stop:"]" ~sep:"," print_attribute)
attrs)
events;
attrs
);
(* close *)
Format.fprintf formatter "}@]@;@?";
()
@ -608,17 +636,17 @@ let divisors_graph =
if i > 2
then
let l = divisors [] 2 i in
let edges = CCSequence.map (fun i -> (), i) (CCSequence.of_list l) in
let edges = seq_map (fun i -> (), i) (fun k -> List.iter k l) in
Node (i, i, edges)
else
Node (i, i, CCSequence.empty)
Node (i, i, fun _ -> ())
in make force
let collatz_graph =
let force i =
if i mod 2 = 0
then Node (i, i, CCSequence.singleton ((), i / 2))
else Node (i, i, CCSequence.singleton ((), i * 3 + 1))
then Node (i, i, fun k -> k ((), i / 2))
else Node (i, i, fun k -> k ((), i * 3 + 1))
in make force
let collatz_graph_bis =
@ -628,10 +656,10 @@ let collatz_graph_bis =
; false, i * 2 ] @
if i mod 3 = 1 then [false, (i-1)/3] else []
in
Node (i, i, CCSequence.of_list l)
Node (i, i, fun k -> List.iter k l)
in make force
let heap_graph =
let force i =
Node (i, i, CCSequence.of_list [(), 2*i; (), 2*i+1])
Node (i, i, fun k -> List.iter k [(), 2*i; (), 2*i+1])
in make force

30
misc/lazyGraph.mli
View file

@ -34,6 +34,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(** {2 Type definitions} *)
type 'a sequence = ('a -> unit) -> unit
type ('id, 'v, 'e) t = {
eq : 'id -> 'id -> bool;
hash : 'id -> int;
@ -44,7 +46,7 @@ type ('id, 'v, 'e) t = {
other vertices, or to Empty if the identifier is not part of the graph. *)
and ('id, 'v, 'e) node =
| Empty
| Node of 'id * 'v * ('e * 'id) CCSequence.t
| Node of 'id * 'v * ('e * 'id) sequence
(** A single node of the graph, with outgoing edges *)
and ('id, 'e) path = ('id * 'e * 'id) list
(** A reverse path (from the last element of the path to the first). *)
@ -70,8 +72,8 @@ val make : ?eq:('id -> 'id -> bool) -> ?hash:('id -> int) ->
(** Build a graph from the [force] function *)
val from_enum : ?eq:('id -> 'id -> bool) -> ?hash:('id -> int) ->
vertices:('id * 'v) CCSequence.t ->
edges:('id * 'e * 'id) CCSequence.t ->
vertices:('id * 'v) sequence ->
edges:('id * 'e * 'id) sequence ->
('id, 'v, 'e) t
(** Concrete (eager) representation of a Graph *)
@ -117,21 +119,21 @@ module Full : sig
| EdgeBackward (* toward the current trail *)
| EdgeTransverse (* toward a totally explored part of the graph *)
val bfs_full : ('id, 'v, 'e) t -> 'id CCSequence.t ->
('id, 'v, 'e) traverse_event CCSequence.t
val bfs_full : ('id, 'v, 'e) t -> 'id sequence ->
('id, 'v, 'e) traverse_event sequence
(** Lazy traversal in breadth first from a finite set of vertices *)
val dfs_full : ('id, 'v, 'e) t -> 'id CCSequence.t ->
('id, 'v, 'e) traverse_event CCSequence.t
val dfs_full : ('id, 'v, 'e) t -> 'id sequence ->
('id, 'v, 'e) traverse_event sequence
(** Lazy traversal in depth first from a finite set of vertices *)
end
(** The traversal functions assign a unique ID to every traversed node *)
val bfs : ('id, 'v, 'e) t -> 'id -> ('id * 'v * int) CCSequence.t
val bfs : ('id, 'v, 'e) t -> 'id -> ('id * 'v * int) sequence
(** Lazy traversal in breadth first *)
val dfs : ('id, 'v, 'e) t -> 'id -> ('id * 'v * int) CCSequence.t
val dfs : ('id, 'v, 'e) t -> 'id -> ('id * 'v * int) sequence
(** Lazy traversal in depth first *)
module Heap : sig
@ -149,7 +151,7 @@ val a_star : ('id, 'v, 'e) t ->
?distance:('id -> 'e -> 'id -> float) ->
goal:('id -> bool) ->
'id ->
(float * ('id, 'e) path) CCSequence.t
(float * ('id, 'e) path) sequence
(** Shortest path from the first node to nodes that satisfy [goal], according
to the given (positive!) distance function. The distance is also returned.
[ignore] allows one to ignore some vertices during exploration.
@ -174,7 +176,7 @@ val is_dag : ('id, _, _) t -> 'id -> bool
(** Is the subgraph explorable from the given vertex, a Directed
Acyclic Graph? *)
val is_dag_full : ('id, _, _) t -> 'id CCSequence.t -> bool
val is_dag_full : ('id, _, _) t -> 'id sequence -> bool
(** Is the Graph reachable from the given vertices, a DAG? See {! is_dag} *)
val find_cycle : ('id, _, 'e) t -> 'id -> ('id, 'e) path
@ -196,7 +198,7 @@ val map : vertices:('v -> 'v2) -> edges:('e -> 'e2) ->
('id, 'v, 'e) t -> ('id, 'v2, 'e2) t
(** Map vertice and edge labels *)
val flatMap : ('id -> 'id CCSequence.t) ->
val flatMap : ('id -> 'id sequence) ->
('id, 'v, 'e) t ->
('id, 'v, 'e) t
(** Replace each vertex by some vertices. By mapping [v'] to [f v'=v1,...,vn],
@ -231,12 +233,12 @@ module Dot : sig
val pp_enum : ?eq:('id -> 'id -> bool) -> ?hash:('id -> int) ->
name:string -> Format.formatter ->
('id,attribute list,attribute list) Full.traverse_event CCSequence.t ->
('id,attribute list,attribute list) Full.traverse_event sequence ->
unit
val pp : name:string -> ('id, attribute list, attribute list) t ->
Format.formatter ->
'id CCSequence.t -> unit
'id sequence -> unit
(** Pretty print the given graph (starting from the given set of vertices)
to the channel in DOT format *)
end

10
misc/pHashtbl.ml
View file

@ -25,6 +25,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(** {1 Open addressing hashtable (robin hood hashing)} *)
type 'a sequence = ('a -> unit) -> unit
type ('a, 'b) t = {
mutable buckets : ('a, 'b) bucket array;
mutable size : int;
@ -77,7 +79,7 @@ let clear t =
(** Index of slot, for i-th probing starting from hash [h] in
a table of length [n] *)
let addr h n i = (h + i) mod n
(** Insert (key -> value) in table, starting with the hash. *)
let insert t key value =
let n = Array.length t.buckets in
@ -217,12 +219,10 @@ let filter pred t =
(** Add the given pairs to the hashtable *)
let of_seq t seq =
CCSequence.iter (fun (k,v) -> add t k v) seq
seq (fun (k,v) -> add t k v)
(** CCSequence of pairs *)
let to_seq t =
CCSequence.from_iter
(fun kont -> iter (fun k v -> kont (k,v)) t)
let to_seq t kont = iter (fun k v -> kont (k,v)) t
(** Statistics on the table *)
let stats t = (Array.length t.buckets, t.size, t.size, 0, 0, 1)

8
misc/pHashtbl.mli
View file

@ -25,6 +25,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(** {1 Open addressing hashtable (robin hood hashing)} *)
type 'a sequence = ('a -> unit) -> unit
type ('a, 'b) t = {
mutable buckets : ('a, 'b) bucket array;
mutable size : int;
@ -90,11 +92,11 @@ val filter : ('a -> 'b -> bool) -> ('a, 'b) t -> unit
val fold : ('c -> 'a -> 'b -> 'c) -> 'c -> ('a, 'b) t -> 'c
(** Fold on bindings *)
val of_seq : ('a, 'b) t -> ('a * 'b) CCSequence.t -> unit
val of_seq : ('a, 'b) t -> ('a * 'b) sequence -> unit
(** Add the given pairs to the hashtable *)
val to_seq : ('a, 'b) t -> ('a * 'b) CCSequence.t
(** CCSequence of pairs *)
val to_seq : ('a, 'b) t -> ('a * 'b) sequence
(** Sequence of pairs *)
val stats : (_, _) t -> int * int * int * int * int * int
(** Cf Weak.S *)

2
misc/parseReact.ml
View file

@ -232,6 +232,6 @@ let run p seq =
<|> (skip_spaces >> exact '(' >> many1 ~sep:(exact ' ') (delay p) >>= fun l ->
skip_spaces >> exact ')' >> return (list_ l))
in
let res = run (p ()) (CCSequence.of_str "(a b (c d))") in
let res = run (p ()) (Sequence.of_str "(a b (c d))") in
assert_equal res [list_ [atom "a"; atom "b"; list_ [atom "c"; atom "d"]]]
*)

79
misc/persistentGraph.ml
View file

@ -25,6 +25,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(** {1 A simple polymorphic directed graph.} *)
type 'a sequence = ('a -> unit) -> unit
type ('v, 'e) t = ('v, ('v, 'e) node) PHashtbl.t
(** Graph parametrized by a type for vertices, and one for edges *)
and ('v, 'e) node = {
@ -83,25 +85,27 @@ let add t v1 e v2 =
()
let add_seq t seq =
CCSequence.iter (fun (v1,e,v2) -> add t v1 e v2) seq
seq (fun (v1,e,v2) -> add t v1 e v2)
let next t v =
CCSequence.of_list (PHashtbl.find t v).n_next
let next t v k =
List.iter k (PHashtbl.find t v).n_next
let prev t v =
CCSequence.of_list (PHashtbl.find t v).n_prev
let prev t v k =
List.iter k (PHashtbl.find t v).n_prev
let seq_map f seq k = seq (fun x -> k (f x))
let seq_filter p seq k = seq (fun x -> if p x then k x)
let between t v1 v2 =
let edges = CCSequence.of_list (PHashtbl.find t v1).n_next in
let edges = CCSequence.filter (fun (e, v2') -> (PHashtbl.get_eq t) v2 v2') edges in
CCSequence.map fst edges
let edges k = List.iter k (PHashtbl.find t v1).n_next in
let edges = seq_filter (fun (e, v2') -> (PHashtbl.get_eq t) v2 v2') edges in
seq_map fst edges
(** Call [k] on every vertex *)
let iter_vertices t k =
PHashtbl.iter (fun v _ -> k v) t
let vertices t =
CCSequence.from_iter (iter_vertices t)
let vertices t = iter_vertices t
(** Call [k] on every edge *)
let iter t k =
@ -109,27 +113,37 @@ let iter t k =
(fun v1 node -> List.iter (fun (e, v2) -> k (v1, e, v2)) node.n_next)
t
let to_seq t =
CCSequence.from_iter (iter t)
let to_seq t = iter t
(** {2 Global operations} *)
exception ExitIsEmpty
let seq_is_empty seq =
try seq (fun _ -> raise ExitIsEmpty); true
with ExitIsEmpty -> false
(** Roots, ie vertices with no incoming edges *)
let roots g =
let vertices = vertices g in
CCSequence.filter (fun v -> CCSequence.is_empty (prev g v)) vertices
seq_filter (fun v -> seq_is_empty (prev g v)) vertices
(** Leaves, ie vertices with no outgoing edges *)
let leaves g =
let vertices = vertices g in
CCSequence.filter (fun v -> CCSequence.is_empty (next g v)) vertices
seq_filter (fun v -> seq_is_empty (next g v)) vertices
exception ExitHead
let seq_head seq =
let r = ref None in
try
seq (fun x -> r := Some x; raise ExitHead); None
with ExitHead -> !r
(** Pick a vertex, or raise Not_found *)
let choose g =
match CCSequence.to_list (CCSequence.take 1 (vertices g)) with
| [x] -> x
| [] -> raise Not_found
| _ -> assert false
match seq_head (vertices g) with
| Some x -> x
| None -> raise Not_found
let rev_edge (v,e,v') = (v',e,v)
@ -155,14 +169,12 @@ let bfs graph first k =
(* yield current node *)
k v;
(* explore children *)
CCSequence.iter
next graph v
(fun (e, v') -> if not (Hashset.mem explored v')
then (Hashset.add explored v'; Queue.push v' q))
(next graph v)
done
let bfs_seq graph first =
CCSequence.from_iter (fun k -> bfs graph first k)
let bfs_seq graph first k = bfs graph first k
(** DFS, with callbacks called on each encountered node and edge *)
let dfs_full graph ?(labels=mk_v_table graph)
@ -183,7 +195,7 @@ first
(* enter the node *)
enter trail';
(* explore edges *)
CCSequence.iter
next graph v
(fun (e, v') ->
try let n' = PHashtbl.find labels v' in
if n' < n && List.exists (fun (_,n'') -> n' = n'') trail'
@ -192,8 +204,8 @@ first
fwd_edge (v,e,v') (* forward or cross edge *)
with Not_found ->
tree_edge (v,e,v'); (* tree edge *)
explore trail' v') (* explore the subnode *)
(next graph v);
explore trail' v' (* explore the subnode *)
);
(* exit the node *)
exit trail'
end
@ -216,10 +228,10 @@ let is_dag g =
else try
let labels = mk_v_table g in
(* do a DFS from each root; any back edge indicates a cycle *)
CCSequence.iter
vertices g
(fun v ->
dfs_full g ~labels ~back_edge:(fun _ -> raise Exit) v)
(vertices g);
dfs_full g ~labels ~back_edge:(fun _ -> raise Exit) v
);
true (* complete traversal without back edge *)
with Exit ->
false (* back edge detected! *)
@ -259,14 +271,13 @@ let min_path_full (type v) (type e) graph
else begin
Hashset.add explored v;
(* explore successors *)
CCSequence.iter
next graph v
(fun (e, v') ->
if Hashset.mem explored v' || ignore v' then ()
else
let cost_v' = (cost v e v') + cost_v in
let path' = (v',e,v) :: path in
Heap.insert q (v', cost_v', path'))
(next graph v)
end
done;
(* if a satisfying path was found, Exit would have been raised *)
@ -307,7 +318,7 @@ type attribute = [
(** Pretty print the graph in DOT, on given formatter. Using a sequence
allows to easily select which edges are important,
or to combine several graphs with [CCSequence.append]. *)
or to combine several graphs with [seq_append]. *)
let pp ~name ?vertices
~(print_edge : 'v -> 'e -> 'v -> attribute list)
~(print_vertex : 'v -> attribute list) formatter (graph : ('v, 'e) t) =
@ -341,14 +352,14 @@ let pp ~name ?vertices
(* print preamble *)
Format.fprintf formatter "@[<v2>digraph %s {@;" name;
(* print edges *)
CCSequence.iter
to_seq graph
(fun (v1, e, v2) ->
let attributes = print_edge v1 e v2 in
Format.fprintf formatter " @[<h>%a -> %a [%a];@]@."
pp_vertex v1 pp_vertex v2
(CCList.print ~sep:"," print_attribute)
attributes)
(to_seq graph);
attributes
);
(* print vertices *)
PHashtbl.iter
(fun v _ ->

22
misc/persistentGraph.mli
View file

@ -25,6 +25,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(** {1 A simple polymorphic directed graph.} *)
type 'a sequence = ('a -> unit) -> unit
(** {2 Basics} *)
type ('v, 'e) t
@ -51,31 +53,31 @@ val length : (_, _) t -> int
val add : ('v,'e) t -> 'v -> 'e -> 'v -> unit
(** Add an edge between two vertices *)
val add_seq : ('v,'e) t -> ('v * 'e * 'v) CCSequence.t -> unit
val add_seq : ('v,'e) t -> ('v * 'e * 'v) sequence -> unit
(** Add the vertices to the graph *)
val next : ('v, 'e) t -> 'v -> ('e * 'v) CCSequence.t
val next : ('v, 'e) t -> 'v -> ('e * 'v) sequence
(** Outgoing edges *)
val prev : ('v, 'e) t -> 'v -> ('e * 'v) CCSequence.t
val prev : ('v, 'e) t -> 'v -> ('e * 'v) sequence
(** Incoming edges *)
val between : ('v, 'e) t -> 'v -> 'v -> 'e CCSequence.t
val between : ('v, 'e) t -> 'v -> 'v -> 'e sequence
val iter_vertices : ('v, 'e) t -> ('v -> unit) -> unit
val vertices : ('v, 'e) t -> 'v CCSequence.t
val vertices : ('v, 'e) t -> 'v sequence
(** Iterate on vertices *)
val iter : ('v, 'e) t -> ('v * 'e * 'v -> unit) -> unit
val to_seq : ('v, 'e) t -> ('v * 'e * 'v) CCSequence.t
val to_seq : ('v, 'e) t -> ('v * 'e * 'v) sequence
(** Dump the graph as a sequence of vertices *)
(** {2 Global operations} *)
val roots : ('v, 'e) t -> 'v CCSequence.t
val roots : ('v, 'e) t -> 'v sequence
(** Roots, ie vertices with no incoming edges *)
val leaves : ('v, 'e) t -> 'v CCSequence.t
val leaves : ('v, 'e) t -> 'v sequence
(** Leaves, ie vertices with no outgoing edges *)
val choose : ('v, 'e) t -> 'v
@ -92,8 +94,8 @@ val rev : ('v, 'e) t -> unit
val bfs : ('v, 'e) t -> 'v -> ('v -> unit) -> unit
(** Breadth-first search, from given 'v *)
val bfs_seq : ('v, 'e) t -> 'v -> 'v CCSequence.t
(** CCSequence of vertices traversed during breadth-first search *)
val bfs_seq : ('v, 'e) t -> 'v -> 'v sequence
(** Sequence of vertices traversed during breadth-first search *)
val dfs_full : ('v, 'e) t ->
?labels:('v, int) PHashtbl.t ->

8
misc/skipList.ml
View file

@ -25,6 +25,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(** {1 Imperative skip-list} *)
type 'a gen = unit -> 'a option
(** Most functions are inspired from
"A skip list cookbook", William Pugh, 1989. *)
@ -187,6 +189,10 @@ let gen l =
x := a.(0);
Some (k, !v)
let rec gen_iter f g = match g() with
| None -> ()
| Some x -> f x; gen_iter f g
(** Add content of the iterator to the list *)
let of_gen l gen =
CCGen.iter (fun (k,v) -> add l k v) gen
gen_iter (fun (k,v) -> add l k v) gen

6
misc/skipList.mli
View file

@ -25,6 +25,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(** {1 Imperative skip-list} *)
type 'a gen = unit -> 'a option
type ('a, 'b) t
(** A skip list that maps elements of type 'a to elements of type 'b *)
@ -53,6 +55,6 @@ val remove : ('a, 'b) t -> 'a -> unit
val length : (_, _) t -> int
(** Number of elements *)
val gen : ('a, 'b) t -> ('a * 'b) CCGen.t
val gen : ('a, 'b) t -> ('a * 'b) gen
val of_gen : ('a, 'b) t -> ('a * 'b) CCGen.t -> unit
val of_gen : ('a, 'b) t -> ('a * 'b) gen -> unit

12
misc/smallSet.ml
View file

@ -25,6 +25,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(** {1 Small set structure} *)
type 'a sequence = ('a -> unit) -> unit
type 'a t = {
cmp : 'a -> 'a -> int;
nodes : 'a node;
@ -123,11 +125,15 @@ let to_seq set =
iter k set
let of_seq set seq =
CCSequence.fold add set seq
let set = ref set in
seq (fun x -> set := add !set x);
!set
let to_list set =
CCSequence.to_rev_list (to_seq set)
let l = ref [] in
to_seq set (fun x -> l := x :: !l);
!l
let of_list set l =
of_seq set (CCSequence.of_list l)
List.fold_left add set l

7
misc/smallSet.mli
View file

@ -29,6 +29,9 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
function. It is implemented as a sorted list, so most operations
are in linear time. *)
type 'a sequence = ('a -> unit) -> unit
type 'a t
(** Set of elements of type 'a *)
@ -59,9 +62,9 @@ val iter : ('a -> unit) -> 'a t -> unit
val size : _ t -> int
(** Number of elements *)
val to_seq : 'a t -> 'a CCSequence.t
val to_seq : 'a t -> 'a sequence
val of_seq : 'a t -> 'a CCSequence.t -> 'a t
val of_seq : 'a t -> 'a sequence -> 'a t
val to_list : 'a t -> 'a list

20
misc/splayMap.ml
View file

@ -29,6 +29,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
http://www.cs.cornell.edu/Courses/cs3110/2009fa/recitations/rec-splay.html
*)
type 'a sequence = ('a -> unit) -> unit
(** {2 Polymorphic Maps} *)
type ('a, 'b) t = {
@ -192,11 +194,12 @@ let choose t =
| Node (k, v, _, _) -> k, v
let to_seq t =
CCSequence.from_iter
(fun kont -> iter t (fun k v -> kont (k, v)))
fun kont -> iter t (fun k v -> kont (k, v))
let of_seq t seq =
CCSequence.fold (fun t (k, v) -> add t k v) t seq
let t = ref t in
seq (fun (k, v) -> t := add !t k v);
!t
(** {2 Functorial interface} *)
@ -238,9 +241,9 @@ module type S = sig
val choose : 'a t -> (key * 'a)
(** Some binding, or raises Not_found *)
val to_seq : 'a t -> (key * 'a) CCSequence.t
val to_seq : 'a t -> (key * 'a) sequence
val of_seq : 'a t -> (key * 'a) CCSequence.t -> 'a t
val of_seq : 'a t -> (key * 'a) sequence -> 'a t
end
module type ORDERED = sig
@ -404,9 +407,10 @@ module Make(X : ORDERED) = struct
| Node (k, v, _, _) -> k, v
let to_seq t =
CCSequence.from_iter
(fun kont -> iter t (fun k v -> kont (k, v)))
fun kont -> iter t (fun k v -> kont (k, v))
let of_seq t seq =
CCSequence.fold (fun t (k, v) -> add t k v) t seq
let t = ref t in
seq (fun (k, v) -> t := add !t k v);
!t
end

11
misc/splayMap.mli
View file

@ -28,6 +28,9 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(* TODO: map-wide operations: merge, compare, equal, for_all, exists,
batch (sorted) add, partition, split, max_elt, min_elt, map... *)
type 'a sequence = ('a -> unit) -> unit
(** {2 Polymorphic Maps} *)
type ('a, 'b) t
@ -69,9 +72,9 @@ val size : (_, _) t -> int
val choose : ('a, 'b) t -> ('a * 'b)
(** Some binding, or raises Not_found *)
val to_seq : ('a, 'b) t -> ('a * 'b) CCSequence.t
val to_seq : ('a, 'b) t -> ('a * 'b) sequence
val of_seq : ('a, 'b) t -> ('a * 'b) CCSequence.t -> ('a, 'b) t
val of_seq : ('a, 'b) t -> ('a * 'b) sequence -> ('a, 'b) t
(** {2 Functorial interface} *)
@ -113,9 +116,9 @@ module type S = sig
val choose : 'a t -> (key * 'a)
(** Some binding, or raises Not_found *)
val to_seq : 'a t -> (key * 'a) CCSequence.t
val to_seq : 'a t -> (key * 'a) sequence
val of_seq : 'a t -> (key * 'a) CCSequence.t -> 'a t
val of_seq : 'a t -> (key * 'a) sequence -> 'a t
end
module type ORDERED = sig

1
tests/run_tests.ml
View file

@ -13,7 +13,6 @@ let suite =
Test_cc.suite;
Test_puf.suite;
Test_vector.suite;
Test_gen.suite;
Test_deque.suite;
Test_fHashtbl.suite;
Test_fQueue.suite;

2
tests/test_CCHeap.ml
View file

@ -3,8 +3,6 @@
open OUnit
module Sequence = CCSequence
module H = CCHeap.Make(struct type t = int let leq x y =x<=y end)
let empty = H.empty

1
tests/test_PersistentHashtbl.ml
View file

@ -2,7 +2,6 @@
open OUnit
module H = CCPersistentHashtbl.Make(CCInt)
module Sequence = CCSequence
let test_add () =
let h = H.create 32 in

2
tests/test_bv.ml
View file

@ -1,6 +1,6 @@
open OUnit
module Sequence = CCSequence
let test_cardinal () =
let bv1 = CCBV.create ~size:87 true in

2
tests/test_deque.ml
View file

@ -2,7 +2,7 @@
open OUnit
module Deque = CCDeque
module Sequence = CCSequence
let plist l = CCPrint.to_string (CCList.pp CCInt.pp) l
let pint i = string_of_int i

2
tests/test_fHashtbl.ml
View file

@ -2,7 +2,7 @@
open OUnit
open Containers_misc
module Sequence = CCSequence
module Test(SomeHashtbl : FHashtbl.S with type key = int) = struct
let test_add () =

2
tests/test_fQueue.ml
View file

@ -2,7 +2,7 @@
open OUnit
module FQueue = CCFQueue
module Sequence = CCSequence
let test_empty () =
let q = FQueue.empty in

2
tests/test_flatHashtbl.ml
View file

@ -2,7 +2,7 @@
open OUnit
open Containers_misc
module Sequence = CCSequence
module IHashtbl = FlatHashtbl.Make(struct
type t = int

132
tests/test_gen.ml
View file

@ -1,132 +0,0 @@
open OUnit
open CCFun
module Gen = CCGen
module GR = Gen.Restart
let pint i = string_of_int i
let plist l =
CCPrint.to_string (CCList.pp CCInt.pp) l
let pstrlist l =
CCPrint.to_string (CCList.pp Buffer.add_string) l
let test_singleton () =
let gen = Gen.singleton 42 in
OUnit.assert_equal (Some 42) (Gen.get gen);
OUnit.assert_equal None (Gen.get gen);
let gen = Gen.singleton 42 in
OUnit.assert_equal 1 (Gen.length gen);
()
let test_iter () =
let e = GR.(1 -- 10) in
OUnit.assert_equal ~printer:pint 10 (GR.length e);
OUnit.assert_equal [1;2] GR.(to_list (1 -- 2));
OUnit.assert_equal [1;2;3;4;5] (GR.to_list (GR.take 5 e));
()
let test_map () =
let e = Gen.(1 -- 10) in
let e' = Gen.map string_of_int e in
OUnit.assert_equal ~printer:pstrlist ["9"; "10"] (Gen.to_list (Gen.drop 8 e'));
()
let test_append () =
let e = Gen.append Gen.(1 -- 5) Gen.(6 -- 10) in
OUnit.assert_equal [10;9;8;7;6;5;4;3;2;1] (Gen.to_rev_list e);
()
let test_flatMap () =
let e = Gen.(1 -- 3) in
let e' = Gen.(e >>= (fun x -> x -- (x+1))) in
OUnit.assert_equal [1;2;2;3;3;4] (Gen.to_list e');
()
let test_zip () =
let e = Gen.zip_with (+) (Gen.repeat 1) Gen.(4--7) in
OUnit.assert_equal [5;6;7;8] (Gen.to_list e);
()
let test_filterMap () =
let f x = if x mod 2 = 0 then Some (string_of_int x) else None in
let e = Gen.filter_map f Gen.(1 -- 10) in
OUnit.assert_equal ["2"; "4"; "6"; "8"; "10"] (Gen.to_list e);
()
let test_merge () =
let e = Gen.of_list [Gen.(1--3); Gen.(4--6); Gen.(7--9)] in
let e' = Gen.merge e in
OUnit.assert_equal [1;2;3;4;5;6;7;8;9] (Gen.to_list e' |> List.sort compare);
()
let test_persistent () =
let i = ref 0 in
let gen () =
let j = !i in
if j > 5 then None else (incr i; Some j)
in
let e = Gen.persistent gen in
OUnit.assert_equal [0;1;2;3;4;5] (GR.to_list e);
OUnit.assert_equal [0;1;2;3;4;5] (GR.to_list e);
OUnit.assert_equal [0;1;2;3;4;5] (GR.to_list e);
()
let test_round_robin () =
let e = GR.round_robin ~n:2 GR.(1--10) in
match e with
| [a;b] ->
OUnit.assert_equal [1;3;5;7;9] (Gen.to_list a);
OUnit.assert_equal [2;4;6;8;10] (Gen.to_list b)
| _ -> OUnit.assert_failure "wrong list lenght"
let test_big_rr () =
let e = GR.round_robin ~n:3 GR.(1 -- 999) in
let l = List.map Gen.length e in
OUnit.assert_equal [333;333;333] l;
()
let test_merge_sorted () =
[Gen.of_list [1;3;5]; Gen.of_list [0;1;1;3;4;6;10]; Gen.of_list [2;2;11]]
|> Gen.sorted_merge_n ?cmp:None
|> Gen.to_list
|> OUnit.assert_equal ~printer:Helpers.print_int_list [0;1;1;1;2;2;3;3;4;5;6;10;11]
let test_interleave () =
let e1 = Gen.of_list [1;3;5;7;9] in
let e2 = Gen.of_list [2;4;6;8;10] in
let e = Gen.interleave e1 e2 in
OUnit.assert_equal [1;2;3;4;5;6;7;8;9;10] (Gen.to_list e);
()
let test_intersperse () =
let e = Gen.(1 -- 5) in
let e' = Gen.intersperse 0 e in
OUnit.assert_equal [1;0;2;0;3;0;4;0;5] (Gen.to_list e');
()
let test_product () =
let printer = Helpers.print_int_int_list in
let e = Gen.product Gen.(1--3) Gen.(4--5) in
OUnit.assert_equal ~printer [1,4; 1,5; 2,4; 2,5; 3,4; 3,5]
(List.sort compare (Gen.to_list e));
()
let suite =
"test_gen" >:::
[ "test_singleton" >:: test_singleton;
"test_iter" >:: test_iter;
"test_map" >:: test_map;
"test_append" >:: test_append;
"test_flatMap" >:: test_flatMap;
"test_zip" >:: test_zip;
"test_filterMap" >:: test_filterMap;
"test_merge" >:: test_merge;
"test_persistent" >:: test_persistent;
"test_round_robin" >:: test_round_robin;
"test_big_rr" >:: test_big_rr;
"test_merge_sorted" >:: test_merge_sorted;
"test_interleave" >:: test_interleave;
"test_intersperse" >:: test_intersperse;
"test_product" >:: test_product;
]

2
tests/test_graph.ml
View file

@ -5,7 +5,7 @@ open OUnit
open Helpers
open Containers_misc
module Sequence = CCSequence
module G = PersistentGraph
(* build a graph from a list of pairs of ints *)

2
tests/test_heap.ml
View file

@ -3,7 +3,7 @@
open OUnit
open Helpers
open Containers_misc
module Sequence = CCSequence
let test_empty () =
let h = Heap.empty ~cmp:(fun x y -> x - y) in

6
tests/test_mixtbl.ml
View file

@ -66,7 +66,7 @@ let test_keys () =
Mixtbl.set ~inj:inj_int tbl "foo" 1;
Mixtbl.set ~inj:inj_int tbl "bar" 2;
Mixtbl.set ~inj:inj_str tbl "baaz" "hello";
let l = Mixtbl.keys_seq tbl |> CCSequence.to_list in
let l = Mixtbl.keys_seq tbl |> Sequence.to_list in
OUnit.assert_equal ["baaz"; "bar"; "foo"] (List.sort compare l);
()
@ -78,9 +78,9 @@ let test_bindings () =
Mixtbl.set ~inj:inj_int tbl "bar" 2;
Mixtbl.set ~inj:inj_str tbl "baaz" "hello";
Mixtbl.set ~inj:inj_str tbl "str" "rts";
let l_int = Mixtbl.bindings_of tbl ~inj:inj_int |> CCSequence.to_list in
let l_int = Mixtbl.bindings_of tbl ~inj:inj_int |> Sequence.to_list in
OUnit.assert_equal ["bar", 2; "foo", 1] (List.sort compare l_int);
let l_str = Mixtbl.bindings_of tbl ~inj:inj_str |> CCSequence.to_list in
let l_str = Mixtbl.bindings_of tbl ~inj:inj_str |> Sequence.to_list in
OUnit.assert_equal ["baaz", "hello"; "str", "rts"] (List.sort compare l_str);
()

2
tests/test_pHashtbl.ml
View file

@ -2,7 +2,7 @@
open OUnit
open Containers_misc
module Sequence = CCSequence
let test_add () =
let h = PHashtbl.create 5 in

2
tests/test_splayMap.ml
View file

@ -2,7 +2,7 @@
open OUnit
open Containers_misc
module Sequence = CCSequence
let test1 () =
let empty = SplayMap.empty () in

2
tests/test_vector.ml
View file

@ -2,7 +2,7 @@
open OUnit
module Vector = CCVector
module Sequence = CCSequence
let test_clear () =
let v = Vector.of_seq Sequence.(1 -- 10) in

6
tests/threads/test_future.ml
View file

@ -15,9 +15,9 @@ let test_mvar () =
()
let test_parallel () =
let l = CCSequence.(1 -- 300) in
let l = CCSequence.map (fun _ -> Future.spawn (fun () -> Thread.delay 0.1; 1)) l in
let l = CCSequence.to_list l in
let l = Sequence.(1 -- 300) in
let l = Sequence.map (fun _ -> Future.spawn (fun () -> Thread.delay 0.1; 1)) l in
let l = Sequence.to_list l in
let l' = List.map Future.get l in
OUnit.assert_equal 300 (List.fold_left (+) 0 l');
()