more builtin metthods

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/fastclass@5945 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

3 files changed, 43 insertions, 9 deletions

diff --git a/bytecomp/translclass.ml b/bytecomp/translclass.ml
index 98d956aca8..16b1e4309a 100644
--- a/bytecomp/translclass.ml
+++ b/bytecomp/translclass.ml
@@ -456,26 +456,29 @@ let rec builtin_meths self env env2 body =
   let const_path = const_path (env::self) in
   let conv = function
     (* Lvar s when List.mem s self ->  "_self", [] *)
-    | p when const_path p -> "_const", [p]
+    | p when const_path p -> "const", [p]
     | Lprim(Parrayrefu _, [Lvar s; Lvar n]) when List.mem s self ->
-        "_var", [Lvar n]
+        "var", [Lvar n]
     | Lprim(Pfield n, [Lvar e]) when Ident.same e env ->
-        "_env", [Lvar env2; Lconst(Const_pointer n)]
+        "env", [Lvar env2; Lconst(Const_pointer n)]
     | Lsend(Lvar n, Lvar s, []) when List.mem s self ->
-        "_meth", [Lvar n]
+        "meth", [Lvar n]
     | _ -> raise Not_found
   in
   match body with
   | Llet(Alias, s', Lvar s, body) when List.mem s self ->
       builtin_meths self env env2 body
   | Lapply(f, [arg]) when const_path f ->
-      let s, args = conv arg in ("app"^s, f :: args)
+      let s, args = conv arg in ("app_"^s, f :: args)
   | Lapply(f, [arg; p]) when const_path f && const_path p ->
       let s, args = conv arg in
-      ("app"^s^"_const", f :: args @ [p])
+      ("app_"^s^"_const", f :: args @ [p])
   | Lapply(f, [p; arg]) when const_path f && const_path p ->
       let s, args = conv arg in
-      ("app_const"^s, f :: p :: args)
+      ("app_const_"^s, f :: p :: args)
+  | Lsend(Lvar n, Lvar s, [arg]) when List.mem s self ->
+      let s, args = conv arg in
+      ("meth_app_"^s, Lvar n :: args)
   | Lfunction (Curried, [x], body) ->
       let rec enter self = function
         | Lprim(Parraysetu _, [Lvar s; Lvar n; Lvar x'])
@@ -487,7 +490,7 @@ let rec builtin_meths self env env2 body =
       in enter self body
   | Lfunction _ -> raise Not_found
   | _ ->
-      let s, args = conv body in ("get"^s, args)
+      let s, args = conv body in ("get_"^s, args)
 
 module M = struct
   open CamlinternalOO
@@ -511,6 +514,10 @@ module M = struct
     | "app_var_const"   -> AppVarConst
     | "app_env_const"   -> AppEnvConst
     | "app_meth_const"  -> AppMethConst
+    | "meth_app_const"  -> MethAppConst
+    | "meth_app_var"    -> MethAppVar
+    | "meth_app_env"    -> MethAppEnv
+    | "meth_app_meth"   -> MethAppMeth
     | _ -> assert false
     in Lconst(Const_pointer(Obj.magic tag)) :: args
 end
diff --git a/stdlib/camlinternalOO.ml b/stdlib/camlinternalOO.ml
index 321024f6f6..1b6b99165b 100644
--- a/stdlib/camlinternalOO.ml
+++ b/stdlib/camlinternalOO.ml
@@ -544,6 +544,13 @@ let app_const_env f x e n =
   ret (fun obj -> f x (Obj.field (Array.unsafe_get obj e) n))
 let app_env_const f e n x =
   ret (fun obj -> f (Obj.field (Array.unsafe_get obj e) n) x)
+let meth_app_const n x = ret (fun obj -> (magic (send obj n)) x)
+let meth_app_var n m =
+  ret (fun obj -> (magic (send obj n)) (Array.unsafe_get obj m))
+let meth_app_env n e m =
+  ret (fun obj -> (magic (send obj n)) (Obj.field (Array.unsafe_get obj e) m))
+let meth_app_meth n m =
+  ret (fun obj -> (magic (send obj n)) (send obj m))
 
 type impl =
     GetConst
@@ -562,6 +569,10 @@ type impl =
   | AppVarConst
   | AppEnvConst
   | AppMethConst
+  | MethAppConst
+  | MethAppVar
+  | MethAppEnv
+  | MethAppMeth
   | Closure of Obj.t
 
 let method_impl i arr =
@@ -590,9 +601,17 @@ let method_impl i arr =
       let f = next() and n = next() and x = next() in app_var_const f n x
   | AppEnvConst ->
       let f = next() and e = next () and n = next() and x = next() in
-      app_const_env f e n x
+      app_env_const f e n x
   | AppMethConst ->
       let f = next() and n = next() and x = next() in app_meth_const f n x
+  | MethAppConst ->
+      let n = next() and x = next() in meth_app_const n x
+  | MethAppVar ->
+      let n = next() and m = next() in meth_app_var n m
+  | MethAppEnv ->
+      let n = next() and e = next() and m = next() in meth_app_env n e m
+  | MethAppMeth ->
+      let n = next() and m = next() in meth_app_meth n m
   | Closure _ as clo -> magic clo
 
 let set_methods table methods =
diff --git a/stdlib/camlinternalOO.mli b/stdlib/camlinternalOO.mli
index de4f692a44..b29ae17086 100644
--- a/stdlib/camlinternalOO.mli
+++ b/stdlib/camlinternalOO.mli
@@ -86,6 +86,10 @@ val app_const_meth : (t -> t -> t) -> t -> label -> closure
 val app_var_const : (t -> t -> t) -> int -> t -> closure
 val app_env_const : (t -> t -> t) -> int -> int -> t -> closure
 val app_meth_const : (t -> t -> t) -> label -> t -> closure
+val meth_app_const : label -> t -> closure
+val meth_app_var : label -> int -> closure
+val meth_app_env : label -> int -> int -> closure
+val meth_app_meth : label -> label -> closure
 
 type impl =
     GetConst
@@ -104,6 +108,10 @@ type impl =
   | AppVarConst
   | AppEnvConst
   | AppMethConst
+  | MethAppConst
+  | MethAppVar
+  | MethAppEnv
+  | MethAppMeth
   | Closure of t
 
 (** {6 Parameters} *)