Merge pull request #10542 from lpw25/fix-unboxed-immediate64

Fix detection of immediate64 types through unboxed types

.depend

@@ -1543,13 +1543,11 @@ typing/typedecl_separability.cmi : \
     typing/env.cmi
 typing/typedecl_unboxed.cmo : \
     typing/types.cmi \
-    typing/predef.cmi \
     typing/env.cmi \
     typing/ctype.cmi \
     typing/typedecl_unboxed.cmi
 typing/typedecl_unboxed.cmx : \
     typing/types.cmx \
-    typing/predef.cmx \
     typing/env.cmx \
     typing/ctype.cmx \
     typing/typedecl_unboxed.cmi
@@ -1704,27 +1702,31 @@ typing/typemod.cmi : \
 typing/typeopt.cmo : \
     typing/types.cmi \
     typing/typedtree.cmi \
-    typing/typedecl.cmi \
+    typing/typedecl_unboxed.cmi \
+    typing/type_immediacy.cmi \
     typing/predef.cmi \
     typing/path.cmi \
     lambda/lambda.cmi \
     typing/ident.cmi \
     typing/env.cmi \
     typing/ctype.cmi \
     utils/config.cmi \
+    utils/clflags.cmi \
     parsing/asttypes.cmi \
     typing/typeopt.cmi
 typing/typeopt.cmx : \
     typing/types.cmx \
     typing/typedtree.cmx \
-    typing/typedecl.cmx \
+    typing/typedecl_unboxed.cmx \
+    typing/type_immediacy.cmx \
     typing/predef.cmx \
     typing/path.cmx \
     lambda/lambda.cmx \
     typing/ident.cmx \
     typing/env.cmx \
     typing/ctype.cmx \
     utils/config.cmx \
+    utils/clflags.cmx \
     parsing/asttypes.cmi \
     typing/typeopt.cmi
 typing/typeopt.cmi : \

Changes

@@ -104,6 +104,8 @@ Working version
   otherwise the derived pointer is live across a poll point.
   (Vincent Laviron and Xavier Leroy, review by Xavier Leroy and Sadiq Jaffer)
 
+- #10542: Fix detection of immediate64 types through unboxed types.
+  (Leo White, review by Stephen Dolan and Gabriel Scherer)
 
 OCaml 4.13.0
 -------------

testsuite/tests/basic-modules/anonymous.ocamlc.reference

@@ -13,11 +13,12 @@
         (apply (field 1 (global CamlinternalMod!)) [0: [0]] B
           (module-defn(B) Anonymous anonymous.ml(33):703-773
             (let (x = [0: "foo" "bar"]) (makeblock 0))))
-        (let (f = (function param 0) s = (makemutable 0 ""))
+        (let (f = (function param : int 0) s = (makemutable 0 ""))
           (seq
             (ignore
               (let (*match* = (setfield_ptr 0 s "Hello World!"))
                 (makeblock 0)))
             (let
-              (drop = (function param 0) *match* = (apply drop (field 0 s)))
+              (drop = (function param : int 0)
+               *match* = (apply drop (field 0 s)))
               (makeblock 0 A B f s drop))))))))

testsuite/tests/basic-modules/anonymous.ocamlopt.flambda.reference

@@ -12,9 +12,11 @@
       (apply (field 1 (global CamlinternalMod!)) [0: [0]] B
         (module-defn(B) Anonymous anonymous.ml(33):703-773
           (let (x = [0: "foo" "bar"]) (makeblock 0))))
-      (let (f = (function param 0) s = (makemutable 0 ""))
+      (let (f = (function param : int 0) s = (makemutable 0 ""))
         (seq
           (ignore
             (let (*match* = (setfield_ptr 0 s "Hello World!")) (makeblock 0)))
-          (let (drop = (function param 0) *match* = (apply drop (field 0 s)))
+          (let
+            (drop = (function param : int 0)
+             *match* = (apply drop (field 0 s)))
             (makeblock 0 A B f s drop)))))))

