Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
master
Alain Frisch 2012-01-06 14:17:56 +00:00
parent c0e3b9cb42
commit 4979a58d94
2 changed files with 18 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
typing/env.ml
View File

@ -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

20
typing/typeclass.ml
View File

@ -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