Fix a stack overflow on option of a recursive @unboxed variant

changes/recursive-unboxed-option.fix.md

@@ -0,0 +1 @@
+- Fix a stack overflow when compiling `option` of a recursive `@unboxed` variant.

compiler/ml/typeopt.ml

@@ -37,7 +37,8 @@ let scrape env ty = (scrape_ty env ty).desc
      records the type at the definition type so for ['a option]
      it will always be [Tvar]
 *)
-let rec type_cannot_contain_undefined (typ : Types.type_expr) (env : Env.t) =
+let rec cannot_contain_undefined ~visiting (typ : Types.type_expr) (env : Env.t)
+    =
   match scrape env typ with
   | Tconstr (p, _, _) -> (
     (* all built in types could not inhabit none-like values:
@@ -72,7 +73,13 @@ let rec type_cannot_contain_undefined (typ : Types.type_expr) (env : Env.t) =
              _ );
       } ->
         false (* conservative *)
+      | {type_kind = Type_variant _} when List.exists (Path.same p) visiting ->
+        (* A value reaches [undefined] through finitely many unboxed
+           payloads, so the cases met again add none: whether the variant
+           can be [undefined] is decided by its other cases *)
+        true
       | {type_kind = Type_variant (cdecls, layout_ref)} ->
+        let visiting = p :: visiting in
         let layout = Variant_runtime.get_layout layout_ref in
         let rec all_cases_cannot_contain_undefined position = function
           | [] -> true
@@ -90,13 +97,13 @@ let rec type_cannot_contain_undefined (typ : Types.type_expr) (env : Env.t) =
                match cd.cd_args with
                | Cstr_tuple [t] ->
                  Ast_untagged_variants.type_is_builtin_object t
-                 || type_cannot_contain_undefined t env
+                 || cannot_contain_undefined ~visiting t env
                | Cstr_tuple [] -> true
                | Cstr_tuple (_ :: _ :: _) ->
                  true (* Not actually possible for an unboxed payload. *)
                | Cstr_record [{ld_type = t}] ->
                  Ast_untagged_variants.type_is_builtin_object t
-                 || type_cannot_contain_undefined t env
+                 || cannot_contain_undefined ~visiting t env
                | Cstr_record ([] | _ :: _ :: _) -> true)
             && all_cases_cannot_contain_undefined (position + 1) rest
         in
@@ -106,6 +113,9 @@ let rec type_cannot_contain_undefined (typ : Types.type_expr) (env : Env.t) =
   | Tobject _ ->
     false
 
+let type_cannot_contain_undefined typ env =
+  cannot_contain_undefined ~visiting:[] typ env
+
 let is_function_type env ty =
   match scrape env ty with
   | Tarrow (params, ret) -> Some ((List.hd params).typ, ret)

tests/tests/src/option_recursive_unboxed_test.mjs

@@ -0,0 +1,35 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as Mocha from "mocha";
+import * as Test_utils from "./test_utils.mjs";
+import * as Primitive_option from "@rescript/runtime/lib/es6/Primitive_option.mjs";
+
+function someT(x) {
+  return x;
+}
+
+function someA(x) {
+  return x;
+}
+
+function someU(x) {
+  return Primitive_option.some(x);
+}
+
+Mocha.describe("Option_recursive_unboxed_test", () => {
+  Mocha.test("a recursive variant that cannot be undefined", () => {
+    Test_utils.eq("File \"option_recursive_unboxed_test.res\", line 20, characters 7-14", "End", "End");
+    Test_utils.eq("File \"option_recursive_unboxed_test.res\", line 21, characters 7-14", "AEnd", "AEnd");
+  });
+  Mocha.test("a recursive variant that can be undefined", () => {
+    Test_utils.eq("File \"option_recursive_unboxed_test.res\", line 25, characters 7-14", false, false);
+    Test_utils.eq("File \"option_recursive_unboxed_test.res\", line 26, characters 7-14", false, false);
+  });
+});
+
+export {
+  someT,
+  someA,
+  someU,
+}
+/*  Not a pure module */

tests/tests/src/option_recursive_unboxed_test.res

@@ -0,0 +1,28 @@
+open Mocha
+open Test_utils
+
+// Whether option of a recursive @unboxed variant can be unboxed (#9018)
+
+@unboxed type rec t = Recur(t) | End
+
+@unboxed type rec a = A(b) | AEnd
+@unboxed and b = B(a) | BEnd
+
+// Can be undefined through its own case, so option of it stays boxed
+@unboxed type rec u = Wrap(u) | @as(undefined) Missing
+
+let someT = (x: t) => Some(x)
+let someA = (x: a) => Some(x)
+let someU = (x: u) => Some(x)
+
+describe(__MODULE__, () => {
+  test("a recursive variant that cannot be undefined", () => {
+    eq(__LOC__, Obj.magic(someT(End)), "End")
+    eq(__LOC__, Obj.magic(someA(A(B(AEnd)))), "AEnd")
+  })
+
+  test("a recursive variant that can be undefined", () => {
+    eq(__LOC__, someU(Missing) == None, false)
+    eq(__LOC__, someU(Wrap(Missing)) == None, false)
+  })
+})