Skip to content
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion dune
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
(library
(public_name vector)
(modules vector))
(modules vector)
(libraries nullable-array))

(test
(name test)
Expand Down
14 changes: 7 additions & 7 deletions test.ml
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@ open Format
open Vector

let () =
let v = make 0 ~dummy:42 in
let v = create () in
push v 17;
push v 2;
assert (length v = 2);
Expand All @@ -13,7 +13,7 @@ let () =

let () =
let n = 20 in
let v = make 1 ~dummy:0 in
let v = make 1 0 in
push v 1;
for i = 2 to n do push v (get v (i-2) + get v (i-1)) done;
assert (length v = n+1);
Expand All @@ -23,7 +23,7 @@ let () =
(* stack *)

let () =
let s = create ~dummy:42 in
let s = create () in
push s 1;
assert (top s = 1);
push s 2;
Expand All @@ -40,8 +40,8 @@ let () =
()

let () =
let v = make 12 ~dummy:() in
for i = 0 to 1000 do resize v i done;
for i = 1000 downto 0 do resize v i done;
for _ = 1 to 1000 do resize v (Random.int 10_000) done;
let v = make 12 () in
for i = 0 to 1000 do resize v i () done;
for i = 1000 downto 0 do shrink v i done;
for _ = 1 to 1000 do resize v (Random.int 10_000) () done;
()
119 changes: 72 additions & 47 deletions vector.ml
Original file line number Diff line number Diff line change
Expand Up @@ -13,104 +13,129 @@
(* *)
(**************************************************************************)

module Narray = Nullable_array

type 'a t = {
dummy: 'a;
mutable size: int;
mutable data: 'a array; (* 0 <= size <= Array.length data *)
mutable data: 'a Narray.t; (* 0 <= size <= Narray.length data *)
}

let make n ~dummy =
if n < 0 || n > Sys.max_array_length then invalid_arg "Vector.make";
{ dummy = dummy; size = n; data = Array.make n dummy; }
let make n v =
if n < 0 || n > Narray.max_length then invalid_arg "Vector.make";
{ size = n; data = Narray.make_some n v; }

let create ~dummy =
make 0 ~dummy
let create () =
{ size = 0; data = Narray.empty_array }

let init n ~dummy f =
if n < 0 || n > Sys.max_array_length then invalid_arg "Vector.init";
{ dummy = dummy; size = n; data = Array.init n f; }
let init n f =
if n < 0 || n > Narray.max_length then invalid_arg "Vector.init";
{ size = n; data = Narray.init_some n f; }

let length a =
a.size

let get a i =
if i < 0 || i >= a.size then invalid_arg "Vector.get";
Array.unsafe_get a.data i
Narray.unsafe_get_some a.data i

let set a i v =
if i < 0 || i >= a.size then invalid_arg "Vector.set";
Array.unsafe_set a.data i v
Narray.unsafe_set_some a.data i v

let unsafe_get a i =
Array.unsafe_get a.data i
Narray.unsafe_get_some a.data i

let unsafe_set a i v =
Array.unsafe_set a.data i v
Narray.unsafe_set_some a.data i v

(* shrink that assumes [0 <= s < a.size] *)
let unsafe_shrink a s =
let n = Narray.length a.data in
if 4 * s < n then (* reallocate into a smaller array *)
a.data <- Narray.sub a.data 0 s
else begin
for i = s to a.size - s do
Narray.clear a.data i
done
end;
a.size <- s

let shrink a s =
if s < 0 then invalid_arg "Vector.shrink";
if s < a.size then unsafe_shrink a s

(* expansion that creates an uninitialised suffix *)
let unsafe_expand a s =
if s > a.size then begin
let n = Narray.length a.data in
if s > n then begin
let n' = min (max (2 * n) s) Narray.max_length in
let a' = Narray.make n' in
Narray.blit a.data 0 a' 0 a.size;
a.data <- a'
end;
a.size <- s
end

let resize a s =
let resize a s v =
if s < 0 then invalid_arg "Vector.resize";
let n = Array.length a.data in
if s <= a.size then
(* shrink *)
if 4 * s < n then (* reallocate into a smaller array *)
a.data <- Array.sub a.data 0 s
else
Array.fill a.data s (a.size - s) a.dummy
unsafe_shrink a s
else begin
let n = Narray.length a.data in
(* grow *)
if s > n then begin (* reallocate into a larger array *)
if s > Sys.max_array_length then invalid_arg "Vector.resize: cannot grow";
let n' = min (max (2 * n) s) Sys.max_array_length in
let a' = Array.make n' a.dummy in
Array.blit a.data 0 a' 0 a.size;
if s > Narray.max_length then invalid_arg "Vector.resize: cannot grow";
let n' = min (max (2 * n) s) Narray.max_length in
let a' = Narray.make_some n' v in
Narray.blit a.data 0 a' 0 a.size;
a.data <- a'
end
end;
a.size <- s
end;
a.size <- s
end
Comment on lines +85 to +95
Copy link
Contributor Author

