diff options
| -rw-r--r-- | typing/typeclass.ml | 27 |
1 files changed, 9 insertions, 18 deletions
diff --git a/typing/typeclass.ml b/typing/typeclass.ml index fa6d86d8f..7480b4dc0 100644 --- a/typing/typeclass.ml +++ b/typing/typeclass.ml @@ -1235,26 +1235,17 @@ let class_type_declarations env cls = (*******************************) -let approx_class env sdecl = - let (params, _) = sdecl.pci_params in - Ctype.begin_def(); - let ty_params = List.map (fun _ -> Ctype.newvar()) params in - let cl_cty = - Tcty_signature { cty_self = Ctype.newvar(); - cty_vars = Vars.empty; - cty_concr = Concr.empty } in - Ctype.end_def(); - List.iter Ctype.generalize ty_params; - generalize_class_type cl_cty; - (Ident.create sdecl.pci_name, - { clty_params = ty_params; clty_type = cl_cty; clty_path = unbound_class }, - Ident.create sdecl.pci_name, - Typedecl.abstract_type_decl (List.length params), - Ident.create ("#" ^ sdecl.pci_name), - Typedecl.abstract_type_decl (List.length params)) +(* Approximate the class declaration as class ['params] id = object end *) +let approx_class sdecl = + let self' = + { ptyp_desc = Ptyp_any; ptyp_loc = Location.none } in + let clty' = + { pcty_desc = Pcty_signature(self', []); + pcty_loc = sdecl.pci_expr.pcty_loc } in + { sdecl with pci_expr = clty' } let approx_class_declarations env sdecls = - List.map (approx_class env) sdecls + fst (class_type_declarations env (List.map approx_class sdecls)) (*******************************) |