diff --git a/dune-project b/dune-project new file mode 100644 index 0000000..2c59b4c --- /dev/null +++ b/dune-project @@ -0,0 +1,2 @@ +(lang dune 2.0) +(name nullable-array) diff --git a/lib/nullable_array.ml b/lib/nullable_array.ml index 3763607..c93439a 100644 --- a/lib/nullable_array.ml +++ b/lib/nullable_array.ml @@ -139,6 +139,18 @@ let make (n:int) : 'a t = already does it *) Array.make (n+1) (null:elt) +let make_some (n:int) (v:'a) : 'a t = + if n < 0 then invalid_arg "Nullable_array.make_some"; + let a = Array.make (n+1) (Obj.magic (Sys.opaque_identity v) : elt) in + Array.unsafe_set a 0 null; + a + +let init_some (n:int) (f:int -> 'a) : 'a t = + if n < 0 then invalid_arg "Nullable_array.init_some"; + Array.init (n+1) (function + | 0 -> (null:elt) + | i -> (Obj.magic (f (i-1)) : elt)) + let empty_array : 'a t = [| null |] let get_null (a:'a t) : elt = @@ -171,6 +183,10 @@ let set_some (a:'a t) (n:int) (v:'a) : unit = if n < 0 then invalid_arg "Nullable_array.set_some"; set_elt (a:'a t) (n+1) (Obj.magic v : elt) +let fill_some (a:'a t) (pos:int) (len:int) (v:'a) : unit = + let v = (Sys.opaque_identity (Obj.magic v : elt)) in + Array.fill a (pos+1) len v + let clear (a:'a t) (n:int) : unit = if n < 0 then invalid_arg "Nullable_array.clear"; let null = get_null a in @@ -196,6 +212,49 @@ let iteri ~(some:int -> 'a -> unit) ~(none:int -> unit) (a:'a t) : unit = done [@@ocaml.inline] +let map_some (f:'a -> 'b) (from:'a t) : 'b t = + let null = get_null from in + let len = Array.length from in + let to_ = Array.make len null in + for i = 1 to len - 1 do + let elt = Array.unsafe_get from i in + if elt != null then + let elt' : elt = Obj.magic (f (Obj.magic elt:'a)) in + unsafe_set_elt to_ i elt' + done; + to_ + +let mapi_some (f:int -> 'a -> 'b) (from:'a t) : 'b t = + let null = get_null from in + let len = Array.length from in + let to_ = Array.make len null in + for i = 1 to len - 1 do + let elt = Array.unsafe_get from i in + if elt != null then + let elt' : elt = Obj.magic (f (i-1) (Obj.magic elt:'a)) in + unsafe_set_elt to_ i elt' + done; + to_ + +let unsafe_sub (a:'a t) (pos:int) (len:int) : 'a t = + if pos = 0 then + (* Let the runtime copy the null element *) + Array.sub a pos (len+1) + else + (* Include an extra element at the start of the new array, + then set it to [null]. *) + let res = Array.sub a (pos-1) (len+1) in + unsafe_set_elt res 0 (get_null a); + res + +let sub (a:'a t) (pos:int) (len:int) : 'a t = + if pos < 0 || len < 0 || pos > length a - len + then invalid_arg "Nullable_array.sub" + else unsafe_sub a pos len + +let copy (a:'a t) : 'a t = + unsafe_sub a 0 (length a) + let unsafe_manual_blit (from:'a t) (from_start:int) (to_:'a t) (to_start:int) (len:int) = let null_from = get_null from in let null_to = get_null to_ in @@ -224,6 +283,17 @@ let blit (from:'a t) (from_start:int) (to_:'a t) (to_start:int) (len:int) = (unsafe_manual_blit [@inlined never]) from from_start to_ to_start len end +let of_array (a:'a array) : 'a t = + init_some (Array.length a) (fun i -> Array.unsafe_get a i) + +let of_list (l:'a list) : 'a t = + let a = make (List.length l) in + let rec fill i = function + | [] -> a + | x :: xs -> unsafe_set_elt a i (Obj.magic x : elt); fill (i+1) xs + in + fill 1 l + let equal (a1:'a t) (a2:'a t) ~(equal:'a -> 'a -> bool) = length a1 = length a2 && let null1 = get_null a1 in @@ -247,6 +317,8 @@ let equal (a1:'a t) (a2:'a t) ~(equal:'a -> 'a -> bool) = in loop (length a1) +let max_length = Sys.max_array_length - 1 + (* Unsafe functions *) let unsafe_get_some (a:'a t) (n:int) : 'a = diff --git a/lib/nullable_array.mli b/lib/nullable_array.mli index 3f73379..f13f782 100644 --- a/lib/nullable_array.mli +++ b/lib/nullable_array.mli @@ -44,6 +44,26 @@ val make : int -> 'a t Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length - 1]. *) +val make_some : int -> 'a -> 'a t +(** [make_some n x] Create an array of size [n] in which each element is + initially set to [Some x]. + + Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length - 1]. *) + +val init_some : int -> (int -> 'a) -> 'a t +(** [init_some n f] Returns a fresh array of length [n], with the element at + index [i] given by [Some (f i)]. + + Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length - 1]. *) + +val sub : 'a t -> int -> int -> 'a t +(** [sub a pos len] returns a fresh array of length [len], containing the + elements number [pos] to [pos + len - 1] of array [a]. + + Raise [Invalid_argument] if [pos] and [len] do not designate a valid + subarray of a; that is, if [pos < 0], or [len < 0], or [pos + len > length + a]. *) + val empty_array : 'a t (** A preallocated empty array *) @@ -81,6 +101,13 @@ val set_some : 'a t -> int -> 'a -> unit {[set_some a n v; assert( get a n = Some v )]} *) +val fill_some : 'a t -> int -> int -> 'a -> unit +(** [fill_some a pos len x] Modifies array [a] in place, replacing + each element from [pos] to [pos + len - 1] with [Some x]. + + Raise [Invalid_argument "index out of bounds"] if [pos] + and [len] do not designate a valid subarray of [a]. *) + val clear : 'a t -> int -> unit (** [clear a n] Modifies array [a] in place, replacing element number [n] with [None]. @@ -100,6 +127,34 @@ val iteri : some:(int -> 'a -> unit) -> none:(int -> unit) -> 'a t -> unit [some 0 v0; none 1; some 2 v2]. *) +val map_some : ('a -> 'b) -> 'a t -> 'b t +(** [map_some f a] builds an array [a'] of size equal to [a] in which each + non-null element is given by applying [f] to the corresponding element + in [a]. + + For example: + + {[ + map_some f [| Some v0; None; Some v2; None |] + = [| Some (f v0); None; Some (f v2); None |] + ]} + *) + +val mapi_some : (int -> 'a -> 'b) -> 'a t -> 'b t +(** [mapi_some] is like {!map_some}, but also supplies the index of non-null + elements to the mapping function. + + For example: + + {[ + mapi_some f [| Some v0; None; Some v2; None |] + = [| Some (f 0 v0); None; Some (f 2 v2); None |] + ]} + *) + +val copy : 'a t -> 'a t +(** [copy a] results a fresh array containing the same elements as [a]. *) + val blit : 'a t -> int -> 'a t -> int -> int -> unit (** [blit from from_start to to_start len] copies [len] elements from array [from], starting at element number [from_start], @@ -112,6 +167,18 @@ val blit : 'a t -> int -> 'a t -> int -> int -> unit [to_start] and [len] do not designate a valid subarray of [to]. *) +val of_array : 'a array -> 'a t +(** [of_array a] returns a fresh array containing the elements of [a]. + + Raise [Invalid_argument] if the length of [a] is greater than + {!max_length}. *) + +val of_list : 'a list -> 'a t +(** [of_list l] returns a fresh array containing the elements of [l]. + + Raise [Invalid_argument] if the length of [l] is greater than + {!max_length}. *) + val equal : 'a t -> 'a t -> equal:('a -> 'a -> bool) -> bool (** [equal a1 a2 ~equal] is true if [a1] and [a2] have the same length and for all elements of [a1] and [a2] @@ -124,6 +191,9 @@ val equal : 'a t -> 'a t -> equal:('a -> 'a -> bool) -> bool [equal empty_array empty_array ~equal] is [true] *) +val max_length : int +(** [max_length] is [Sys.max_array_length - 1]. *) + (**/**) (** {6 Undocumented functions} *) diff --git a/nullable-array.opam b/nullable-array.opam index 1d169b6..1b67047 100644 --- a/nullable-array.opam +++ b/nullable-array.opam @@ -22,7 +22,7 @@ build: [ ] depends: [ - "dune" {>= "1.10"} + "dune" {>= "2.0"} "ocaml" {>= "4.03" (* use Sys.opaque_identity *) & < "4.13~"} (* need to be tested before announcing that a version is correct *) ]