v0.17~preview.128.42+83

src/type_equal.ml

@@ -151,7 +151,7 @@ module Id = struct
     val type_key : t key
 
     (* type equality: given another key, produce an [equal] if they represent the same
-       registered type instance *)
+       type instance *)
     val type_equal : 'a key -> (t, 'a) equal option
   end
 
@@ -192,7 +192,7 @@ module Id = struct
     type nonrec 'a t = 'a t
   end)
 
-  module Register0 (T : Arg0) = struct
+  module Create0 (T : Arg0) = struct
     type _ key += T0 : T.t key
 
     let type_equal_id : T.t t =
@@ -214,7 +214,7 @@ module Id = struct
     ;;
   end
 
-  module Register1 (T : Arg1) = struct
+  module Create1 (T : Arg1) = struct
     type _ key += T1 : 'a key -> 'a T.t key
 
     let type_equal_id (type a) ((module A) : a t) : a T.t t =
@@ -239,7 +239,7 @@ module Id = struct
     ;;
   end
 
-  module Register2 (T : Arg2) = struct
+  module Create2 (T : Arg2) = struct
     type _ key += T2 : 'a key * 'b key -> ('a, 'b) T.t key
 
     let type_equal_id (type a b) ((module A) : a t) ((module B) : b t) : (a, b) T.t t =
@@ -264,7 +264,7 @@ module Id = struct
     ;;
   end
 
-  module Register3 (T : Arg3) = struct
+  module Create3 (T : Arg3) = struct
     type _ key += T3 : 'a key * 'b key * 'c key -> ('a, 'b, 'c) T.t key
 
     let type_equal_id
@@ -295,9 +295,9 @@ module Id = struct
     ;;
   end
 
-  let register (type a) ~name sexp_of_t =
+  let create (type a) ~name sexp_of_t =
     let module T =
