v0.18~preview.130.36+188

Author: public-release

shadow-stdlib/gen/mapper.mll

@@ -274,6 +274,10 @@ let module_replacement = function
   | "Gc"       -> Some No_equivalent
   | "Printexc" -> Some (Repl_text "Use [Exn] or [Backtrace] instead")
   | "Seq"      -> Some (Approx "Sequence")
+  | "Atomic"   ->
+    Some (Repl_text "\
+Use [Atomic] from [Portable] (or [Core], which reexports it from\n\
+[Portable]) instead")
   | _          -> None
 
 let replace ~is_exn id replacement =

src/array.ml

@@ -1,6 +1,7 @@
 open! Import
 include Array_intf.Definitions
-include Array0
+module Array = Array0
+include Array
 
 type ('a : any_non_null) t = 'a array
 
@@ -567,7 +568,7 @@ let filter_map t ~f = filter_mapi t ~f:(fun _i a -> f a) [@nontail]
 let filter_opt t = filter_map t ~f:Fn.id
 
 let raise_length_mismatch name n1 n2 =
-  invalid_argf "length mismatch in %s: %d <> %d" name n1 n2 ()
+  Printf.invalid_argf "length mismatch in %s: %d <> %d" name n1 n2 ()
 [@@cold]
 ;;
 
@@ -916,7 +917,16 @@ let transpose_exn tt =
   | Some tt' -> tt'
 ;;
 
-let map t ~f = map t ~f
+[@@@warning "-incompatible-with-upstream"]
+
+let%template[@kind
+              ki = (value, float64, bits32, bits64, word, immediate, immediate64)
+              , ko = (value, float64, bits32, bits64, word, immediate, immediate64)] map
+  t
+  ~f
+  =
+  (map [@kind ki ko]) t ~f
+;;
 
 include%template Binary_searchable.Make1 [@modality portable] (struct
     type nonrec 'a t = 'a t

src/array0.ml

@@ -137,17 +137,18 @@ let fill (local_ a) ~pos ~len v =
   else unsafe_fill a pos len v
 ;;
 
-let init len ~(local_ f : _ -> _) =
+let%template[@alloc a = (heap, stack)] init len ~(local_ f : _ -> _) =
   if len = 0
   then [||]
   else if len < 0
   then invalid_arg "Array.init"
   else (
-    let res = create ~len (f 0) in
-    for i = 1 to Int0.pred len do
-      unsafe_set res i (f i)
-    done;
-    res)
+    (let res = (create [@alloc a]) ~len (f 0) in
+     for i = 1 to Int0.pred len do
+       unsafe_set res i (f i)
+     done;
+     res)
+    [@exclave_if_stack a])
 ;;
 
 let make_matrix = Stdlib.Array.make_matrix
@@ -190,7 +191,35 @@ let iteri t ~(local_ f : _ -> _ -> _) =
   done
 ;;
 
-let map (local_ t) ~(local_ f : _ -> _) =
+[@@@warning "-incompatible-with-upstream"]
+
+let%template[@kind
+              ki = (value, immediate, immediate64, float64, bits32, bits64, word)
+              , ko = (float64, bits32, bits64, word)] map
+  (type (a : ki) (b : ko))
+  (local_ (t : a array))
+  ~(local_ f : _ -> _)
+  : b array
+  =
+  let len = length t in
+  if len = 0
+  then [||]
+  else (
+    let r = magic_create_uninitialized ~len in
+    for i = 0 to len - 1 do
+      unsafe_set r i (f (unsafe_get t i))
+    done;
+    r)
+;;
+
+let%template[@kind
+              ki = (value, immediate, immediate64, float64, bits32, bits64, word)
+              , ko = (value, immediate, immediate64)] map
+  (type (a : ki) (b : ko))
+  (local_ (t : a array))
+  ~(local_ f : _ -> _)
+  : b array
+  =
   let len = length t in
   if len = 0
   then [||]

src/array0.mli

@@ -0,0 +1,104 @@
+@@ portable
+
+[%%template:
+  external create
+    : ('a : any_non_null).
+    len:int -> 'a -> 'a array @ m
+    = "%makearray_dynamic"
+  [@@alloc __ @ m = (heap_global, stack_local)] [@@layout_poly]]
+
+external create_local
+  : ('a : any_non_null).
+  len:int -> 'a -> local_ 'a array
+  = "%makearray_dynamic"
+[@@layout_poly]
+
+external magic_create_uninitialized
+  : ('a : any_non_null).
+  len:int -> ('a array[@local_opt])
+  = "%makearray_dynamic_uninit"
+[@@layout_poly]
+
+external%template get
+  : ('a : any_non_null).
+  ('a array[@local_opt]) @ m -> (int[@local_opt]) -> 'a @ m
+  = "%array_safe_get"
+[@@layout_poly] [@@mode m = (uncontended, shared)]
+
+external length
+  : ('a : any_non_null).
+  ('a array[@local_opt]) @ contended -> int
+  = "%array_length"
+[@@layout_poly]
+
+external set
+  : ('a : any_non_null).
+  ('a array[@local_opt]) -> (int[@local_opt]) -> 'a -> unit
+  = "%array_safe_set"
+[@@layout_poly]
+
+external%template unsafe_get
+  : ('a : any_non_null).
+  ('a array[@local_opt]) @ m -> (int[@local_opt]) -> 'a @ m
+  = "%array_unsafe_get"
+[@@mode m = (uncontended, shared)] [@@layout_poly]
+
+external unsafe_set
+  : ('a : any_non_null).
+  ('a array[@local_opt]) -> (int[@local_opt]) -> 'a -> unit
+  = "%array_unsafe_set"
+[@@layout_poly]
+
+external unsafe_blit
+  :  src:('a array[@local_opt])
+  -> src_pos:int
+  -> dst:('a array[@local_opt])
+  -> dst_pos:int
+  -> len:int
+  -> unit
+  = "caml_array_blit"
+
+external unsafe_fill : local_ 'a array -> int -> int -> 'a -> unit = "caml_array_fill"
+external unsafe_sub : local_ 'a array -> int -> int -> 'a array = "caml_array_sub"
+external concat : local_ 'a array list -> 'a array = "caml_array_concat"
+val max_length : int
+val create_float_uninitialized : len:int -> float array
+val append : 'a array -> 'a array -> 'a array
+
+val blit
+  :  src:'a array @ local
+  -> src_pos:int
+  -> dst:'a array @ local
+  -> dst_pos:int
+  -> len:int
+  -> unit
+
+val fill : 'a array @ local -> pos:int -> len:int -> 'a -> unit
+
+val%template init : int -> f:(int -> 'a) @ local -> 'a array @ m
+[@@alloc __ @ m = (heap_global, stack_local)]
+
+val make_matrix : dimx:int -> dimy:int -> 'a -> 'a array array
+val of_list : 'a list -> 'a array
+val sub : 'a array @ local -> pos:int -> len:int -> 'a array
+val to_list : 'a array -> 'a list
+val fold : 'a array -> init:'b -> f:('b -> 'a -> 'b) @ local -> 'b
+
+val%template fold_right : 'a array @ m -> f:('a @ m -> 'b -> 'b) @ local -> init:'b -> 'b
+[@@mode m = (uncontended, shared)]
+
+val iter : 'a array -> f:('a -> unit) @ local -> unit
+val iteri : 'a array -> f:(int -> 'a -> unit) @ local -> unit
+
+[@@@warning "-incompatible-with-upstream"]
+
+val%template map
+  : ('a : ki) ('b : ko).
+  'a array @ local -> f:('a -> 'b) @ local -> 'b array
+[@@kind
+  ki = (value, immediate, immediate64, float64, bits32, bits64, word)
+  , ko = (value, immediate, immediate64, float64, bits32, bits64, word)]
+
+val mapi : 'a array -> f:(int -> 'a -> 'b) @ local -> 'b array
+val stable_sort : 'a array -> compare:('a -> 'a -> int) -> unit
+val swap : 'a array @ local -> int -> int -> unit

src/array_intf.ml

@@ -17,6 +17,11 @@ module Definitions = struct
     include Indexed_container.S1_with_creators with type 'a t := 'a t
     include Invariant.S1 with type 'a t := 'a t
 
+    val%template map : ('a : ki) ('b : ko). 'a t -> f:local_ ('a -> 'b) -> 'b t
+    [@@kind
+      ki = (value, float64, bits32, bits64, word, immediate, immediate64)
+      , ko = (value, float64, bits32, bits64, word, immediate, immediate64)]
+
     (** Maximum length of a normal array. The maximum length of a float array is
         [max_length/2] on 32-bit machines and [max_length] on 64-bit machines. *)
     val max_length : int
@@ -117,6 +122,10 @@ module Definitions = struct
         float array representations are enabled. *)
     val create_float_uninitialized : len:int -> float t
 
+    (** [init n ~f] creates an array of length [n] with index [i] set to [f i]. *)
+    val%template init : int -> f:(int -> 'a) @ local -> 'a array @ m
+    [@@alloc __ @ m = (heap_global, stack_local)]
+
     (** [Array.make_matrix dimx dimy e] returns a two-dimensional array (an array of
         arrays) with first dimension [dimx] and second dimension [dimy]. All the elements
         of this new matrix are initially physically equal to [e]. The element ([x,y]) of a

src/array_permute.mli

@@ -0,0 +1,8 @@
+@@ portable
+
+val permute
+  :  ?random_state:Random.State.t
+  -> ?pos:int
+  -> ?len:int
+  -> 'a array @ local
+  -> unit

src/base.ml

@@ -38,7 +38,6 @@ include (
     end
     (* Modules defined in Base *)
     with module Array := Shadow_stdlib.Array
-    with module Atomic := Shadow_stdlib.Atomic
     with module Bool := Shadow_stdlib.Bool
     with module Buffer := Shadow_stdlib.Buffer
     with module Bytes := Shadow_stdlib.Bytes
@@ -187,10 +186,8 @@ end
 (**/**)
 
 module Exported_for_specific_uses = struct
-  module Fieldslib = Fieldslib
   module Globalize = Globalize
   module Obj_array = Obj_array
-  module Variantslib = Variantslib
 
   let am_testing = am_testing
 end

src/blit.ml

@@ -3,23 +3,23 @@ include Blit_intf.Definitions
 
 [@@@warning "-incompatible-with-upstream"]
 
-module%template.portable Make1_phantom_distinct
+module%template.portable Make1_phantom2_distinct
     (Src : sig
-       type ('elt : k, 'phantom) t
+       type ('elt : k, 'p1, 'p2) t
 
-       val length : local_ (_, _) t -> int
+       val length : local_ (_, _, _) t -> int
      end)
     (Dst : sig
-       type ('elt : k, 'phantom) t
+       type ('elt : k, 'p1, 'p2) t
 
-       val length : local_ (_, _) t -> int
-       val create_like : len:int -> local_ ('elt, _) Src.t -> ('elt, _) t
-       val unsafe_blit : (('elt, _) Src.t, ('elt, _) t) blit
+       val length : local_ (_, _, _) t -> int
+       val create_like : len:int -> local_ ('elt, _, _) Src.t -> ('elt, _, _) t
+       val unsafe_blit : (('elt, _, _) Src.t, ('elt, _, _) t) blit
      end) :
-  S1_phantom_distinct
+  S1_phantom2_distinct
   [@kind k]
-  with type ('elt, 'phantom) src := ('elt, 'phantom) Src.t
-  with type ('elt, 'phantom) dst := ('elt, 'phantom) Dst.t = struct
+  with type ('elt, 'p1, 'p2) src := ('elt, 'p1, 'p2) Src.t
+  with type ('elt, 'p1, 'p2) dst := ('elt, 'p1, 'p2) Dst.t = struct
   let unsafe_blit = Dst.unsafe_blit
 
   let blit ~src ~src_pos ~dst ~dst_pos ~len =
@@ -71,10 +71,10 @@ module%template.portable [@modality p] Make1 (Sequence : Sequence1 [@kind k]) =
   module Seq = struct
     include Sequence
 
-    type ('a : k, _) t = 'a Sequence.t
+    type ('a : k, _, _) t = 'a Sequence.t
   end
 
-  include Make1_phantom_distinct [@kind k] [@modality p] (Seq) (Seq)
+  include Make1_phantom2_distinct [@kind k] [@modality p] (Seq) (Seq)
 end
 [@@kind k = (value, immediate, immediate64)]
 
@@ -87,7 +87,7 @@ module%template.portable
   end) =
 struct
   module Sequence = struct
-    type (_, _) t = Sequence.t
+    type (_, _, _) t = Sequence.t
 
     open Sequence
 
@@ -96,7 +96,7 @@ struct
     let unsafe_blit = unsafe_blit
   end
 
-  include Make1_phantom_distinct [@modality p] (Sequence) (Sequence)
+  include Make1_phantom2_distinct [@modality p] (Sequence) (Sequence)
 end
 
 module%template.portable
@@ -108,16 +108,16 @@ module%template.portable
        val create : len:int -> t
        val unsafe_blit : (Src.t, t) blit
      end) =
-  Make1_phantom_distinct [@modality p]
+  Make1_phantom2_distinct [@modality p]
     (struct
-      type (_, _) t = Src.t
+      type (_, _, _) t = Src.t
 
       open Src
 
       let length = length
     end)
     (struct
-      type (_, _) t = Dst.t
+      type (_, _, _) t = Dst.t
 
       open Dst