diff options
Diffstat (limited to 'bytecomp')
| -rw-r--r-- | bytecomp/translclass.ml | 16 | ||||
| -rw-r--r-- | bytecomp/translobj.ml | 2 | ||||
| -rw-r--r-- | bytecomp/translobj.mli | 2 |
3 files changed, 16 insertions, 4 deletions
diff --git a/bytecomp/translclass.ml b/bytecomp/translclass.ml index d186bdebf..cf5783a97 100644 --- a/bytecomp/translclass.ml +++ b/bytecomp/translclass.ml @@ -607,12 +607,20 @@ let transl_class ids cl_id arity pub_meths cl vflag = let meth_ids = get_class_meths cl in let subst env lam i0 new_ids' = let fv = free_variables lam in + (* prerr_ids "cl_id =" [cl_id]; prerr_ids "fv =" (IdentSet.elements fv); *) let fv = List.fold_right IdentSet.remove !new_ids' fv in - let fv = IdentSet.filter (fun id -> List.mem id new_ids) fv in - (* need to handle methods specially (PR#3576) *) - let fm = IdentSet.diff (free_methods lam) meth_ids in - let fv = IdentSet.union fv fm in + (* We need to handle method ids specially, as they do not appear + in the typing environment (PR#3576, PR#4560) *) + (* very hacky: we add and remove free method ids on the fly, + depending on the visit order... *) + method_ids := + IdentSet.diff (IdentSet.union (free_methods lam) !method_ids) meth_ids; + (* prerr_ids "meth_ids =" (IdentSet.elements meth_ids); + prerr_ids "method_ids =" (IdentSet.elements !method_ids); *) + let new_ids = List.fold_right IdentSet.add new_ids !method_ids in + let fv = IdentSet.inter fv new_ids in new_ids' := !new_ids' @ IdentSet.elements fv; + (* prerr_ids "new_ids' =" !new_ids'; *) let i = ref (i0-1) in List.fold_left (fun subst id -> diff --git a/bytecomp/translobj.ml b/bytecomp/translobj.ml index 9899e44b3..e97fbfc13 100644 --- a/bytecomp/translobj.ml +++ b/bytecomp/translobj.ml @@ -123,6 +123,7 @@ let transl_store_label_init glob size f arg = let wrapping = ref false let top_env = ref Env.empty let classes = ref [] +let method_ids = ref IdentSet.empty let oo_add_class id = classes := id :: !classes; @@ -138,6 +139,7 @@ let oo_wrap env req f x = cache_required := req; top_env := env; classes := []; + method_ids := IdentSet.empty; let lambda = f x in let lambda = List.fold_left diff --git a/bytecomp/translobj.mli b/bytecomp/translobj.mli index d6e432da5..26fa504b4 100644 --- a/bytecomp/translobj.mli +++ b/bytecomp/translobj.mli @@ -24,5 +24,7 @@ val transl_label_init: lambda -> lambda val transl_store_label_init: Ident.t -> int -> ('a -> lambda) -> 'a -> int * lambda +val method_ids: IdentSet.t ref (* reset when starting a new wrapper *) + val oo_wrap: Env.t -> bool -> ('a -> lambda) -> 'a -> lambda val oo_add_class: Ident.t -> Env.t * bool |