testsuite/tests/basic-modules/anonymous.ocamlopt.reference

@@ -12,7 +12,7 @@
         (let (x = [0: "foo" "bar"]) (makeblock 0)))
       (setfield_ptr(root-init) 0 (global Anonymous!) A)
       (setfield_ptr(root-init) 1 (global Anonymous!) B)
-      (let (f = (function param 0))
+      (let (f = (function param : int 0))
         (setfield_ptr(root-init) 2 (global Anonymous!) f))
       (let (s = (makemutable 0 ""))
         (setfield_ptr(root-init) 3 (global Anonymous!) s))
@@ -21,7 +21,7 @@
           (*match* =
              (setfield_ptr 0 (field 3 (global Anonymous!)) "Hello World!"))
           (makeblock 0)))
-      (let (drop = (function param 0))
+      (let (drop = (function param : int 0))
         (setfield_ptr(root-init) 4 (global Anonymous!) drop))
       (let
         (*match* =

testsuite/tests/basic/patmatch_for_multiple.ml

@@ -76,8 +76,8 @@ let _ = fun a b ->
   | ((true, _) as _g)
   | ((false, _) as _g) -> ()
 [%%expect{|
-(function a/98 b/99 0)
-(function a/98 b/99 0)
+(function a/98[int] b/99 : int 0)
+(function a/98[int] b/99 : int 0)
 - : bool -> 'a -> unit = <fun>
 |}];;
 
@@ -96,8 +96,8 @@ let _ = fun a b -> match a, b with
 | (false, _) as p -> p
 (* outside, trivial *)
 [%%expect {|
-(function a/102 b/103 (let (p/104 =a (makeblock 0 a/102 b/103)) p/104))
-(function a/102 b/103 (makeblock 0 a/102 b/103))
+(function a/102[int] b/103 (let (p/104 =a (makeblock 0 a/102 b/103)) p/104))
+(function a/102[int] b/103 (makeblock 0 a/102 b/103))
 - : bool -> 'a -> bool * 'a = <fun>
 |}]
 
@@ -106,8 +106,8 @@ let _ = fun a b -> match a, b with
 | ((false, _) as p) -> p
 (* inside, trivial *)
 [%%expect{|
-(function a/106 b/107 (let (p/108 =a (makeblock 0 a/106 b/107)) p/108))
-(function a/106 b/107 (makeblock 0 a/106 b/107))
+(function a/106[int] b/107 (let (p/108 =a (makeblock 0 a/106 b/107)) p/108))
+(function a/106[int] b/107 (makeblock 0 a/106 b/107))
 - : bool -> 'a -> bool * 'a = <fun>
 |}];;
 
@@ -116,10 +116,11 @@ let _ = fun a b -> match a, b with
 | (false as x, _) as p -> x, p
 (* outside, simple *)
 [%%expect {|
-(function a/112 b/113
-  (let (x/114 =a a/112 p/115 =a (makeblock 0 a/112 b/113))
-    (makeblock 0 x/114 p/115)))
-(function a/112 b/113 (makeblock 0 a/112 (makeblock 0 a/112 b/113)))
+(function a/112[int] b/113
+  (let (x/114 =a[int] a/112 p/115 =a (makeblock 0 a/112 b/113))
+    (makeblock 0 (int,*) x/114 p/115)))
+(function a/112[int] b/113
+  (makeblock 0 (int,*) a/112 (makeblock 0 a/112 b/113)))
 - : bool -> 'a -> bool * (bool * 'a) = <fun>
 |}]
 
@@ -128,10 +129,11 @@ let _ = fun a b -> match a, b with
 | ((false as x, _) as p) -> x, p
 (* inside, simple *)
 [%%expect {|
-(function a/118 b/119
-  (let (x/120 =a a/118 p/121 =a (makeblock 0 a/118 b/119))
-    (makeblock 0 x/120 p/121)))
-(function a/118 b/119 (makeblock 0 a/118 (makeblock 0 a/118 b/119)))
+(function a/118[int] b/119
+  (let (x/120 =a[int] a/118 p/121 =a (makeblock 0 a/118 b/119))
+    (makeblock 0 (int,*) x/120 p/121)))
+(function a/118[int] b/119
+  (makeblock 0 (int,*) a/118 (makeblock 0 a/118 b/119)))
 - : bool -> 'a -> bool * (bool * 'a) = <fun>
 |}]
 
@@ -140,15 +142,15 @@ let _ = fun a b -> match a, b with
 | (false, x) as p -> x, p
 (* outside, complex *)
 [%%expect{|
-(function a/128 b/129
+(function a/128[int] b/129[int]
   (if a/128
-    (let (x/130 =a a/128 p/131 =a (makeblock 0 a/128 b/129))
-      (makeblock 0 x/130 p/131))
+    (let (x/130 =a[int] a/128 p/131 =a (makeblock 0 a/128 b/129))
+      (makeblock 0 (int,*) x/130 p/131))
     (let (x/132 =a b/129 p/133 =a (makeblock 0 a/128 b/129))
-      (makeblock 0 x/132 p/133))))
-(function a/128 b/129
-  (if a/128 (makeblock 0 a/128 (makeblock 0 a/128 b/129))
-    (makeblock 0 b/129 (makeblock 0 a/128 b/129))))
+      (makeblock 0 (int,*) x/132 p/133))))
+(function a/128[int] b/129[int]
+  (if a/128 (makeblock 0 (int,*) a/128 (makeblock 0 a/128 b/129))
+    (makeblock 0 (int,*) b/129 (makeblock 0 a/128 b/129))))
 - : bool -> bool -> bool * (bool * bool) = <fun>
 |}]
 
