expose Lsend through %send primitive

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

3 files changed, 20 insertions, 10 deletions

diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml
index c68f0cea20..49f4bd8ae7 100644
--- a/bytecomp/translcore.ml
+++ b/bytecomp/translcore.ml
@@ -516,7 +516,11 @@ let rec transl_exp e =
 and transl_exp0 e =
   match e.exp_desc with
     Texp_ident(path, {val_kind = Val_prim p}) ->
-      transl_primitive p
+      if p.prim_name = "%send" then
+	let obj = Ident.create "obj" and meth = Ident.create "meth" in
+	Lfunction(Curried, [obj; meth], Lsend(Lvar meth, Lvar obj, []))
+      else
+	transl_primitive p
   | Texp_ident(path, {val_kind = Val_anc _}) ->
       raise(Error(e.exp_loc, Free_super_var))
   | Texp_ident(path, {val_kind = Val_reg | Val_self _}) ->
@@ -538,7 +542,10 @@ and transl_exp0 e =
     when List.length args = p.prim_arity
     && List.for_all (fun (arg,_) -> arg <> None) args ->
       let args = List.map (function Some x, _ -> x | _ -> assert false) args in
-      let prim = transl_prim p args in
+      if p.prim_name = "%send" then
+	let obj = transl_exp (List.hd args) in
+	event_after e (Lsend (transl_exp (List.nth args 1), obj, []))
+      else let prim = transl_prim p args in
       begin match (prim, args) with
         (Praise, [arg1]) ->
           Lprim(Praise, [event_after arg1 (transl_exp arg1)])
diff --git a/stdlib/camlinternalOO.ml b/stdlib/camlinternalOO.ml
index eec1c0d62f..29e81dc8c0 100644
--- a/stdlib/camlinternalOO.ml
+++ b/stdlib/camlinternalOO.ml
@@ -489,9 +489,12 @@ let create_object_and_run_initializers obj_0 table =
     obj
   end
 
+(* Equivalent primitive below
 let send obj lab =
   let (buck, elem) = decode lab in
   (magic obj : (obj -> t) array array array).(0).(buck).(elem) obj
+*)
+external send : obj -> label -> 'a = "%send"
 
 (**** table collection access ****)
 
@@ -541,23 +544,23 @@ let set_var n   = ret (fun obj x -> Array.unsafe_set obj n x)
 let app_const f x = ret (fun obj -> f x)
 let app_var f n   = ret (fun obj -> f (Array.unsafe_get obj n))
 let app_env f e n = ret (fun obj -> f (Obj.field (Array.unsafe_get obj e) n))
-let app_meth f n  = ret (fun obj -> f (repr(send obj n)))
+let app_meth f n  = ret (fun obj -> f (send obj n))
 let app_const_const f x y = ret (fun obj -> f x y)
 let app_const_var f x n   = ret (fun obj -> f x (Array.unsafe_get obj n))
-let app_const_meth f x n = ret (fun obj -> f x (repr(send obj n)))
+let app_const_meth f x n = ret (fun obj -> f x (send obj n))
 let app_var_const f n x = ret (fun obj -> f (Array.unsafe_get obj n) x)
-let app_meth_const f n x = ret (fun obj -> f (repr(send obj n)) x)
+let app_meth_const f n x = ret (fun obj -> f (send obj n) x)
 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_const n x = ret (fun obj -> (send obj n) x)
 let meth_app_var n m =
-  ret (fun obj -> (magic (send obj n)) (Array.unsafe_get obj m))
+  ret (fun obj -> (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))
+  ret (fun obj -> (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))
+  ret (fun obj -> (send obj n) (send obj m))
 
 type impl =
     GetConst
diff --git a/stdlib/camlinternalOO.mli b/stdlib/camlinternalOO.mli
index 8d5853079a..0195d465f5 100644
--- a/stdlib/camlinternalOO.mli
+++ b/stdlib/camlinternalOO.mli
@@ -60,7 +60,7 @@ val create_object_opt : obj -> table -> obj
 val run_initializers : obj -> table -> unit
 val run_initializers_opt : obj -> obj -> table -> obj
 val create_object_and_run_initializers : obj -> table -> obj
-val send : obj -> label -> t
+external send : obj -> label -> t = "%send"
 
 (** {6 Table cache} *)