Make recursive type verification logic better by allowing it to see through multiple levels of indirection. Still can trigger "unexpected OpaqueTy" bugs, but that's better than infinite loops.

Author: pcwalton

src/boot/me/semant.ml

@@ -2134,7 +2134,11 @@ and vec_sty (word_bits:Il.bits) : Il.scalar_ty =
   let ptr = Il.ScalarTy (Il.AddrTy Il.OpaqueTy) in
     Il.AddrTy (Il.StructTy [| word; word; word; ptr |])
 
-and referent_type (cx:ctxt) (t:Ast.ty) : Il.referent_ty =
+and referent_type
+    ?parent_tag:parent_tag
+    (cx:ctxt)
+    (t:Ast.ty)
+    : Il.referent_ty =
   let s t = Il.ScalarTy t in
   let v b = Il.ValTy b in
   let p t = Il.AddrTy t in
@@ -2149,12 +2153,7 @@ and referent_type (cx:ctxt) (t:Ast.ty) : Il.referent_ty =
   let tag ttag =
     let n = get_n_tag_tups cx ttag in
     let union =
-      let rty t =
-        match t with
-            Ast.TY_box (Ast.TY_tag dst_tag) when is_back_edge ttag dst_tag ->
-              sp (Il.StructTy [| word; Il.OpaqueTy |])
-          | _ -> referent_type cx t
-      in
+      let rty t = referent_type ~parent_tag:ttag cx t in
       let tup ttup = Il.StructTy (Array.map rty ttup) in
         Array.init n (fun i -> tup (get_nth_tag_tup cx ttag i))
     in
@@ -2194,7 +2193,13 @@ and referent_type (cx:ctxt) (t:Ast.ty) : Il.referent_ty =
       | Ast.TY_fn _ -> fn_rty cx false
       | Ast.TY_obj _ -> obj_rty word_bits
 
-      | Ast.TY_tag ttag -> tag ttag
+      | Ast.TY_tag ttag ->
+          begin
+            match parent_tag with
+                Some parent_tag when is_back_edge ttag parent_tag ->
+                  Il.OpaqueTy
+              | _ -> tag ttag
+          end
 
       | Ast.TY_chan _
       | Ast.TY_port _
@@ -2205,14 +2210,15 @@ and referent_type (cx:ctxt) (t:Ast.ty) : Il.referent_ty =
       | Ast.TY_native _ -> ptr
 
       | Ast.TY_box t ->
-          sp (Il.StructTy [| word; referent_type cx t |])
+          sp (Il.StructTy
+            [| word; referent_type ?parent_tag:parent_tag cx t |])
 
-      | Ast.TY_mutable t -> referent_type cx t
+      | Ast.TY_mutable t -> referent_type ?parent_tag:parent_tag cx t
 
       | Ast.TY_param (i, _) -> Il.ParamTy i
 
       | Ast.TY_named _ -> bug () "named type in referent_type"
-      | Ast.TY_constrained (t, _) -> referent_type cx t
+      | Ast.TY_constrained (t, _) -> referent_type ?parent_tag:parent_tag cx t
 
 and slot_referent_type (cx:ctxt) (sl:Ast.slot) : Il.referent_ty =
   let s t = Il.ScalarTy t in

src/boot/me/type.ml

@@ -1010,7 +1010,7 @@ let populate_tag_graph_node (cx:Semant.ctxt) (id:Common.opaque_id) (n:int) =
       | Ast.TY_rec ty_rec ->
           Array.iter (fun (_, ty) -> add_ty ty) ty_rec
       | Ast.TY_fn ty_fn -> add_ty_fn ty_fn
-      | Ast.TY_vec ty | Ast.TY_chan ty | Ast.TY_port ty | Ast.TY_mutable ty
+      | Ast.TY_chan ty | Ast.TY_port ty | Ast.TY_mutable ty
           | Ast.TY_constrained (ty, _) -> add_ty ty
       | Ast.TY_obj (_, ty_fns) ->
           Hashtbl.iter (fun _ ty_fn -> add_ty_fn ty_fn) ty_fns