Use the extension_constructor type in Obj

Rename Obj.extension_slot to Obj.extension_constructor as well

stdlib/obj.ml

@@ -60,7 +60,7 @@ let int_tag = 1000
 let out_of_heap_tag = 1001
 let unaligned_tag = 1002
 
-let extension_slot x =
+let extension_constructor x =
   let x = repr x in
   let slot =
     if (is_block x) && (tag x) <> object_tag && (size x) >= 1 then field x 0
@@ -68,24 +68,13 @@ let extension_slot x =
   in
   let name =
     if (is_block slot) && (tag slot) = object_tag then field slot 0
-    else raise Not_found
+    else invalid_arg "Obj.extension_constructor"
   in
-    if (tag name) = string_tag then slot
-    else raise Not_found
+    if (tag name) = string_tag then (obj slot : extension_constructor)
+    else invalid_arg "Obj.extension_constructor"
 
-let extension_name x =
-  try
-    let slot = extension_slot x in
-      (obj (field slot 0) : string)
-  with Not_found -> invalid_arg "Obj.extension_name"
+let extension_name (slot : extension_constructor) =
+  (obj (field (repr slot) 0) : string)
 
-let extension_id x =
-  try
-    let slot = extension_slot x in
-      (obj (field slot 1) : int)
-  with Not_found -> invalid_arg "Obj.extension_id"
-
-let extension_slot x =
-  try
-    extension_slot x
-  with Not_found -> invalid_arg "Obj.extension_slot"
+let extension_id (slot : extension_constructor) =
+  (obj (field (repr slot) 1) : int)

stdlib/obj.mli

@@ -57,9 +57,9 @@ val int_tag : int
 val out_of_heap_tag : int
 val unaligned_tag : int   (* should never happen @since 3.11.0 *)
 
-val extension_name : 'a -> string
-val extension_id : 'a -> int
-val extension_slot : 'a -> t
+val extension_constructor : 'a -> extension_constructor
+val extension_name : extension_constructor -> string
+val extension_id : extension_constructor -> int
 
 (** The following two functions are deprecated.  Use module {!Marshal}
     instead. *)

testsuite/tests/typing-extensions/extensions.ml

@@ -296,19 +296,22 @@ type foo +=
   | Bar of int
 ;;
 
-let n1 = Obj.extension_name Foo
+let extension_name e = Obj.extension_name (Obj.extension_constructor e);;
+let extension_id e = Obj.extension_id (Obj.extension_constructor e);;
+
+let n1 = extension_name Foo
 ;;
 
-let n2 = Obj.extension_name (Bar 1)
+let n2 = extension_name (Bar 1)
 ;;
 
-let t = (Obj.extension_id (Bar 2)) = (Obj.extension_id (Bar 3)) (* true *)
+let t = (extension_id (Bar 2)) = (extension_id (Bar 3)) (* true *)
 ;;
 
-let f = (Obj.extension_id (Bar 2)) = (Obj.extension_id Foo) (* false *)
+let f = (extension_id (Bar 2)) = (extension_id Foo) (* false *)
 ;;
 
-let is_foo x = (Obj.extension_id Foo) = (Obj.extension_id x)
+let is_foo x = (extension_id Foo) = (extension_id x)
 
 type foo += Foo
 ;;
@@ -316,8 +319,8 @@ type foo += Foo
 let f = is_foo Foo
 ;;
 
-let _ = Obj.extension_name 7 (* Invald_arg *)
+let _ = Obj.extension_constructor 7 (* Invald_arg *)
 ;;
 
-let _ = Obj.extension_id (object method m = 3 end) (* Invald_arg *)
+let _ = Obj.extension_constructor (object method m = 3 end) (* Invald_arg *)
 ;;

testsuite/tests/typing-extensions/extensions.ml.reference

@@ -119,6 +119,8 @@ Error: This extension does not match the definition of type bar
 #     val y : exn * exn = (Foo (3, _), Bar (Some 5))
 #         type foo = ..
 #         type foo += Foo | Bar of int
+#   val extension_name : 'a -> string = <fun>
+# val extension_id : 'a -> int = <fun>
 #     val n1 : string = "Foo"
 #     val n2 : string = "Bar"
 #     val t : bool = true
@@ -126,6 +128,6 @@ Error: This extension does not match the definition of type bar
 #         val is_foo : 'a -> bool = <fun>
 type foo += Foo
 #     val f : bool = false
-#     Exception: Invalid_argument "Obj.extension_name".
-#     Exception: Invalid_argument "Obj.extension_id".
+#     Exception: Invalid_argument "Obj.extension_constructor".
+#     Exception: Invalid_argument "Obj.extension_constructor".
 #