diff -Naur ocaml/bytecomp/translcore.ml ocaml_spec/bytecomp/translcore.ml
--- ocaml/bytecomp/translcore.ml	2006-01-27 15:33:42.000000000 +0100
+++ ocaml_spec/bytecomp/translcore.ml	2006-08-04 21:35:35.000000000 +0200
@@ -266,6 +266,24 @@
   { prim_name = "caml_obj_dup"; prim_arity = 1; prim_alloc = true;
     prim_native_name = ""; prim_native_float = false }
 
+let specialize_prim prim e =
+  try
+    let (gencomp, intcomp, floatcomp, stringcomp,
+         nativeintcomp, int32comp, int64comp,
+         simplify_constant_constructor) =
+      Hashtbl.find comparisons_table prim.prim_name in
+    let t = first_arg_has_base_type e in
+    if t Predef.path_int || t Predef.path_char then intcomp
+    else if t Predef.path_float then floatcomp
+    else if t Predef.path_string then stringcomp
+    else if t Predef.path_nativeint then nativeintcomp
+    else if t Predef.path_int32 then int32comp
+    else if t Predef.path_int64 then int64comp
+    else gencomp
+  with Not_found ->
+    try Hashtbl.find primitives_table prim.prim_name
+    with Not_found -> Pccall prim
+
 let transl_prim prim args =
   try
     let (gencomp, intcomp, floatcomp, stringcomp,
@@ -336,6 +354,13 @@
   let params = make_params p.prim_arity in
   Lfunction(Curried, params, Lprim(prim, List.map (fun id -> Lvar id) params))
 
+let transl_primitive_ty p e =
+  let prim = specialize_prim p e in
+  let rec make_params n =
+    if n <= 0 then [] else Ident.create "prim" :: make_params (n-1) in
+  let params = make_params p.prim_arity in
+  Lfunction(Curried, params, Lprim(prim, List.map (fun id -> Lvar id) params))
+
 (* To check the well-formedness of r.h.s. of "let rec" definitions *)
 
 let check_recursive_lambda idlist lam =
@@ -544,7 +569,7 @@
 	Lfunction(Curried, [obj; meth; cache; pos],
                   Lsend(Cached, Lvar meth, Lvar obj, [Lvar cache; Lvar pos]))
       else
-	transl_primitive p
+	transl_primitive_ty p e
   | Texp_ident(path, {val_kind = Val_anc _}) ->
       raise(Error(e.exp_loc, Free_super_var))
   | Texp_ident(path, {val_kind = Val_reg | Val_self _}) ->
diff -Naur ocaml/bytecomp/typeopt.ml ocaml_spec/bytecomp/typeopt.ml
--- ocaml/bytecomp/typeopt.ml	2004-04-16 02:50:23.000000000 +0200
+++ ocaml_spec/bytecomp/typeopt.ml	2006-08-04 21:34:53.000000000 +0200
@@ -22,6 +22,17 @@
 open Typedtree
 open Lambda
 
+let first_arg_has_base_type exp base_ty_path =
+  let exp_ty =
+    Ctype.expand_head exp.exp_env (Ctype.correct_levels exp.exp_type) in
+  match Ctype.repr exp_ty with
+    |  {desc = Tarrow(_, ty, _, _)} -> 
+	 begin match Ctype.repr (Ctype.expand_head exp.exp_env ty) with
+	   | {desc = Tconstr(p, _, _)} -> Path.same p base_ty_path
+	   | _ -> false
+	 end
+    | _ -> false
+
 let has_base_type exp base_ty_path =
   let exp_ty =
     Ctype.expand_head exp.exp_env (Ctype.correct_levels exp.exp_type) in
diff -Naur ocaml/bytecomp/typeopt.mli ocaml_spec/bytecomp/typeopt.mli
--- ocaml/bytecomp/typeopt.mli	2000-02-28 16:45:50.000000000 +0100
+++ ocaml_spec/bytecomp/typeopt.mli	2006-08-04 21:34:57.000000000 +0200
@@ -14,6 +14,7 @@
 
 (* Auxiliaries for type-based optimizations, e.g. array kinds *)
 
+val first_arg_has_base_type : Typedtree.expression -> Path.t -> bool
 val has_base_type : Typedtree.expression -> Path.t -> bool
 val maybe_pointer : Typedtree.expression -> bool
 val array_kind : Typedtree.expression -> Lambda.array_kind