Implement various standard functions for nullable arrays

Author: craigfe

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 =

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} *)