Skip to content

Commit

Permalink
Actually ignore types not in the recursive group
Browse files Browse the repository at this point in the history
  • Loading branch information
rtjoa committed Dec 30, 2024
1 parent d66efd4 commit 57b7033
Show file tree
Hide file tree
Showing 2 changed files with 23 additions and 17 deletions.
25 changes: 14 additions & 11 deletions testsuite/tests/typing-layouts-unboxed-records/recursive.ml
Original file line number Diff line number Diff line change
Expand Up @@ -173,19 +173,16 @@ Error: The definition of "bad" is recursive without boxing:
type bad = #( s * s )
and ('a : any) record_id2 = #{ a : 'a }
and s = #{ u : u }
and u = #(int * bad alias_id record_id2)
and u = #(int * bad record_id2)
[%%expect{|
Line 1, characters 0-21:
1 | type bad = #( s * s )
^^^^^^^^^^^^^^^^^^^^^
Error: The definition of "bad" is recursive without boxing:
"bad" = "#(s * s)",
"#(s * s)" contains "u",
"u" = "#(int * bad alias_id record_id2)",
"#(int * bad alias_id record_id2)" contains "bad alias_id",
"bad alias_id" = "bad",
"bad" = "#(s * s)",
"#(s * s)" contains "s"
"u" = "#(int * bad record_id2)",
"#(int * bad record_id2)" contains "bad"
|}]

(* We also check recursive types via modules *)
Expand Down Expand Up @@ -247,15 +244,21 @@ Error: Unboxed record element types must have a representable layout.
(***************************************)
(* Singleton recursive unboxed records *)

(* CR layouts v7.2: allow bounded repetition of the same type constructor of
unboxed records. *)
type 'a safe = #{ a : 'a }
type x = int safe safe
[%%expect{|
type 'a safe = #{ a : 'a; }
Line 2, characters 0-22:
2 | type x = int safe safe
^^^^^^^^^^^^^^^^^^^^^^
type x = int safe safe
|}]

(* CR layouts v7.2: allow bounded repetition of the same type constructor of
unboxed records. *)
type 'a safe = #{ a : 'a }
and x = int safe safe
[%%expect{|
Line 2, characters 0-21:
2 | and x = int safe safe
^^^^^^^^^^^^^^^^^^^^^
Error: The definition of "x" is recursive without boxing:
"x" = "int safe safe",
"int safe safe" contains "int safe"
Expand Down
15 changes: 9 additions & 6 deletions typing/typedecl.ml
Original file line number Diff line number Diff line change
Expand Up @@ -2101,7 +2101,10 @@ let check_unboxed_recursion ~abs_env env loc path0 ty0 to_check =
| ty' ->
begin match get_desc ty with
| Tconstr (path, _, _) ->
expand (Path.Set.add path parents) (Expands_to (ty, ty') :: trace) ty'
if to_check path then
expand (Path.Set.add path parents) (Expands_to (ty, ty') :: trace) ty'
else
parents, trace, ty
| _ ->
(* Only [Tconstr]s can be expanded *)
Misc.fatal_error "Typedecl.check_unboxed_recursion"
Expand All @@ -2115,11 +2118,11 @@ let check_unboxed_recursion ~abs_env env loc path0 ty0 to_check =
let parents, trace, ty = expand parents trace ty in
match get_desc ty with
| Tconstr (path, _, _) ->
(* If we get a Tconstr, we only need to visit if it's part of this group
of mutually recursive typedecls. *)
if not (to_check path) then () else
check_visited parents trace ty;
visit_subtypes (Path.Set.add path parents) trace ty
(* Only visit [Tconstr]s in this recursive group of typedecls. *)
if to_check path then begin
check_visited parents trace ty;
visit_subtypes (Path.Set.add path parents) trace ty
end
| _ ->
visit_subtypes parents trace ty
and visit_subtypes parents trace ty =
Expand Down

0 comments on commit 57b7033

Please sign in to comment.