mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 03:05:28 -05:00
updated and fixed things in core/:
fixed warnings, updated Sequence/Gen with tests and more recent interface; added printers
This commit is contained in:
parent
2dc743965b
commit
113ea6d395
11 changed files with 613 additions and 340 deletions
446
core/CCGen.ml
446
core/CCGen.ml
|
|
@ -67,10 +67,6 @@ module type S = sig
|
||||||
val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
|
val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
|
||||||
(** Fold on the generator, tail-recursively *)
|
(** Fold on the generator, tail-recursively *)
|
||||||
|
|
||||||
val fold2 : ('c -> 'a -> 'b -> 'c) -> 'c -> 'a t -> 'b t -> 'c
|
|
||||||
(** Fold on the two enums in parallel. Stops once one of the enums
|
|
||||||
is exhausted. *)
|
|
||||||
|
|
||||||
val reduce : ('a -> 'a -> 'a) -> 'a t -> 'a
|
val reduce : ('a -> 'a -> 'a) -> 'a t -> 'a
|
||||||
(** Fold on non-empty sequences (otherwise raise Invalid_argument) *)
|
(** Fold on non-empty sequences (otherwise raise Invalid_argument) *)
|
||||||
|
|
||||||
|
|
@ -83,9 +79,6 @@ module type S = sig
|
||||||
val iteri : (int -> 'a -> unit) -> 'a t -> unit
|
val iteri : (int -> 'a -> unit) -> 'a t -> unit
|
||||||
(** Iterate on elements with their index in the enum, from 0 *)
|
(** Iterate on elements with their index in the enum, from 0 *)
|
||||||
|
|
||||||
val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit
|
|
||||||
(** Iterate on the two sequences. Stops once one of them is exhausted.*)
|
|
||||||
|
|
||||||
val length : _ t -> int
|
val length : _ t -> int
|
||||||
(** Length of an enum (linear time) *)
|
(** Length of an enum (linear time) *)
|
||||||
|
|
||||||
|
|
@ -100,7 +93,7 @@ module type S = sig
|
||||||
val flatten : 'a gen t -> 'a t
|
val flatten : 'a gen t -> 'a t
|
||||||
(** Flatten the enumeration of generators *)
|
(** Flatten the enumeration of generators *)
|
||||||
|
|
||||||
val flatMap : ('a -> 'b gen) -> 'a t -> 'b t
|
val flat_map : ('a -> 'b gen) -> 'a t -> 'b t
|
||||||
(** Monadic bind; each element is transformed to a sub-enum
|
(** Monadic bind; each element is transformed to a sub-enum
|
||||||
which is then iterated on, before the next element is processed,
|
which is then iterated on, before the next element is processed,
|
||||||
and so on. *)
|
and so on. *)
|
||||||
|
|
@ -118,19 +111,24 @@ module type S = sig
|
||||||
(** n-th element, or Not_found
|
(** n-th element, or Not_found
|
||||||
@raise Not_found if the generator contains less than [n] arguments *)
|
@raise Not_found if the generator contains less than [n] arguments *)
|
||||||
|
|
||||||
|
val take_nth : int -> 'a t -> 'a t
|
||||||
|
(** [take_nth n g] returns every element of [g] whose index
|
||||||
|
is a multiple of [n]. For instance [take_nth 2 (1--10) |> to_list]
|
||||||
|
will return [1;3;5;7;9] *)
|
||||||
|
|
||||||
val filter : ('a -> bool) -> 'a t -> 'a t
|
val filter : ('a -> bool) -> 'a t -> 'a t
|
||||||
(** Filter out elements that do not satisfy the predicate. *)
|
(** Filter out elements that do not satisfy the predicate. *)
|
||||||
|
|
||||||
val takeWhile : ('a -> bool) -> 'a t -> 'a t
|
val take_while : ('a -> bool) -> 'a t -> 'a t
|
||||||
(** Take elements while they satisfy the predicate *)
|
(** Take elements while they satisfy the predicate *)
|
||||||
|
|
||||||
val dropWhile : ('a -> bool) -> 'a t -> 'a t
|
val drop_while : ('a -> bool) -> 'a t -> 'a t
|
||||||
(** Drop elements while they satisfy the predicate *)
|
(** Drop elements while they satisfy the predicate *)
|
||||||
|
|
||||||
val filterMap : ('a -> 'b option) -> 'a t -> 'b t
|
val filter_map : ('a -> 'b option) -> 'a t -> 'b t
|
||||||
(** Maps some elements to 'b, drop the other ones *)
|
(** _maps some elements to 'b, drop the other ones *)
|
||||||
|
|
||||||
val zipIndex : 'a t -> (int * 'a) t
|
val zip_index : 'a t -> (int * 'a) t
|
||||||
(** Zip elements with their index in the enum *)
|
(** Zip elements with their index in the enum *)
|
||||||
|
|
||||||
val unzip : ('a * 'b) t -> 'a t * 'b t
|
val unzip : ('a * 'b) t -> 'a t * 'b t
|
||||||
|
|
@ -174,10 +172,13 @@ module type S = sig
|
||||||
(** {2 Multiple iterators} *)
|
(** {2 Multiple iterators} *)
|
||||||
|
|
||||||
val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
|
val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
|
||||||
|
(** map on the two sequences. Stops once one of them is exhausted.*)
|
||||||
|
|
||||||
val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit
|
val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit
|
||||||
|
(** Iterate on the two sequences. Stops once one of them is exhausted.*)
|
||||||
|
|
||||||
val fold2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc
|
val fold2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc
|
||||||
|
(** Fold the common prefix of the two iterators *)
|
||||||
|
|
||||||
val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
|
val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
|
||||||
(** Succeeds if all pairs of elements satisfy the predicate.
|
(** Succeeds if all pairs of elements satisfy the predicate.
|
||||||
|
|
@ -187,7 +188,7 @@ module type S = sig
|
||||||
(** Succeeds if some pair of elements satisfy the predicate.
|
(** Succeeds if some pair of elements satisfy the predicate.
|
||||||
Ignores elements of an iterator if the other runs dry. *)
|
Ignores elements of an iterator if the other runs dry. *)
|
||||||
|
|
||||||
val zipWith : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
|
val zip_with : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
|
||||||
(** Combine common part of the enums (stops when one is exhausted) *)
|
(** Combine common part of the enums (stops when one is exhausted) *)
|
||||||
|
|
||||||
val zip : 'a t -> 'b t -> ('a * 'b) t
|
val zip : 'a t -> 'b t -> ('a * 'b) t
|
||||||
|
|
@ -312,15 +313,33 @@ end
|
||||||
|
|
||||||
let empty () = None
|
let empty () = None
|
||||||
|
|
||||||
|
(*$T empty
|
||||||
|
empty |> to_list = []
|
||||||
|
*)
|
||||||
|
|
||||||
let singleton x =
|
let singleton x =
|
||||||
let first = ref true in
|
let first = ref true in
|
||||||
fun () ->
|
fun () ->
|
||||||
if !first then (first := false; Some x) else None
|
if !first then (first := false; Some x) else None
|
||||||
|
|
||||||
let rec repeat x () = Some x
|
(*T singleton
|
||||||
|
singleton 1 |> to_list = [1]
|
||||||
|
singleton "foo" |> to_list = ["foo"]
|
||||||
|
*)
|
||||||
|
|
||||||
|
let repeat x () = Some x
|
||||||
|
|
||||||
|
(*$T repeat
|
||||||
|
repeat 42 |> take 3 |> to_list = [42; 42; 42]
|
||||||
|
*)
|
||||||
|
|
||||||
let repeatedly f () = Some (f ())
|
let repeatedly f () = Some (f ())
|
||||||
|
|
||||||
|
(*$T repeatedly
|
||||||
|
repeatedly (let r = ref 0 in fun () -> incr r; !r) \
|
||||||
|
|> take 5 |> to_list = [1;2;3;4;5]
|
||||||
|
*)
|
||||||
|
|
||||||
let iterate x f =
|
let iterate x f =
|
||||||
let cur = ref x in
|
let cur = ref x in
|
||||||
fun () ->
|
fun () ->
|
||||||
|
|
@ -328,6 +347,10 @@ let iterate x f =
|
||||||
cur := f !cur;
|
cur := f !cur;
|
||||||
Some x
|
Some x
|
||||||
|
|
||||||
|
(*$T iterate
|
||||||
|
iterate 0 ((+)1) |> take 5 |> to_list = [0;1;2;3;4]
|
||||||
|
*)
|
||||||
|
|
||||||
let next gen = gen ()
|
let next gen = gen ()
|
||||||
|
|
||||||
let get gen = gen ()
|
let get gen = gen ()
|
||||||
|
|
@ -337,6 +360,14 @@ let get_exn gen =
|
||||||
| Some x -> x
|
| Some x -> x
|
||||||
| None -> raise (Invalid_argument "Gen.get_exn")
|
| None -> raise (Invalid_argument "Gen.get_exn")
|
||||||
|
|
||||||
|
(*$R get_exn
|
||||||
|
let g = of_list [1;2;3] in
|
||||||
|
assert_equal 1 (get_exn g);
|
||||||
|
assert_equal 2 (get_exn g);
|
||||||
|
assert_equal 3 (get_exn g);
|
||||||
|
assert_raises (Invalid_argument "Gen.get_exn") (fun () -> get_exn g)
|
||||||
|
*)
|
||||||
|
|
||||||
let junk gen = ignore (gen ())
|
let junk gen = ignore (gen ())
|
||||||
|
|
||||||
let rec fold f acc gen =
|
let rec fold f acc gen =
|
||||||
|
|
@ -344,6 +375,11 @@ let rec fold f acc gen =
|
||||||
| None -> acc
|
| None -> acc
|
||||||
| Some x -> fold f (f acc x) gen
|
| Some x -> fold f (f acc x) gen
|
||||||
|
|
||||||
|
(*$Q
|
||||||
|
(Q.list Q.small_int) (fun l -> \
|
||||||
|
of_list l |> fold (fun l x->x::l) [] = List.rev l)
|
||||||
|
*)
|
||||||
|
|
||||||
let reduce f g =
|
let reduce f g =
|
||||||
let acc = match g () with
|
let acc = match g () with
|
||||||
| None -> raise (Invalid_argument "reduce")
|
| None -> raise (Invalid_argument "reduce")
|
||||||
|
|
@ -361,6 +397,11 @@ let unfold f acc =
|
||||||
acc := acc';
|
acc := acc';
|
||||||
Some x
|
Some x
|
||||||
|
|
||||||
|
(*$T unfold
|
||||||
|
unfold (fun (prev,cur) -> Some (prev, (cur,prev+cur))) (0,1) \
|
||||||
|
|> take 7 |> to_list = [0; 1; 1; 2; 3; 5; 8]
|
||||||
|
*)
|
||||||
|
|
||||||
let init ?(limit=max_int) f =
|
let init ?(limit=max_int) f =
|
||||||
let r = ref 0 in
|
let r = ref 0 in
|
||||||
fun () ->
|
fun () ->
|
||||||
|
|
@ -371,6 +412,10 @@ let init ?(limit=max_int) f =
|
||||||
let _ = incr r in
|
let _ = incr r in
|
||||||
Some x
|
Some x
|
||||||
|
|
||||||
|
(*$T init
|
||||||
|
init ~limit:5 (fun i->i) |> to_list = [0;1;2;3;4]
|
||||||
|
*)
|
||||||
|
|
||||||
let rec iter f gen =
|
let rec iter f gen =
|
||||||
match gen() with
|
match gen() with
|
||||||
| None -> ()
|
| None -> ()
|
||||||
|
|
@ -387,9 +432,19 @@ let is_empty gen = match gen () with
|
||||||
| None -> true
|
| None -> true
|
||||||
| Some _ -> false
|
| Some _ -> false
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
is_empty empty
|
||||||
|
not (is_empty (singleton 2))
|
||||||
|
*)
|
||||||
|
|
||||||
let length gen =
|
let length gen =
|
||||||
fold (fun acc _ -> acc + 1) 0 gen
|
fold (fun acc _ -> acc + 1) 0 gen
|
||||||
|
|
||||||
|
(*$Q
|
||||||
|
(Q.list Q.small_int) (fun l -> \
|
||||||
|
of_list l |> length = List.length l)
|
||||||
|
*)
|
||||||
|
|
||||||
(* useful state *)
|
(* useful state *)
|
||||||
type 'a run_state =
|
type 'a run_state =
|
||||||
| Init
|
| Init
|
||||||
|
|
@ -412,10 +467,10 @@ let scan f acc g =
|
||||||
state := Run acc';
|
state := Run acc';
|
||||||
Some acc'
|
Some acc'
|
||||||
|
|
||||||
let rec iter2 f gen1 gen2 =
|
(*$T scan
|
||||||
match gen1(), gen2() with
|
scan (fun acc x -> x+1::acc) [] (1--5) |> to_list \
|
||||||
| Some x, Some y -> f x y; iter2 f gen1 gen2
|
= [[]; [2]; [3;2]; [4;3;2]; [5;4;3;2]; [6;5;4;3;2]]
|
||||||
| _ -> ()
|
*)
|
||||||
|
|
||||||
(** {3 Lazy} *)
|
(** {3 Lazy} *)
|
||||||
|
|
||||||
|
|
@ -427,6 +482,12 @@ let map f gen =
|
||||||
| None -> stop:= true; None
|
| None -> stop:= true; None
|
||||||
| Some x -> Some (f x)
|
| Some x -> Some (f x)
|
||||||
|
|
||||||
|
(*$Q map
|
||||||
|
(Q.list Q.small_int) (fun l -> \
|
||||||
|
let f x = x*2 in \
|
||||||
|
of_list l |> map f |> to_list = List.map f l)
|
||||||
|
*)
|
||||||
|
|
||||||
let append gen1 gen2 =
|
let append gen1 gen2 =
|
||||||
let first = ref true in
|
let first = ref true in
|
||||||
let rec next() =
|
let rec next() =
|
||||||
|
|
@ -437,6 +498,11 @@ let append gen1 gen2 =
|
||||||
else gen2()
|
else gen2()
|
||||||
in next
|
in next
|
||||||
|
|
||||||
|
(*$Q
|
||||||
|
(Q.pair (Q.list Q.small_int)(Q.list Q.small_int)) (fun (l1,l2) -> \
|
||||||
|
append (of_list l1) (of_list l2) |> to_list = l1 @ l2)
|
||||||
|
*)
|
||||||
|
|
||||||
let flatten next_gen =
|
let flatten next_gen =
|
||||||
let state = ref Init in
|
let state = ref Init in
|
||||||
(* get next element *)
|
(* get next element *)
|
||||||
|
|
@ -455,7 +521,7 @@ let flatten next_gen =
|
||||||
in
|
in
|
||||||
next
|
next
|
||||||
|
|
||||||
let flatMap f next_elem =
|
let flat_map f next_elem =
|
||||||
let state = ref Init in
|
let state = ref Init in
|
||||||
let rec next() =
|
let rec next() =
|
||||||
match !state with
|
match !state with
|
||||||
|
|
@ -474,6 +540,12 @@ let flatMap f next_elem =
|
||||||
in
|
in
|
||||||
next
|
next
|
||||||
|
|
||||||
|
(*$Q flat_map
|
||||||
|
(Q.list Q.small_int) (fun l -> \
|
||||||
|
let f x = of_list [x;x*2] in \
|
||||||
|
eq (map f (of_list l) |> flatten) (flat_map f (of_list l)))
|
||||||
|
*)
|
||||||
|
|
||||||
let mem ?(eq=(=)) x gen =
|
let mem ?(eq=(=)) x gen =
|
||||||
let rec mem eq x gen =
|
let rec mem eq x gen =
|
||||||
match gen() with
|
match gen() with
|
||||||
|
|
@ -491,6 +563,11 @@ let take n gen =
|
||||||
| None -> count := ~-1; None (* indicate stop *)
|
| None -> count := ~-1; None (* indicate stop *)
|
||||||
| (Some _) as x -> incr count; x
|
| (Some _) as x -> incr count; x
|
||||||
|
|
||||||
|
(*$Q
|
||||||
|
(Q.pair Q.small_int (Q.list Q.small_int)) (fun (n,l) -> \
|
||||||
|
of_list l |> take n |> length = Pervasives.min n (List.length l))
|
||||||
|
*)
|
||||||
|
|
||||||
(* call [gen] at most [n] times, and stop *)
|
(* call [gen] at most [n] times, and stop *)
|
||||||
let rec __drop n gen =
|
let rec __drop n gen =
|
||||||
if n = 0 then ()
|
if n = 0 then ()
|
||||||
|
|
@ -511,6 +588,12 @@ let drop n gen =
|
||||||
gen()
|
gen()
|
||||||
end
|
end
|
||||||
|
|
||||||
|
(*$Q
|
||||||
|
(Q.pair Q.small_int (Q.list Q.small_int)) (fun (n,l) -> \
|
||||||
|
let g1,g2 = take n (of_list l), drop n (of_list l) in \
|
||||||
|
append g1 g2 |> to_list = l)
|
||||||
|
*)
|
||||||
|
|
||||||
let nth n gen =
|
let nth n gen =
|
||||||
assert (n>=0);
|
assert (n>=0);
|
||||||
__drop n gen;
|
__drop n gen;
|
||||||
|
|
@ -518,6 +601,25 @@ let nth n gen =
|
||||||
| None -> raise Not_found
|
| None -> raise Not_found
|
||||||
| Some x -> x
|
| Some x -> x
|
||||||
|
|
||||||
|
(*$= nth & ~printer:string_of_int
|
||||||
|
4 (nth 4 (0--10))
|
||||||
|
8 (nth 8 (0--10))
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
(try ignore (nth 11 (1--10)); false with Not_found -> true)
|
||||||
|
*)
|
||||||
|
|
||||||
|
let take_nth n gen =
|
||||||
|
assert (n>=1);
|
||||||
|
let i = ref n in
|
||||||
|
let rec next() =
|
||||||
|
match gen() with
|
||||||
|
| None -> None
|
||||||
|
| (Some _) as res when !i = n -> i:=1; res
|
||||||
|
| Some _ -> incr i; next()
|
||||||
|
in next
|
||||||
|
|
||||||
let filter p gen =
|
let filter p gen =
|
||||||
let rec next () =
|
let rec next () =
|
||||||
(* wrap exception into option, for next to be tailrec *)
|
(* wrap exception into option, for next to be tailrec *)
|
||||||
|
|
@ -529,16 +631,23 @@ let filter p gen =
|
||||||
else next () (* discard element *)
|
else next () (* discard element *)
|
||||||
in next
|
in next
|
||||||
|
|
||||||
let takeWhile p gen =
|
(*$T
|
||||||
|
filter (fun x ->x mod 2 = 0) (1--10) |> to_list = [2;4;6;8;10]
|
||||||
|
*)
|
||||||
|
|
||||||
|
let take_while p gen =
|
||||||
let stop = ref false in
|
let stop = ref false in
|
||||||
let rec next () =
|
fun () ->
|
||||||
if !stop
|
if !stop
|
||||||
then None
|
then None
|
||||||
else match gen() with
|
else match gen() with
|
||||||
| (Some x) as res ->
|
| (Some x) as res ->
|
||||||
if p x then res else (stop := true; None)
|
if p x then res else (stop := true; None)
|
||||||
| None -> stop:=true; None
|
| None -> stop:=true; None
|
||||||
in next
|
|
||||||
|
(*$T
|
||||||
|
take_while (fun x ->x<10) (1--1000) |> eq (1--9)
|
||||||
|
*)
|
||||||
|
|
||||||
module DropWhileState = struct
|
module DropWhileState = struct
|
||||||
type t =
|
type t =
|
||||||
|
|
@ -547,9 +656,9 @@ module DropWhileState = struct
|
||||||
| Yield
|
| Yield
|
||||||
end
|
end
|
||||||
|
|
||||||
let dropWhile p gen =
|
let drop_while p gen =
|
||||||
let open DropWhileState in
|
let open DropWhileState in
|
||||||
let state = ref Stop in
|
let state = ref Drop in
|
||||||
let rec next () =
|
let rec next () =
|
||||||
match !state with
|
match !state with
|
||||||
| Stop -> None
|
| Stop -> None
|
||||||
|
|
@ -566,7 +675,11 @@ let dropWhile p gen =
|
||||||
end
|
end
|
||||||
in next
|
in next
|
||||||
|
|
||||||
let filterMap f gen =
|
(*$T
|
||||||
|
drop_while (fun x-> x<10) (1--20) |> eq (10--20)
|
||||||
|
*)
|
||||||
|
|
||||||
|
let filter_map f gen =
|
||||||
(* tailrec *)
|
(* tailrec *)
|
||||||
let rec next () =
|
let rec next () =
|
||||||
match gen() with
|
match gen() with
|
||||||
|
|
@ -577,7 +690,12 @@ let filterMap f gen =
|
||||||
| (Some _) as res -> res
|
| (Some _) as res -> res
|
||||||
in next
|
in next
|
||||||
|
|
||||||
let zipIndex gen =
|
(*$T
|
||||||
|
filter_map (fun x-> if x mod 2 = 0 then Some (string_of_int x) else None) (1--10) \
|
||||||
|
|> to_list = List.map string_of_int [2;4;6;8;10]
|
||||||
|
*)
|
||||||
|
|
||||||
|
let zip_index gen =
|
||||||
let r = ref ~-1 in
|
let r = ref ~-1 in
|
||||||
fun () ->
|
fun () ->
|
||||||
match gen() with
|
match gen() with
|
||||||
|
|
@ -586,6 +704,10 @@ let zipIndex gen =
|
||||||
incr r;
|
incr r;
|
||||||
Some (!r, x)
|
Some (!r, x)
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
zip_index (1--5) |> to_list = [0,1; 1,2; 2,3; 3,4; 4,5]
|
||||||
|
*)
|
||||||
|
|
||||||
let unzip gen =
|
let unzip gen =
|
||||||
let stop = ref false in
|
let stop = ref false in
|
||||||
let q1 = Queue.create () in
|
let q1 = Queue.create () in
|
||||||
|
|
@ -612,6 +734,17 @@ let unzip gen =
|
||||||
in
|
in
|
||||||
next_left, next_right
|
next_left, next_right
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
unzip (of_list [1,2;3,4]) |> (fun (x,y)-> to_list x, to_list y) \
|
||||||
|
= ([1;3], [2;4])
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*$Q
|
||||||
|
(Q.list (Q.pair Q.small_int Q.small_int)) (fun l -> \
|
||||||
|
of_list l |> unzip |> (fun (x,y) -> to_list x,to_list y) = \
|
||||||
|
List.split l)
|
||||||
|
*)
|
||||||
|
|
||||||
(* [partition p l] returns the elements that satisfy [p],
|
(* [partition p l] returns the elements that satisfy [p],
|
||||||
and the elements that do not satisfy [p] *)
|
and the elements that do not satisfy [p] *)
|
||||||
let partition p gen =
|
let partition p gen =
|
||||||
|
|
@ -637,6 +770,11 @@ let partition p gen =
|
||||||
in
|
in
|
||||||
nexttrue, nextfalse
|
nexttrue, nextfalse
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
partition (fun x -> x mod 2 = 0) (1--10) |> \
|
||||||
|
(fun (x,y)->to_list x, to_list y) = ([2;4;6;8;10], [1;3;5;7;9])
|
||||||
|
*)
|
||||||
|
|
||||||
let rec for_all p gen =
|
let rec for_all p gen =
|
||||||
match gen() with
|
match gen() with
|
||||||
| None -> true
|
| None -> true
|
||||||
|
|
@ -654,6 +792,11 @@ let min ?(lt=fun x y -> x < y) gen =
|
||||||
in
|
in
|
||||||
fold (fun min x -> if lt x min then x else min) first gen
|
fold (fun min x -> if lt x min then x else min) first gen
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
min (of_list [1;4;6;0;11; -2]) = ~-2
|
||||||
|
(try ignore (min empty); false with Invalid_argument _ -> true)
|
||||||
|
*)
|
||||||
|
|
||||||
let max ?(lt=fun x y -> x < y) gen =
|
let max ?(lt=fun x y -> x < y) gen =
|
||||||
let first = match gen () with
|
let first = match gen () with
|
||||||
| Some x -> x
|
| Some x -> x
|
||||||
|
|
@ -661,6 +804,11 @@ let max ?(lt=fun x y -> x < y) gen =
|
||||||
in
|
in
|
||||||
fold (fun max x -> if lt max x then x else max) first gen
|
fold (fun max x -> if lt max x then x else max) first gen
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
max (of_list [1;4;6;0;11; -2]) = 11
|
||||||
|
(try ignore (max empty); false with Invalid_argument _ -> true)
|
||||||
|
*)
|
||||||
|
|
||||||
let eq ?(eq=(=)) gen1 gen2 =
|
let eq ?(eq=(=)) gen1 gen2 =
|
||||||
let rec check () =
|
let rec check () =
|
||||||
match gen1(), gen2() with
|
match gen1(), gen2() with
|
||||||
|
|
@ -670,6 +818,11 @@ let eq ?(eq=(=)) gen1 gen2 =
|
||||||
in
|
in
|
||||||
check ()
|
check ()
|
||||||
|
|
||||||
|
(*$Q
|
||||||
|
(Q.pair (Q.list Q.small_int)(Q.list Q.small_int)) (fun (l1,l2) -> \
|
||||||
|
eq (of_list l1)(of_list l2) = (l1 = l2))
|
||||||
|
*)
|
||||||
|
|
||||||
let lexico ?(cmp=Pervasives.compare) gen1 gen2 =
|
let lexico ?(cmp=Pervasives.compare) gen1 gen2 =
|
||||||
let rec lexico () =
|
let rec lexico () =
|
||||||
match gen1(), gen2() with
|
match gen1(), gen2() with
|
||||||
|
|
@ -683,17 +836,32 @@ let lexico ?(cmp=Pervasives.compare) gen1 gen2 =
|
||||||
|
|
||||||
let compare ?cmp gen1 gen2 = lexico ?cmp gen1 gen2
|
let compare ?cmp gen1 gen2 = lexico ?cmp gen1 gen2
|
||||||
|
|
||||||
|
(*$Q
|
||||||
|
(Q.pair (Q.list Q.small_int)(Q.list Q.small_int)) (fun (l1,l2) -> \
|
||||||
|
let sign x = if x < 0 then -1 else if x=0 then 0 else 1 in \
|
||||||
|
sign (compare (of_list l1)(of_list l2)) = sign (Pervasives.compare l1 l2))
|
||||||
|
*)
|
||||||
|
|
||||||
let rec find p e = match e () with
|
let rec find p e = match e () with
|
||||||
| None -> None
|
| None -> None
|
||||||
| Some x when p x -> Some x
|
| Some x when p x -> Some x
|
||||||
| Some _ -> find p e
|
| Some _ -> find p e
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
find (fun x -> x>=5) (1--10) = Some 5
|
||||||
|
find (fun x -> x>5) (1--4) = None
|
||||||
|
*)
|
||||||
|
|
||||||
let sum e =
|
let sum e =
|
||||||
let rec sum acc = match e() with
|
let rec sum acc = match e() with
|
||||||
| None -> acc
|
| None -> acc
|
||||||
| Some x -> sum (x+acc)
|
| Some x -> sum (x+acc)
|
||||||
in sum 0
|
in sum 0
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
sum (1--10) = 55
|
||||||
|
*)
|
||||||
|
|
||||||
(** {2 Multiple Iterators} *)
|
(** {2 Multiple Iterators} *)
|
||||||
|
|
||||||
let map2 f e1 e2 =
|
let map2 f e1 e2 =
|
||||||
|
|
@ -701,11 +869,20 @@ let map2 f e1 e2 =
|
||||||
| Some x, Some y -> Some (f x y)
|
| Some x, Some y -> Some (f x y)
|
||||||
| _ -> None
|
| _ -> None
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
map2 (+) (1--5) (1--4) |> eq (of_list [2;4;6;8])
|
||||||
|
map2 (+) (1--5) (repeat 0) |> eq (1--5)
|
||||||
|
*)
|
||||||
|
|
||||||
let rec iter2 f e1 e2 =
|
let rec iter2 f e1 e2 =
|
||||||
match e1(), e2() with
|
match e1(), e2() with
|
||||||
| Some x, Some y -> f x y; iter2 f e1 e2
|
| Some x, Some y -> f x y; iter2 f e1 e2
|
||||||
| _ -> ()
|
| _ -> ()
|
||||||
|
|
||||||
|
(*$T iter2
|
||||||
|
let r = ref 0 in iter2 (fun _ _ -> incr r) (1--10) (4--6); !r = 3
|
||||||
|
*)
|
||||||
|
|
||||||
let rec fold2 f acc e1 e2 =
|
let rec fold2 f acc e1 e2 =
|
||||||
match e1(), e2() with
|
match e1(), e2() with
|
||||||
| Some x, Some y -> fold2 f (f acc x y) e1 e2
|
| Some x, Some y -> fold2 f (f acc x y) e1 e2
|
||||||
|
|
@ -721,7 +898,7 @@ let rec exists2 p e1 e2 =
|
||||||
| Some x, Some y -> p x y || exists2 p e1 e2
|
| Some x, Some y -> p x y || exists2 p e1 e2
|
||||||
| _ -> false
|
| _ -> false
|
||||||
|
|
||||||
let zipWith f a b =
|
let zip_with f a b =
|
||||||
let stop = ref false in
|
let stop = ref false in
|
||||||
fun () ->
|
fun () ->
|
||||||
if !stop then None
|
if !stop then None
|
||||||
|
|
@ -729,7 +906,13 @@ let zipWith f a b =
|
||||||
| Some xa, Some xb -> Some (f xa xb)
|
| Some xa, Some xb -> Some (f xa xb)
|
||||||
| _ -> stop:=true; None
|
| _ -> stop:=true; None
|
||||||
|
|
||||||
let zip a b = zipWith (fun x y -> x,y) a b
|
let zip a b = zip_with (fun x y -> x,y) a b
|
||||||
|
|
||||||
|
(*$Q
|
||||||
|
(Q.list Q.small_int) (fun l -> \
|
||||||
|
zip_with (fun x y->x,y) (of_list l) (of_list l) \
|
||||||
|
|> unzip |> fst |> to_list = l)
|
||||||
|
*)
|
||||||
|
|
||||||
(** {3 Complex combinators} *)
|
(** {3 Complex combinators} *)
|
||||||
|
|
||||||
|
|
@ -746,7 +929,6 @@ module MergeState = struct
|
||||||
| Stop
|
| Stop
|
||||||
end
|
end
|
||||||
|
|
||||||
(* TODO tests *)
|
|
||||||
(* state machine:
|
(* state machine:
|
||||||
(NewGen -> YieldAndNew)* // then no more generators in next_gen, so
|
(NewGen -> YieldAndNew)* // then no more generators in next_gen, so
|
||||||
-> Yield* -> Stop *)
|
-> Yield* -> Stop *)
|
||||||
|
|
@ -792,6 +974,11 @@ let merge next_gen =
|
||||||
end
|
end
|
||||||
in next
|
in next
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
merge (of_list [of_list [1;3;5]; of_list [2;4;6]; of_list [7;8;9]]) \
|
||||||
|
|> to_list |> List.sort Pervasives.compare = [1;2;3;4;5;6;7;8;9]
|
||||||
|
*)
|
||||||
|
|
||||||
let intersection ?(cmp=Pervasives.compare) gen1 gen2 =
|
let intersection ?(cmp=Pervasives.compare) gen1 gen2 =
|
||||||
let x1 = ref (gen1 ()) in
|
let x1 = ref (gen1 ()) in
|
||||||
let x2 = ref (gen2 ()) in
|
let x2 = ref (gen2 ()) in
|
||||||
|
|
@ -808,6 +995,11 @@ let intersection ?(cmp=Pervasives.compare) gen1 gen2 =
|
||||||
| _ -> None
|
| _ -> None
|
||||||
in next
|
in next
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
intersection (of_list [1;1;2;3;4;8]) (of_list [1;2;4;5;6;7;8;9]) \
|
||||||
|
|> to_list = [1;2;4;8]
|
||||||
|
*)
|
||||||
|
|
||||||
let sorted_merge ?(cmp=Pervasives.compare) gen1 gen2 =
|
let sorted_merge ?(cmp=Pervasives.compare) gen1 gen2 =
|
||||||
let x1 = ref (gen1 ()) in
|
let x1 = ref (gen1 ()) in
|
||||||
let x2 = ref (gen2 ()) in
|
let x2 = ref (gen2 ()) in
|
||||||
|
|
@ -825,6 +1017,11 @@ let sorted_merge ?(cmp=Pervasives.compare) gen1 gen2 =
|
||||||
x2 := gen2 ();
|
x2 := gen2 ();
|
||||||
r
|
r
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
sorted_merge (of_list [1;2;2;3;5;10;100]) (of_list [2;4;5;6;11]) \
|
||||||
|
|> to_list = [1;2;2;2;3;4;5;5;6;10;11;100]
|
||||||
|
*)
|
||||||
|
|
||||||
(** {4 Mutable heap (taken from heap.ml to avoid dependencies)} *)
|
(** {4 Mutable heap (taken from heap.ml to avoid dependencies)} *)
|
||||||
module Heap = struct
|
module Heap = struct
|
||||||
type 'a t = {
|
type 'a t = {
|
||||||
|
|
@ -884,6 +1081,11 @@ let sorted_merge_n ?(cmp=Pervasives.compare) l =
|
||||||
| None -> Some x (* gen empty, drop it *)
|
| None -> Some x (* gen empty, drop it *)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
sorted_merge_n [of_list [1;2;2;3;5;10;100]; of_list [2;4;5;6;11]; (6--10)] \
|
||||||
|
|> to_list = [1;2;2;2;3;4;5;5;6;6;7;8;9;10;10;11;100]
|
||||||
|
*)
|
||||||
|
|
||||||
let round_robin ?(n=2) gen =
|
let round_robin ?(n=2) gen =
|
||||||
(* array of queues, together with their index *)
|
(* array of queues, together with their index *)
|
||||||
let qs = Array.init n (fun i -> Queue.create ()) in
|
let qs = Array.init n (fun i -> Queue.create ()) in
|
||||||
|
|
@ -916,6 +1118,11 @@ let round_robin ?(n=2) gen =
|
||||||
let l = Array.mapi (fun i _ -> (fun () -> next i)) qs in
|
let l = Array.mapi (fun i _ -> (fun () -> next i)) qs in
|
||||||
Array.to_list l
|
Array.to_list l
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
round_robin ~n:3 (1--12) |> List.map to_list = \
|
||||||
|
[[1;4;7;10]; [2;5;8;11]; [3;6;9;12]]
|
||||||
|
*)
|
||||||
|
|
||||||
(* Duplicate the enum into [n] generators (default 2). The generators
|
(* Duplicate the enum into [n] generators (default 2). The generators
|
||||||
share the same underlying instance of the enum, so the optimal case is
|
share the same underlying instance of the enum, so the optimal case is
|
||||||
when they are consumed evenly *)
|
when they are consumed evenly *)
|
||||||
|
|
@ -943,6 +1150,12 @@ let tee ?(n=2) gen =
|
||||||
let l = Array.mapi (fun i _ -> (fun () -> next i)) qs in
|
let l = Array.mapi (fun i _ -> (fun () -> next i)) qs in
|
||||||
Array.to_list l
|
Array.to_list l
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
tee ~n:3 (1--12) |> List.map to_list = \
|
||||||
|
[to_list (1--12); to_list (1--12); to_list (1--12)]
|
||||||
|
*)
|
||||||
|
|
||||||
|
|
||||||
module InterleaveState = struct
|
module InterleaveState = struct
|
||||||
type 'a t =
|
type 'a t =
|
||||||
| Only of 'a gen
|
| Only of 'a gen
|
||||||
|
|
@ -971,6 +1184,11 @@ let interleave gen_a gen_b =
|
||||||
res
|
res
|
||||||
in next
|
in next
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
interleave (repeat 0) (1--5) |> take 10 |> to_list = \
|
||||||
|
[0;1;0;2;0;3;0;4;0;5]
|
||||||
|
*)
|
||||||
|
|
||||||
module IntersperseState = struct
|
module IntersperseState = struct
|
||||||
type 'a t =
|
type 'a t =
|
||||||
| Start
|
| Start
|
||||||
|
|
@ -1000,6 +1218,10 @@ let intersperse x gen =
|
||||||
| Some _ as res -> state := YieldElem res; next()
|
| Some _ as res -> state := YieldElem res; next()
|
||||||
in next
|
in next
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
intersperse 0 (1--5) |> to_list = [1;0;2;0;3;0;4;0;5]
|
||||||
|
*)
|
||||||
|
|
||||||
(* Cartesian product *)
|
(* Cartesian product *)
|
||||||
let product gena genb =
|
let product gena genb =
|
||||||
let all_a = ref [] in
|
let all_a = ref [] in
|
||||||
|
|
@ -1040,6 +1262,12 @@ let product gena genb =
|
||||||
in
|
in
|
||||||
next
|
next
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
product (1--3) (of_list ["a"; "b"]) |> to_list \
|
||||||
|
|> List.sort Pervasives.compare = \
|
||||||
|
[1, "a"; 1, "b"; 2, "a"; 2, "b"; 3, "a"; 3, "b"]
|
||||||
|
*)
|
||||||
|
|
||||||
(* Group equal consecutive elements together. *)
|
(* Group equal consecutive elements together. *)
|
||||||
let group ?(eq=(=)) gen =
|
let group ?(eq=(=)) gen =
|
||||||
match gen() with
|
match gen() with
|
||||||
|
|
@ -1062,6 +1290,11 @@ let group ?(eq=(=)) gen =
|
||||||
Some l
|
Some l
|
||||||
in next
|
in next
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
group (of_list [0;0;0;1;0;2;2;3;4;5;5;5;5;10]) |> to_list = \
|
||||||
|
[[0;0;0];[1];[0];[2;2];[3];[4];[5;5;5;5];[10]]
|
||||||
|
*)
|
||||||
|
|
||||||
let uniq ?(eq=(=)) gen =
|
let uniq ?(eq=(=)) gen =
|
||||||
let state = ref Init in
|
let state = ref Init in
|
||||||
let rec next() = match !state with
|
let rec next() = match !state with
|
||||||
|
|
@ -1081,6 +1314,11 @@ let uniq ?(eq=(=)) gen =
|
||||||
end
|
end
|
||||||
in next
|
in next
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
uniq (of_list [0;0;0;1;0;2;2;3;4;5;5;5;5;10]) |> to_list = \
|
||||||
|
[0;1;0;2;3;4;5;10]
|
||||||
|
*)
|
||||||
|
|
||||||
let sort ?(cmp=Pervasives.compare) gen =
|
let sort ?(cmp=Pervasives.compare) gen =
|
||||||
(* build heap *)
|
(* build heap *)
|
||||||
let h = Heap.empty ~cmp in
|
let h = Heap.empty ~cmp in
|
||||||
|
|
@ -1089,22 +1327,32 @@ let sort ?(cmp=Pervasives.compare) gen =
|
||||||
if Heap.is_empty h
|
if Heap.is_empty h
|
||||||
then None
|
then None
|
||||||
else Some (Heap.pop h)
|
else Some (Heap.pop h)
|
||||||
|
(*$T
|
||||||
|
sort (of_list [0;0;0;1;0;2;2;3;4;5;5;5;-42;5;10]) |> to_list = \
|
||||||
|
[-42;0;0;0;0;1;2;2;3;4;5;5;5;5;10]
|
||||||
|
*)
|
||||||
|
|
||||||
|
|
||||||
(* NOTE: using a set is not really possible, because once we have built the
|
(* NOTE: using a set is not really possible, because once we have built the
|
||||||
set there is no simple way to iterate on it *)
|
set there is no simple way to iterate on it *)
|
||||||
let sort_uniq ?(cmp=Pervasives.compare) gen =
|
let sort_uniq ?(cmp=Pervasives.compare) gen =
|
||||||
uniq ~eq:(fun x y -> cmp x y = 0) (sort ~cmp gen)
|
uniq ~eq:(fun x y -> cmp x y = 0) (sort ~cmp gen)
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
sort_uniq (of_list [0;0;0;1;0;2;2;3;4;5;42;5;5;42;5;10]) |> to_list = \
|
||||||
|
[0;1;2;3;4;5;10;42]
|
||||||
|
*)
|
||||||
|
|
||||||
let chunks n e =
|
let chunks n e =
|
||||||
let rec next () =
|
let rec next () =
|
||||||
match e() with
|
match e() with
|
||||||
| None -> None
|
| None -> None
|
||||||
| Some x ->
|
| Some x ->
|
||||||
let a = Array.make n x in
|
let a = Array.make n x in
|
||||||
fill a (n-1)
|
fill a 1
|
||||||
|
|
||||||
and fill a i =
|
and fill a i =
|
||||||
(* fill the array. [i] elements remain to fill *)
|
(* fill the array. [i]: current index to fill *)
|
||||||
if i = n
|
if i = n
|
||||||
then Some a
|
then Some a
|
||||||
else match e() with
|
else match e() with
|
||||||
|
|
@ -1115,6 +1363,11 @@ let chunks n e =
|
||||||
in
|
in
|
||||||
next
|
next
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
chunks 25 (0--100) |> map Array.to_list |> to_list = \
|
||||||
|
List.map to_list [(0--24); (25--49);(50--74);(75--99);(100--100)]
|
||||||
|
*)
|
||||||
|
|
||||||
(*
|
(*
|
||||||
let permutations enum =
|
let permutations enum =
|
||||||
failwith "not implemented" (* TODO *)
|
failwith "not implemented" (* TODO *)
|
||||||
|
|
@ -1139,10 +1392,18 @@ let of_list l =
|
||||||
let to_rev_list gen =
|
let to_rev_list gen =
|
||||||
fold (fun acc x -> x :: acc) [] gen
|
fold (fun acc x -> x :: acc) [] gen
|
||||||
|
|
||||||
|
(*$Q
|
||||||
|
(Q.list Q.small_int) (fun l -> \
|
||||||
|
to_rev_list (of_list l) = List.rev l)
|
||||||
|
*)
|
||||||
|
|
||||||
let to_list gen = List.rev (to_rev_list gen)
|
let to_list gen = List.rev (to_rev_list gen)
|
||||||
|
|
||||||
let to_array gen =
|
let to_array gen =
|
||||||
let l = to_rev_list gen in
|
let l = to_rev_list gen in
|
||||||
|
match l with
|
||||||
|
| [] -> [| |]
|
||||||
|
| _ ->
|
||||||
let a = Array.of_list l in
|
let a = Array.of_list l in
|
||||||
let n = Array.length a in
|
let n = Array.length a in
|
||||||
(* reverse array *)
|
(* reverse array *)
|
||||||
|
|
@ -1163,6 +1424,11 @@ let of_array ?(start=0) ?len a =
|
||||||
then None
|
then None
|
||||||
else (let x = a.(!i) in incr i; Some x)
|
else (let x = a.(!i) in incr i; Some x)
|
||||||
|
|
||||||
|
(*$Q
|
||||||
|
(Q.array Q.small_int) (fun a -> \
|
||||||
|
of_array a |> to_array = a)
|
||||||
|
*)
|
||||||
|
|
||||||
let rand_int i =
|
let rand_int i =
|
||||||
repeatedly (fun () -> Random.int i)
|
repeatedly (fun () -> Random.int i)
|
||||||
|
|
||||||
|
|
@ -1200,7 +1466,7 @@ let pp ?(start="") ?(stop="") ?(sep=",") ?(horizontal=false) pp_elem formatter g
|
||||||
module Infix = struct
|
module Infix = struct
|
||||||
let (--) = int_range
|
let (--) = int_range
|
||||||
|
|
||||||
let (>>=) x f = flatMap f x
|
let (>>=) x f = flat_map f x
|
||||||
end
|
end
|
||||||
|
|
||||||
include Infix
|
include Infix
|
||||||
|
|
@ -1221,8 +1487,6 @@ module Restart = struct
|
||||||
|
|
||||||
let repeat x () = repeat x
|
let repeat x () = repeat x
|
||||||
|
|
||||||
let repeatedly f () = repeatedly f
|
|
||||||
|
|
||||||
let unfold f acc () = unfold f acc
|
let unfold f acc () = unfold f acc
|
||||||
|
|
||||||
let init ?limit f () = init ?limit f
|
let init ?limit f () = init ?limit f
|
||||||
|
|
@ -1257,7 +1521,7 @@ module Restart = struct
|
||||||
|
|
||||||
let flatten e () = flatten (e ())
|
let flatten e () = flatten (e ())
|
||||||
|
|
||||||
let flatMap f e () = flatMap f (e ())
|
let flat_map f e () = flat_map f (e ())
|
||||||
|
|
||||||
let mem ?eq x e = mem ?eq x (e ())
|
let mem ?eq x e = mem ?eq x (e ())
|
||||||
|
|
||||||
|
|
@ -1267,19 +1531,21 @@ module Restart = struct
|
||||||
|
|
||||||
let nth n e = nth n (e ())
|
let nth n e = nth n (e ())
|
||||||
|
|
||||||
|
let take_nth n e () = take_nth n (e ())
|
||||||
|
|
||||||
let filter p e () = filter p (e ())
|
let filter p e () = filter p (e ())
|
||||||
|
|
||||||
let takeWhile p e () = takeWhile p (e ())
|
let take_while p e () = take_while p (e ())
|
||||||
|
|
||||||
let dropWhile p e () = dropWhile p (e ())
|
let drop_while p e () = drop_while p (e ())
|
||||||
|
|
||||||
let filterMap f e () = filterMap f (e ())
|
let filter_map f e () = filter_map f (e ())
|
||||||
|
|
||||||
let zipWith f e1 e2 () = zipWith f (e1 ()) (e2 ())
|
let zip_with f e1 e2 () = zip_with f (e1 ()) (e2 ())
|
||||||
|
|
||||||
let zip e1 e2 () = zip (e1 ()) (e2 ())
|
let zip e1 e2 () = zip (e1 ()) (e2 ())
|
||||||
|
|
||||||
let zipIndex e () = zipIndex (e ())
|
let zip_index e () = zip_index (e ())
|
||||||
|
|
||||||
let unzip e = map fst e, map snd e
|
let unzip e = map fst e, map snd e
|
||||||
|
|
||||||
|
|
@ -1373,7 +1639,7 @@ module Restart = struct
|
||||||
module Infix = struct
|
module Infix = struct
|
||||||
let (--) = int_range
|
let (--) = int_range
|
||||||
|
|
||||||
let (>>=) x f = flatMap f x
|
let (>>=) x f = flat_map f x
|
||||||
end
|
end
|
||||||
|
|
||||||
include Infix
|
include Infix
|
||||||
|
|
@ -1386,53 +1652,65 @@ end
|
||||||
|
|
||||||
let start g = g ()
|
let start g = g ()
|
||||||
|
|
||||||
(** {4 Mutable double-linked list, similar to {! Deque.t} *)
|
(** {6 Unrolled mutable list} *)
|
||||||
module MList = struct
|
module MList = struct
|
||||||
type 'a t = 'a node option ref
|
type 'a node =
|
||||||
and 'a node = {
|
| Nil
|
||||||
content : 'a;
|
| Cons of 'a array * int ref * 'a node ref
|
||||||
mutable prev : 'a node;
|
|
||||||
mutable next : 'a node;
|
|
||||||
}
|
|
||||||
|
|
||||||
let create () = ref None
|
let of_gen gen =
|
||||||
|
let start = ref Nil in
|
||||||
|
let chunk_size = ref 8 in
|
||||||
|
(* fill the list. prev: tail-reference from previous node,
|
||||||
|
* cur: current list node *)
|
||||||
|
let rec fill prev cur =
|
||||||
|
match cur, gen() with
|
||||||
|
| _, None -> prev := cur; () (* done *)
|
||||||
|
| Nil, Some x ->
|
||||||
|
let n = !chunk_size in
|
||||||
|
if n < 4096 then chunk_size := 2 * !chunk_size;
|
||||||
|
fill prev (Cons (Array.make n x, ref 1, ref Nil))
|
||||||
|
| Cons (a, n, next), Some x ->
|
||||||
|
assert (!n < Array.length a);
|
||||||
|
a.(!n) <- x;
|
||||||
|
incr n;
|
||||||
|
if !n = Array.length a
|
||||||
|
then begin
|
||||||
|
prev := cur;
|
||||||
|
fill next Nil
|
||||||
|
end else fill prev cur
|
||||||
|
in
|
||||||
|
fill start !start ;
|
||||||
|
!start
|
||||||
|
|
||||||
let is_empty d =
|
let to_gen l () =
|
||||||
match !d with
|
let cur = ref l in
|
||||||
| None -> true
|
let i = ref 0 in
|
||||||
| Some _ -> false
|
let rec next() = match !cur with
|
||||||
|
| Nil -> None
|
||||||
let push_back d x =
|
| Cons (a,n,l') ->
|
||||||
match !d with
|
if !i = !n
|
||||||
| None ->
|
then begin
|
||||||
let rec elt = {
|
cur := !l';
|
||||||
content = x; prev = elt; next = elt; } in
|
i := 0;
|
||||||
d := Some elt
|
next()
|
||||||
| Some first ->
|
end else begin
|
||||||
let elt = { content = x; next=first; prev=first.prev; } in
|
let y = a.(!i) in
|
||||||
first.prev.next <- elt;
|
incr i;
|
||||||
first.prev <- elt
|
Some y
|
||||||
|
|
||||||
(* conversion to enum *)
|
|
||||||
let to_enum d =
|
|
||||||
fun () ->
|
|
||||||
match !d with
|
|
||||||
| None -> (fun () -> None)
|
|
||||||
| Some first ->
|
|
||||||
let cur = ref first in (* current element of the list *)
|
|
||||||
let stop = ref false in (* are we done yet? *)
|
|
||||||
fun () ->
|
|
||||||
if !stop then None
|
|
||||||
else begin
|
|
||||||
let x = (!cur).content in
|
|
||||||
cur := (!cur).next;
|
|
||||||
(if !cur == first then stop := true); (* EOG, we made a full cycle *)
|
|
||||||
Some x
|
|
||||||
end
|
end
|
||||||
|
in
|
||||||
|
next
|
||||||
end
|
end
|
||||||
|
|
||||||
(** Store content of the generator in an enum *)
|
(** Store content of the generator in an enum *)
|
||||||
let persistent gen =
|
let persistent gen =
|
||||||
let l = MList.create () in
|
let l = MList.of_gen gen in
|
||||||
iter (MList.push_back l) gen;
|
MList.to_gen l
|
||||||
MList.to_enum l
|
|
||||||
|
(*$T
|
||||||
|
let g = 1--10 in let g' = persistent g in \
|
||||||
|
Restart.to_list g' = Restart.to_list g'
|
||||||
|
let g = 1--10 in let g' = persistent g in \
|
||||||
|
Restart.to_list g' = [1;2;3;4;5;6;7;8;9;10]
|
||||||
|
*)
|
||||||
|
|
|
||||||
|
|
@ -109,7 +109,7 @@ module type S = sig
|
||||||
val flatten : 'a gen t -> 'a t
|
val flatten : 'a gen t -> 'a t
|
||||||
(** Flatten the enumeration of generators *)
|
(** Flatten the enumeration of generators *)
|
||||||
|
|
||||||
val flatMap : ('a -> 'b gen) -> 'a t -> 'b t
|
val flat_map : ('a -> 'b gen) -> 'a t -> 'b t
|
||||||
(** Monadic bind; each element is transformed to a sub-enum
|
(** Monadic bind; each element is transformed to a sub-enum
|
||||||
which is then iterated on, before the next element is processed,
|
which is then iterated on, before the next element is processed,
|
||||||
and so on. *)
|
and so on. *)
|
||||||
|
|
@ -127,19 +127,24 @@ module type S = sig
|
||||||
(** n-th element, or Not_found
|
(** n-th element, or Not_found
|
||||||
@raise Not_found if the generator contains less than [n] arguments *)
|
@raise Not_found if the generator contains less than [n] arguments *)
|
||||||
|
|
||||||
|
val take_nth : int -> 'a t -> 'a t
|
||||||
|
(** [take_nth n g] returns every element of [g] whose index
|
||||||
|
is a multiple of [n]. For instance [take_nth 2 (1--10) |> to_list]
|
||||||
|
will return [1;3;5;7;9] *)
|
||||||
|
|
||||||
val filter : ('a -> bool) -> 'a t -> 'a t
|
val filter : ('a -> bool) -> 'a t -> 'a t
|
||||||
(** Filter out elements that do not satisfy the predicate. *)
|
(** Filter out elements that do not satisfy the predicate. *)
|
||||||
|
|
||||||
val takeWhile : ('a -> bool) -> 'a t -> 'a t
|
val take_while : ('a -> bool) -> 'a t -> 'a t
|
||||||
(** Take elements while they satisfy the predicate *)
|
(** Take elements while they satisfy the predicate *)
|
||||||
|
|
||||||
val dropWhile : ('a -> bool) -> 'a t -> 'a t
|
val drop_while : ('a -> bool) -> 'a t -> 'a t
|
||||||
(** Drop elements while they satisfy the predicate *)
|
(** Drop elements while they satisfy the predicate *)
|
||||||
|
|
||||||
val filterMap : ('a -> 'b option) -> 'a t -> 'b t
|
val filter_map : ('a -> 'b option) -> 'a t -> 'b t
|
||||||
(** Maps some elements to 'b, drop the other ones *)
|
(** Maps some elements to 'b, drop the other ones *)
|
||||||
|
|
||||||
val zipIndex : 'a t -> (int * 'a) t
|
val zip_index : 'a t -> (int * 'a) t
|
||||||
(** Zip elements with their index in the enum *)
|
(** Zip elements with their index in the enum *)
|
||||||
|
|
||||||
val unzip : ('a * 'b) t -> 'a t * 'b t
|
val unzip : ('a * 'b) t -> 'a t * 'b t
|
||||||
|
|
@ -199,7 +204,7 @@ module type S = sig
|
||||||
(** Succeeds if some pair of elements satisfy the predicate.
|
(** Succeeds if some pair of elements satisfy the predicate.
|
||||||
Ignores elements of an iterator if the other runs dry. *)
|
Ignores elements of an iterator if the other runs dry. *)
|
||||||
|
|
||||||
val zipWith : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
|
val zip_with : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
|
||||||
(** Combine common part of the enums (stops when one is exhausted) *)
|
(** Combine common part of the enums (stops when one is exhausted) *)
|
||||||
|
|
||||||
val zip : 'a t -> 'b t -> ('a * 'b) t
|
val zip : 'a t -> 'b t -> ('a * 'b) t
|
||||||
|
|
|
||||||
|
|
@ -74,9 +74,6 @@ let rec equal f l1 l2 = match l1, l2 with
|
||||||
| [], _ | _, [] -> false
|
| [], _ | _, [] -> false
|
||||||
| x1::l1', x2::l2' -> f x1 x2 && equal f l1' l2'
|
| x1::l1', x2::l2' -> f x1 x2 && equal f l1' l2'
|
||||||
|
|
||||||
(* difference list *)
|
|
||||||
type 'a dlist = 'a list -> 'a list
|
|
||||||
|
|
||||||
(* append difference lists *)
|
(* append difference lists *)
|
||||||
let _d_append f1 f2 =
|
let _d_append f1 f2 =
|
||||||
fun l -> f1 (f2 l)
|
fun l -> f1 (f2 l)
|
||||||
|
|
@ -290,7 +287,7 @@ module Idx = struct
|
||||||
Idx.insert [1;2;3] 1 10 = [1;10;2;3]
|
Idx.insert [1;2;3] 1 10 = [1;10;2;3]
|
||||||
*)
|
*)
|
||||||
|
|
||||||
let rec remove l0 i =
|
let remove l0 i =
|
||||||
let rec aux l acc i = match l with
|
let rec aux l acc i = match l with
|
||||||
| [] -> l0
|
| [] -> l0
|
||||||
| _::l' when i=0 -> List.rev_append acc l'
|
| _::l' when i=0 -> List.rev_append acc l'
|
||||||
|
|
@ -383,6 +380,7 @@ end
|
||||||
type 'a sequence = ('a -> unit) -> unit
|
type 'a sequence = ('a -> unit) -> unit
|
||||||
type 'a gen = unit -> 'a option
|
type 'a gen = unit -> 'a option
|
||||||
type 'a printer = Buffer.t -> 'a -> unit
|
type 'a printer = Buffer.t -> 'a -> unit
|
||||||
|
type 'a formatter = Format.formatter -> 'a -> unit
|
||||||
|
|
||||||
let to_seq l k = List.iter k l
|
let to_seq l k = List.iter k l
|
||||||
let of_seq seq =
|
let of_seq seq =
|
||||||
|
|
@ -425,3 +423,14 @@ let pp ?(start="[") ?(stop="]") ?(sep=", ") pp_item buf l =
|
||||||
(*$T
|
(*$T
|
||||||
CCPrint.to_string (pp CCPrint.int) [1;2;3] = "[1, 2, 3]"
|
CCPrint.to_string (pp CCPrint.int) [1;2;3] = "[1, 2, 3]"
|
||||||
*)
|
*)
|
||||||
|
|
||||||
|
let print ?(start="[") ?(stop="]") ?(sep=", ") pp_item fmt l =
|
||||||
|
let rec print fmt l = match l with
|
||||||
|
| x::((y::xs) as l) ->
|
||||||
|
pp_item fmt x;
|
||||||
|
Format.pp_print_string fmt sep;
|
||||||
|
print fmt l
|
||||||
|
| x::[] -> pp_item fmt x
|
||||||
|
| [] -> ()
|
||||||
|
in
|
||||||
|
Format.fprintf fmt "@[%s%a%s@]" start print l stop
|
||||||
|
|
|
||||||
|
|
@ -172,6 +172,7 @@ end
|
||||||
type 'a sequence = ('a -> unit) -> unit
|
type 'a sequence = ('a -> unit) -> unit
|
||||||
type 'a gen = unit -> 'a option
|
type 'a gen = unit -> 'a option
|
||||||
type 'a printer = Buffer.t -> 'a -> unit
|
type 'a printer = Buffer.t -> 'a -> unit
|
||||||
|
type 'a formatter = Format.formatter -> 'a -> unit
|
||||||
|
|
||||||
val to_seq : 'a t -> 'a sequence
|
val to_seq : 'a t -> 'a sequence
|
||||||
val of_seq : 'a sequence -> 'a t
|
val of_seq : 'a sequence -> 'a t
|
||||||
|
|
@ -183,3 +184,6 @@ val of_gen : 'a gen -> 'a t
|
||||||
|
|
||||||
val pp : ?start:string -> ?stop:string -> ?sep:string ->
|
val pp : ?start:string -> ?stop:string -> ?sep:string ->
|
||||||
'a printer -> 'a t printer
|
'a printer -> 'a t printer
|
||||||
|
|
||||||
|
val print : ?start:string -> ?stop:string -> ?sep:string ->
|
||||||
|
'a formatter -> 'a t formatter
|
||||||
|
|
|
||||||
|
|
@ -144,97 +144,94 @@ let intersperse elem seq =
|
||||||
|
|
||||||
(** Mutable unrolled list to serve as intermediate storage *)
|
(** Mutable unrolled list to serve as intermediate storage *)
|
||||||
module MList = struct
|
module MList = struct
|
||||||
type 'a t = {
|
type 'a node =
|
||||||
content : 'a array; (* elements of the node *)
|
| Nil
|
||||||
mutable len : int; (* number of elements in content *)
|
| Cons of 'a array * int ref * 'a node ref
|
||||||
mutable tl : 'a t; (* tail *)
|
|
||||||
} (** A list that contains some elements, and may point to another list *)
|
|
||||||
|
|
||||||
let _empty () : 'a t = Obj.magic 0
|
let of_seq seq =
|
||||||
(** Empty list, for the tl field *)
|
let start = ref Nil in
|
||||||
|
let chunk_size = ref 8 in
|
||||||
|
(* fill the list. prev: tail-reference from previous node *)
|
||||||
|
let prev, cur = ref start, ref Nil in
|
||||||
|
seq
|
||||||
|
(fun x -> match !cur with
|
||||||
|
| Nil ->
|
||||||
|
let n = !chunk_size in
|
||||||
|
if n < 4096 then chunk_size := 2 * !chunk_size;
|
||||||
|
cur := Cons (Array.make n x, ref 1, ref Nil)
|
||||||
|
| Cons (a,n,next) ->
|
||||||
|
assert (!n < Array.length a);
|
||||||
|
a.(!n) <- x;
|
||||||
|
incr n;
|
||||||
|
if !n = Array.length a then begin
|
||||||
|
!prev := !cur;
|
||||||
|
prev := next;
|
||||||
|
cur := Nil
|
||||||
|
end
|
||||||
|
);
|
||||||
|
!prev := !cur;
|
||||||
|
!start
|
||||||
|
|
||||||
let make n =
|
let rec iter f l = match l with
|
||||||
assert (n > 0);
|
| Nil -> ()
|
||||||
{ content = Array.make n (Obj.magic 0);
|
| Cons (a, n, tl) ->
|
||||||
len = 0;
|
for i=0 to !n - 1 do f a.(i) done;
|
||||||
tl = _empty ();
|
iter f !tl
|
||||||
}
|
|
||||||
|
|
||||||
let rec is_empty l =
|
|
||||||
l.len = 0 && (l.tl == _empty () || is_empty l.tl)
|
|
||||||
|
|
||||||
let rec iter f l =
|
|
||||||
for i = 0 to l.len - 1 do f l.content.(i); done;
|
|
||||||
if l.tl != _empty () then iter f l.tl
|
|
||||||
|
|
||||||
let iteri f l =
|
let iteri f l =
|
||||||
let rec iteri i f l =
|
let rec iteri i f l = match l with
|
||||||
for j = 0 to l.len - 1 do f (i+j) l.content.(j); done;
|
| Nil -> ()
|
||||||
if l.tl != _empty () then iteri (i+l.len) f l.tl
|
| Cons (a, n, tl) ->
|
||||||
|
for j=0 to !n - 1 do f (i+j) a.(j) done;
|
||||||
|
iteri (i+ !n) f !tl
|
||||||
in iteri 0 f l
|
in iteri 0 f l
|
||||||
|
|
||||||
let rec iter_rev f l =
|
let rec iter_rev f l = match l with
|
||||||
(if l.tl != _empty () then iter_rev f l.tl);
|
| Nil -> ()
|
||||||
for i = l.len - 1 downto 0 do f l.content.(i); done
|
| Cons (a, n, tl) ->
|
||||||
|
iter_rev f !tl;
|
||||||
|
for i = !n-1 downto 0 do f a.(i) done
|
||||||
|
|
||||||
let length l =
|
let length l =
|
||||||
let rec len acc l =
|
let rec len acc l = match l with
|
||||||
if l.tl == _empty () then acc+l.len else len (acc+l.len) l.tl
|
| Nil -> acc
|
||||||
|
| Cons (_, n, tl) -> len (acc+ !n) !tl
|
||||||
in len 0 l
|
in len 0 l
|
||||||
|
|
||||||
(** Get element by index *)
|
(** Get element by index *)
|
||||||
let rec get l i =
|
let rec get l i = match l with
|
||||||
if i < l.len then l.content.(i)
|
| Nil -> raise (Invalid_argument "MList.get")
|
||||||
else if i >= l.len && l.tl == _empty () then raise (Invalid_argument "MList.get")
|
| Cons (a, n, _) when i < !n -> a.(i)
|
||||||
else get l.tl (i - l.len)
|
| Cons (_, n, tl) -> get !tl (i- !n)
|
||||||
|
|
||||||
(** Push [x] at the end of the list. It returns the block in which the
|
let to_seq l k = iter k l
|
||||||
element is inserted. *)
|
|
||||||
let rec push x l =
|
|
||||||
if l.len = Array.length l.content
|
|
||||||
then begin (* insert in the next block *)
|
|
||||||
(if l.tl == _empty () then
|
|
||||||
let n = Array.length l.content in
|
|
||||||
l.tl <- make (n + n lsr 1));
|
|
||||||
push x l.tl
|
|
||||||
end else begin (* insert in l *)
|
|
||||||
l.content.(l.len) <- x;
|
|
||||||
l.len <- l.len + 1;
|
|
||||||
l
|
|
||||||
end
|
|
||||||
|
|
||||||
(** Reverse list (in place), and returns the new head *)
|
let _to_next arg l =
|
||||||
let rev l =
|
let cur = ref l in
|
||||||
let rec rev prev l =
|
let i = ref 0 in (* offset in cons *)
|
||||||
(* reverse array *)
|
let rec get_next _ = match !cur with
|
||||||
for i = 0 to (l.len-1) / 2 do
|
| Nil -> None
|
||||||
let x = l.content.(i) in
|
| Cons (_, n, tl) when !i = !n ->
|
||||||
l.content.(i) <- l.content.(l.len - i - 1);
|
cur := !tl;
|
||||||
l.content.(l.len - i - 1) <- x;
|
i := 0;
|
||||||
done;
|
get_next arg
|
||||||
(* reverse next block *)
|
| Cons (a, n, _) ->
|
||||||
let l' = l.tl in
|
let x = a.(!i) in
|
||||||
l.tl <- prev;
|
incr i;
|
||||||
if l' == _empty () then l else rev l l'
|
Some x
|
||||||
in
|
in get_next
|
||||||
rev (_empty ()) l
|
|
||||||
|
|
||||||
(** Build a MList of elements of the Seq. The optional argument indicates
|
let to_gen l = _to_next () l
|
||||||
the size of the blocks *)
|
|
||||||
let of_seq ?(size=8) seq =
|
let to_stream l =
|
||||||
(* read sequence into a MList.t *)
|
Stream.from (_to_next 42 l) (* 42=magic cookiiiiiie *)
|
||||||
let start = make size in
|
|
||||||
let l = ref start in
|
|
||||||
seq (fun x -> l := push x !l);
|
|
||||||
start
|
|
||||||
end
|
end
|
||||||
|
|
||||||
(** Iterate on the sequence, storing elements in a data structure.
|
(** Iterate on the sequence, storing elements in a data structure.
|
||||||
The resulting sequence can be iterated on as many times as needed. *)
|
The resulting sequence can be iterated on as many times as needed. *)
|
||||||
let persistent ?(blocksize=64) seq =
|
let persistent seq =
|
||||||
if blocksize < 2 then failwith "Sequence.persistent: blocksize too small";
|
let l = MList.of_seq seq in
|
||||||
let l = MList.of_seq ~size:blocksize seq in
|
MList.to_seq l
|
||||||
from_iter (fun k -> MList.iter k l)
|
|
||||||
|
|
||||||
(** Sort the sequence. Eager, O(n) ram and O(n ln(n)) time. *)
|
(** Sort the sequence. Eager, O(n) ram and O(n ln(n)) time. *)
|
||||||
let sort ?(cmp=Pervasives.compare) seq =
|
let sort ?(cmp=Pervasives.compare) seq =
|
||||||
|
|
@ -316,14 +313,19 @@ let scan f acc seq =
|
||||||
let acc = ref acc in
|
let acc = ref acc in
|
||||||
seq (fun elt -> let acc' = f !acc elt in k acc'; acc := acc'))
|
seq (fun elt -> let acc' = f !acc elt in k acc'; acc := acc'))
|
||||||
|
|
||||||
(** Max element of the sequence, using the given comparison
|
let max ?(lt=fun x y -> x < y) seq =
|
||||||
function. A default element has to be provided. *)
|
let ret = ref None in
|
||||||
let max ?(lt=fun x y -> x < y) seq m =
|
seq (fun x -> match !ret with
|
||||||
fold (fun m x -> if lt m x then x else m) m seq
|
| None -> ret := Some x
|
||||||
|
| Some y -> if lt y x then ret := Some x);
|
||||||
|
!ret
|
||||||
|
|
||||||
(** Min element of the sequence, using the given comparison function *)
|
let min ?(lt=fun x y -> x < y) seq =
|
||||||
let min ?(lt=fun x y -> x < y) seq m =
|
let ret = ref None in
|
||||||
fold (fun m x -> if lt x m then x else m) m seq
|
seq (fun x -> match !ret with
|
||||||
|
| None -> ret := Some x
|
||||||
|
| Some y -> if lt x y then ret := Some x);
|
||||||
|
!ret
|
||||||
|
|
||||||
exception ExitSequence
|
exception ExitSequence
|
||||||
|
|
||||||
|
|
@ -470,14 +472,8 @@ let of_stream s =
|
||||||
|
|
||||||
(** Convert to a stream. The sequence is made persistent. *)
|
(** Convert to a stream. The sequence is made persistent. *)
|
||||||
let to_stream seq =
|
let to_stream seq =
|
||||||
let l = ref (MList.of_seq seq) in
|
let l = MList.of_seq seq in
|
||||||
let i = ref 0 in
|
MList.to_stream l
|
||||||
let rec get_next () =
|
|
||||||
if !l == MList._empty () then None
|
|
||||||
else if (!l).MList.len = !i then (l := (!l).MList.tl; i := 0; get_next ())
|
|
||||||
else let x = (!l).MList.content.(!i) in (incr i; Some x)
|
|
||||||
in
|
|
||||||
Stream.from (fun _ -> get_next ())
|
|
||||||
|
|
||||||
(** Push elements of the sequence on the stack *)
|
(** Push elements of the sequence on the stack *)
|
||||||
let to_stack s seq = iter (fun x -> Stack.push x s) seq
|
let to_stack s seq = iter (fun x -> Stack.push x s) seq
|
||||||
|
|
@ -541,6 +537,10 @@ let int_range ~start ~stop =
|
||||||
fun k ->
|
fun k ->
|
||||||
for i = start to stop do k i done
|
for i = start to stop do k i done
|
||||||
|
|
||||||
|
let int_range_dec ~start ~stop =
|
||||||
|
fun k ->
|
||||||
|
for i = start downto stop do k i done
|
||||||
|
|
||||||
(** Convert the given set to a sequence. The set module must be provided. *)
|
(** Convert the given set to a sequence. The set module must be provided. *)
|
||||||
let of_set (type s) (type v) m set =
|
let of_set (type s) (type v) m set =
|
||||||
let module S = (val m : Set.S with type t = s and type elt = v) in
|
let module S = (val m : Set.S with type t = s and type elt = v) in
|
||||||
|
|
@ -554,6 +554,21 @@ let to_set (type s) (type v) m seq =
|
||||||
(fun set x -> S.add x set)
|
(fun set x -> S.add x set)
|
||||||
S.empty seq
|
S.empty seq
|
||||||
|
|
||||||
|
type 'a gen = unit -> 'a option
|
||||||
|
|
||||||
|
let of_gen g =
|
||||||
|
(* consume the generator to build a MList *)
|
||||||
|
let rec iter1 k = match g () with
|
||||||
|
| None -> ()
|
||||||
|
| Some x -> k x; iter1 k
|
||||||
|
in
|
||||||
|
let l = MList.of_seq iter1 in
|
||||||
|
MList.to_seq l
|
||||||
|
|
||||||
|
let to_gen seq =
|
||||||
|
let l = MList.of_seq seq in
|
||||||
|
MList.to_gen l
|
||||||
|
|
||||||
(** {2 Functorial conversions between sets and sequences} *)
|
(** {2 Functorial conversions between sets and sequences} *)
|
||||||
|
|
||||||
module Set = struct
|
module Set = struct
|
||||||
|
|
@ -630,70 +645,23 @@ let random_array a =
|
||||||
|
|
||||||
let random_list l = random_array (Array.of_list l)
|
let random_list l = random_array (Array.of_list l)
|
||||||
|
|
||||||
(** {2 Type-classes} *)
|
|
||||||
|
|
||||||
module TypeClass = struct
|
|
||||||
(** {3 Classes} *)
|
|
||||||
type ('a,'b) sequenceable = {
|
|
||||||
to_seq : 'b -> 'a t;
|
|
||||||
of_seq : 'a t -> 'b;
|
|
||||||
}
|
|
||||||
|
|
||||||
type ('a,'b) addable = {
|
|
||||||
empty : 'b;
|
|
||||||
add : 'b -> 'a -> 'b;
|
|
||||||
}
|
|
||||||
|
|
||||||
type 'a monoid = ('a,'a) addable
|
|
||||||
|
|
||||||
type ('a,'b) iterable = {
|
|
||||||
iter : ('a -> unit) -> 'b -> unit;
|
|
||||||
}
|
|
||||||
|
|
||||||
(** {3 Instances} *)
|
|
||||||
|
|
||||||
let (sequenceable : ('a,'a t) sequenceable) = {
|
|
||||||
to_seq = (fun seq -> seq);
|
|
||||||
of_seq = (fun seq -> seq);
|
|
||||||
}
|
|
||||||
|
|
||||||
let (iterable : ('a, 'a t) iterable) = {
|
|
||||||
iter = (fun f seq -> iter f seq);
|
|
||||||
}
|
|
||||||
|
|
||||||
let (monoid : 'a t monoid) = {
|
|
||||||
empty = empty;
|
|
||||||
add = (fun s1 s2 -> append s1 s2);
|
|
||||||
}
|
|
||||||
|
|
||||||
(** {3 Conversions} *)
|
|
||||||
|
|
||||||
let of_iterable iterable x =
|
|
||||||
from_iter (fun k -> iterable.iter k x)
|
|
||||||
|
|
||||||
|
|
||||||
let to_addable addable seq =
|
|
||||||
fold addable.add addable.empty seq
|
|
||||||
end
|
|
||||||
|
|
||||||
(** {2 Infix functions} *)
|
(** {2 Infix functions} *)
|
||||||
|
|
||||||
module Infix = struct
|
module Infix = struct
|
||||||
let (--) i j = int_range ~start:i ~stop:j
|
let (--) i j = int_range ~start:i ~stop:j
|
||||||
|
|
||||||
let (|>) x f = f x
|
let (--^) i j = int_range_dec ~start:i ~stop:j
|
||||||
|
|
||||||
let (@@) a b = append a b
|
|
||||||
|
|
||||||
let (>>=) x f = flatMap f x
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
include Infix
|
||||||
|
|
||||||
(** {2 Pretty printing of sequences} *)
|
(** {2 Pretty printing of sequences} *)
|
||||||
|
|
||||||
(** Pretty print a sequence of ['a], using the given pretty printer
|
(** Pretty print a sequence of ['a], using the given pretty printer
|
||||||
to print each elements. An optional separator string can be provided. *)
|
to print each elements. An optional separator string can be provided. *)
|
||||||
let pp_seq ?(sep=", ") pp_elt formatter seq =
|
let print ?(start="") ?(stop="") ?(sep=", ") pp_elt formatter seq =
|
||||||
let first = ref true in
|
let first = ref true in
|
||||||
|
Format.pp_print_string formatter start;
|
||||||
iter
|
iter
|
||||||
(fun x ->
|
(fun x ->
|
||||||
(if !first then first := false
|
(if !first then first := false
|
||||||
|
|
@ -702,4 +670,22 @@ let pp_seq ?(sep=", ") pp_elt formatter seq =
|
||||||
Format.pp_print_cut formatter ();
|
Format.pp_print_cut formatter ();
|
||||||
end);
|
end);
|
||||||
pp_elt formatter x)
|
pp_elt formatter x)
|
||||||
seq
|
seq;
|
||||||
|
Format.pp_print_string formatter stop;
|
||||||
|
()
|
||||||
|
|
||||||
|
let pp ?(start="") ?(stop="") ?(sep=", ") pp_elt buf seq =
|
||||||
|
let first = ref true in
|
||||||
|
Buffer.add_string buf start;
|
||||||
|
iter
|
||||||
|
(fun x ->
|
||||||
|
if !first then first := false else Buffer.add_string buf sep;
|
||||||
|
pp_elt buf x)
|
||||||
|
seq;
|
||||||
|
Buffer.add_string buf stop;
|
||||||
|
()
|
||||||
|
|
||||||
|
let to_string ?start ?stop ?sep pp_elt seq =
|
||||||
|
let buf = Buffer.create 25 in
|
||||||
|
pp ?start ?stop ?sep pp_elt buf seq;
|
||||||
|
Buffer.contents buf
|
||||||
|
|
|
||||||
|
|
@ -151,15 +151,11 @@ val fmap : ('a -> 'b option) -> 'a t -> 'b t
|
||||||
val intersperse : 'a -> 'a t -> 'a t
|
val intersperse : 'a -> 'a t -> 'a t
|
||||||
(** Insert the single element between every element of the sequence *)
|
(** Insert the single element between every element of the sequence *)
|
||||||
|
|
||||||
val persistent : ?blocksize:int -> 'a t -> 'a t
|
val persistent : 'a t -> 'a t
|
||||||
(** Iterate on the sequence, storing elements in a data structure.
|
(** Iterate on the sequence, storing elements in a data structure.
|
||||||
The resulting sequence can be iterated on as many times as needed.
|
The resulting sequence can be iterated on as many times as needed.
|
||||||
{b Note}: calling persistent on an already persistent sequence
|
{b Note}: calling persistent on an already persistent sequence
|
||||||
will still make a new copy of the sequence!
|
will still make a new copy of the sequence! *)
|
||||||
|
|
||||||
@param blocksize the size of chunks in the unrolled list
|
|
||||||
used to store elements. Use bigger values for bigger sequences.
|
|
||||||
Default: 64 *)
|
|
||||||
|
|
||||||
val sort : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t
|
val sort : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t
|
||||||
(** Sort the sequence. Eager, O(n) ram and O(n ln(n)) time.
|
(** Sort the sequence. Eager, O(n) ram and O(n ln(n)) time.
|
||||||
|
|
@ -195,12 +191,14 @@ val unfoldr : ('b -> ('a * 'b) option) -> 'b -> 'a t
|
||||||
val scan : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b t
|
val scan : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b t
|
||||||
(** Sequence of intermediate results *)
|
(** Sequence of intermediate results *)
|
||||||
|
|
||||||
val max : ?lt:('a -> 'a -> bool) -> 'a t -> 'a -> 'a
|
val max : ?lt:('a -> 'a -> bool) -> 'a t -> 'a option
|
||||||
(** Max element of the sequence, using the given comparison
|
(** Max element of the sequence, using the given comparison function.
|
||||||
function. A default element has to be provided. *)
|
@return None if the sequence is empty, Some [m] where [m] is the maximal
|
||||||
|
element otherwise *)
|
||||||
|
|
||||||
val min : ?lt:('a -> 'a -> bool) -> 'a t -> 'a -> 'a
|
val min : ?lt:('a -> 'a -> bool) -> 'a t -> 'a option
|
||||||
(** Min element of the sequence, using the given comparison function *)
|
(** Min element of the sequence, using the given comparison function.
|
||||||
|
see {!max} for more details. *)
|
||||||
|
|
||||||
val take : int -> 'a t -> 'a t
|
val take : int -> 'a t -> 'a t
|
||||||
(** Take at most [n] elements from the sequence. Works on infinite
|
(** Take at most [n] elements from the sequence. Works on infinite
|
||||||
|
|
@ -243,7 +241,7 @@ val map2_2 : ('a -> 'b -> 'c) -> ('a -> 'b -> 'd) -> ('a, 'b) t2 -> ('c, 'd) t2
|
||||||
val to_list : 'a t -> 'a list
|
val to_list : 'a t -> 'a list
|
||||||
|
|
||||||
val to_rev_list : 'a t -> 'a list
|
val to_rev_list : 'a t -> 'a list
|
||||||
(** Get the list of the reversed sequence (more efficient) *)
|
(** Get the list of the reversed sequence (more efficient than {!to_list}) *)
|
||||||
|
|
||||||
val of_list : 'a list -> 'a t
|
val of_list : 'a list -> 'a t
|
||||||
|
|
||||||
|
|
@ -315,7 +313,12 @@ val to_buffer : char t -> Buffer.t -> unit
|
||||||
(** Copy content of the sequence into the buffer *)
|
(** Copy content of the sequence into the buffer *)
|
||||||
|
|
||||||
val int_range : start:int -> stop:int -> int t
|
val int_range : start:int -> stop:int -> int t
|
||||||
(** Iterator on integers in [start...stop] by steps 1 *)
|
(** Iterator on integers in [start...stop] by steps 1. Also see
|
||||||
|
{!(--)} for an infix version. *)
|
||||||
|
|
||||||
|
val int_range_dec : start:int -> stop:int -> int t
|
||||||
|
(** Iterator on decreasing integers in [stop...start] by steps -1.
|
||||||
|
See {!(--^)} for an infix version *)
|
||||||
|
|
||||||
val of_set : (module Set.S with type elt = 'a and type t = 'b) -> 'b -> 'a t
|
val of_set : (module Set.S with type elt = 'a and type t = 'b) -> 'b -> 'a t
|
||||||
(** Convert the given set to a sequence. The set module must be provided. *)
|
(** Convert the given set to a sequence. The set module must be provided. *)
|
||||||
|
|
@ -323,6 +326,14 @@ val of_set : (module Set.S with type elt = 'a and type t = 'b) -> 'b -> 'a t
|
||||||
val to_set : (module Set.S with type elt = 'a and type t = 'b) -> 'a t -> 'b
|
val to_set : (module Set.S with type elt = 'a and type t = 'b) -> 'a t -> 'b
|
||||||
(** Convert the sequence to a set, given the proper set module *)
|
(** Convert the sequence to a set, given the proper set module *)
|
||||||
|
|
||||||
|
type 'a gen = unit -> 'a option
|
||||||
|
|
||||||
|
val of_gen : 'a gen -> 'a t
|
||||||
|
(** Traverse eagerly the generator and build a sequence from it *)
|
||||||
|
|
||||||
|
val to_gen : 'a t -> 'a gen
|
||||||
|
(** Make the sequence persistent (O(n)) and then iterate on it. Eager. *)
|
||||||
|
|
||||||
(** {2 Functorial conversions between sets and sequences} *)
|
(** {2 Functorial conversions between sets and sequences} *)
|
||||||
|
|
||||||
module Set : sig
|
module Set : sig
|
||||||
|
|
@ -375,51 +386,30 @@ val random_list : 'a list -> 'a t
|
||||||
(** Infinite sequence of random elements of the list. Basically the
|
(** Infinite sequence of random elements of the list. Basically the
|
||||||
same as {!random_array}. *)
|
same as {!random_array}. *)
|
||||||
|
|
||||||
(** {2 Type-classes} *)
|
|
||||||
|
|
||||||
module TypeClass : sig
|
|
||||||
(** {3 Classes} *)
|
|
||||||
type ('a,'b) sequenceable = {
|
|
||||||
to_seq : 'b -> 'a t;
|
|
||||||
of_seq : 'a t -> 'b;
|
|
||||||
}
|
|
||||||
|
|
||||||
type ('a,'b) addable = {
|
|
||||||
empty : 'b;
|
|
||||||
add : 'b -> 'a -> 'b;
|
|
||||||
}
|
|
||||||
|
|
||||||
type 'a monoid = ('a,'a) addable
|
|
||||||
|
|
||||||
type ('a,'b) iterable = {
|
|
||||||
iter : ('a -> unit) -> 'b -> unit;
|
|
||||||
}
|
|
||||||
|
|
||||||
(** {3 Instances} *)
|
|
||||||
|
|
||||||
val sequenceable : ('a,'a t) sequenceable
|
|
||||||
val iterable : ('a,'a t) iterable
|
|
||||||
val monoid : 'a t monoid
|
|
||||||
|
|
||||||
(** {3 Conversions} *)
|
|
||||||
|
|
||||||
val of_iterable : ('a,'b) iterable -> 'b -> 'a t
|
|
||||||
val to_addable : ('a,'b) addable -> 'a t -> 'b
|
|
||||||
end
|
|
||||||
|
|
||||||
(** {2 Infix functions} *)
|
(** {2 Infix functions} *)
|
||||||
|
|
||||||
module Infix : sig
|
module Infix : sig
|
||||||
val (--) : int -> int -> int t
|
val (--) : int -> int -> int t
|
||||||
|
|
||||||
val (|>) : 'a -> ('a -> 'b) -> 'b
|
val (--^) : int -> int -> int t
|
||||||
|
(** [a --^ b] is the range of integers from [b] to [a], both included,
|
||||||
val (@@) : 'a t -> 'a t -> 'a t
|
in decreasing order (starts from [a]).
|
||||||
|
It will therefore be empty if [a < b]. *)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
include module type of Infix
|
||||||
|
|
||||||
(** {2 Pretty printing of sequences} *)
|
(** {2 Pretty printing of sequences} *)
|
||||||
|
|
||||||
val pp_seq : ?sep:string -> (Format.formatter -> 'a -> unit) ->
|
val print : ?start:string -> ?stop:string -> ?sep:string ->
|
||||||
|
(Format.formatter -> 'a -> unit) ->
|
||||||
Format.formatter -> 'a t -> unit
|
Format.formatter -> 'a t -> unit
|
||||||
(** Pretty print a sequence of ['a], using the given pretty printer
|
(** Pretty print a sequence of ['a], using the given pretty printer
|
||||||
to print each elements. An optional separator string can be provided. *)
|
to print each elements. An optional separator string can be provided. *)
|
||||||
|
|
||||||
|
val pp : ?start:string -> ?stop:string -> ?sep:string ->
|
||||||
|
(Buffer.t -> 'a -> unit) ->
|
||||||
|
Buffer.t -> 'a t -> unit
|
||||||
|
|
||||||
|
val to_string : ?start:string -> ?stop:string -> ?sep:string ->
|
||||||
|
(Buffer.t -> 'a -> unit) -> 'a t -> string
|
||||||
|
|
|
||||||
|
|
@ -37,8 +37,6 @@ let create i =
|
||||||
vec = Array.create i (Obj.magic None);
|
vec = Array.create i (Obj.magic None);
|
||||||
}
|
}
|
||||||
|
|
||||||
(** resize the underlying array so that it can contains the
|
|
||||||
given number of elements *)
|
|
||||||
let resize v newcapacity =
|
let resize v newcapacity =
|
||||||
assert (newcapacity >= v.size);
|
assert (newcapacity >= v.size);
|
||||||
let new_vec = Array.create newcapacity (Obj.magic None) in
|
let new_vec = Array.create newcapacity (Obj.magic None) in
|
||||||
|
|
@ -46,7 +44,6 @@ let resize v newcapacity =
|
||||||
v.vec <- new_vec;
|
v.vec <- new_vec;
|
||||||
()
|
()
|
||||||
|
|
||||||
(** Be sure that [v] can contain [size] elements, resize it if needed. *)
|
|
||||||
let ensure v size =
|
let ensure v size =
|
||||||
if v.size < size
|
if v.size < size
|
||||||
then
|
then
|
||||||
|
|
|
||||||
|
|
@ -36,6 +36,10 @@ val create : int -> 'a t
|
||||||
val clear : 'a t -> unit
|
val clear : 'a t -> unit
|
||||||
(** clear the content of the vector *)
|
(** clear the content of the vector *)
|
||||||
|
|
||||||
|
val ensure : 'a t -> int -> unit
|
||||||
|
(** Ensure that the vector can contain that much elements, resizing it
|
||||||
|
if required *)
|
||||||
|
|
||||||
val is_empty : 'a t -> bool
|
val is_empty : 'a t -> bool
|
||||||
(** is the vector empty? *)
|
(** is the vector empty? *)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -578,13 +578,13 @@ module Dot = struct
|
||||||
(function
|
(function
|
||||||
| Full.EnterVertex (v, attrs, _, _) ->
|
| Full.EnterVertex (v, attrs, _, _) ->
|
||||||
Format.fprintf formatter " @[<h>%a [%a];@]@." pp_vertex v
|
Format.fprintf formatter " @[<h>%a [%a];@]@." pp_vertex v
|
||||||
(CCSequence.pp_seq ~sep:"," print_attribute) (CCSequence.of_list attrs)
|
(CCList.print ~sep:"," print_attribute) attrs
|
||||||
| Full.ExitVertex _ -> ()
|
| Full.ExitVertex _ -> ()
|
||||||
| Full.MeetEdge (v2, attrs, v1, _) ->
|
| Full.MeetEdge (v2, attrs, v1, _) ->
|
||||||
Format.fprintf formatter " @[<h>%a -> %a [%a];@]@."
|
Format.fprintf formatter " @[<h>%a -> %a [%a];@]@."
|
||||||
pp_vertex v1 pp_vertex v2
|
pp_vertex v1 pp_vertex v2
|
||||||
(CCSequence.pp_seq ~sep:"," print_attribute)
|
(CCList.print ~sep:"," print_attribute)
|
||||||
(CCSequence.of_list attrs))
|
attrs)
|
||||||
events;
|
events;
|
||||||
(* close *)
|
(* close *)
|
||||||
Format.fprintf formatter "}@]@;@?";
|
Format.fprintf formatter "}@]@;@?";
|
||||||
|
|
|
||||||
|
|
@ -346,15 +346,15 @@ let pp ~name ?vertices
|
||||||
let attributes = print_edge v1 e v2 in
|
let attributes = print_edge v1 e v2 in
|
||||||
Format.fprintf formatter " @[<h>%a -> %a [%a];@]@."
|
Format.fprintf formatter " @[<h>%a -> %a [%a];@]@."
|
||||||
pp_vertex v1 pp_vertex v2
|
pp_vertex v1 pp_vertex v2
|
||||||
(CCSequence.pp_seq ~sep:"," print_attribute)
|
(CCList.print ~sep:"," print_attribute)
|
||||||
(CCSequence.of_list attributes))
|
attributes)
|
||||||
(to_seq graph);
|
(to_seq graph);
|
||||||
(* print vertices *)
|
(* print vertices *)
|
||||||
PHashtbl.iter
|
PHashtbl.iter
|
||||||
(fun v _ ->
|
(fun v _ ->
|
||||||
let attributes = print_vertex v in
|
let attributes = print_vertex v in
|
||||||
Format.fprintf formatter " @[<h>%a [%a];@]@." pp_vertex v
|
Format.fprintf formatter " @[<h>%a [%a];@]@." pp_vertex v
|
||||||
(CCSequence.pp_seq ~sep:"," print_attribute) (CCSequence.of_list attributes))
|
(CCList.print ~sep:"," print_attribute) attributes)
|
||||||
vertices;
|
vertices;
|
||||||
(* close *)
|
(* close *)
|
||||||
Format.fprintf formatter "}@]@;";
|
Format.fprintf formatter "}@]@;";
|
||||||
|
|
|
||||||
|
|
@ -306,7 +306,7 @@ let bench_enum () =
|
||||||
let enum () =
|
let enum () =
|
||||||
let open CCGen in
|
let open CCGen in
|
||||||
let seq = int_range 0 n in
|
let seq = int_range 0 n in
|
||||||
let seq = flatMap (fun x -> int_range x (x+10)) seq in
|
let seq = flat_map (fun x -> int_range x (x+10)) seq in
|
||||||
fold (+) 0 seq in
|
fold (+) 0 seq in
|
||||||
Bench.bench
|
Bench.bench
|
||||||
[ "sequence.flatMap", seq;
|
[ "sequence.flatMap", seq;
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue