Clearer reaching path printing for unboxed recursion check

testsuite/tests/typing-layouts-unboxed-records/recursive.ml

@@ -78,7 +78,8 @@ Line 1, characters 0-31:
 1 | type a_bad = #{ b_bad : b_bad }
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: The definition of "a_bad" is recursive without boxing:
-         "a_bad" contains "a_bad"
+         "a_bad" contains "b_bad",
+         "b_bad" contains "a_bad"
 |}]
 
 type bad : any = #{ bad : bad }
@@ -165,9 +166,11 @@ Line 1, characters 0-21:
     ^^^^^^^^^^^^^^^^^^^^^
 Error: The definition of "bad" is recursive without boxing:
          "bad" = "#(s * s)",
-         "#(s * s)" contains "u",
+         "#(s * s)" contains "s",
+         "s" contains "u",
          "u" = "#(int * bad record_id2)",
-         "#(int * bad record_id2)" contains "bad"
+         "#(int * bad record_id2)" contains "bad record_id2",
+         "bad record_id2" contains "bad"
 |}]
 
 type bad = #( s * s )
@@ -180,9 +183,11 @@ Line 1, characters 0-21:
     ^^^^^^^^^^^^^^^^^^^^^
 Error: The definition of "bad" is recursive without boxing:
          "bad" = "#(s * s)",
-         "#(s * s)" contains "u",
+         "#(s * s)" contains "s",
+         "s" contains "u",
          "u" = "#(int * bad record_id2)",
-         "#(int * bad record_id2)" contains "bad"
+         "#(int * bad record_id2)" contains "bad record_id2",
+         "bad record_id2" contains "bad"
 |}]
 
 (* We also check recursive types via modules *)
@@ -211,7 +216,8 @@ Lines 1-7, characters 0-3:
 7 | end
 Error: The definition of "Bad_rec1.t" is recursive without boxing:
          "Bad_rec1.t" = "#(Bad_rec1.s * Bad_rec1.s)",
-         "#(Bad_rec1.s * Bad_rec1.s)" contains "Bad_rec2.u",
+         "#(Bad_rec1.s * Bad_rec1.s)" contains "Bad_rec1.s",
+         "Bad_rec1.s" contains "Bad_rec2.u",
          "Bad_rec2.u" = "Bad_rec1.t Bad_rec2.id",
          "Bad_rec1.t Bad_rec2.id" = "Bad_rec1.t",
          "Bad_rec1.t" = "#(Bad_rec1.s * Bad_rec1.s)",

typing/typedecl.ml

@@ -3568,8 +3568,10 @@ module Reaching_path = struct
 
   (* Simplify a reaching path before showing it in error messages. *)
   let simplify path =
+    let is_tconstr ty = match get_desc ty with Tconstr _ -> true | _ -> false in
     let rec simplify : t -> t = function
-      | Contains (ty1, _ty2) :: Contains (_ty2', ty3) :: rest ->
+      | Contains (ty1, _ty2) :: Contains (ty2', ty3) :: rest
+        when not (is_tconstr ty2') ->
           (* If t1 contains t2 and t2 contains t3, then t1 contains t3
              and we don't need to show t2. *)
           simplify (Contains (ty1, ty3) :: rest)