v0.18~preview.130.33+516

Author: public-release

composition_infix/src/composition_infix.mli

@@ -3,5 +3,5 @@
     - [ a |> (f >> g) = a |> f |> g ]
     - [ (f << g) a = f (g a) ] *)
 
-val ( >> ) : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c
-val ( << ) : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c
+val ( >> ) : 'a 'b 'c. ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c
+val ( << ) : 'a 'b 'c. ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c

md5/src/md5_lib.ml

@@ -4,6 +4,7 @@ type t = string
 let empty = Digest.string ""
 let make s = if s = empty then empty else s
 let make_local s = if s = empty then empty else s
+let compare__local = compare
 let compare = compare
 let length = 16
 let to_binary s = s
@@ -16,6 +17,7 @@ let of_binary_exn s =
 
 let unsafe_of_binary = make
 let unsafe_of_binary_local = make_local
+let unsafe_of_binary__local = make_local
 
 external globalize : t -> t = "caml_obj_dup"
 

md5/src/md5_lib.mli

@@ -1,6 +1,7 @@
 type t
 
 val compare : t -> t -> int
+val compare__local : t -> t -> int
 
 (** [length = 16] is the size of the digest in bytes. *)
 val length : int
@@ -13,6 +14,7 @@ val of_binary_exn : string -> t
 val unsafe_of_binary : string -> t
 
 val unsafe_of_binary_local : string -> t
+val unsafe_of_binary__local : string -> t
 val globalize : t -> t
 val to_hex : t -> string
 val of_hex_exn : string -> t

src/array.ml

@@ -3,9 +3,10 @@ include Array_intf.Definitions
 include Array0
 
 type 'a t = 'a array
-[@@deriving compare ~localize, globalize, sexp ~localize, sexp_grammar]
 