@@ -158,19 +160,19 @@ let _ = fun a b -> match a, b with
   -> x, p
 (* inside, complex *)
 [%%expect{|
-(function a/134 b/135
+(function a/134[int] b/135[int]
   (catch
     (if a/134
-      (let (x/142 =a a/134 p/143 =a (makeblock 0 a/134 b/135))
+      (let (x/142 =a[int] a/134 p/143 =a (makeblock 0 a/134 b/135))
         (exit 10 x/142 p/143))
       (let (x/140 =a b/135 p/141 =a (makeblock 0 a/134 b/135))
         (exit 10 x/140 p/141)))
-   with (10 x/136 p/137) (makeblock 0 x/136 p/137)))
-(function a/134 b/135
+   with (10 x/136[int] p/137) (makeblock 0 (int,*) x/136 p/137)))
+(function a/134[int] b/135[int]
   (catch
     (if a/134 (exit 10 a/134 (makeblock 0 a/134 b/135))
       (exit 10 b/135 (makeblock 0 a/134 b/135)))
-   with (10 x/136 p/137) (makeblock 0 x/136 p/137)))
+   with (10 x/136[int] p/137) (makeblock 0 (int,*) x/136 p/137)))
 - : bool -> bool -> bool * (bool * bool) = <fun>
 |}]
 
@@ -183,15 +185,15 @@ let _ = fun a b -> match a, b with
 | (false as x, _) as p -> x, p
 (* outside, onecase *)
 [%%expect {|
-(function a/144 b/145
+(function a/144[int] b/145[int]
   (if a/144
-    (let (x/146 =a a/144 _p/147 =a (makeblock 0 a/144 b/145))
-      (makeblock 0 x/146 [0: 1 1]))
-    (let (x/148 =a a/144 p/149 =a (makeblock 0 a/144 b/145))
-      (makeblock 0 x/148 p/149))))
-(function a/144 b/145
-  (if a/144 (makeblock 0 a/144 [0: 1 1])
-    (makeblock 0 a/144 (makeblock 0 a/144 b/145))))
+    (let (x/146 =a[int] a/144 _p/147 =a (makeblock 0 a/144 b/145))
+      (makeblock 0 (int,*) x/146 [0: 1 1]))
+    (let (x/148 =a[int] a/144 p/149 =a (makeblock 0 a/144 b/145))
+      (makeblock 0 (int,*) x/148 p/149))))
+(function a/144[int] b/145[int]
+  (if a/144 (makeblock 0 (int,*) a/144 [0: 1 1])
+    (makeblock 0 (int,*) a/144 (makeblock 0 a/144 b/145))))
 - : bool -> bool -> bool * (bool * bool) = <fun>
 |}]
 
