diff options
-rw-r--r-- | typing/ctype.ml | 3 | ||||
-rw-r--r-- | typing/printtyp.ml | 9 |
2 files changed, 7 insertions, 5 deletions
diff --git a/typing/ctype.ml b/typing/ctype.ml index f7f9c31bf..361f0a8f8 100644 --- a/typing/ctype.ml +++ b/typing/ctype.ml @@ -2566,8 +2566,9 @@ let rec build_subtype env visited loops posi level t = | _ -> raise Not_found end | None -> assert false in + let t'_level = if tl = [] then !current_level else t'.level in let ty = - subst env t'.level abbrev None cl_abbr.type_params tl body in + subst env t'_level abbrev None cl_abbr.type_params tl body in let ty = repr ty in let ty1, tl1 = match ty.desc with diff --git a/typing/printtyp.ml b/typing/printtyp.ml index 3aa294b01..19bb1c0e0 100644 --- a/typing/printtyp.ml +++ b/typing/printtyp.ml @@ -537,7 +537,7 @@ let tree_of_metho sch concrete csil (lab, kind, ty) = let rec prepare_class_type params = function | Tcty_constr (p, tyl, cty) -> let sty = Ctype.self_type cty in - if List.memq sty !visited_objects + if List.memq (proxy sty) !visited_objects || List.exists (fun ty -> (repr ty).desc <> Tvar) params || List.exists (deep_occur sty) tyl then prepare_class_type params cty @@ -545,8 +545,9 @@ let rec prepare_class_type params = function | Tcty_signature sign -> let sty = repr sign.cty_self in (* Self may have a name *) - if List.memq sty !visited_objects then add_alias sty - else visited_objects := proxy sty :: !visited_objects; + let px = proxy sty in + if List.memq px !visited_objects then add_alias sty + else visited_objects := px :: !visited_objects; let (fields, _) = Ctype.flatten_fields (Ctype.object_fields sign.cty_self) in @@ -560,7 +561,7 @@ let rec tree_of_class_type sch params = function | Tcty_constr (p', tyl, cty) -> let sty = Ctype.self_type cty in - if List.memq sty !visited_objects + if List.memq (proxy sty) !visited_objects || List.exists (fun ty -> (repr ty).desc <> Tvar) params then tree_of_class_type sch params cty |