flambda-backend: Remove immutable arrays from stdlib.ml and stdlib.mli (

#1154)

stdlib/iarray.ml

@@ -4,6 +4,8 @@ open! Stdlib
 
 [@@@ocaml.flambda_o3]
 
+(* If you update this file please also update iarrayLabels.ml *)
+
 (* An alias for the type of immutable arrays. *)
 type +'a t = 'a iarray
 

stdlib/iarrayLabels.ml

@@ -8,4 +8,98 @@ open! Stdlib
 
 [@@@ocaml.nolabels]
 
-include Iarray
+(* CR mshinwell: Change to "include Iarray"; we can't do this at present
+   as it requires referencing Stdlib__Iarray which will work under the make
+   build but not under dune. *)
+
+(* CR aspectorzabusky: This needs a copyright header; should I copy [array.ml]? *)
+
+(* An alias for the type of immutable arrays. *)
+type +'a t = 'a iarray
+
+(* Array operations *)
+
+external length       : 'a iarray -> int       = "%array_length"
+external get          : 'a iarray -> int -> 'a = "%array_safe_get"
+external ( .:() )     : 'a iarray -> int -> 'a = "%array_safe_get"
+external unsafe_get   : 'a iarray -> int -> 'a = "%array_unsafe_get"
+
+(* Immutable and mutable arrays have the same runtime representation; we
+   construct immutable arrays by constructing mutable arrays and then blindly
+   casting them to become immutable.  This is safe here because:
+   1. None of these functions mutate their array inputs;
+   2. None of these functions hold on to their array inputs; and
+   3. All of these functions return fresh arrays if they return an array. *)
+let init =
+  Obj.magic (Array.init : int -> (int -> 'a) -> 'a array)
+let append =
+  Obj.magic (Array.append : 'a array -> 'a array -> 'a array)
+let concat =
+  Obj.magic (Array.concat : 'a array list -> 'a array)
+let sub =
+  Obj.magic (Array.sub : 'a array -> int -> int -> 'a array)
+let to_list =
+  Obj.magic (Array.to_list : 'a array -> 'a list)
+let of_list =
+  Obj.magic (Array.of_list : 'a list -> 'a array)
+let iter =
+  Obj.magic (Array.iter : ('a -> unit) -> 'a array -> unit)
+let iteri =
+  Obj.magic (Array.iteri : (int -> 'a -> unit) -> 'a array -> unit)
+let map =
+  Obj.magic (Array.map : ('a -> 'b) -> 'a array -> 'b array)
+let mapi =
+  Obj.magic (Array.mapi : (int -> 'a -> 'b) -> 'a array -> 'b array)
+let fold_left =
+  Obj.magic (Array.fold_left : ('a -> 'b -> 'a) -> 'a -> 'b array -> 'a)
+let fold_left_map =
+  Obj.magic (Array.fold_left_map :
+               ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array)
+let fold_right =
+  Obj.magic (Array.fold_right : ('b -> 'a -> 'a) -> 'b array -> 'a -> 'a)
+let iter2 =
+  Obj.magic (Array.iter2 : ('a -> 'b -> unit) -> 'a array -> 'b array -> unit)
+let map2 =
+  Obj.magic (Array.map2 : ('a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array)
+let for_all =
+  Obj.magic (Array.for_all : ('a -> bool) -> 'a array -> bool)
+let exists =
+  Obj.magic (Array.exists : ('a -> bool) -> 'a array -> bool)
+let for_all2 =
+  Obj.magic (Array.for_all2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool)
+let exists2 =
+  Obj.magic (Array.exists2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool)
+let mem =
+  Obj.magic (Array.mem : 'a -> 'a array -> bool)
+let memq =
+  Obj.magic (Array.memq : 'a -> 'a array -> bool)
+let find_opt =
+  Obj.magic (Array.find_opt : ('a -> bool) -> 'a array -> 'a option)
+let find_map =
+  Obj.magic (Array.find_map : ('a -> 'b option) -> 'a array -> 'b option)
+let split =
+  Obj.magic (Array.split : ('a * 'b) array -> 'a array * 'b array)
+let combine =
+  Obj.magic (Array.combine : 'a array -> 'b array -> ('a * 'b) array)
+let to_seq =
+  Obj.magic (Array.to_seq : 'a array -> 'a Seq.t)
+let to_seqi =
+  Obj.magic (Array.to_seqi : 'a array -> (int * 'a) Seq.t)
+let of_seq =
+  Obj.magic (Array.of_seq : 'a Seq.t -> 'a array)
+
+(* Only safe if the array isn't used after this call *)
+let unsafe_of_array : 'a array -> 'a iarray = Obj.magic
+
+(* Must be fully applied due to the value restriction *)
+let lift_sort sorter cmp iarr =
+  let arr = Array.of_iarray iarr in
+  sorter cmp arr;
+  unsafe_of_array arr
+
+let sort cmp iarr = lift_sort Array.sort cmp iarr
+let stable_sort cmp iarr = lift_sort Array.stable_sort cmp iarr
+let fast_sort cmp iarr = lift_sort Array.fast_sort cmp iarr
+
+let to_array = Array.of_iarray
+let of_array = Array.to_iarray

stdlib/stdlib.ml

@@ -229,10 +229,6 @@ external unsafe_char_of_int : int -> char = "%identity"
 let char_of_int n =
   if n < 0 || n > 255 then invalid_arg "char_of_int" else unsafe_char_of_int n
 
-(* Array operations -- more in modules Array and Iarray *)
-
-external ( .:() ) : 'a iarray -> int -> 'a = "%array_safe_get"
-
 (* Unit operations *)
 
 external ignore : 'a -> unit = "%ignore"
@@ -608,8 +604,6 @@ module Gc           = Gc
 module Genlex       = Genlex
 module Hashtbl      = Hashtbl
 module In_channel   = In_channel
-module Iarray       = Iarray
-module IarrayLabels = IarrayLabels
 module Int          = Int
 module Int32        = Int32
 module Int64        = Int64

stdlib/stdlib.mli

@@ -724,21 +724,6 @@ val char_of_int : int -> char
    outside the range 0--255. *)
 
 
-(** {1 Array operations}
-
-   More array operations are provided in modules {!Array} and {!Iarray}.
-*)
-
-external ( .:() ) : 'a iarray -> int -> 'a = "%array_safe_get"
-(** [a.:(n)] returns the element number [n] of immutable array [a].
-   The first element has number 0.
-   The last element has number [length a - 1].
-   You can also write [a.:(n)] instead of [get a n].
-
-   @raise Invalid_argument
-   if [n] is outside the range 0 to [(length a - 1)]. *)
-
-
 (** {1 Unit operations} *)
 
 external ignore : 'a -> unit = "%ignore"
@@ -1436,8 +1421,6 @@ module Genlex       = Genlex
 [@@deprecated "Use the camlp-streams library instead."]
 module Hashtbl      = Hashtbl
 module In_channel   = In_channel
-module Iarray       = Iarray
-module IarrayLabels = IarrayLabels
 module Int          = Int
 module Int32        = Int32
 module Int64        = Int64

testsuite/tests/array-functions/test_iarray.ml

@@ -2,6 +2,9 @@
    flags = "-extension immutable_arrays_experimental"
 *)
 
+module Iarray = Stdlib__Iarray
+external ( .:() ) : 'a iarray -> int -> 'a = "%array_safe_get"
+
 (* Copied from [test.ml], but with all the [Array.fill] tests deleted *)
 
 (* [iarray]s don't have the [make*] functions, so we redefine them here *)

testsuite/tests/backtrace/pr2195-locs.byte.reference

@@ -1,4 +1,4 @@
 Fatal error: exception Stdlib.Exit
-Raised by primitive operation at Stdlib.open_in_gen in file "stdlib.ml", line 412, characters 28-54
+Raised by primitive operation at Stdlib.open_in_gen in file "stdlib.ml", line 408, characters 28-54
 Called from Pr2195 in file "pr2195.ml", line 24, characters 6-19
 Re-raised at Pr2195 in file "pr2195.ml", line 29, characters 4-41

testsuite/tests/backtrace/pr2195.opt.reference

@@ -1,5 +1,5 @@
 Fatal error: exception Stdlib.Exit
-Raised by primitive operation at Stdlib.open_in_gen in file "stdlib.ml", line 412, characters 28-54
-Called from Stdlib.open_in in file "stdlib.ml" (inlined), line 417, characters 2-45
+Raised by primitive operation at Stdlib.open_in_gen in file "stdlib.ml", line 408, characters 28-54
+Called from Stdlib.open_in in file "stdlib.ml" (inlined), line 413, characters 2-45
 Called from Pr2195 in file "pr2195.ml", line 24, characters 6-19
 Re-raised at Pr2195 in file "pr2195.ml", line 29, characters 4-41