@@ -200,10 +202,11 @@ let _ = fun a b -> match a, b with
 | ((false as x, _) as p) -> x, p
 (* inside, onecase *)
 [%%expect{|
-(function a/150 b/151
-  (let (x/152 =a a/150 p/153 =a (makeblock 0 a/150 b/151))
-    (makeblock 0 x/152 p/153)))
-(function a/150 b/151 (makeblock 0 a/150 (makeblock 0 a/150 b/151)))
+(function a/150[int] b/151
+  (let (x/152 =a[int] a/150 p/153 =a (makeblock 0 a/150 b/151))
+    (makeblock 0 (int,*) x/152 p/153)))
+(function a/150[int] b/151
+  (makeblock 0 (int,*) a/150 (makeblock 0 a/150 b/151)))
 - : bool -> 'a -> bool * (bool * 'a) = <fun>
 |}]
 
@@ -220,12 +223,12 @@ let _ =fun a b -> match a, b with
 | (_, _) as p -> p
 (* outside, tuplist *)
 [%%expect {|
-(function a/163 b/164
+(function a/163[int] b/164
   (catch
     (if a/163 (if b/164 (let (p/165 =a (field 0 b/164)) p/165) (exit 12))
       (exit 12))
    with (12) (let (p/166 =a (makeblock 0 a/163 b/164)) p/166)))
-(function a/163 b/164
+(function a/163[int] b/164
   (catch (if a/163 (if b/164 (field 0 b/164) (exit 12)) (exit 12)) with (12)
     (makeblock 0 a/163 b/164)))
 - : bool -> bool tuplist -> bool * bool tuplist = <fun>
@@ -236,15 +239,15 @@ let _ = fun a b -> match a, b with
 | ((_, _) as p) -> p
 (* inside, tuplist *)
 [%%expect{|
-(function a/167 b/168
+(function a/167[int] b/168
   (catch
     (catch
       (if a/167
         (if b/168 (let (p/172 =a (field 0 b/168)) (exit 13 p/172)) (exit 14))
         (exit 14))
      with (14) (let (p/171 =a (makeblock 0 a/167 b/168)) (exit 13 p/171)))
    with (13 p/169) p/169))
-(function a/167 b/168
+(function a/167[int] b/168
   (catch
     (catch
       (if a/167 (if b/168 (exit 13 (field 0 b/168)) (exit 14)) (exit 14))

testsuite/tests/translprim/array_spec.compilers.flat.reference

@@ -11,10 +11,11 @@
       (array.unsafe_get[addr] addr_a 0)
       (function a (array.unsafe_get[gen] a 0)) (array.set[int] int_a 0 1)
       (array.set[float] float_a 0 1.) (array.set[addr] addr_a 0 "a")
-      (function a x (array.set[gen] a 0 x)) (array.unsafe_set[int] int_a 0 1)
+      (function a x : int (array.set[gen] a 0 x))
+      (array.unsafe_set[int] int_a 0 1)
       (array.unsafe_set[float] float_a 0 1.)
       (array.unsafe_set[addr] addr_a 0 "a")
-      (function a x (array.unsafe_set[gen] a 0 x))
+      (function a x : int (array.unsafe_set[gen] a 0 x))
       (let
         (eta_gen_len = (function prim stub (array.length[gen] prim))
          eta_gen_safe_get =