-      Register0 (struct
+      Create0 (struct
         type t = a
 
         let name = name
@@ -306,6 +306,4 @@ module Id = struct
     in
     T.type_equal_id
   ;;
-
-  let create = register
 end

src/type_equal_intf.ml

@@ -329,15 +329,11 @@ module type Type_equal = sig
 
     val uid : _ t -> Uid.t
 
-    (** [register ~name] defines a new type identity. Two calls to [register] will result
-        in two distinct identifiers, even for the same arguments with the same type. If
-        the type ['a] doesn't support sexp conversion, then a good practice is to have the
+    (** [create ~name] defines a new type identity. Two calls to [create] will result in
+        two distinct identifiers, even for the same arguments with the same type. If the
+        type ['a] doesn't support sexp conversion, then a good practice is to have the
         converter be [[%sexp_of: _]], (or [sexp_of_opaque], if not using ppx_sexp_conv).
     *)
-    val register : name:string -> ('a -> Sexp.t) -> 'a t
-
-    (** An alias for [register]. Prefer [register] in new code, as it makes the
-        side-effecting nature clearer. *)
     val create : name:string -> ('a -> Sexp.t) -> 'a t
 
     (** Accessors *)
@@ -359,9 +355,9 @@ module type Type_equal = sig
     val same_witness : 'a t -> 'b t -> ('a, 'b) equal option
     val same_witness_exn : 'a t -> 'b t -> ('a, 'b) equal
 
-    module Register0 (T : Arg0) : S0 with type t := T.t
-    module Register1 (T : Arg1) : S1 with type 'a t := 'a T.t
-    module Register2 (T : Arg2) : S2 with type ('a, 'b) t := ('a, 'b) T.t
-    module Register3 (T : Arg3) : S3 with type ('a, 'b, 'c) t := ('a, 'b, 'c) T.t
+    module Create0 (T : Arg0) : S0 with type t := T.t
+    module Create1 (T : Arg1) : S1 with type 'a t := 'a T.t
+    module Create2 (T : Arg2) : S2 with type ('a, 'b) t := ('a, 'b) T.t
+    module Create3 (T : Arg3) : S3 with type ('a, 'b, 'c) t := ('a, 'b, 'c) T.t
   end
 end

test/allocation/bin/dune

@@ -1,4 +1,4 @@
 (executables (names test_option_array_allocation)
  (libraries base expect_test_helpers_core compiler-libs.common
   core_kernel.version_util)
- (preprocess (pps ppx_jane)))
+ (ocamlopt_flags :standard -O3) (preprocess (pps ppx_jane)))

test/allocation/bin/test_option_array_allocation.ml

@@ -34,6 +34,9 @@ let () =
      cannot eliminate the allocation of [Some].  Flambda2 is expected to eliminate the
      allocation, at which point we can [require_no_allocation] (possibly annotating the
      test with [@tags "fast-flambda"]).
+
+     Note that Flambda 2 only eliminates the allocation in optimized mode.
+     In classic mode, it will remain.  This file is compiled with optimized mode.
   *)
   let compiler_eliminates_the_allocation =
     (* [Version_util.x_library_inlining] is the whole reason this is a separate
@@ -47,5 +50,9 @@ let () =
     let _, { Gc.Allocation_report.minor_words_allocated; _ } =
       Gc.measure_allocation get_some
     in
-    assert (minor_words_allocated = 2)
+    if minor_words_allocated <= 2
+    then ()
+    else
+      failwith
+        (Printf.sprintf "Allocated more words than expected: %d" minor_words_allocated)
 ;;

test/test_type_equal.ml

@@ -72,7 +72,7 @@ let%test_module "Type_equal" =
   end)
 ;;
 
-let%expect_test "Register*" =
+let%expect_test "Create*" =
   let test id1 id2 =
     let same_according_to_id = Type_equal.Id.same id1 id2 in
     let eq = if same_according_to_id then "==" else "<>" in
@@ -94,7 +94,7 @@ let%expect_test "Register*" =
             (same_according_to_uid : bool)]
   in
   let module Bool =
-    Type_equal.Id.Register0 (struct
+    Type_equal.Id.Create0 (struct
       type t = bool [@@deriving sexp_of]
 
       let name = "bool"
@@ -104,7 +104,7 @@ let%expect_test "Register*" =
   test Bool.type_equal_id Bool.type_equal_id;
   [%expect {| (bool == bool) |}];
   let module Int =
-    Type_equal.Id.Register0 (struct
+    Type_equal.Id.Create0 (struct
       type t = int [@@deriving sexp_of]
 
       let name = "int"
@@ -116,11 +116,11 @@ let%expect_test "Register*" =
   (* non-self comparison *)
   test Int.type_equal_id Bool.type_equal_id;
   [%expect {| (int <> bool) |}];
-  (* re-registering the same type *)
+  (* re-creating the same type *)
   test Int.type_equal_id (Type_equal.Id.create ~name:"Stdlib.int" sexp_of_int);
   [%expect {| (int <> Stdlib.int) |}];
   let module Option =
-    Type_equal.Id.Register1 (struct
+    Type_equal.Id.Create1 (struct
       type 'a t = 'a option [@@deriving sexp_of]
 
       let name = "option"
@@ -136,7 +136,7 @@ let%expect_test "Register*" =
   test (Option.type_equal_id Int.type_equal_id) (Option.type_equal_id Bool.type_equal_id);
   [%expect {| ((option int) <> (option bool)) |}];
   let module Either =
-    Type_equal.Id.Register2 (struct
+    Type_equal.Id.Create2 (struct
       type ('a, 'b) t = ('a, 'b) Either.t [@@deriving sexp_of]
 
       let name = "either"
@@ -161,7 +161,7 @@ let%expect_test "Register*" =
     (Either.type_equal_id Bool.type_equal_id Int.type_equal_id);
   [%expect {| ((either int bool) <> (either bool int)) |}];
   let module Tuple3 =
-    Type_equal.Id.Register3 (struct
+    Type_equal.Id.Create3 (struct
       type ('a, 'b, 'c) t = 'a * 'b * 'c [@@deriving sexp_of]
 
       let name = "tuple3"