diff --git a/core/CCArray.ml b/core/CCArray.ml index 69d6f445..4f7ad5c6 100644 --- a/core/CCArray.ml +++ b/core/CCArray.ml @@ -162,3 +162,10 @@ let pp_i ?(sep=", ") pp_item buf a = (if i > 0 then Buffer.add_string buf sep); pp_item buf i a.(i) done + +let print ?(sep=", ") pp_item fmt a = + Array.iteri + (fun i x -> + if i > 0 then Format.pp_print_string fmt sep; + pp_item fmt x + ) a diff --git a/core/CCArray.mli b/core/CCArray.mli index 047ef761..555a77c8 100644 --- a/core/CCArray.mli +++ b/core/CCArray.mli @@ -68,9 +68,13 @@ val shuffle : 'a t -> unit (** shuffle randomly the array, in place *) val pp: ?sep:string -> (Buffer.t -> 'a -> unit) - -> Buffer.t -> 'a array -> unit + -> Buffer.t -> 'a t -> unit (** print an array of items with printing function *) val pp_i: ?sep:string -> (Buffer.t -> int -> 'a -> unit) - -> Buffer.t -> 'a array -> unit + -> Buffer.t -> 'a t -> unit (** print an array, giving the printing function both index and item *) + +val print : ?sep:string -> (Format.formatter -> 'a -> unit) + -> Format.formatter -> 'a t -> unit +(** print an array of items with printing function *) diff --git a/core/CCVector.ml b/core/CCVector.ml index 0ea564e7..cf5de68a 100644 --- a/core/CCVector.ml +++ b/core/CCVector.ml @@ -25,30 +25,76 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (** {1 Growable, mutable vector} *) +type 'a sequence = ('a -> unit) -> unit +type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist] +type 'a gen = unit -> 'a option +type 'a equal = 'a -> 'a -> bool +type 'a ord = 'a -> 'a -> int +type 'a printer = Buffer.t -> 'a -> unit +type 'a formatter = Format.formatter -> 'a -> unit + (** a vector of 'a. *) type 'a t = { mutable size : int; mutable vec : 'a array; } -let create i = - let i = max i 3 in - { size = 0; - vec = Array.create i (Obj.magic None); - } +let create () = { + size = 0; + vec = [| |]; +} -let resize v newcapacity = +let create_with ?(capacity=128) x = { + size = 0; + vec = Array.make capacity x; +} + +(*$T + (create_with ~capacity:200 1 |> capacity) >= 200 +*) + +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 empty? *) +let _empty_array v = + Array.length v.vec = 0 + +(* assuming the underlying array isn't empty, resize it *) +let _resize v newcapacity = assert (newcapacity >= v.size); - let new_vec = Array.create newcapacity (Obj.magic None) in + assert (not (_empty_array v)); + let new_vec = Array.create newcapacity v.vec.(0) in Array.blit v.vec 0 new_vec 0 v.size; v.vec <- new_vec; () +(*$T + (let v = create_with ~capacity:10 1 in ensure v 200; capacity v >= 200) +*) + +(* grow the array, using [x] as a filler if required *) +let _grow v x = + if _empty_array v + then v.vec <- Array.make 32 x + else + let size = min (2 * Array.length v.vec + 10) Sys.max_array_length in + _resize v size + let ensure v size = - if v.size < size + if Array.length v.vec = 0 + then () + else if v.size < size then - let size' = min (2 * v.size) Sys.max_array_length in - resize v size' + let size' = min size Sys.max_array_length in + _resize v size' let clear v = v.size <- 0 @@ -56,59 +102,92 @@ let clear v = let is_empty v = v.size = 0 let push v x = - (if v.size = Array.length v.vec then resize v (2 * v.size)); + if v.size = Array.length v.vec + then _grow v x; Array.unsafe_set v.vec v.size x; v.size <- v.size + 1 (** add all elements of b to a *) let append a b = - (if Array.length a.vec < a.size + b.size - then resize a (2 * (a.size + b.size))); - Array.blit b.vec 0 a.vec a.size b.size; - a.size <- a.size + b.size + if _empty_array a + then if _empty_array b + then () + else ( + a.vec <- Array.copy b.vec; + a.size <- b.size + ) + else ( + ensure a (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 + ) -let append_array a b = - (if Array.length a.vec < a.size + Array.length b - then resize a (2 * (a.size + Array.length b))); - Array.blit b 0 a.vec a.size (Array.length b); - a.size <- a.size + Array.length b +let get v i = + if i < 0 || i >= v.size then failwith "Vector.get"; + Array.unsafe_get v.vec i + +let set v i x = + if i < 0 || i >= v.size then failwith "Vector.set"; + Array.unsafe_set v.vec i x let append_seq a seq = seq (fun x -> push a x) -let pop v = - (if v.size = 0 then failwith "Vector.pop on empty vector"); +let append_array a b = + Array.iter (push a) b + +let equal eq v1 v2 = + let n = min v1.size v2.size in + let rec check i = + if i = n + then v1.size = v2.size + else eq (get v1 i) (get v2 i) && check (i+1) + in check 0 + +let compare cmp v1 v2 = + let n = min v1.size v2.size in + let rec check i = + if i = n + then Pervasives.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 + +let pop_exn v = + if v.size = 0 + then failwith "Vector.pop on empty vector"; v.size <- v.size - 1; let x = v.vec.(v.size) in x -let copy v = - let v' = create v.size in - Array.blit v.vec 0 v'.vec 0 v.size; - v'.size <- v.size; - v' +let pop v = + try Some (pop_exn v) + with Failure _ -> None + +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 +*) let shrink v n = - if n > v.size - then failwith "cannot shrink to bigger size" - else v.size <- n + if n < v.size then v.size <- n -let member ?(eq=(=)) v x = - let n = v.size in - let rec check i = - if i = n then false - else if eq x v.vec.(i) then true - else check (i+1) - in check 0 - -let sort ?(cmp=compare) v = +let sort cmp v = (* copy array (to avoid junk in it), then sort the array *) let a = Array.sub v.vec 0 v.size in Array.fast_sort cmp a; v.vec <- a -let uniq_sort ?(cmp=compare) v = - sort ~cmp v; +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 @@ -116,64 +195,83 @@ let uniq_sort ?(cmp=compare) v = 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 *) + 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 *) + then traverse v.vec.(0) 1 1 + (* start at 1, to get the first element in hand *) -let iter v k = +let iter k v = for i = 0 to v.size -1 do k (Array.unsafe_get v.vec i) done -let iteri v k = +let iteri k v = for i = 0 to v.size -1 do k i (Array.unsafe_get v.vec i) done -let map v f = - let v' = create v.size in - for i = 0 to v.size - 1 do - let x = f (Array.unsafe_get v.vec i) in - Array.unsafe_set v'.vec i x - done; - v'.size <- v.size; - v' +let map f v = + if _empty_array v + then create () + else { + size=v.size; + vec=Array.map f v.vec + } -let filter v f = - let v' = create v.size in - for i = 0 to v.size - 1 do - let x = Array.unsafe_get v.vec i in - if f x then push v' x; - done; - v' +let filter p v = + if _empty_array v + then create () + else ( + let v' = create_with ~capacity:v.size v.vec.(0) in + Array.iter + (fun x -> if p x then push v' x) + v.vec; + v' + ) -let fold v acc f = - let acc = ref acc in - for i = 0 to v.size - 1 do - let x = Array.unsafe_get v.vec i in - acc := f !acc x; - done; - !acc +(*$T + filter (fun x-> x mod 2=0) (of_list [1;2;3;4;5]) |> to_list = [2;4] +*) -let exists v p = +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 +*) + +let exists p v = let n = v.size in let rec check i = if i = n then false - else if p v.vec.(i) then true - else check (i+1) + else p v.vec.(i) || check (i+1) in check 0 -let for_all v p = +let for_all p v = let n = v.size in let rec check i = if i = n then true - else if not (p v.vec.(i)) then false - else check (i+1) + else p v.vec.(i) && check (i+1) in check 0 -let find v p = +let member ?(eq=(=)) x v = + exists (eq x) v + +let find_exn p v = let n = v.size in let rec check i = if i = n then raise Not_found @@ -181,65 +279,166 @@ let find v p = else check (i+1) in check 0 -let get v i = - (if i < 0 || i >= v.size then failwith "Vector.get"); - Array.unsafe_get v.vec i +let find p v = + try Some (find_exn p v) + with Not_found -> None -let set v i x = - (if i < 0 || i >= v.size then failwith "Vector.set"); - Array.unsafe_set v.vec i x +let filter_map f v = + let v' = create () in + iter + (fun x -> match f x with + | None -> () + | Some y -> push v' y + ) v; + v' + +let flat_map f v = + let v' = create () in + iter (fun x -> iter (push v') (f x)) v; + v' + +let flat_map' f v = + let v' = create () in + iter + (fun x -> + let seq = f x in + seq (fun y -> push v' y) + ) v; + v' + +let (>>=) x f = flat_map f x + +let (>|=) x f = map f x + +let rev' 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 + ) let rev v = - 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 + let v' = copy v in + rev' 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 = [] +*) let size v = v.size let length v = v.size +let capacity v = Array.length v.vec + let unsafe_get_array v = v.vec -type 'a sequence = ('a -> unit) -> unit - -let of_seq ?(init=create 10) seq = +let of_seq ?(init=create ()) seq = append_seq init seq; init -let to_seq = iter +(*$T + of_seq CCSequence.(1 -- 10) |> to_list = CCList.(1 -- 10) +*) + +let to_seq v k = iter k v let slice v start len = assert (start >= 0 && len >= 0); fun k -> assert (start+len < v.size); - for i = start to start+len do + for i = start to start+len-1 do let x = Array.unsafe_get v.vec i in k x done -let from_array a = - let c = Array.length a in - let v = create c in - Array.blit a 0 v.vec 0 c; - v.size <- c; - v +(*$T + slice (of_list [0;1;2;3;4]) 1 3 |> CCList.of_seq = [1;2;3] +*) -let from_list l = - let v = create 10 in - List.iter (push v) l; - v +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] +*) + +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::l' -> + let v = create_with ~capacity:(List.length l + 5) x in + List.iter (push v) l; + v let to_array v = Array.sub v.vec 0 v.size let to_list v = - let l = ref [] in - for i = 0 to v.size - 1 do - l := get v i :: !l; - done; - List.rev !l + 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 + +let of_klist ?(init=create ()) l = + let rec aux l = match l() with + | `Nil -> init + | `Cons (x,l') -> push init x; aux l' + in aux l + +let to_klist v = + let rec aux i () = + if i=v.size then `Nil + else `Cons (v.vec.(i), aux (i+1)) + in aux 0 + +let pp ?(start="[") ?(stop="]") ?(sep=", ") pp_item buf v = + Buffer.add_string buf start; + iteri + (fun i x -> + if i > 0 then Buffer.add_string buf sep; + pp_item buf x + ) v; + Buffer.add_string buf stop + +let print ?(start="[") ?(stop="]") ?(sep=", ") pp_item fmt v = + Format.fprintf fmt "@[%s" start; + iteri + (fun i x -> + if i > 0 then Format.pp_print_string fmt sep; + pp_item fmt x + ) v; + Format.fprintf fmt "%s@]" stop diff --git a/core/CCVector.mli b/core/CCVector.mli index 697c601e..6981935c 100644 --- a/core/CCVector.mli +++ b/core/CCVector.mli @@ -29,16 +29,33 @@ type 'a t (** the type of a vector of 'a *) type 'a sequence = ('a -> unit) -> unit +type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist] +type 'a gen = unit -> 'a option +type 'a equal = 'a -> 'a -> bool +type 'a ord = 'a -> 'a -> int +type 'a printer = Buffer.t -> 'a -> unit +type 'a formatter = Format.formatter -> 'a -> unit -val create : int -> 'a t -(** create a vector of given initial capacity *) +val create : unit -> 'a t +(** Create a new, empty vector *) + +val create_with : ?capacity:int -> 'a -> 'a t +(** Create a new vector, using the given value as a filler. + @param capacity the size of the underlying array + {b caution}: the value will likely not be GC'd before the vector is. *) + +val make : int -> 'a -> 'a t +(** [make n x] makes a vector of size [n], filled with [x] *) + +val init : int -> (int -> 'a) -> 'a t +(** Init the vector with the given function and size *) val clear : 'a t -> unit (** 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 *) +(** Hint to the vector that it should have at least the given capacity. + Just a hint, will not be enforced if the vector is empty. *) val is_empty : 'a t -> bool (** is the vector empty? *) @@ -55,56 +72,88 @@ val append_array : 'a t -> 'a array -> unit val append_seq : 'a t -> 'a sequence -> unit (** Append content of sequence *) -val pop : 'a t -> 'a -(** remove last element, or raise a Failure if empty *) +val equal : 'a equal -> 'a t equal + +val compare : 'a ord -> 'a t ord +(** Lexicographic comparison *) + +val pop : 'a t -> 'a option +(** Remove last element, or [None] *) + +val pop_exn : 'a t -> 'a +(** remove last element, or raise a Failure if empty + @raise Failure on an empty vector *) val copy : 'a t -> 'a t (** shallow copy *) val shrink : 'a t -> int -> unit -(** shrink to the given size (remove elements above this size) *) +(** shrink to the given size (remove elements above this size). + Does nothing if the parameter is bigger than the current size. *) -val member : ?eq:('a -> 'a -> bool) -> 'a t -> 'a -> bool +val member : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool (** is the element a member of the vector? *) -val sort : ?cmp:('a -> 'a -> int) -> 'a t -> unit +val sort : ('a -> 'a -> int) -> 'a t -> unit (** sort the array in place*) -val uniq_sort : ?cmp:('a -> 'a -> int) -> 'a t -> unit +val uniq_sort : ('a -> 'a -> int) -> 'a t -> unit (** sort the array and remove duplicates in place*) -val iter : 'a t -> ('a -> unit) -> unit +val iter : ('a -> unit) -> 'a t -> unit (** iterate on the vector *) -val iteri : 'a t -> (int -> 'a -> unit) -> unit +val iteri : (int -> 'a -> unit) -> 'a t -> unit (** iterate on the vector with indexes *) -val map : 'a t -> ('a -> 'b) -> 'b t +val map : ('a -> 'b) -> 'a t -> 'b t (** map elements of the vector *) -val filter : 'a t -> ('a -> bool) -> 'a t +val filter : ('a -> bool) -> 'a t -> 'a t (** filter elements from vector *) -val fold : 'a t -> 'b -> ('b -> 'a -> 'b) -> 'b +val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b (** fold on elements of the vector *) -val exists : 'a t -> ('a -> bool) -> bool +val exists : ('a -> bool) -> 'a t -> bool (** existential test *) -val for_all : 'a t -> ('a -> bool) -> bool +val for_all : ('a -> bool) -> 'a t -> bool (** universal test *) -val find : 'a t -> ('a -> bool) -> 'a -(** find an element that satisfies the predicate, or Not_found *) +val find : ('a -> bool) -> 'a t -> 'a option +(** Find an element that satisfies the predicate *) + +val find_exn : ('a -> bool) -> 'a t -> 'a +(** find an element that satisfies the predicate, or + @raise Not_found if no element does *) + +val filter_map : ('a -> 'b option) -> 'a t -> 'b t +(** Map elements with a function, possibly filtering some of them out *) + +val flat_map : ('a -> 'b t) -> 'a t -> 'b t +(** Map each element to a sub-vector *) + +val flat_map' : ('a -> 'b sequence) -> 'a t -> 'b t +(** Like {!flat_map}, but using {!sequence} for intermediate collections *) + +val (>>=) : 'a t -> ('a -> 'b t) -> 'b t + +val (>|=) : 'a t -> ('a -> 'b) -> 'b t val get : 'a t -> int -> 'a -(** access element, or Failure if bad index *) +(** access element, or + @raise Failure if bad index *) val set : 'a t -> int -> 'a -> unit -(** access element, or Failure if bad index *) +(** access element, or + @raise Failure if bad index *) -val rev : 'a t -> unit -(** Reverse array in place *) +val rev : 'a t -> 'a t +(** Reverse the vector *) + +val rev' : 'a t -> unit +(** Reverse the vector in place *) val size : 'a t -> int (** number of elements in vector *) @@ -112,21 +161,37 @@ val size : 'a t -> int val length : _ t -> int (** Synonym for {! size} *) +val capacity : _ t -> int +(** Number of elements the vector can contain without being resized *) + val unsafe_get_array : 'a t -> 'a array -(** Access the underlying *shared* array (do not modify!). +(** Access the underlying {b shared} array (do not modify!). [unsafe_get_array v] is longer than [size v], but elements at higher index than [size v] are undefined (do not access!). *) +val (--) : int -> int -> int t +(** Range of integers (both included) *) + +val of_array : 'a array -> 'a t +val of_list : 'a list -> 'a t +val to_array : 'a t -> 'a array +val to_list : 'a t -> 'a list + val of_seq : ?init:'a t -> 'a sequence -> 'a t val to_seq : 'a t -> 'a sequence val slice : 'a t -> int -> int -> 'a sequence (** [slice v start len] is the sequence of elements from [v.(start)] - to [v.(start+len)] included. *) + to [v.(start+len-1)]. *) -val from_array : 'a array -> 'a t -val from_list : 'a list -> 'a t -val to_array : 'a t -> 'a array -val to_list : 'a t -> 'a list +val of_klist : ?init:'a t -> 'a klist -> 'a t +val to_klist : 'a t -> 'a klist +val of_gen : ?init:'a t -> 'a gen -> 'a t +val to_gen : 'a t -> 'a gen +val pp : ?start:string -> ?stop:string -> ?sep:string -> + 'a printer -> 'a t printer + +val print : ?start:string -> ?stop:string -> ?sep:string -> + 'a formatter -> 'a t formatter