From d0c3af549247a9588d1feb75580e25260ceeb520 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 13 Dec 2014 03:11:16 +0100 Subject: [PATCH] continue removal of CCGen/CCsequence --- _oasis | 12 +-- advanced/CCLinq.ml | 104 +++++++++++------------ benchs/bench_conv.ml | 4 +- benchs/run_benchs.ml | 12 +-- core/CCBV.ml | 2 +- core/CCIO.ml | 56 ++++++++++-- core/CCVector.ml | 4 +- examples/mem_size.ml | 2 +- misc/absSet.ml | 16 ++-- misc/absSet.mli | 14 +-- misc/circList.ml | 2 +- misc/fHashtbl.ml | 24 +++--- misc/fHashtbl.mli | 6 +- misc/flatHashtbl.ml | 13 +-- misc/flatHashtbl.mli | 6 +- misc/hashset.ml | 12 ++- misc/hashset.mli | 6 +- misc/heap.ml | 2 + misc/heap.mli | 6 +- misc/lazyGraph.ml | 146 +++++++++++++++++++------------- misc/lazyGraph.mli | 30 ++++--- misc/pHashtbl.ml | 10 +-- misc/pHashtbl.mli | 8 +- misc/parseReact.ml | 2 +- misc/persistentGraph.ml | 79 +++++++++-------- misc/persistentGraph.mli | 22 ++--- misc/skipList.ml | 8 +- misc/skipList.mli | 6 +- misc/smallSet.ml | 12 ++- misc/smallSet.mli | 7 +- misc/splayMap.ml | 20 +++-- misc/splayMap.mli | 11 ++- tests/run_tests.ml | 1 - tests/test_CCHeap.ml | 2 - tests/test_PersistentHashtbl.ml | 1 - tests/test_bv.ml | 2 +- tests/test_deque.ml | 2 +- tests/test_fHashtbl.ml | 2 +- tests/test_fQueue.ml | 2 +- tests/test_flatHashtbl.ml | 2 +- tests/test_gen.ml | 132 ----------------------------- tests/test_graph.ml | 2 +- tests/test_heap.ml | 2 +- tests/test_mixtbl.ml | 6 +- tests/test_pHashtbl.ml | 2 +- tests/test_splayMap.ml | 2 +- tests/test_vector.ml | 2 +- tests/threads/test_future.ml | 6 +- 48 files changed, 415 insertions(+), 417 deletions(-) delete mode 100644 tests/test_gen.ml diff --git a/_oasis b/_oasis index 6386f2b3..104e273b 100644 --- a/_oasis +++ b/_oasis @@ -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 diff --git a/advanced/CCLinq.ml b/advanced/CCLinq.ml index 17cf74de..82433e3d 100644 --- a/advanced/CCLinq.ml +++ b/advanced/CCLinq.ml @@ -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) diff --git a/benchs/bench_conv.ml b/benchs/bench_conv.ml index c117fda8..7e958f36 100644 --- a/benchs/bench_conv.ml +++ b/benchs/bench_conv.ml @@ -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; diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index ec53abbd..3bde113e 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -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 () = diff --git a/core/CCBV.ml b/core/CCBV.ml index 37eeebb2..ac31693c 100644 --- a/core/CCBV.ml +++ b/core/CCBV.ml @@ -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 = diff --git a/core/CCIO.ml b/core/CCIO.ml index 1ebe7064..7e19187e 100644 --- a/core/CCIO.ml +++ b/core/CCIO.ml @@ -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 diff --git a/core/CCVector.ml b/core/CCVector.ml index 143a5a55..f6cc9234 100644 --- a/core/CCVector.ml +++ b/core/CCVector.ml @@ -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 = diff --git a/examples/mem_size.ml b/examples/mem_size.ml index d424e9ed..4e69c083 100644 --- a/examples/mem_size.ml +++ b/examples/mem_size.ml @@ -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 = diff --git a/misc/absSet.ml b/misc/absSet.ml index c8cbb06c..b8603320 100644 --- a/misc/absSet.ml +++ b/misc/absSet.ml @@ -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) diff --git a/misc/absSet.mli b/misc/absSet.mli index 4bcec095..8ff8302a 100644 --- a/misc/absSet.mli +++ b/misc/absSet.mli @@ -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 diff --git a/misc/circList.ml b/misc/circList.ml index 9c795a98..0b0670be 100644 --- a/misc/circList.ml +++ b/misc/circList.ml @@ -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 = diff --git a/misc/fHashtbl.ml b/misc/fHashtbl.ml index fe1b3ea2..a72dd203 100644 --- a/misc/fHashtbl.ml +++ b/misc/fHashtbl.ml @@ -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 diff --git a/misc/fHashtbl.mli b/misc/fHashtbl.mli index 9bb7ca4f..27866813 100644 --- a/misc/fHashtbl.mli +++ b/misc/fHashtbl.mli @@ -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} *) diff --git a/misc/flatHashtbl.ml b/misc/flatHashtbl.ml index b2e2ce8d..1ff59a21 100644 --- a/misc/flatHashtbl.ml +++ b/misc/flatHashtbl.ml @@ -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) diff --git a/misc/flatHashtbl.mli b/misc/flatHashtbl.mli index 44f2c1f4..55b462a7 100644 --- a/misc/flatHashtbl.mli +++ b/misc/flatHashtbl.mli @@ -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 *) diff --git a/misc/hashset.ml b/misc/hashset.ml index 5ff54bfe..110e4994 100644 --- a/misc/hashset.ml +++ b/misc/hashset.ml @@ -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 diff --git a/misc/hashset.mli b/misc/hashset.mli index 92af637f..f421c557 100644 --- a/misc/hashset.mli +++ b/misc/hashset.mli @@ -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] *) diff --git a/misc/heap.ml b/misc/heap.ml index 1b7be900..7b402d51 100644 --- a/misc/heap.ml +++ b/misc/heap.ml @@ -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; diff --git a/misc/heap.mli b/misc/heap.mli index ba901f98..e9adee7c 100644 --- a/misc/heap.mli +++ b/misc/heap.mli @@ -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 diff --git a/misc/lazyGraph.ml b/misc/lazyGraph.ml index 3a2f893a..6262096c 100644 --- a/misc/lazyGraph.ml +++ b/misc/lazyGraph.ml @@ -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 "@[digraph %s {@;" name; (* traverse *) - CCSequence.iter + events (function | Full.EnterVertex (v, attrs, _, _) -> Format.fprintf formatter " @[%a %a;@]@." pp_vertex v @@ -584,8 +612,8 @@ module Dot = struct Format.fprintf formatter " @[%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 diff --git a/misc/lazyGraph.mli b/misc/lazyGraph.mli index 1b33d983..5c88d026 100644 --- a/misc/lazyGraph.mli +++ b/misc/lazyGraph.mli @@ -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 diff --git a/misc/pHashtbl.ml b/misc/pHashtbl.ml index fc138ecf..86458bcf 100644 --- a/misc/pHashtbl.ml +++ b/misc/pHashtbl.ml @@ -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) diff --git a/misc/pHashtbl.mli b/misc/pHashtbl.mli index d5d8bd54..2a9c82c1 100644 --- a/misc/pHashtbl.mli +++ b/misc/pHashtbl.mli @@ -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 *) diff --git a/misc/parseReact.ml b/misc/parseReact.ml index d1eee788..99b7c12e 100644 --- a/misc/parseReact.ml +++ b/misc/parseReact.ml @@ -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"]]] *) diff --git a/misc/persistentGraph.ml b/misc/persistentGraph.ml index 1928e6f5..fb42ea08 100644 --- a/misc/persistentGraph.ml +++ b/misc/persistentGraph.ml @@ -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 "@[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 " @[%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 _ -> diff --git a/misc/persistentGraph.mli b/misc/persistentGraph.mli index 6c061706..8ec044cc 100644 --- a/misc/persistentGraph.mli +++ b/misc/persistentGraph.mli @@ -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 -> diff --git a/misc/skipList.ml b/misc/skipList.ml index 60db79a6..c9af6a63 100644 --- a/misc/skipList.ml +++ b/misc/skipList.ml @@ -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 diff --git a/misc/skipList.mli b/misc/skipList.mli index 42b357c9..d701e4b9 100644 --- a/misc/skipList.mli +++ b/misc/skipList.mli @@ -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 diff --git a/misc/smallSet.ml b/misc/smallSet.ml index 24b5ae69..23082bfa 100644 --- a/misc/smallSet.ml +++ b/misc/smallSet.ml @@ -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 diff --git a/misc/smallSet.mli b/misc/smallSet.mli index 1582b5e8..0a46593e 100644 --- a/misc/smallSet.mli +++ b/misc/smallSet.mli @@ -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 diff --git a/misc/splayMap.ml b/misc/splayMap.ml index 5e6465f9..4a9de67d 100644 --- a/misc/splayMap.ml +++ b/misc/splayMap.ml @@ -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 diff --git a/misc/splayMap.mli b/misc/splayMap.mli index 8d591977..6733f506 100644 --- a/misc/splayMap.mli +++ b/misc/splayMap.mli @@ -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 diff --git a/tests/run_tests.ml b/tests/run_tests.ml index cf4787ac..2641584d 100644 --- a/tests/run_tests.ml +++ b/tests/run_tests.ml @@ -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; diff --git a/tests/test_CCHeap.ml b/tests/test_CCHeap.ml index a0c97a79..3b4547a3 100644 --- a/tests/test_CCHeap.ml +++ b/tests/test_CCHeap.ml @@ -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 diff --git a/tests/test_PersistentHashtbl.ml b/tests/test_PersistentHashtbl.ml index 8d466484..dd84be8a 100644 --- a/tests/test_PersistentHashtbl.ml +++ b/tests/test_PersistentHashtbl.ml @@ -2,7 +2,6 @@ open OUnit module H = CCPersistentHashtbl.Make(CCInt) -module Sequence = CCSequence let test_add () = let h = H.create 32 in diff --git a/tests/test_bv.ml b/tests/test_bv.ml index d6909679..2a7a6152 100644 --- a/tests/test_bv.ml +++ b/tests/test_bv.ml @@ -1,6 +1,6 @@ open OUnit -module Sequence = CCSequence + let test_cardinal () = let bv1 = CCBV.create ~size:87 true in diff --git a/tests/test_deque.ml b/tests/test_deque.ml index aecd15d1..76a5448a 100644 --- a/tests/test_deque.ml +++ b/tests/test_deque.ml @@ -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 diff --git a/tests/test_fHashtbl.ml b/tests/test_fHashtbl.ml index 1c81e37e..d77d7b13 100644 --- a/tests/test_fHashtbl.ml +++ b/tests/test_fHashtbl.ml @@ -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 () = diff --git a/tests/test_fQueue.ml b/tests/test_fQueue.ml index 33082e5e..7388d551 100644 --- a/tests/test_fQueue.ml +++ b/tests/test_fQueue.ml @@ -2,7 +2,7 @@ open OUnit module FQueue = CCFQueue -module Sequence = CCSequence + let test_empty () = let q = FQueue.empty in diff --git a/tests/test_flatHashtbl.ml b/tests/test_flatHashtbl.ml index 60437386..d0cde3a9 100644 --- a/tests/test_flatHashtbl.ml +++ b/tests/test_flatHashtbl.ml @@ -2,7 +2,7 @@ open OUnit open Containers_misc -module Sequence = CCSequence + module IHashtbl = FlatHashtbl.Make(struct type t = int diff --git a/tests/test_gen.ml b/tests/test_gen.ml deleted file mode 100644 index 17596130..00000000 --- a/tests/test_gen.ml +++ /dev/null @@ -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; - ] diff --git a/tests/test_graph.ml b/tests/test_graph.ml index a18913a7..70e126d3 100644 --- a/tests/test_graph.ml +++ b/tests/test_graph.ml @@ -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 *) diff --git a/tests/test_heap.ml b/tests/test_heap.ml index c4162e23..62b62586 100644 --- a/tests/test_heap.ml +++ b/tests/test_heap.ml @@ -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 diff --git a/tests/test_mixtbl.ml b/tests/test_mixtbl.ml index f58fc2bb..f3e8c320 100644 --- a/tests/test_mixtbl.ml +++ b/tests/test_mixtbl.ml @@ -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); () diff --git a/tests/test_pHashtbl.ml b/tests/test_pHashtbl.ml index ce663ecd..c00f0d27 100644 --- a/tests/test_pHashtbl.ml +++ b/tests/test_pHashtbl.ml @@ -2,7 +2,7 @@ open OUnit open Containers_misc -module Sequence = CCSequence + let test_add () = let h = PHashtbl.create 5 in diff --git a/tests/test_splayMap.ml b/tests/test_splayMap.ml index aa22a5a1..fb1d85b8 100644 --- a/tests/test_splayMap.ml +++ b/tests/test_splayMap.ml @@ -2,7 +2,7 @@ open OUnit open Containers_misc -module Sequence = CCSequence + let test1 () = let empty = SplayMap.empty () in diff --git a/tests/test_vector.ml b/tests/test_vector.ml index 878937a4..c8ece7c6 100644 --- a/tests/test_vector.ml +++ b/tests/test_vector.ml @@ -2,7 +2,7 @@ open OUnit module Vector = CCVector -module Sequence = CCSequence + let test_clear () = let v = Vector.of_seq Sequence.(1 -- 10) in diff --git a/tests/threads/test_future.ml b/tests/threads/test_future.ml index 4c7bdf18..cabb7f39 100644 --- a/tests/threads/test_future.ml +++ b/tests/threads/test_future.ml @@ -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'); ()