v0.18~preview.130.100+614

Author: public-release

base.opam

@@ -12,20 +12,20 @@ build: [
 ]
 depends: [
   "ocaml" {>= "5.1.0"}
+  "base_internalhash_types"
   "basement"
   "capsule0"
+  "nonempty_list_type"
   "ocaml_intrinsics_kernel"
   "ppx_array_base"
   "ppx_base"
-  "ppx_cold"
-  "ppx_hash"
   "ppxlib_jane"
   "sexplib0"
   "dune"                    {>= "3.17.0"}
   "dune-configurator"
   "ppxlib"                  {>= "0.33.0" & < "0.36.0"}
 ]
-available: arch != "arm32" & arch != "x86_32"
+available: arch != "x86_32"
 synopsis: "Full standard library replacement for OCaml"
 description: "
 Full standard library replacement for OCaml

lint/dune

@@ -1,5 +1,5 @@
 (library
  (name ppx_base_lint)
  (kind ppx_rewriter)
- (libraries compiler-libs.common ppx_cold ppxlib ppxlib_jane ppxlib.stdppx)
+ (libraries compiler-libs.common ppxlib ppxlib_jane ppxlib.stdppx)
  (preprocess no_preprocessing))

lint/ppx_base_lint.ml

@@ -1,7 +1,6 @@
 open Ppxlib
 open Stdppx
 
-let expand_cold = ref true
 let error ~loc fmt = Location.raise_errorf ~loc (Stdlib.( ^^ ) "ppx_base_lint:" fmt)
 
 type suspicious_id = Stdlib_submodule of string
@@ -42,23 +41,6 @@ let rec is_stdlib_dot_something : Longident.t -> bool = function
   | _ -> false
 ;;
 
-let print_payload ppf = function
-  | PStr x -> Pprintast.structure ppf x
-  | PSig x -> Pprintast.signature ppf x
-  | PTyp x -> Pprintast.core_type ppf x
-  | PPat (x, None) -> Pprintast.pattern ppf x
-  | PPat (x, Some w) ->
-    Stdlib.Format.fprintf ppf "%a@ when@ %a" Pprintast.pattern x Pprintast.expression w
-;;
-
-let remove_loc =
-  object
-    inherit Ast_traverse.map
-    method! location _ = Location.none
-    method! location_stack _ = []
-  end
-;;
-
 let check current_module =
   let zero_modules = zero_modules () in
   object
@@ -105,75 +87,6 @@ let check current_module =
              ~loc:mb.pmb_loc
              "you cannot alias [Stdlib] sub-modules, use them directly"
          | _ -> ())
