diff options
| -rw-r--r-- | typing/ctype.ml | 2 | ||||
| -rw-r--r-- | typing/oprint.ml | 2 | ||||
| -rw-r--r-- | typing/typedecl.ml | 19 |
3 files changed, 13 insertions, 10 deletions
diff --git a/typing/ctype.ml b/typing/ctype.ml index 42a4b71a6..351fcfafe 100644 --- a/typing/ctype.ml +++ b/typing/ctype.ml @@ -929,7 +929,7 @@ let rec copy_sep fixed free bound visited ty = let bound = tl @ bound in let visited = List.map2 (fun ty t -> ty,(t,bound)) tl tl' @ visited in - Tpoly (copy_rec t1, tl') + Tpoly (copy_sep fixed free bound visited t1, tl') | _ -> copy_type_desc copy_rec ty.desc end; t diff --git a/typing/oprint.ml b/typing/oprint.ml index a6d5c34b1..40490a2da 100644 --- a/typing/oprint.ml +++ b/typing/oprint.ml @@ -362,7 +362,7 @@ and print_out_type_decl kwd ppf (name, args, ty, constraints) = fprintf ppf "@[<2>@[<hv 2>%t@]%a@]" print_name_args print_constraints constraints | Otyp_record lbls -> - fprintf ppf "@[<2>@[<hv 2>%t = %a{%a@;<1 -2>}@]@ %a@]" print_name_args + fprintf ppf "@[<2>@[<hv 2>%t = %a{%a@;<1 -2>}@]%a@]" print_name_args print_virtual v (print_list_init print_out_label (fun ppf -> fprintf ppf "@ ")) lbls print_constraints constraints diff --git a/typing/typedecl.ml b/typing/typedecl.ml index 8e6455dea..f14a3ab37 100644 --- a/typing/typedecl.ml +++ b/typing/typedecl.ml @@ -308,8 +308,9 @@ let check_recursive_abbrev env (name, sdecl) (id, decl) = let rec check_expansion_rec env id args loc id_check_list visited ty = let ty = Ctype.repr ty in if List.memq ty visited then () else - let visited = ty :: visited in - begin match ty.desc with + let check_rec = + check_expansion_rec env id args loc id_check_list (ty :: visited) in + match ty.desc with | Tconstr(Path.Pident id' as path, args', _) -> if Ident.same id id' then begin if not (Ctype.equal env false args args') then @@ -326,14 +327,16 @@ let rec check_expansion_rec env id args loc id_check_list visited ty = try List.iter2 (Ctype.unify env) params args' with Ctype.Unify _ -> assert false end; - check_expansion_rec env id args loc id_check_list visited body + check_rec body end with Not_found -> () - end - | _ -> () - end; - Btype.iter_type_expr - (check_expansion_rec env id args loc id_check_list visited) ty + end; + List.iter check_rec args' + | Tpoly (ty, tl) -> + let _, ty = Ctype.instance_poly false tl ty in + check_rec ty + | _ -> + Btype.iter_type_expr check_rec ty let check_expansion env id_loc_list (id, decl) = if decl.type_params = [] then () else |