ocaml-containers/src/core/CCVector.ml

1133 lines
26 KiB
OCaml

(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Growable, mutable vector} *)
type rw = [`RW]
type ro = [`RO]
type 'a iter = ('a -> unit) -> unit
type 'a gen = unit -> 'a option
type 'a equal = 'a -> 'a -> bool
type 'a ord = 'a -> 'a -> int
type 'a printer = Format.formatter -> 'a -> unit
(** A vector of 'a. *)
type ('a,'mut) t = {
mutable size : int;
mutable vec : 'a array;
}
type 'a vector = ('a, rw) t
type 'a ro_vector = ('a, ro) t
external as_float_arr : 'a array -> float array = "%identity"
external as_obj_arr : 'a array -> Obj.t array = "%identity"
let fill_with_junk_ (a:_ array) i len : unit =
if Obj.(tag (repr a) = double_array_tag) then (
Array.fill (as_float_arr a) i len 0.;
) else (
Array.fill (as_obj_arr a) i len (Obj.repr ());
)
let freeze v = {
size=v.size;
vec=v.vec;
}
let freeze_copy v = {
size=v.size;
vec=Array.sub v.vec 0 v.size;
}
let create () = {
size = 0;
vec = [| |];
}
let create_with ?(capacity=128) x =
let vec = Array.make capacity x in
fill_with_junk_ vec 0 capacity;
{
size = 0;
vec
}
(*$T
(create_with ~capacity:200 1 |> capacity) >= 200
*)
let return x = {
size=1;
vec= [| x |];
}
(*$T
return 42 |> to_list = [42]
return 42 |> length = 1
*)
let make n x = {
size=n;
vec=Array.make n x;
}
let init n f = {
size=n;
vec=Array.init n f;
}
(* is the underlying array empty? *)
let array_is_empty_ v =
Array.length v.vec = 0
(* resize the underlying array using x to temporarily fill the array *)
let resize_ v newcapacity x =
assert (newcapacity >= v.size);
assert (not (array_is_empty_ v));
let new_vec = Array.make newcapacity x in
Array.blit v.vec 0 new_vec 0 v.size;
fill_with_junk_ new_vec v.size (newcapacity-v.size);
v.vec <- new_vec;
()
(*$T
let v = create_with ~capacity:10 1 in \
ensure v 200; capacity v >= 200
*)
(*$T
let v = create() in push v 0.; push v 1.; push v 2.; 3=length v
let v = create() in push v 1.; push v 2.; push v 3.; 6. = (get v 0 +. get v 1 +. get v 2)
let v = create() in push v 0; push v 1; push v 2; 3=length v
let v = create() in push v 1; push v 2; push v 3; 6 = (get v 0 + get v 1 + get v 2)
let v = create() in push v "a"; push v "b"; push v "c"; 3=length v
let v = create() in push v "a"; push v "b"; push v "c"; "abc" = String.concat "" (to_list v)
*)
(*$R
let v = create() in
push v 0.; push v 1.;
clear v;
push v 0.; push v 1.; push v 7.; push v 10.; push v 12.;
truncate v 2;
assert_equal 1. (fold (+.) 0. v);
clear v;
assert_equal 0 (size v);
push v 0.; push v 1.; push v 7.; push v 10.; push v 12.;
assert_equal (1. +. 7. +. 10. +. 12.) (fold (+.) 0. v);
*)
(* grow the array, using [x] as a filler if required *)
let grow_with_ v ~filler:x =
if array_is_empty_ v then (
let len = 4 in
v.vec <- Array.make len x;
(* do not really use [x], it was just for knowing the type *)
fill_with_junk_ v.vec 0 len;
) else (
let n = Array.length v.vec in
let size = min (2 * n + 3) Sys.max_array_length in
if size = n then failwith "vec: can't grow any further";
resize_ v size v.vec.(0)
)
(* v is not empty; ensure it has at least [size] slots.
Use a doubling-size strategy so that calling many times [ensure] will
behave well *)
let ensure_assuming_not_empty_ v ~size =
if size > Sys.max_array_length
then failwith "vec.ensure: size too big"
else (
let n = ref (max 8 (Array.length v.vec)) in
while !n < size do n := min Sys.max_array_length (2* !n) done;
resize_ v !n v.vec.(0)
)
let ensure_with ~init v size =
if array_is_empty_ v then (
v.vec <- Array.make size init;
fill_with_junk_ v.vec 0 size
) else (
ensure_assuming_not_empty_ v ~size
)
let ensure v size =
if not (array_is_empty_ v) then (
ensure_assuming_not_empty_ v ~size
)
let clear v =
v.size <- 0
(*$R
let v = of_iter Iter.(1 -- 10) in
OUnit.assert_equal 10 (size v);
clear v;
OUnit.assert_equal 0 (size v);
OUnit.assert_bool "empty_after_clear" (Iter.is_empty (to_iter v));
*)
let clear_and_reset v =
v.size <- 0;
v.vec <- [||]
(* TODO*)
(*
let v = create() in
let a = Weak.create 1 in
push v ("hello"^"world");
Weak.set a 0 (Some (get v 0));
Gc.full_major(); Gc.compact();
OUnit.assert_bool "is alive" (Weak.check a 0);
Gc.full_major(); Gc.compact();
OUnit.assert_equal None (Weak.get a 0);
*)
let is_empty v = v.size = 0
let push_unsafe_ v x =
Array.unsafe_set v.vec v.size x;
v.size <- v.size + 1
let push v x =
if v.size = Array.length v.vec then grow_with_ v ~filler:x;
push_unsafe_ v x
(*$T
let v = create () in push v 1; to_list v = [1]
let v = of_list [1;2;3] in push v 4; to_list v = [1;2;3;4]
*)
let resize_with v f size =
if size > Sys.max_array_length then
raise (Invalid_argument "vec.resize_with: size too big")
else if size <= Array.length v.vec then
()
else
let new_vec = Array.make size (f 0) in
Array.blit v.vec 0 new_vec 0 (v.size - 1);
for i = v.size to size - 1 do
Array.unsafe_set new_vec i (f i)
done;
v.vec <- new_vec;
v.size <- size;
()
(*$T
let v = make 1 0 in to_list (resize_with v (fun i -> i) 5) = [0;1;2;3;4]
let v = make 1 0 in length (resize_with v (fun i -> i) 5) = 5
let v = make 5 0 in to_list (resize_with v (fun i -> i) 5) = [0;0;0;0;0]
let v = make 5 0 in to_list (resize_with v (fun i -> i) 6) = [0;0;0;0;0;6]
let v = make 5 0 in to_list (resize_with v (fun i -> i) -1) = [0;0;0;0;0]
let v = make 5 0 in length (resize_with v (fun i -> i) 5) = 5
*)
let resize_with_init v ~init size =
if size > Sys.max_array_length then
raise (Invalid_argument "vec.resize_with_init: size too big")
else if size <= Array.length v.vec then
()
else
let new_vec = Array.make size init in
Array.blit v.vec 0 new_vec 0 (v.size - 1);
v.vec <- new_vec;
v.size <- size;
()
(*$T
let v = make 1 0 in to_list (resize_with_init v ~init:1 5) = [1;1;1;1;1]
let v = make 1 0 in length (resize_with_init v ~init:1 5) = 5
let v = make 5 0 in to_list (resize_with_init v ~init:1 5) = [1;1;1;1;1]
let v = make 5 0 in to_list (resize_with_init v ~init:1 -1) = [1;1;1;1;1]
let v = make 5 0 in length (resize_with_init v ~init:1 5) = 5
*)
(** Add all elements of b to a *)
let append a b =
if array_is_empty_ a then (
if array_is_empty_ b then ()
else (
a.vec <- Array.copy b.vec;
a.size <- b.size
)
) else (
ensure_assuming_not_empty_ a ~size:(a.size + b.size);
assert (Array.length a.vec >= a.size + b.size);
Array.blit b.vec 0 a.vec a.size b.size;
a.size <- a.size + b.size
)
(*$T
let v1 = init 5 (fun i->i) and v2 = init 5 (fun i->i+5) in \
append v1 v2; to_list v1 = CCList.(0--9)
let empty = create () and v2 = init 5 (fun i->i) in \
append empty v2; to_list empty = CCList.(0--4)
let v1 = init 5 (fun i->i) and empty = create () in \
append v1 empty; to_list v1 = CCList.(0--4)
let v = init 3 (fun i->i) in \
append v v; to_list v = [0; 1; 2; 0; 1; 2]
let empty = create () in \
append empty empty; to_list empty = []
*)
(*$R
let a = of_iter Iter.(1 -- 5) in
let b = of_iter Iter.(6 -- 10) in
append a b;
OUnit.assert_equal 10 (size a);
OUnit.assert_equal (Iter.to_array Iter.(1 -- 10)) (to_array a);
OUnit.assert_equal (Iter.to_array Iter.(6 -- 10)) (to_array b);
*)
let get v i =
if i < 0 || i >= v.size then invalid_arg "CCVector.get";
Array.unsafe_get v.vec i
let set v i x =
if i < 0 || i >= v.size then invalid_arg "CCVector.set";
Array.unsafe_set v.vec i x
let remove_and_shift v i =
if i < 0 || i >= v.size then invalid_arg "CCVector.remove";
(* if v.(i) not the last element, then put last element at index i *)
if i < v.size - 1
then Array.blit v.vec (i+1) v.vec i (v.size - i - 1);
(* remove one element *)
v.size <- v.size - 1;
fill_with_junk_ v.vec v.size 1
let remove_unordered v i =
if i < 0 || i >= v.size then invalid_arg "CCVector.remove_unordered";
(* if v.(i) not the last element, then put last element at index i *)
if i < v.size - 1
then v.vec.(i) <- v.vec.(v.size - 1);
(* remove one element *)
v.size <- v.size - 1;
fill_with_junk_ v.vec v.size 1
(*$Q remove_and_shift
Q.(list_of_size (Gen.int_range 10 10) small_int) (fun l -> \
let v1 = of_list l and v2 = of_list l in \
remove_and_shift v1 9; \
remove_unordered v2 9; \
to_list v1 = (to_list v2))
Q.(list_of_size (Gen.int_range 10 10) small_int) (fun l -> \
let l = List.sort CCInt.compare l in \
let v = of_list l in\
remove_and_shift v 3; \
to_list v = (List.sort CCInt.compare (to_list v)))
Q.(list_of_size (Gen.int_range 10 10) small_int) (fun l -> \
let l = List.sort CCInt.compare l in \
let v1 = of_list l and v2 = of_list l in \
remove_and_shift v1 3; \
remove_unordered v2 3; \
to_list v1 = (List.sort CCInt.compare (to_list v2)))
*)
let append_iter a i = i (fun x -> push a x)
let append_seq a seq = Seq.iter (fun x -> push a x) seq
let append_array a b =
let len_b = Array.length b in
if array_is_empty_ a then (
a.vec <- Array.copy b;
a.size <- len_b;
) else (
ensure_assuming_not_empty_ a ~size:(a.size + len_b);
Array.blit b 0 a.vec a.size len_b;
a.size <- a.size + len_b
)
(*$T
let v1 = init 5 (fun i->i) and v2 = Array.init 5 (fun i->i+5) in \
append_array v1 v2; to_list v1 = CCList.(0--9)
let empty = create () in \
append_array empty CCArray.(0--5); to_list empty = CCList.(0--5)
let v1 = init 5 (fun i->i) in \
append_array v1 [| |]; to_list v1 = CCList.(0--4)
let empty = create () in \
append_array empty [| |]; to_list empty = []
*)
let append_list a b = match b with
| [] -> ()
| x :: _ ->
(* need to push at least one elem *)
let len_a = a.size in
let len_b = List.length b in
ensure_with ~init:x a (len_a + len_b);
List.iter (push_unsafe_ a) b;
()
(*$Q
Q.(pair (list int)(list int)) (fun (l1,l2) -> \
let v = of_list l1 in append_list v l2; \
to_list v = (l1 @ l2))
Q.(pair (list int)(list int)) (fun (l1,l2) -> \
let v = of_list l1 in append_list v l2; \
length v = List.length l1 + List.length l2)
*)
let rec append_gen a b = match b() with
| None -> ()
| Some x -> push a x; append_gen a b
(*$Q
Q.(pair (list int)(list int)) (fun (l1,l2) -> \
let v = of_list l1 in append_gen v (Gen.of_list l2); \
to_list v = (l1 @ l2))
Q.(pair (list int)(list int)) (fun (l1,l2) -> \
let v = of_list l1 in append_gen v (Gen.of_list l2); \
length v = List.length l1 + List.length l2)
*)
(*$inject
let gen x =
let small = length in
let print = CCOption.map (fun p x -> Q.Print.list p (CCVector.to_list x)) x.Q.print in
Q.make ?print ~small Q.Gen.(list x.Q.gen >|= of_list)
*)
(*$QR
(Q.pair (gen Q.int) (gen Q.int)) (fun (v1,v2) ->
let l1 = to_list v1 in
append v1 v2;
Iter.to_list (to_iter v1) =
Iter.(to_list (append (of_list l1) (to_iter v2)))
)
*)
let equal eq v1 v2 =
v1.size = v2.size
&&
let n = v1.size in
let rec check i =
i = n || (eq (get v1 i) (get v2 i) && check (i+1))
in
check 0
(*$T
equal (=) (create ()) (create ())
equal (=) (return 42) (return 42)
not (equal (=) (create ()) (return 42))
not (equal (=) (return 42) (create ()))
*)
(*$Q
Q.(let g = list_of_size Gen.(0--10) small_int in pair g g) (fun (l1,l2) -> \
equal (=) (of_list l1) (of_list l2) = (l1=l2))
*)
(*$QR
Q.(pair (small_list small_int)(small_list small_int)) (fun (l1,l2) ->
let v1 = of_list l1 in
let v2 = of_list l2 in
equal (=) v1 v2 = (l1=l2))
*)
let compare cmp v1 v2 =
let n = min v1.size v2.size in
let rec check i =
if i = n
then compare v1.size v2.size
else (
let c = cmp (get v1 i) (get v2 i) in
if c = 0 then check (i+1) else c
)
in check 0
(*$QR
Q.(pair (small_list small_int)(small_list small_int)) (fun (l1,l2) ->
let v1 = of_list l1 in
let v2 = of_list l2 in
compare Stdlib.compare v1 v2 = CCList.compare Stdlib.compare l1 l2)
*)
exception Empty
let pop_exn v =
if v.size = 0 then raise Empty;
let new_size = v.size - 1 in
v.size <- new_size;
let x = v.vec.(new_size) in
(* free last element *)
fill_with_junk_ v.vec new_size 1;
x
let pop v =
try Some (pop_exn v)
with Empty -> None
let top v =
if v.size = 0 then None else Some v.vec.(v.size-1)
let top_exn v =
if v.size = 0 then raise Empty;
v.vec.(v.size-1)
(*$T
1 -- 10 |> top = Some 10
create () |> top = None
1 -- 10 |> top_exn = 10
*)
let copy v = {
size = v.size;
vec = Array.sub v.vec 0 v.size;
}
(*$T
(let v = of_list [1;2;3] in let v' = copy v in \
to_list v' = [1;2;3])
create () |> copy |> is_empty
*)
(*$R
let v = of_iter Iter.(1 -- 100) in
OUnit.assert_equal 100 (size v);
let v' = copy v in
OUnit.assert_equal 100 (size v');
clear v';
OUnit.assert_bool "empty" (is_empty v');
OUnit.assert_bool "not_empty" (not (is_empty v));
*)
(*$QR
Q.(small_list small_int) (fun l ->
let v = of_list l in
let v' = copy v in
equal (=) v v')
*)
let truncate v n =
let old_size = v.size in
if n < old_size then (
v.size <- n;
(* free elements by erasing them *)
fill_with_junk_ v.vec n (old_size-n);
)
(*$R
let v = of_iter Iter.(1 -- 10) in
truncate v 5;
OUnit.assert_equal [1;2;3;4;5] (to_list v);
*)
(*$QR
(gen Q.small_int) (fun v ->
let n = size v / 2 in
let l = to_list v in
let h = Iter.(to_list (take n (of_list l))) in
let v' = copy v in
truncate v' n;
h = to_list v'
)
*)
let shrink_to_fit v : unit =
if v.size = 0 then (
v.vec <- [| |]
) else if v.size < Array.length v.vec then (
v.vec <- Array.sub v.vec 0 v.size
)
(*$QR
(gen Q.small_int) (fun v ->
let v' = copy v in
shrink_to_fit v;
to_list v = to_list v'
)
*)
let sort' cmp v =
(* possibly copy array (to avoid junk at its end), then sort the array *)
let a =
if Array.length v.vec = v.size then v.vec
else Array.sub v.vec 0 v.size
in
Array.fast_sort cmp a;
v.vec <- a
let sort cmp v =
let v' = {
size=v.size;
vec=Array.sub v.vec 0 v.size;
} in
Array.sort cmp v'.vec;
v'
(*$QR
(gen Q.small_int) (fun v ->
let v' = copy v in
sort' Stdlib.compare v';
let l = to_list v' in
List.sort Stdlib.compare l = l
)
*)
let uniq_sort cmp v =
sort' cmp v;
let n = v.size in
(* traverse to remove duplicates. i= current index,
j=current append index, j<=i. new_size is the size
the vector will have after removing duplicates. *)
let rec traverse prev i j =
if i >= n then () (* done traversing *)
else if cmp prev v.vec.(i) = 0
then (
v.size <- v.size - 1;
traverse prev (i+1) j
) (* duplicate, remove it *)
else (
v.vec.(j) <- v.vec.(i);
traverse v.vec.(i) (i+1) (j+1)
) (* keep it *)
in
if v.size > 0
then traverse v.vec.(0) 1 1
(* start at 1, to get the first element in hand *)
(*$T
let v = of_list [1;4;5;3;2;4;1] in \
uniq_sort Stdlib.compare v; to_list v = [1;2;3;4;5]
*)
(*$QR & ~long_factor:10
Q.(small_list small_int) (fun l ->
let v = of_list l in
uniq_sort Stdlib.compare v;
to_list v = (CCList.sort_uniq ~cmp:Stdlib.compare l))
*)
let iter k v =
let n = v.size in
for i = 0 to n-1 do
k (Array.unsafe_get v.vec i)
done
let iteri k v =
let n = v.size in
for i = 0 to n-1 do
k i (Array.unsafe_get v.vec i)
done
(*$T
let v = (0--6) in \
iteri (fun i x -> if i = 3 then remove_unordered v i) v; length v = 6
*)
let map f v =
if array_is_empty_ v
then create ()
else (
let vec = Array.init v.size (fun i -> f (Array.unsafe_get v.vec i)) in
{ size=v.size; vec; }
)
(*$T
let v = create() in push v 1; push v 2; push v 3; \
to_list (map string_of_int v) = ["1"; "2"; "3"]
*)
(*$QR
Q.(pair (fun1 Observable.int small_int) (small_list small_int)) (fun (Q.Fun (_,f),l) ->
let v = of_list l in
to_list (map f v) = List.map f l)
*)
let mapi f v =
if array_is_empty_ v
then create ()
else (
let vec = Array.init v.size (fun i -> f i (Array.unsafe_get v.vec i)) in
{ size=v.size; vec; }
)
(*$T mapi
let v = create() in push v 1; push v 2; push v 3; \
to_list (mapi (fun i e -> Printf.sprintf "%i %i" i e) v) = ["0 1"; "1 2"; "2 3"]
*)
(*$QR mapi
Q.(pair (fun2 Observable.int Observable.int small_int) (small_list small_int))
(fun (Q.Fun (_,f),l) ->
let v = of_list l in
to_list (mapi f v) = List.mapi f l)
*)
let map_in_place f v =
iteri
(fun i x -> Array.unsafe_set v.vec i (f x))
v
(*$QR
Q.(pair (fun1 Observable.int small_int) (small_list small_int)) (fun (Q.Fun (_,f),l) ->
let v = of_list l in
map_in_place f v;
to_list v = List.map f l)
*)
let filter_in_place p v =
let i = ref 0 in (* cur element *)
let j = ref 0 in (* cur insertion point *)
let n = v.size in
while !i < n do
if p v.vec.(! i) then (
(* move element i at the first empty slot.
invariant: i >= j*)
if !i > !j then v.vec.(!j) <- v.vec.(!i);
incr i;
incr j
) else incr i
done;
(* free elements *)
fill_with_junk_ v.vec !j (v.size - !j);
v.size <- !j
(*$T
let v = 1 -- 10 in filter_in_place (fun x->x<4) v; \
to_list v = [1;2;3]
*)
(*$QR
Q.(pair (fun1 Observable.int bool) (small_list small_int)) (fun (Q.Fun (_,f),l) ->
let v = of_list l in
filter_in_place f v;
to_list v = List.filter f l)
*)
let filter p v =
if array_is_empty_ v then (
create ()
) else (
let v' = create_with ~capacity:v.size v.vec.(0) in
iter
(fun x -> if p x then push_unsafe_ v' x)
v;
v'
)
(*$T
filter (fun x-> x mod 2=0) (of_list [1;2;3;4;5]) |> to_list = [2;4]
filter (fun x-> x mod 2=0) (1 -- 1_000_000) |> length = 500_000
*)
(*$QR
Q.(pair (fun1 Observable.int bool) (small_list small_int)) (fun (Q.Fun (_,f),l) ->
let v = of_list l in
to_list (filter f v) = List.filter f l)
*)
let fold f acc v =
let rec fold acc i =
if i = v.size then acc
else
let x = Array.unsafe_get v.vec i in
fold (f acc x) (i+1)
in fold acc 0
(*$T
fold (+) 0 (of_list [1;2;3;4;5]) = 15
fold (+) 0 (create ()) = 0
*)
(*$QR
Q.(pair (fun2 Observable.int Observable.int small_int) (small_list small_int)) (fun (Q.Fun (_,f),l) ->
let v = of_list l in
fold f 0 v = List.fold_left f 0 l)
*)
let exists p v =
let n = v.size in
let rec check i =
if i = n then false
else p v.vec.(i) || check (i+1)
in check 0
(*$QR
Q.(pair (fun1 Observable.int bool) (small_list small_int)) (fun (Q.Fun (_,f),l) ->
let v = of_list l in
exists f v = List.exists f l)
*)
let for_all p v =
let n = v.size in
let rec check i =
if i = n then true
else p v.vec.(i) && check (i+1)
in check 0
(*$QR
Q.(pair (fun1 Observable.int bool) (small_list small_int)) (fun (Q.Fun (_,f),l) ->
let v = of_list l in
for_all f v = List.for_all f l)
*)
let member ~eq x v =
exists (eq x) v
let find_internal_ p v =
let n = v.size in
let rec check i =
if i = n then raise_notrace Not_found
else (
let x = v.vec.(i) in
if p x then x
else check (i+1)
)
in check 0
let find_exn p v =
try find_internal_ p v
with Not_found ->
raise Not_found
let find p v =
try Some (find_internal_ p v)
with Not_found -> None
(*$QR
Q.(pair (fun1 Observable.int bool) (small_list small_int)) (fun (Q.Fun (_,f),l) ->
let v = of_list l in
find f v = CCList.find_pred f l)
*)
let find_map f v =
let n = v.size in
let rec search i =
if i=n then None
else match f v.vec.(i) with
| None -> search (i+1)
| Some _ as res -> res
in
search 0
(*$Q
Q.(list small_int) (fun l -> \
let v = of_list l in \
let f x = x>30 && x < 35 in \
find_map (fun x -> if f x then Some x else None) v = find f v)
*)
let filter_map f v =
let v' = create () in
iter
(fun x -> match f x with
| None -> ()
| Some y -> push v' y)
v;
v'
(*$QR
Q.(pair (fun1 Observable.int (option bool)) (small_list small_int)) (fun (Q.Fun (_,f),l) ->
let v = of_list l in
to_list (filter_map f v) = CCList.filter_map f l)
*)
let filter_map_in_place f v =
let i = ref 0 in (* cur element *)
let j = ref 0 in (* cur insertion point *)
let n = v.size in
while !i < n do
match f v.vec.(!i) with
| None -> incr i (* drop *)
| Some y ->
(* move element i at the first empty slot.
invariant: i >= j*)
v.vec.(!j) <- y;
incr i;
incr j
done;
(* free elements *)
fill_with_junk_ v.vec !j (v.size - !j);
v.size <- !j
(*$QR
Q.(pair (fun1 Observable.int (option small_int)) (small_list small_int)) (fun (Q.Fun (_,f),l) ->
let v = of_list l in
filter_map_in_place f v;
to_list v = CCList.filter_map f l)
*)
(* check it frees memory properly *)
(*$R
let s = "coucou" ^ "lol" in
let w = Weak.create 1 in
Weak.set w 0 (Some s);
let v = of_list ["a"; s] in
filter_in_place (fun s -> String.length s <= 1) v;
assert_equal 1 (length v);
assert_equal "a" (get v 0);
Gc.full_major();
assert_equal None (Weak.get w 0);
*)
let flat_map f v =
let v' = create () in
iter (fun x -> iter (push v') (f x)) v;
v'
let flat_map_iter f v =
let v' = create () in
iter
(fun x ->
let seq = f x in
append_iter v' seq)
v;
v'
let flat_map_seq f v =
let v' = create () in
iter
(fun x ->
let seq = f x in
append_seq v' seq)
v;
v'
let flat_map_list f v =
let v' = create () in
iter
(fun x ->
let l = f x in
append_list v' l)
v;
v'
let monoid_product f a1 a2 : _ t =
let na1 = a1.size in
init (na1 * a2.size)
(fun i_prod ->
let i = i_prod mod na1 in
let j = i_prod / na1 in
f a1.vec.(i) a2.vec.(j))
(*$= & ~cmp:(=) ~printer:Q.Print.(list int)
[ 11; 12; 21; 22 ] (List.sort CCInt.compare @@ \
to_list @@ monoid_product (+) (of_list [10; 20]) (of_list [1; 2]))
[ 11; 12; 13; 14 ] (List.sort CCInt.compare @@ \
to_list @@ monoid_product (+) (of_list [10]) (of_list [1; 2; 3; 4]))
*)
let (>>=) x f = flat_map f x
let (>|=) x f = map f x
let rev_in_place v =
if v.size > 0
then (
let n = v.size in
let vec = v.vec in
for i = 0 to (n-1)/2 do
let x = Array.unsafe_get vec i in
let y = Array.unsafe_get vec (n-i-1) in
Array.unsafe_set vec i y;
Array.unsafe_set vec (n-i-1) x;
done
)
(*$QR
Q.(small_list small_int) (fun l ->
let v = of_list l in
rev_in_place v;
to_list v = List.rev l)
*)
let rev v =
let v' = copy v in
rev_in_place v';
v'
(*$T
rev (of_list [1;2;3;4]) |> to_list = [4;3;2;1]
rev (of_list [1;2;3;4;5]) |> to_list = [5;4;3;2;1]
rev (create ()) |> to_list = []
*)
(*$QR
Q.(small_list small_int) (fun l ->
let v = of_list l in
to_list (rev v) = List.rev l)
*)
let rev_iter f v =
let n = v.size in
for i = n-1 downto 0 do
f (Array.unsafe_get v.vec i)
done
(*$T
let v = of_list [1;2;3] in (fun f->rev_iter f v) |> Iter.to_list = [3;2;1]
*)
(*$Q
Q.(list int) (fun l -> \
let v = of_list l in \
(fun f->rev_iter f v) |> Iter.to_list = List.rev l)
*)
let size v = v.size
let length v = v.size
let capacity v = Array.length v.vec
let unsafe_get_array v = v.vec
let of_iter ?(init=create ()) seq =
append_iter init seq;
init
let of_seq ?(init=create ()) seq =
append_seq init seq;
init
(*$T
of_iter Iter.(1 -- 10) |> to_list = CCList.(1 -- 10)
*)
let to_iter v k = iter k v
let to_iter_rev v k =
let n = v.size in
for i = n - 1 downto 0 do
k (Array.unsafe_get v.vec i)
done
let to_seq v =
let rec aux i () =
if i>= size v then Seq.Nil
else Seq.Cons (v.vec.(i), aux (i+1))
in
aux 0
let to_seq_rev v =
let rec aux i () =
if i<0 || i > size v then Seq.Nil
else Seq.Cons (v.vec.(i), aux (i-1))
in
aux (size v-1)
(*$Q
Q.(list int) (fun l -> \
let v= of_list l in v |> to_iter_rev |> Iter.to_rev_list = l)
*)
let slice_iter v start len =
assert (start >= 0 && len >= 0);
fun k ->
assert (start+len <= v.size);
for i = start to start+len-1 do
let x = Array.unsafe_get v.vec i in
k x
done
(*$T
slice_iter (of_list [0;1;2;3;4]) 1 3 |> CCList.of_iter = [1;2;3]
slice_iter (of_list [0;1;2;3;4]) 1 4 |> CCList.of_iter = [1;2;3;4]
slice_iter (of_list [0;1;2;3;4]) 0 5 |> CCList.of_iter = [0;1;2;3;4]
*)
let slice v = (v.vec, 0, v.size)
let (--) i j =
if i>j
then init (i-j+1) (fun k -> i-k)
else init (j-i+1) (fun k -> i+k)
(*$T
(1 -- 4) |> to_list = [1;2;3;4]
(4 -- 1) |> to_list = [4;3;2;1]
(0 -- 0) |> to_list = [0]
*)
(*$Q
Q.(pair small_int small_int) (fun (a,b) -> \
(a -- b) |> to_list = CCList.(a -- b))
*)
let (--^) i j =
if i=j then create()
else if i>j
then init (i-j) (fun k -> i-k)
else init (j-i) (fun k -> i+k)
(*$Q
Q.(pair small_int small_int) (fun (a,b) -> \
(a --^ b) |> to_list = CCList.(a --^ b))
*)
let of_array a =
if Array.length a = 0
then create ()
else {
size=Array.length a;
vec=Array.copy a;
}
let of_list l = match l with
| [] -> create()
| [x] -> return x
| [x;y] -> {size=2; vec=[| x; y |]}
| x::_ ->
let v = create_with ~capacity:(List.length l) x in
List.iter (push_unsafe_ v) l;
v
(*$T
of_list CCList.(1--300_000) |> to_list = CCList.(1--300_000)
*)
let to_array v =
Array.sub v.vec 0 v.size
let to_list v =
List.rev (fold (fun acc x -> x::acc) [] v)
let of_gen ?(init=create ()) g =
let rec aux g = match g() with
| None -> init
| Some x -> push init x; aux g
in aux g
let to_gen v =
let i = ref 0 in
fun () ->
if !i < v.size
then (
let x = v.vec.( !i ) in
incr i;
Some x
) else None
(*$T
let v = (1--10) in to_list v = Gen.to_list (to_gen v)
*)
let to_string ?(start="") ?(stop="") ?(sep=", ") item_to_string v =
start ^ (to_list v |> List.map item_to_string |> String.concat sep) ^ stop
let pp ?(pp_start=fun _ () -> ()) ?(pp_stop=fun _ () -> ())
?(pp_sep=fun fmt () -> Format.fprintf fmt ",@ ") pp_item fmt v =
pp_start fmt ();
iteri
(fun i x ->
if i > 0 then pp_sep fmt ();
pp_item fmt x
) v;
pp_stop fmt ()
include CCShimsMkLet_.Make2(struct
type nonrec ('a,'e) t = ('a,'e) t
let (>|=) = (>|=)
let (>>=) = (>>=)
let monoid_product a1 a2 = monoid_product (fun x y->x,y) a1 a2
end)