diff options
| author | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2003-04-22 10:46:57 +0000 |
|---|---|---|
| committer | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2003-04-22 10:46:57 +0000 |
| commit | b8311b53d09de960bad5dc508f60e65112f07503 (patch) | |
| tree | 7b56ae7c026432869362e5ae6b313f0fba843f7a | |
| parent | 2a43a7097d193c2906c8a3a1704c176749659723 (diff) | |
fix PR#1599 and PR#1616
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@5502 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
| -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 |