-[@@@warning "-incompatible-with-upstream"]
+[%%rederive.portable
+  type nonrec 'a t = 'a array
+  [@@deriving compare ~localize, globalize, sexp ~localize, sexp_grammar]]
 
 (* This module implements a new in-place, constant heap sorting algorithm to replace the
    one used by the standard libraries.  Its only purpose is to be faster (hopefully
@@ -415,6 +416,21 @@ let foldi t ~init ~f =
   !acc
 ;;
 
+let%template foldi_right t ~init ~f =
+  (let rec aux t ~idx ~acc ~f =
+     (if idx < 0
+      then acc
+      else (
+        (* [unsafe_get] is safe, since [idx >= 0 && idx < Array.length t] *)
+        let acc = f idx (unsafe_get t idx) acc in
+        aux t ~idx:(idx - 1) ~acc ~f))
+     [@exclave_if_stack a]
+   in
+   aux t ~idx:(length t - 1) ~acc:init ~f [@nontail])
+  [@exclave_if_stack a]
+[@@alloc a @ m = (stack_local, heap_global)]
+;;
+
 let folding_mapi t ~init ~f =
   let acc = ref init in
   mapi t ~f:(fun i x ->

src/array0.ml

@@ -14,31 +14,40 @@ module Sys = Sys0
 let invalid_argf = Printf.invalid_argf
 
 module Array = struct
-  external create : int -> 'a -> 'a array = "caml_make_vect"
-  external create_local : int -> 'a -> 'a array = "caml_make_vect"
+  [%%template
+    external create : len:int -> 'a -> 'a array = "caml_make_vect"
+    [@@alloc __ = (heap, stack)]]
+
+  let create_local = create
+  let magic_create_uninitialized ~len = create ~len (Stdlib.Obj.magic 0)
+
   external create_float_uninitialized : int -> float array = "caml_make_float_vect"
-  external get : ('a array[@local_opt]) -> (int[@local_opt]) -> 'a = "%array_safe_get"
-  external length : ('a array[@local_opt]) -> int = "%array_length"
+
+  external%template get
+    : 'a.
+    ('a array[@local_opt]) -> (int[@local_opt]) -> 'a
+    = "%array_safe_get"
+  [@@layout_poly] [@@mode m = (uncontended, shared)]
+
+  external length : 'a. ('a array[@local_opt]) -> int = "%array_length" [@@layout_poly]
 
   external set
-    :  ('a array[@local_opt])
-    -> (int[@local_opt])
-    -> 'a
-    -> unit
+    : 'a.
+    ('a array[@local_opt]) -> (int[@local_opt]) -> 'a -> unit
     = "%array_safe_set"
+  [@@layout_poly]
 
-  external unsafe_get
-    :  ('a array[@local_opt])
-    -> (int[@local_opt])
-    -> 'a
+  external%template unsafe_get
+    : 'a.
+    ('a array[@local_opt]) -> (int[@local_opt]) -> 'a
     = "%array_unsafe_get"
+  [@@mode m = (uncontended, shared)] [@@layout_poly]
 
   external unsafe_set
-    :  ('a array[@local_opt])
-    -> (int[@local_opt])
-    -> 'a
-    -> unit
+    : 'a.
+    ('a array[@local_opt]) -> (int[@local_opt]) -> 'a -> unit
     = "%array_unsafe_set"
+  [@@layout_poly]
 
   external unsafe_blit
     :  src:('a array[@local_opt])
@@ -58,16 +67,6 @@ include Array
 
 let max_length = Sys.max_array_length
 
-let create ~len x =
-  try create len x with
-  | Invalid_argument _ -> invalid_argf "Array.create ~len:%d: invalid length" len ()
-;;
-
-let create_local ~len x =
-  try create_local len x with
-  | Invalid_argument _ -> invalid_argf "Array.create_local ~len:%d: invalid length" len ()
-;;
-
 let create_float_uninitialized ~len =
   try create_float_uninitialized len with
   | Invalid_argument _ ->
@@ -126,12 +125,13 @@ let fold t ~init ~(f : _ -> _ -> _) =
   !r
 ;;
 
-let fold_right t ~(f : _ -> _ -> _) ~init =
+let%template fold_right t ~(f : _ -> _ -> _) ~init =
   let r = ref init in
   for i = length t - 1 downto 0 do
-    r := f (unsafe_get t i) !r
+    r := f ((unsafe_get [@mode m]) t i) !r
   done;
   !r
+[@@mode m = (uncontended, shared)]
 ;;
 
 let iter t ~(f : _ -> _) =

src/array_intf.ml

@@ -2,13 +2,14 @@
 
 open! Import
 
-[@@@warning "-incompatible-with-upstream"]
-
 module Definitions = struct
   module type Public = sig
     type 'a t
-    [@@deriving
-      compare ~localize, equal ~localize, globalize, sexp ~localize, sexp_grammar]
+
+    [%%rederive:
+      type nonrec 'a t = 'a t
+      [@@deriving
+        compare ~localize, equal ~localize, globalize, sexp ~localize, sexp_grammar]]
 
     include Binary_searchable.S1 with type 'a t := 'a t
     include Indexed_container.S1_with_creators with type 'a t := 'a t
@@ -18,55 +19,63 @@ module Definitions = struct
         [max_length/2] on 32-bit machines and [max_length] on 64-bit machines. *)
     val max_length : int
 
-    (*_ Declared as externals so that the compiler skips the caml_apply_X wrapping even when
-    compiling without cross library inlining. *)
+    (*_ Declared as externals so that the compiler skips the caml_apply_X wrapping even
+        when compiling without cross library inlining. *)
 
-    external length : ('a t[@local_opt]) -> int = "%array_length"
+    external length : 'a. ('a array[@local_opt]) -> int = "%array_length" [@@layout_poly]
 
     (** [Array.get a n] returns the element number [n] of array [a]. The first element has
         number 0. The last element has number [Array.length a - 1]. You can also write
         [a.(n)] instead of [Array.get a n].
 
         Raise [Invalid_argument "index out of bounds"] if [n] is outside the range 0 to
         [(Array.length a - 1)]. *)
-    external get : ('a t[@local_opt]) -> (int[@local_opt]) -> 'a = "%array_safe_get"
+    external%template get
+      : 'a.
+      ('a array[@local_opt]) -> (int[@local_opt]) -> 'a
+      = "%array_safe_get"
+    [@@layout_poly] [@@mode m = (uncontended, shared)]
 
     (** [Array.set a n x] modifies array [a] in place, replacing element number [n] with
         [x]. You can also write [a.(n) <- x] instead of [Array.set a n x].
 
         Raise [Invalid_argument "index out of bounds"] if [n] is outside the range 0 to
         [Array.length a - 1]. *)
     external set
-      :  ('a t[@local_opt])
-      -> (int[@local_opt])
-      -> 'a
-      -> unit
+      : 'a.
+      ('a array[@local_opt]) -> (int[@local_opt]) -> 'a -> unit
       = "%array_safe_set"
+    [@@layout_poly]
 
     (** Unsafe version of [get]. Can cause arbitrary behavior when used for an
         out-of-bounds array access. *)
-    external unsafe_get
-      :  ('a t[@local_opt])
-      -> (int[@local_opt])
-      -> 'a
+    external%template unsafe_get
+      : 'a.
+      ('a array[@local_opt]) -> (int[@local_opt]) -> 'a
       = "%array_unsafe_get"
+    [@@layout_poly] [@@mode m = (uncontended, shared)]
 
     (** Unsafe version of [set]. Can cause arbitrary behavior when used for an
         out-of-bounds array access. *)
     external unsafe_set
-      :  ('a t[@local_opt])
-      -> (int[@local_opt])
-      -> 'a
-      -> unit
+      : 'a.
+      ('a array[@local_opt]) -> (int[@local_opt]) -> 'a -> unit
       = "%array_unsafe_set"
+    [@@layout_poly]
 
-    (** [create ~len x] creates an array of length [len] with the value [x] populated in
-        each element. *)
-    val create : len:int -> 'a -> 'a t
+    [%%template:
+      val create : len:int -> 'a -> 'a array
+      [@@ocaml.doc
+        " [create ~len x] creates an array of length [len] with the value [x] populated in\n\
+        \          each element. "]
+      [@@alloc __ = (heap, stack)]]
 
-    (** [create_local ~len x] is like [create]. It allocates the array on the local stack.
-        The array's elements are still global. *)
-    val create_local : len:int -> 'a -> 'a t
+    val create_local : len:int -> 'a -> 'a array
+
+    val magic_create_uninitialized : len:int -> 'a array
+    [@@ocaml.doc
+      " [magic_create_uninitialized ~len] creates an array of length [len]. All elements\n\
+      \          are magically populated as a tagged [0]. "]
 
     (** [create_float_uninitialized ~len] creates a float array of length [len] with
         uninitialized elements -- that is, they may contain arbitrary, nondeterministic
@@ -116,6 +125,9 @@ module Definitions = struct
         types. The unsafe versions do not bound-check the arguments. *)
     include Blit.S1 with type 'a t := 'a t
 
+    val%template foldi_right : 'a t -> init:'acc -> f:(int -> 'a -> 'acc -> 'acc) -> 'acc
+    [@@alloc a @ m = (stack_local, heap_global)]
+
     (** [folding_map] is a version of [map] that threads an accumulator through calls to
         [f]. *)
     val folding_map : 'a t -> init:'acc -> f:('acc -> 'a -> 'acc * 'b) -> 'b t
@@ -131,7 +143,8 @@ module Definitions = struct
     (** [Array.fold_right f a ~init] computes
         [f a.(0) (f a.(1) ( ... (f a.(n-1) init) ...))], where [n] is the length of the
         array [a]. *)
-    val fold_right : 'a t -> f:('a -> 'acc -> 'acc) -> init:'acc -> 'acc
+    val%template fold_right : 'a t -> f:('a -> 'acc -> 'acc) -> init:'acc -> 'acc
+    [@@mode m = (uncontended, shared)]
 
     (** All sort functions in this module sort in increasing order by default. *)