@craigfe craigfe May 18, 2021

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Differs from unsafe_expand above only in the use of make_some n' v rather than make n'. Not sure if there's an elegant factorisation that doesn't also allocate an option. Opinions much appreciated.


(** stack interface *)

let is_empty a =
length a = 0

let clear a =
resize a 0
shrink a 0

let push a v =
let n = a.size in
resize a (n+1);
Array.unsafe_set a.data n v
unsafe_expand a (n+1);
Narray.unsafe_set_some a.data n v

exception Empty

let top a =
let n = length a in
if n = 0 then raise Empty;
Array.unsafe_get a.data (n - 1)
Narray.unsafe_get_some a.data (n - 1)

let pop a =
let n = length a - 1 in
if n < 0 then raise Empty;
let r = Array.unsafe_get a.data n in
resize a n;
let r = Narray.unsafe_get_some a.data n in
shrink a n;
r

(** array interface *)

let append a1 a2 =
let n1 = length a1 in
let n2 = length a2 in
resize a1 (n1 + n2);
unsafe_expand a1 (n1 + n2);
for i = 0 to n2 - 1 do unsafe_set a1 (n1 + i) (unsafe_get a2 i) done

let copy a =
{ dummy = a.dummy;
size = a.size;
data = Array.copy a.data; }
{ size = a.size;
data = Narray.copy a.data; }

let sub a ofs len =
if len < 0 || ofs > length a - len then invalid_arg "Vector.sub";
{ dummy = a.dummy; size = len; data = Array.sub a.data ofs len }
{ size = len; data = Narray.sub a.data ofs len }

let fill a ofs len v =
if ofs < 0 || len < 0 || ofs > length a - len then invalid_arg "Vector.fill";
Expand All @@ -133,28 +158,28 @@ let iter f a =
for i = 0 to length a - 1 do f (unsafe_get a i) done

let map f a =
{ dummy = f a.dummy; size = a.size; data = Array.map f a.data }
{ size = a.size; data = Narray.map_some f a.data }

let iteri f a =
for i = 0 to length a - 1 do f i (unsafe_get a i) done

let mapi f a =
{ dummy = f 0 a.dummy; size = a.size; data = Array.mapi f a.data }
{ size = a.size; data = Narray.mapi_some f a.data }

let to_list a =
let rec tolist i res =
if i < 0 then res else tolist (i - 1) (unsafe_get a i :: res) in
tolist (length a - 1) []

let of_list ~dummy l =
let a = Array.of_list l in
{ dummy = dummy; size = Array.length a; data = a }
let of_list l =
let a = Narray.of_list l in
{ size = Narray.length a; data = a }

let to_array a =
Array.sub a.data 0 a.size
Array.init a.size (fun i -> Narray.unsafe_get_some a.data i)

let of_array ~dummy a =
{ dummy = dummy; size = Array.length a; data = Array.copy a }
let of_array a =
{ size = Array.length a; data = Narray.of_array a }

let fold_left f x a =
let r = ref x in
Expand Down
70 changes: 34 additions & 36 deletions vector.mli
Original file line number Diff line number Diff line change
Expand Up @@ -22,10 +22,9 @@
growing the array (and shrinks it whenever the number of elements
comes to one fourth of the capacity).

The unused part of the internal array is filled with a dummy value,
which is user-provided at creation time (and referred to below
as ``the dummy value''). Consequently, vectors do not retain pointers
to values that are not used anymore after a shrinking.
The unused part of the internal array has an unspecified but stable
representation. Consequently, vectors do not retain pointers to
values that are not used anymore after a shrinking.

Vectors provide an efficient implementation of stacks, with a
better locality of reference than list-based implementations (such
Expand All @@ -43,41 +42,48 @@ type 'a t
(** {2 Operations proper to vectors, or with a different type and/or
semantics than those of module [Array]} *)

val make: int -> dummy:'a -> 'a t
(** [Vector.make n dummy] returns a fresh vector of length [n].
val make: int -> 'a -> 'a t
(** [Vector.make n v] returns a fresh vector of length [n].
All the elements of this new vector are initially
physically equal to [dummy] (in the sense of the [==] predicate).
physically equal to [v] (in the sense of the [==] predicate).

Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length].
If the value of [dummy] is a floating-point number, then the maximum
size is only [Sys.max_array_length / 2].*)
Raise [Invalid_argument] if [n < 0] or [n >= Sys.max_array_length]. *)
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

We could also provide Vector.max_length to correspond with Nullable_array.max_length.

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

That would be nice indeed.


val create: dummy:'a -> 'a t
(** [Vector.create dummy] returns a fresh vector of length [0]. *)
val create: unit -> 'a t
(** [Vector.create ()] returns a fresh vector of length [0]. *)

