summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJacques Garrigue <garrigue at math.nagoya-u.ac.jp>2003-11-15 08:41:48 +0000
committerJacques Garrigue <garrigue at math.nagoya-u.ac.jp>2003-11-15 08:41:48 +0000
commit1ba38b1d960af254606742b575d685e6dea8abd9 (patch)
treedb773ec183b96b7c14c02cddfa046a87649eaf8c
parente368fe981df6b2fdf57cb655fe406e68d9f18ea6 (diff)
downloadocaml-1ba38b1d960af254606742b575d685e6dea8abd9.tar.gz
only lookup keys for ancestors that may change
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/fastclass@5923 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
-rw-r--r--bytecomp/translclass.ml13
1 files changed, 9 insertions, 4 deletions
diff --git a/bytecomp/translclass.ml b/bytecomp/translclass.ml
index 486a36e0e0..a9d7d880cf 100644
--- a/bytecomp/translclass.ml
+++ b/bytecomp/translclass.ml
@@ -110,7 +110,7 @@ let rec build_object_init cl_table obj params inh_init obj_init cl =
Tclass_ident path ->
let obj_init = Ident.create "obj_init"
and env_init = Ident.create "env_init" in
- ((obj_init, env_init, transl_path path)::inh_init,
+ ((obj_init, env_init, path)::inh_init,
Lapply(Lvar obj_init, [obj]))
| Tclass_structure str ->
create_object cl_table obj (fun obj ->
@@ -220,7 +220,8 @@ let rec build_class_init cla pub_meths cstr inh_init cl_init msubst top cl =
match cl.cl_desc with
Tclass_ident path ->
begin match inh_init with
- (obj_init, env_init, lpath)::inh_init ->
+ (obj_init, env_init, path)::inh_init ->
+ let lpath = transl_path path in
(inh_init,
Llet (Strict, (if top then obj_init else env_init),
Lapply(Lprim(Pfield 1, [lpath]), Lvar cla ::
@@ -511,7 +512,7 @@ let transl_class ids cl_id arity pub_meths cl =
List.map (fun id -> Lvar id) !new_ids_meths)) ::
List.map (fun id -> Lvar id) !new_ids_init)
and linh_envs =
- List.map (fun (_, _, lpath) -> Lprim(Pfield 3, [lpath])) inh_init
+ List.map (fun (_, _, p) -> Lprim(Pfield 3, [transl_path p])) inh_init
in
let make_envs lam =
Llet(StrictOpt, envs,
@@ -524,8 +525,12 @@ let transl_class ids cl_id arity pub_meths cl =
in
let obj_init2 = Ident.create "obj_init"
and cached = Ident.create "cached" in
+ let inh_paths =
+ List.filter
+ (fun (_,_,path) -> List.exists (Ident.same (Path.head path)) new_ids)
+ inh_init in
let inh_keys =
- List.map (fun (_,_,lpath) -> Lprim(Pfield 2, [lpath])) inh_init in
+ List.map (fun (_,_,p) -> Lprim(Pfield 2, [transl_path p])) inh_paths in
let lclass lam =
Llet(Strict, class_init,
Lfunction(Curried, [cla], def_ids cla cl_init), lam)