diff options
| author | Alain Frisch <alain@frisch.fr> | 2012-01-06 14:17:56 +0000 |
|---|---|---|
| committer | Alain Frisch <alain@frisch.fr> | 2012-01-06 14:17:56 +0000 |
| commit | 4979a58d94f8d2980c9f5d36307d15400c50cb84 (patch) | |
| tree | efbe910ab46c699170f11da72535a8d7f90d269c /typing | |
| parent | c0e3b9cb4204b77b59456f75aa56f20ec54e2208 (diff) | |
| download | ocaml-4979a58d94f8d2980c9f5d36307d15400c50cb84.tar.gz | |
Avoid problem with the use of Typeclass.unbound_class.
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/unused_declarations@11998 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'typing')
| -rw-r--r-- | typing/env.ml | 6 | ||||
| -rw-r--r-- | typing/typeclass.ml | 20 |
2 files changed, 18 insertions, 8 deletions
diff --git a/typing/env.ml b/typing/env.ml index 6aa2445108..0433ed7c8c 100644 --- a/typing/env.ml +++ b/typing/env.ml @@ -556,11 +556,15 @@ let lookup_label lid env = let lookup_class lid env = let (_, desc) as r = lookup_class lid env in - mark_type_path env desc.cty_path; + (* special support for Typeclass.unbound_class *) + if Path.name desc.cty_path = "" then ignore (lookup_type lid env) + else mark_type_path env desc.cty_path; r let lookup_cltype lid env = let (_, desc) as r = lookup_cltype lid env in + if Path.name desc.clty_path = "" then ignore (lookup_type lid env) + else mark_type_path env desc.clty_path; mark_type_path env desc.clty_path; r diff --git a/typing/typeclass.ml b/typing/typeclass.ml index d9e265d317..34b651e186 100644 --- a/typing/typeclass.ml +++ b/typing/typeclass.ml @@ -805,10 +805,16 @@ and class_expr cl_num val_env met_env scl = let pv = List.map (function (id, id', ty) -> + let path = Pident id' in + let vd = Env.find_value path val_env' (* do not mark the value as being used *) in (id, - Typecore.type_exp val_env' - {pexp_desc = Pexp_ident (Longident.Lident (Ident.name id)); - pexp_loc = Location.none})) + { + exp_desc = Texp_ident(path, vd); + exp_loc = Location.none; + exp_type = Ctype.instance val_env' vd.val_type; + exp_env = val_env' + }) + ) pv in let rec not_function = function @@ -1019,7 +1025,7 @@ let rec approx_description ct = (*******************************) -let temp_abbrev env id arity = +let temp_abbrev loc env id arity = let params = ref [] in for i = 1 to arity do params := Ctype.newvar () :: !params @@ -1034,7 +1040,7 @@ let temp_abbrev env id arity = type_manifest = Some ty; type_variance = List.map (fun _ -> true, true, true) !params; type_newtype_level = None; - type_loc = Location.none; + type_loc = loc; } env in @@ -1044,8 +1050,8 @@ let rec initial_env define_class approx (res, env) (cl, id, ty_id, obj_id, cl_id) = (* Temporary abbreviations *) let arity = List.length (fst cl.pci_params) in - let (obj_params, obj_ty, env) = temp_abbrev env obj_id arity in - let (cl_params, cl_ty, env) = temp_abbrev env cl_id arity in + let (obj_params, obj_ty, env) = temp_abbrev cl.pci_loc env obj_id arity in + let (cl_params, cl_ty, env) = temp_abbrev cl.pci_loc env cl_id arity in (* Temporary type for the class constructor *) let constr_type = approx cl.pci_expr in |