val init: int -> dummy:'a -> (int -> 'a) -> 'a t
val init: int -> (int -> 'a) -> 'a t
(** [Vector.init n f] returns a fresh vector of length [n],
with element number [i] initialized to the result of [f i].
In other terms, [Vector.init n f] tabulates the results of [f]
applied to the integers [0] to [n-1].

Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length].
If the return type of [f] is [float], then the maximum
size is only [Sys.max_array_length / 2].*)
Raise [Invalid_argument] if [n < 0] or [n >= Sys.max_array_length]. *)

val resize: 'a t -> int -> unit
(** [Vector.resize a n] sets the length of vector [a] to [n].
val resize: 'a t -> int -> 'a -> unit
(** [Vector.resize a n v] sets the length of vector [a] to [n].
If [n > Vector.length a], the new elements in the vector are
initially physically equal to [v].

The elements that are no longer part of the vector, if any, are
internally replaced by the dummy value of vector [a], so that they
cleared from the internal representation, so that they
can be garbage collected when possible.

Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length]. *)
Raise [Invalid_argument] if [n < 0] or [n >= Sys.max_array_length]. *)

val shrink: 'a t -> int -> unit
(** [Vector.shrink a n] reduces the length of vector [a] to be at most [n].
If [n >= Vector.length a], this operation has no effect.
Copy link
Contributor Author

@craigfe craigfe May 18, 2021

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm unsure if this is the ideal semantics for shrink (or if the name is confusing given those semantics). Perhaps the user will expect "shrink a n ensures length a = n", in which case perhaps we should raise when n > length a.

Copy link
Owner

@backtracking backtracking May 18, 2021

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes, I have mixed feelings about this one.

  • If shrink is exposed in the API, I would prefer it to fail when n > Vector.length a
  • A simpler solution is not to expose it, since users can always use resize to implement their own shrink on top of it.


The elements that are no longer part of the vector, if any, are
cleared from the internal representation, so that they
can be garbage collected when possible.

Raise [Invalid_argument] if [n < 0]. *)

(** {2 Stack interface}

Contrary to standard library's {Stack}, module {Vector} uses less space
Contrary to standard library's {!Stack}, module [Vector] uses less space
(between N and 2N words, instead of 3N) and has better data locality. *)

val push: 'a t -> 'a -> unit
Expand Down Expand Up @@ -110,7 +116,7 @@ val is_empty: 'a t -> bool

val length: 'a t -> int
(** Return the length (number of elements) of the given vector.
Note: the number of memory words occupiedby the vector can be larger. *)
Note: the number of memory words occupied by the vector can be larger. *)

val get: 'a t -> int -> 'a
(** [Vector.get a n] returns the element number [n] of vector [a].
Expand Down Expand Up @@ -161,15 +167,15 @@ val blit : 'a t -> int -> 'a t -> int -> int -> unit
val to_list : 'a t -> 'a list
(** [Vector.to_list a] returns the list of all the elements of [a]. *)

val of_list: dummy:'a -> 'a list -> 'a t
(** [Vector.of_list dummy l] returns a fresh vector containing the elements
val of_list: 'a list -> 'a t
(** [Vector.of_list l] returns a fresh vector containing the elements
of [l]. *)

val to_array: 'a t -> 'a array
(** [Vector.to_array a] returns the array of all the elements of [a]. *)

val of_array: dummy:'a -> 'a array -> 'a t
(** [Vector.of_array dummy a] returns a fresh vector containing the elements
val of_array: 'a array -> 'a t
(** [Vector.of_array a] returns a fresh vector containing the elements
of [a]. *)

val iter : ('a -> unit) -> 'a t -> unit
Expand All @@ -179,12 +185,7 @@ val iter : ('a -> unit) -> 'a t -> unit

val map : ('a -> 'b) -> 'a t -> 'b t
(** [Vector.map f a] applies function [f] to all the elements of [a],
and builds a fresh vector with the results returned by [f].

Note: the dummy value of the returned vector is obtained by applying
[f] to the dummy value of [a]. If this is not what you want,
first create a new vector and then fill it with the value
[f (get a 0)], [f (get a 1)], etc. *)
and builds a fresh vector with the results returned by [f]. *)

val iteri : (int -> 'a -> unit) -> 'a t -> unit
(** Same as {!Vector.iter}, but the
Expand All @@ -194,10 +195,7 @@ val iteri : (int -> 'a -> unit) -> 'a t -> unit
val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t
(** Same as {!Vector.map}, but the
function is applied to the index of the element as first argument,
and the element itself as second argument.

Note: the dummy value of the returned vector is obtained by applying
[f 0] to the dummy value of [a]. *)
and the element itself as second argument. *)

val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
(** [Vector.fold_left f x a] computes
Expand Down
Loading