-
-    method! attributes attrs =
-      super#attributes attrs;
-      if !expand_cold
-      then (
-        let is_cold attr = String.equal attr.attr_name.txt "cold" in
-        match List.find_opt attrs ~f:is_cold with
-        | None -> ()
-        | Some attr ->
-          let expansion =
-            Ppx_cold.expand_cold_attribute attr
-            |> List.map ~f:(fun a ->
-              { a with
-                attr_name =
-                  { a.attr_name with
-                    txt =
-                      (let string = a.attr_name.txt
-                       and prefix = "ocaml." in
-                       if String.is_prefix string ~prefix
-                       then String.drop_prefix string (String.length prefix)
-                       else string)
-                  }
-              })
-          in
-          let is_part_of_expansion attr =
-            List.exists expansion ~f:(fun a ->
-              String.equal a.attr_name.txt attr.attr_name.txt
-              || String.equal ("ocaml." ^ a.attr_name.txt) attr.attr_name.txt)
-          in
-          let new_attrs =
-            List.concat_map attrs ~f:(fun a ->
-              if is_cold a
-              then a :: expansion
-              else if is_part_of_expansion a
-              then []
-              else [ a ])
-          in
-          if not
-               (Poly.equal
-                  (remove_loc#attributes attrs)
-                  (remove_loc#attributes new_attrs))
-          then (
-            (* Remove attributes written by the user that correspond to attributes in the
-               expansion *)
-            List.iter attrs ~f:(fun a ->
-              if is_part_of_expansion a
-              then Driver.register_correction ~loc:a.attr_loc ~repl:"");
-            let attribute_level =
-              String.make
-                (attr.attr_name.loc.loc_start.pos_cnum
-                 - attr.attr_loc.loc_start.pos_cnum
-                 - 1)
-                '@'
-            in
-            let repl =
-              Stdlib.Format.asprintf
-                "@[<h>%a@]"
-                (Stdlib.Format.pp_print_list (fun ppf x ->
-                   Stdlib.Format.fprintf
-                     ppf
-                     "[%s%s@ %a]"
-                     attribute_level
-                     x.attr_name.txt
-                     print_payload
-                     x.attr_payload))
-                (attr :: expansion)
-            in
-            Driver.register_correction ~loc:attr.attr_loc ~repl);
-          Ppxlib.Attribute.mark_as_handled_manually attr)
   end
 ;;
 
@@ -183,10 +96,6 @@ let module_of_loc (loc : Location.t) =
 ;;
 
 let () =
-  Ppxlib.Driver.add_arg
-    "-do-not-correct-cold-attributes"
-    (Clear expand_cold)
-    ~doc:"do not automatically expand [@cold] attributes";
   Ppxlib.Driver.register_transformation
     "base_lint"
     ~impl:(function

ppx/src/dune

@@ -1,6 +1,6 @@
 (library
  (name ppx_base_internal)
- (kind ppx_deriver)
+ (kind ppx_rewriter)
  (libraries ppxlib ppxlib_jane ppxlib.stdppx)
  (preprocess
   (pps ppxlib.metaquot)))

src/array.ml

@@ -470,17 +470,14 @@ let max_elt t ~compare =
 
 let[@inline always] findi_internal t ~f ~if_found ~if_not_found =
   let length = length t in
-  if length = 0
-  then (if_not_found [@inlined]) ()
-  else (
-    let rec loop i =
-      if i < length
-      then (
-        let x = unsafe_get t i in
-        if (f [@inlined hint]) i x then (if_found [@inlined]) ~i ~value:x else loop (i + 1))
-      else (if_not_found [@inlined]) ()
-    in
-    (loop [@inlined]) 0 [@nontail])
+  let rec loop i =
+    if i < length
+    then (
+      let x = unsafe_get t i in
+      if (f [@inlined hint]) i x then (if_found [@inlined]) ~i ~value:x else loop (i + 1))
+    else (if_not_found [@inlined]) ()
+  in
+  (loop [@inlined]) 0 [@nontail]
 [@@kind k1 = k1, k2 = (value_or_null, k1, value_or_null & k1)]
 ;;
 
@@ -997,6 +994,22 @@ let map_inplace t ~f =
   done
 ;;
 
+let find_or_null t ~f =
+  (findi_internal [@inlined])
+    t
+    ~f:(fun _i x -> f x)
+    ~if_not_found:(fun () -> Null)
+    ~if_found:(fun ~i:_ ~value:v -> This v) [@nontail]
+;;
+
+let findi_or_null t ~f =
+  (findi_internal [@inlined])
+    t
+    ~f
+    ~if_not_found:(fun () -> Null)
+    ~if_found:(fun ~i ~value:v -> This (i, v)) [@nontail]
+;;
+
 let find_consecutive_duplicate t ~equal =
   let n = length t in
   if n <= 1

src/array0.mli

@@ -49,13 +49,19 @@ val concat : 'a. 'a array list -> 'a array]
 
 val max_length : int
 val create_float_uninitialized : len:int -> float array
-val blit : src:'a array -> src_pos:int -> dst:'a array -> dst_pos:int -> len:int -> unit
-val make_matrix : dimx:int -> dimy:int -> 'a -> 'a array array
 
-val%template fold_right : 'a array -> f:('a -> 'b -> 'b) -> init:'b -> 'b
-[@@mode m = (uncontended, shared)]
+include sig
+  [@@@implicit_kind: 'a]
+  [@@@implicit_kind: 'b]
 
-val stable_sort : 'a array -> compare:('a -> 'a -> int) -> unit
+  val blit : src:'a array -> src_pos:int -> dst:'a array -> dst_pos:int -> len:int -> unit
+  val make_matrix : dimx:int -> dimy:int -> 'a -> 'a array array
+
+  val%template fold_right : 'a array -> f:('a -> 'b -> 'b) -> init:'b -> 'b
+  [@@mode m = (uncontended, shared)]
+
+  val stable_sort : 'a array -> compare:('a -> 'a -> int) -> unit
+end
 
 [%%template:
 [@@@kind.default k' = (base_or_null, value_or_null mod external64)]