Ajout des litteraux de type int32, nativeint, int64

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

28 files changed, 510 insertions, 191 deletions

diff --git a/Changes b/Changes
index 5ada8a79d7..5f2f41fd36 100644
--- a/Changes
+++ b/Changes
@@ -8,6 +8,8 @@ Language features:
   provided in the type definition module.
   That way, the construction functions can enforce any required invariant for
   the datatype.
+- Added integer literals of types int32, nativeint, int64
+  (written with an 'l', 'n' or 'L' suffix respectively).
 
 Type-checking:
 - Allow polymorphic generalization of covariant parts of expansive expressions
diff --git a/asmcomp/alpha/emit.mlp b/asmcomp/alpha/emit.mlp
index b52c17a6be..385200a5a6 100644
--- a/asmcomp/alpha/emit.mlp
+++ b/asmcomp/alpha/emit.mlp
@@ -379,7 +379,7 @@ let emit_instr fallthrough i =
               fatal_error "Emit_alpha: Imove"
         end
     | Lop(Iconst_int n) ->
-        if n = Nativeint.zero then
+        if n = 0n then
           `	clr	{emit_reg i.res.(0)}\n`
         else if digital_asm || 
                 (n >= Nativeint.of_int (-0x80000000) &&
diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp
index 13684b2944..e911b6b764 100644
--- a/asmcomp/arm/emit.mlp
+++ b/asmcomp/arm/emit.mlp
@@ -189,11 +189,11 @@ let decompose_intconst n fn =
   let i = ref n in
   let shift = ref 0 in
   let ninstr = ref 0 in
-  while !i <> Nativeint.zero do
+  while !i <> 0n do
     if Nativeint.to_int (Nativeint.shift_right !i !shift) land 3 = 0 then
       shift := !shift + 2
     else begin
-      let mask = Nativeint.shift_left (Nativeint.of_int 0xFF) !shift in
+      let mask = Nativeint.shift_left 0xFFn !shift in
       let bits = Nativeint.logand !i mask in
       fn bits;
       shift := !shift + 8;
diff --git a/asmcomp/closure.ml b/asmcomp/closure.ml
index 6ab5098cbc..d4ff4e2231 100644
--- a/asmcomp/closure.ml
+++ b/asmcomp/closure.ml
@@ -110,7 +110,8 @@ let lambda_smaller lam threshold =
     if !size > threshold then raise Exit;
     match lam with
       Uvar v -> ()
-    | Uconst(Const_base(Const_int _ | Const_char _ | Const_float _) |
+    | Uconst(Const_base(Const_int _ | Const_char _ | Const_float _ |
+                        Const_int32 _ | Const_int64 _ | Const_nativeint _) |
              Const_pointer _) -> incr size
     | Uconst _ ->
         raise Exit (* avoid duplication of structured constants *)
@@ -312,7 +313,9 @@ let rec substitute sb ulam =
 
 let is_simple_argument = function
     Uvar _ -> true
-  | Uconst(Const_base(Const_int _ | Const_char _ | Const_float _)) -> true
+  | Uconst(Const_base(Const_int _ | Const_char _ | Const_float _ |
+                      Const_int32 _ | Const_int64 _ | Const_nativeint _)) ->
+      true
   | Uconst(Const_pointer _) -> true
   | _ -> false
 
diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
index a9779bdbe2..d4ba9df7d9 100644
--- a/asmcomp/cmmgen.ml
+++ b/asmcomp/cmmgen.ml
@@ -69,9 +69,8 @@ let min_repr_int = min_int asr 1
 let int_const n =
   if n <= max_repr_int && n >= min_repr_int
   then Cconst_int((n lsl 1) + 1)
-  else Cconst_natint(Nativeint.add
-                       (Nativeint.shift_left (Nativeint.of_int n) 1)
-                       Nativeint.one)
+  else Cconst_natint
+          (Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n)
 
 let add_const c n =
   if n = 0 then c else Cop(Caddi, [c; Cconst_int n])
@@ -401,9 +400,8 @@ let transl_constant = function
   | Const_pointer n ->      
       if n <= max_repr_int && n >= min_repr_int
       then Cconst_pointer((n lsl 1) + 1)
-      else Cconst_natpointer(Nativeint.add
-                                (Nativeint.shift_left (Nativeint.of_int n) 1)
-                                Nativeint.one)
+      else Cconst_natpointer
+              (Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n)
   | cst ->
       let lbl = new_const_symbol() in
       structured_constants := (lbl, cst) :: !structured_constants;
@@ -416,60 +414,61 @@ let constant_closures =
 
 (* Boxed integers *)
 
-let operations_boxed_int bi =
-  match bi with Pnativeint -> "nativeint_ops"
-              | Pint32 -> "int32_ops"
-              | Pint64 -> "int64_ops"
-
-let constant_boxed_ints =
-  ref ([] : (string * boxed_integer * nativeint) list)
+let box_int_constant bi n =
+  match bi with
+    Pnativeint -> Const_base(Const_nativeint n)
+  | Pint32 -> Const_base(Const_int32 (Nativeint.to_int32 n))
+  | Pint64 -> Const_base(Const_int64 (Int64.of_nativeint n))
 
-let label_constant_boxed_int bi n =
-  let s = new_const_symbol() in
-  constant_boxed_ints := (s, bi, n) :: !constant_boxed_ints;
-  s
+let operations_boxed_int bi =
+  match bi with
+    Pnativeint -> "nativeint_ops"
+  | Pint32 -> "int32_ops"
+  | Pint64 -> "int64_ops"
 
 let box_int bi arg =
   match arg with
     Cconst_int n ->
-      Cconst_symbol(label_constant_boxed_int bi (Nativeint.of_int n))
+      transl_constant (box_int_constant bi (Nativeint.of_int n))
   | Cconst_natint n ->
-      Cconst_symbol(label_constant_boxed_int bi n)
+      transl_constant (box_int_constant bi n)
   | _ ->
-      if bi = Pint32 && size_int = 8 && big_endian then
-        let id = Ident.create "bint" in
-        Clet(id, Cop(Calloc, [alloc_boxedint_header;
-                              Cconst_symbol(operations_boxed_int bi);
-                              Cconst_int 0]),
-             Csequence(Cop(Cstore Thirtytwo_signed,
-                           [Cop(Cadda, [Cvar id; Cconst_int size_addr]);
-                                        arg]),
-                       Cvar id))
-      else
-        Cop(Calloc, [alloc_boxedint_header;
-                     Cconst_symbol(operations_boxed_int bi);
-                     arg])
+      let arg' =
+        if bi = Pint32 && size_int = 8 && big_endian
+        then Cop(Clsl, [arg; Cconst_int 32])
+        else arg in
+      Cop(Calloc, [alloc_boxedint_header;
+                   Cconst_symbol(operations_boxed_int bi);
+                   arg])
 
 let unbox_int bi arg =
   match arg with
-    Cop(Calloc, [hdr; ops; contents]) -> 
-      if bi = Pint32 && size_int = 8 then
-        (* Force sign-extension of low-order 32 bits *)
-        Cop(Casr, [Cop(Clsl, [contents; Cconst_int 32]); Cconst_int 32])
-      else
-        contents
+    Cop(Calloc, [hdr; ops; Cop(Clsl, [contents; Cconst_int 32])])
+    when bi = Pint32 && size_int = 8 && big_endian ->
+      (* Force sign-extension of low 32 bits *)
+      Cop(Casr, [Cop(Clsl, [contents; Cconst_int 32]); Cconst_int 32])
+  | Cop(Calloc, [hdr; ops; contents])
+    when bi = Pint32 && size_int = 8 && not big_endian ->
+      (* Force sign-extension of low 32 bits *)
+      Cop(Casr, [Cop(Clsl, [contents; Cconst_int 32]); Cconst_int 32])
+  | Cop(Calloc, [hdr; ops; contents]) -> 
+      contents
   | _ ->
       Cop(Cload(if bi = Pint32 then Thirtytwo_signed else Word),
           [Cop(Cadda, [arg; Cconst_int size_addr])])
 
 let unbox_unsigned_int bi arg =
   match arg with
-    Cop(Calloc, [hdr; ops; contents]) -> 
-      if bi = Pint32 && size_int = 8 then
-        (* Force zero-extension of low-order 32 bits *)
-        Cop(Clsr, [Cop(Clsl, [contents; Cconst_int 32]); Cconst_int 32])
-      else
-        contents
+    Cop(Calloc, [hdr; ops; Cop(Clsl, [contents; Cconst_int 32])])
+    when bi = Pint32 && size_int = 8 && big_endian ->
+      (* Force zero-extension of low 32 bits *)
+      Cop(Clsr, [Cop(Clsl, [contents; Cconst_int 32]); Cconst_int 32])
+  | Cop(Calloc, [hdr; ops; contents])
+    when bi = Pint32 && size_int = 8 && not big_endian ->
+      (* Force zero-extension of low 32 bits *)
+      Cop(Clsr, [Cop(Clsl, [contents; Cconst_int 32]); Cconst_int 32])
+  | Cop(Calloc, [hdr; ops; contents]) -> 
+      contents
   | _ ->
       Cop(Cload(if bi = Pint32 then Thirtytwo_unsigned else Word),
           [Cop(Cadda, [arg; Cconst_int size_addr])])
@@ -1317,7 +1316,13 @@ and transl_unbox_float = function
   | exp -> unbox_float(transl exp)
 
 and transl_unbox_int bi = function
-    Uprim(Pbintofint bi', [Uconst(Const_base(Const_int i))]) when bi = bi' ->
+    Uconst(Const_base(Const_int32 n)) ->
+      Cconst_natint (Nativeint.of_int32 n)
+  | Uconst(Const_base(Const_nativeint n)) ->
+      Cconst_natint n
+  | Uconst(Const_base(Const_int64 n)) ->
+      assert (size_int = 8); Cconst_natint (Int64.to_nativeint n)
+  | Uprim(Pbintofint bi', [Uconst(Const_base(Const_int i))]) when bi = bi' ->
       Cconst_int i
   | exp -> unbox_int bi (transl exp)
 
@@ -1500,6 +1505,15 @@ let rec emit_constant symb cst cont =
       Cint(string_header (String.length s)) ::
       Cdefine_symbol symb ::
       emit_string_constant s cont
+  | Const_base(Const_int32 n) ->
+      Cint(boxedint_header) :: Cdefine_symbol symb ::
+      emit_boxed_int32_constant n cont
+  | Const_base(Const_int64 n) ->
+      Cint(boxedint_header) :: Cdefine_symbol symb ::
+      emit_boxed_int64_constant n cont
+  | Const_base(Const_nativeint n) ->
+      Cint(boxedint_header) :: Cdefine_symbol symb ::
+      emit_boxed_nativeint_constant n cont
   | Const_block(tag, fields) ->
       let (emit_fields, cont1) = emit_constant_fields fields cont in
       Cint(block_header tag (List.length fields)) ::
@@ -1522,8 +1536,7 @@ and emit_constant_fields fields cont =
 and emit_constant_field field cont =
   match field with
     Const_base(Const_int n) ->
-      (Cint(Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 
-                          Nativeint.one),
+      (Cint(Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n),
        cont)
   | Const_base(Const_char c) ->
       (Cint(Nativeint.of_int(((Char.code c) lsl 1) + 1)), cont)
@@ -1536,9 +1549,23 @@ and emit_constant_field field cont =
       (Clabel_address lbl,
        Cint(string_header (String.length s)) :: Cdefine_label lbl :: 
        emit_string_constant s cont)
+  | Const_base(Const_int32 n) ->
+      let lbl = new_const_label() in
+      (Clabel_address lbl,
+       Cint(boxedint_header) :: Cdefine_label lbl ::
+       emit_boxed_int32_constant n cont)
+  | Const_base(Const_int64 n) ->
+      let lbl = new_const_label() in
+      (Clabel_address lbl,
+       Cint(boxedint_header) :: Cdefine_label lbl ::
+       emit_boxed_int64_constant n cont)
+  | Const_base(Const_nativeint n) ->
+      let lbl = new_const_label() in
+      (Clabel_address lbl,
+       Cint(boxedint_header) :: Cdefine_label lbl ::
+       emit_boxed_nativeint_constant n cont)
   | Const_pointer n ->
-      (Cint(Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 
-                          Nativeint.one),
+      (Cint(Nativeint.add (Nativeint.shift_left (Nativeint.of_int n) 1) 1n),
        cont)
   | Const_block(tag, fields) ->
       let lbl = new_const_label() in
@@ -1556,15 +1583,27 @@ and emit_string_constant s cont =
   let n = size_int - 1 - (String.length s) mod size_int in
   Cstring s :: Cskip n :: Cint8 n :: cont
 
-(* Emit boxed integer constants *)
+and emit_boxed_int32_constant n cont =
+  let n = Nativeint.of_int32 n in
+  if size_int = 8 then
+    Csymbol_address("int32_ops") :: Cint32 n :: Cint32 0n :: cont
+  else
+    Csymbol_address("int32_ops") :: Cint n :: cont
+
+and emit_boxed_nativeint_constant n cont =
+  Csymbol_address("nativeint_ops") :: Cint n :: cont
 
-let emit_boxedint_constant lbl bi n =
-  Cint boxedint_header ::
-  Cdefine_symbol lbl ::
-  Csymbol_address(operations_boxed_int bi) ::
-  (if bi = Pint32 && size_int = 8
-   then [Cint32 n; Cint32 Nativeint.zero]
-   else [Cint n])
+and emit_boxed_int64_constant n cont =
+  let lo = Int64.to_nativeint n in
+  if size_int = 8 then
+    Csymbol_address("int64_ops") :: Cint lo :: cont
+  else begin
+    let hi = Int64.to_nativeint (Int64.shift_right n 32) in
+    if big_endian then
+      Csymbol_address("int64_ops") :: Cint hi :: Cint lo :: cont
+    else
+      Csymbol_address("int64_ops") :: Cint lo :: Cint hi :: cont
+  end
 
 (* Emit constant closures *)
 
@@ -1578,7 +1617,7 @@ let emit_constant_closure symb fundecls cont =
           if arity = 1 then
             Cint(infix_header pos) ::
             Csymbol_address label ::
-            Cint(Nativeint.of_int 3) ::
+            Cint 3n ::
             emit_others (pos + 3) rem
           else
             Cint(infix_header pos) ::
@@ -1590,7 +1629,7 @@ let emit_constant_closure symb fundecls cont =
       Cdefine_symbol symb ::
       if arity = 1 then
         Csymbol_address label ::
-        Cint(Nativeint.of_int 3) ::
+        Cint 3n ::
         emit_others 3 remainder
       else
         Csymbol_address(curry_function arity) ::
@@ -1607,11 +1646,6 @@ let emit_all_constants cont =
     !structured_constants;
   structured_constants := [];
   List.iter
-    (fun (symb, bi, n) ->
-        c := Cdata(emit_boxedint_constant symb bi n) :: !c)
-    !constant_boxed_ints;
-  constant_boxed_ints := [];
-  List.iter
     (fun (symb, fundecls) ->
         c := Cdata(emit_constant_closure symb fundecls []) :: !c)
     !constant_closures;
@@ -1770,7 +1804,7 @@ let entry_point namelist =
 
 (* Generate the table of globals *)
 
-let cint_zero = Cint(Nativeint.zero)
+let cint_zero = Cint 0n
 
 let global_table namelist =
   Cdata(Cglobal_symbol "caml_globals" ::
diff --git a/asmcomp/i386/emit.mlp b/asmcomp/i386/emit.mlp
index 91e360744e..f718072bf2 100644
--- a/asmcomp/i386/emit.mlp
+++ b/asmcomp/i386/emit.mlp
@@ -395,7 +395,7 @@ let emit_instr fallthrough i =
               `	movl	{emit_reg src}, {emit_reg dst}\n`
         end
     | Lop(Iconst_int n) ->
-        if n = Nativeint.zero then begin
+        if n = 0n then begin
           match i.res.(0).loc with
             Reg n -> `	xorl	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
           | _     -> `	movl	$0, {emit_reg i.res.(0)}\n`
@@ -597,10 +597,10 @@ let emit_instr fallthrough i =
         stack_offset := !stack_offset - 8;
         `	subl	$8, %esp\n`;
         `	fnstcw	4(%esp)\n`;
-        `	movl	4(%esp), %eax\n`;
+        `	movw	4(%esp), %ax\n`;
         `	movb    $12, %ah\n`;
-        `	movl	%eax, (%esp)\n`;
-        `	fldcw	(%esp)\n`;
+        `	movw	%ax, 0(%esp)\n`;
+        `	fldcw	0(%esp)\n`;
         begin match i.res.(0).loc with
           Stack s ->
             `	fist{pop_suffix i}l	{emit_reg i.res.(0)}\n`
diff --git a/asmcomp/i386/emit_nt.mlp b/asmcomp/i386/emit_nt.mlp
index 367847e7c8..21c9246e19 100644
--- a/asmcomp/i386/emit_nt.mlp
+++ b/asmcomp/i386/emit_nt.mlp
@@ -369,7 +369,7 @@ let emit_instr i =
             `	mov	{emit_reg dst}, {emit_reg src}\n`
         end
     | Lop(Iconst_int n) ->
-        if n = Nativeint.zero then begin
+        if n = 0n then begin
           match i.res.(0).loc with
             Reg n -> `	xor	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
           | _     -> `	mov	{emit_reg i.res.(0)}, 0\n`
@@ -575,9 +575,9 @@ let emit_instr i =
         stack_offset := !stack_offset - 8;
         `	sub	esp, 8\n`;
         `	fnstcw	[esp+4]\n`;
-        `	mov	eax, [esp+4]\n`;
+        `	mov	ax, [esp+4]\n`;
         `	mov	ah, 12\n`;
-        `	mov	[esp], eax\n`;
+        `	mov	[esp], ax\n`;
         `	fldcw	[esp]\n`;
         begin match i.res.(0).loc with
           Stack s ->
diff --git a/asmcomp/mips/emit.mlp b/asmcomp/mips/emit.mlp
index 030ee4f679..6191096b45 100644
--- a/asmcomp/mips/emit.mlp
+++ b/asmcomp/mips/emit.mlp
@@ -241,7 +241,7 @@ let emit_instr i =
               fatal_error "Emit_mips: Imove"
         end
     | Lop(Iconst_int n) ->
-        if n = Nativeint.zero then
+        if n = 0n then
           `	move	{emit_reg i.res.(0)}, $0\n`
         else
           `	li	{emit_reg i.res.(0)}, {emit_nativeint n}\n`
diff --git a/boot/ocamlc b/boot/ocamlc
index 61df2d6696..ffc14dfc46 100755
--- a/boot/ocamlc
+++ b/boot/ocamlc
diff --git a/boot/ocamllex b/boot/ocamllex
index 5d30fceb30..1852faf5e3 100755
--- a/boot/ocamllex
+++ b/boot/ocamllex
diff --git a/bytecomp/matching.ml b/bytecomp/matching.ml
index 4d1c1d0847..bd155d4a7f 100644
--- a/bytecomp/matching.ml
+++ b/bytecomp/matching.ml
@@ -1291,13 +1291,9 @@ let sort_lambda_list l =
   List.sort
     (fun (x,_) (y,_) -> match x,y with
     | Const_float f1, Const_float f2 -> float_compare f1 f2
-    | Const_int i1, Const_int i2 -> Pervasives.compare i1 i2
-    | Const_char c1, Const_char c2 ->  Pervasives.compare c1 c2
-    | Const_string s1, Const_string s2 -> Pervasives.compare s1 s2
-    | _ -> assert false)
+    | _, _ -> Pervasives.compare x y)
     l
 
-
 let rec cut n l =
   if n = 0 then [],l
   else match l with
@@ -1733,8 +1729,23 @@ let combine_constant arg cst partial ctx def
         make_test_sequence
           fail
           (Pfloatcomp Cneq) (Pfloatcomp Clt)
-          arg const_lambda_list in
-  lambda1,jumps_union local_jumps total
+          arg const_lambda_list
+    | Const_int32 _ ->
+        make_test_sequence
+          fail
+          (Pbintcomp(Pint32, Cneq)) (Pbintcomp(Pint32, Clt))
+          arg const_lambda_list
+    | Const_int64 _ ->
+        make_test_sequence
+          fail
+          (Pbintcomp(Pint64, Cneq)) (Pbintcomp(Pint64, Clt))
+          arg const_lambda_list
+    | Const_nativeint _ ->
+        make_test_sequence
+          fail
+          (Pbintcomp(Pnativeint, Cneq)) (Pbintcomp(Pnativeint, Clt))
+          arg const_lambda_list
+  in lambda1,jumps_union local_jumps total
 
 
 
diff --git a/bytecomp/printlambda.ml b/bytecomp/printlambda.ml
index 909ee46391..b8af27831c 100644
--- a/bytecomp/printlambda.ml
+++ b/bytecomp/printlambda.ml
@@ -21,12 +21,12 @@ open Lambda
 
 let rec struct_const ppf = function
   | Const_base(Const_int n) -> fprintf ppf "%i" n
-  | Const_base(Const_char c) ->
-      fprintf ppf "%C" c
-  | Const_base(Const_string s) ->
-      fprintf ppf "%S" s
-  | Const_base(Const_float s) ->
-      fprintf ppf "%s" s
+  | Const_base(Const_char c) -> fprintf ppf "%C" c
+  | Const_base(Const_string s) -> fprintf ppf "%S" s
+  | Const_base(Const_float f) -> fprintf ppf "%s" f
+  | Const_base(Const_int32 n) -> fprintf ppf "%lil" n
+  | Const_base(Const_int64 n) -> fprintf ppf "%LiL" n
+  | Const_base(Const_nativeint n) -> fprintf ppf "%nin" n
   | Const_pointer n -> fprintf ppf "%ia" n
   | Const_block(tag, []) ->
       fprintf ppf "[%i]" tag
diff --git a/bytecomp/symtable.ml b/bytecomp/symtable.ml
index 74ec833b02..9ea585954d 100644
--- a/bytecomp/symtable.ml
+++ b/bytecomp/symtable.ml
@@ -201,7 +201,10 @@ let rec transl_const = function
     Const_base(Const_int i) -> Obj.repr i
   | Const_base(Const_char c) -> Obj.repr c
   | Const_base(Const_string s) -> Obj.repr s
-  | Const_base(Const_float f) -> Obj.repr(float_of_string f)
+  | Const_base(Const_float f) -> Obj.repr (float_of_string f)
+  | Const_base(Const_int32 i) -> Obj.repr i
+  | Const_base(Const_int64 i) -> Obj.repr i
+  | Const_base(Const_nativeint i) -> Obj.repr i
   | Const_pointer i -> Obj.repr i
   | Const_block(tag, fields) ->
       let block = Obj.new_block tag (List.length fields) in
diff --git a/parsing/asttypes.mli b/parsing/asttypes.mli
index 5aa9603a2f..f9824d0590 100644
--- a/parsing/asttypes.mli
+++ b/parsing/asttypes.mli
@@ -19,6 +19,9 @@ type constant =
   | Const_char of char
   | Const_string of string
   | Const_float of string
+  | Const_int32 of int32
+  | Const_int64 of int64
+  | Const_nativeint of nativeint
 
 type rec_flag = Nonrecursive | Recursive | Default
 
diff --git a/parsing/lexer.mll b/parsing/lexer.mll
index 6eb9a209cd..1ac5a5f1d2 100644
--- a/parsing/lexer.mll
+++ b/parsing/lexer.mll
@@ -231,6 +231,8 @@ let oct_literal =
   '0' ['o' 'O'] ['0'-'7'] ['0'-'7' '_']*
 let bin_literal =
   '0' ['b' 'B'] ['0'-'1'] ['0'-'1' '_']*
+let int_literal =
+  decimal_literal | hex_literal | oct_literal | bin_literal
 let float_literal =
   ['0'-'9'] ['0'-'9' '_']* 
   ('.' ['0'-'9' '_']* )?
@@ -268,10 +270,20 @@ rule token = parse
             LIDENT s }
   | uppercase identchar *
       { UIDENT(Lexing.lexeme lexbuf) }       (* No capitalized keywords *)
-  | decimal_literal | hex_literal | oct_literal | bin_literal
+  | int_literal
       { INT (int_of_string(Lexing.lexeme lexbuf)) }
   | float_literal
-      { FLOAT (remove_underscores (Lexing.lexeme lexbuf)) }
+      { FLOAT (remove_underscores(Lexing.lexeme lexbuf)) }
+  | int_literal "l"
+      { let s = Lexing.lexeme lexbuf in
+        INT32 (Int32.of_string(String.sub s 0 (String.length s - 1))) }
+  | int_literal "L"
+      { let s = Lexing.lexeme lexbuf in
+        INT64 (Int64.of_string(String.sub s 0 (String.length s - 1))) }
+  | int_literal "n"
+      { let s = Lexing.lexeme lexbuf in
+        NATIVEINT 
+          (Nativeint.of_string(String.sub s 0 (String.length s - 1))) }
   | "\""
       { reset_string_buffer();
         let string_start = lexbuf.lex_start_p in
diff --git a/parsing/parser.mly b/parsing/parser.mly
index eaac02c0b3..5f809a6a8d 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -87,6 +87,12 @@ let mkuminus name arg =
   match name, arg.pexp_desc with
   | "-", Pexp_constant(Const_int n) ->
       mkexp(Pexp_constant(Const_int(-n)))
+  | "-", Pexp_constant(Const_int32 n) ->
+      mkexp(Pexp_constant(Const_int32(Int32.neg n)))
+  | "-", Pexp_constant(Const_int64 n) ->
+      mkexp(Pexp_constant(Const_int64(Int64.neg n)))
+  | "-", Pexp_constant(Const_nativeint n) ->
+      mkexp(Pexp_constant(Const_nativeint(Nativeint.neg n)))
   | _, Pexp_constant(Const_float f) ->
       mkexp(Pexp_constant(Const_float(neg_float_string f)))
   | _ ->
@@ -234,6 +240,8 @@ let mktype_kind vflag kind =
 %token INHERIT
 %token INITIALIZER
 %token <int> INT
+%token <int32> INT32
+%token <int64> INT64
 %token <string> LABEL
 %token LAZY
 %token LBRACE
@@ -253,6 +261,7 @@ let mktype_kind vflag kind =
 %token MINUSGREATER
 %token MODULE
 %token MUTABLE
+%token <nativeint> NATIVEINT
 %token NEW
 %token OBJECT
 %token OF
@@ -1365,11 +1374,17 @@ constant:
   | CHAR                                        { Const_char $1 }
   | STRING                                      { Const_string $1 }
   | FLOAT                                       { Const_float $1 }
+  | INT32                                       { Const_int32 $1 }
+  | INT64                                       { Const_int64 $1 }
+  | NATIVEINT                                   { Const_nativeint $1 }
 ;
 signed_constant:
     constant                                    { $1 }
   | MINUS INT                                   { Const_int(- $2) }
-  | subtractive FLOAT                           { Const_float("-" ^ $2) }
+  | MINUS FLOAT                                 { Const_float("-" ^ $2) }
+  | MINUS INT32                                 { Const_int32(Int32.neg $2) }
+  | MINUS INT64                                 { Const_int64(Int64.neg $2) }
+  | MINUS NATIVEINT                             { Const_nativeint(Nativeint.neg $2) }
 ;
 /* Identifiers and long identifiers */
 
diff --git a/parsing/printast.ml b/parsing/printast.ml
index f411935868..a44c61efe5 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -46,9 +46,11 @@ let fmt_constant f x =
   match x with
   | Const_int (i) -> fprintf f "Const_int %d" i;
   | Const_char (c) -> fprintf f "Const_char %02x" (Char.code c);
-  | Const_string (s) ->
-      fprintf f "Const_string %S" s;
+  | Const_string (s) -> fprintf f "Const_string %S" s;
   | Const_float (s) -> fprintf f "Const_float %s" s;
+  | Const_int32 (i) -> fprintf f "Const_int32 %ld" i;
+  | Const_int64 (i) -> fprintf f "Const_int64 %Ld" i;
+  | Const_nativeint (i) -> fprintf f "Const_nativeint %nd" i;
 ;;
 
 let fmt_mutable_flag f x =
diff --git a/stdlib/int32.ml b/stdlib/int32.ml
index e21c22c56a..c8a98b0642 100644
--- a/stdlib/int32.ml
+++ b/stdlib/int32.ml
@@ -32,15 +32,15 @@ external to_int : int32 -> int = "%int32_to_int"
 external of_float : float -> int32 = "int32_of_float"
 external to_float : int32 -> float = "int32_to_float"
 
-let zero = of_int 0
-let one = of_int 1
-let minus_one = of_int (-1)
-let succ n = add n one
-let pred n = sub n one
-let abs n = if n >= zero then n else neg n
-let min_int = shift_left one 31
-let max_int = sub min_int one
-let lognot n = logxor n minus_one
+let zero = 0l
+let one = 1l
+let minus_one = -1l
+let succ n = add n 1l
+let pred n = sub n 1l
+let abs n = if n >= 0l then n else neg n
+let min_int = 0x80000000l
+let max_int = 0x7FFFFFFFl
+let lognot n = logxor n (-1l)
 
 external format : string -> int32 -> string = "int32_format"
 let to_string n = format "%d" n
diff --git a/stdlib/int64.ml b/stdlib/int64.ml
index 6889e34781..8b634a5f2e 100644
--- a/stdlib/int64.ml
+++ b/stdlib/int64.ml
@@ -36,17 +36,15 @@ external to_int32 : int64 -> int32 = "%int64_to_int32"
 external of_nativeint : nativeint -> int64 = "%int64_of_nativeint"
 external to_nativeint : int64 -> nativeint = "%int64_to_nativeint"
 
-let zero = try of_int 0 with Invalid_argument _ -> Obj.magic Int32.zero
-let one = try of_int 1 with Invalid_argument _ -> Obj.magic Int32.one
-let minus_one = try of_int (-1) with Invalid_argument _ -> Obj.magic Int32.minus_one
-let succ n = add n one
-let pred n = sub n one
-let abs n = if n >= zero then n else neg n
-let min_int =
-  try shift_left one 63 with Invalid_argument _ -> Obj.magic Int32.min_int
-let max_int =
-  try sub min_int one with Invalid_argument _ -> Obj.magic Int32.max_int
-let lognot n = logxor n minus_one
+let zero = 0L
+let one = 1L
+let minus_one = -1L
+let succ n = add n 1L
+let pred n = sub n 1L
+let abs n = if n >= 0L then n else neg n
+let min_int = 0x8000000000000000L
+let max_int = 0x7FFFFFFFFFFFFFFFL
+let lognot n = logxor n (-1L)
 
 external format : string -> int64 -> string = "int64_format"
 let to_string n = format "%d" n
diff --git a/stdlib/nativeint.ml b/stdlib/nativeint.ml
index 36c55ae66b..216f2b30bc 100644
--- a/stdlib/nativeint.ml
+++ b/stdlib/nativeint.ml
@@ -34,16 +34,16 @@ external to_float : nativeint -> float = "nativeint_to_float"
 external of_int32: int32 -> nativeint = "%nativeint_of_int32"
 external to_int32: nativeint -> int32 = "%nativeint_to_int32"
 
-let zero = of_int 0
-let one = of_int 1
-let minus_one = of_int (-1)
-let succ n = add n one
-let pred n = sub n one
-let abs n = if n >= zero then n else neg n
+let zero = 0n
+let one = 1n
+let minus_one = -1n
+let succ n = add n 1n
+let pred n = sub n 1n
+let abs n = if n >= 0n then n else neg n
 let size = Sys.word_size
-let min_int = shift_left one (size - 1)
-let max_int = sub min_int one
-let lognot n = logxor n minus_one
+let min_int = shift_left 1n (size - 1)
+let max_int = sub min_int 1n
+let lognot n = logxor n (-1n)
 
 external format : string -> nativeint -> string = "nativeint_format"
 let to_string n = format "%d" n
diff --git a/test/Moretest/Makefile b/test/Moretest/Makefile
index 215ed6a3ea..e2b69441b0 100644
--- a/test/Moretest/Makefile
+++ b/test/Moretest/Makefile
@@ -126,6 +126,9 @@ regexp.byt: ../../otherlibs/str/str.cma regexp.ml
 regexp.opt: ../../otherlibs/str/str.cmxa regexp.ml
 	$(CAMLOPT) -I ../../otherlibs/str -o regexp.opt str.cmxa regexp.ml
 
+md5.out: md5.ml
+	$(CAMLOPT) -unsafe -inline 100 -o md5.out md5.ml
+
 # Common rules
 
 .SUFFIXES:
diff --git a/test/Moretest/md5.ml b/test/Moretest/md5.ml
new file mode 100644
index 0000000000..46d8a10a42
--- /dev/null
+++ b/test/Moretest/md5.ml
@@ -0,0 +1,219 @@
+(* Test int32 arithmetic and optimizations using the MD5 algorithm *)
+
+open Printf
+
+type context =
+  { buf: string;
+    mutable pos: int;
+    mutable a: int32;
+    mutable b: int32;
+    mutable c: int32;
+    mutable d: int32;
+    mutable bits: int64 }
+
+let step1 w x y z data s =
+  let w =
+    Int32.add (Int32.add w data)
+              (Int32.logxor z (Int32.logand x (Int32.logxor y z))) in
+  Int32.add x
+    (Int32.logor (Int32.shift_left w s) (Int32.shift_right_logical w (32-s)))
+
+let step2 w x y z data s =
+  let w =
+    Int32.add (Int32.add w data)
+              (Int32.logxor y (Int32.logand z (Int32.logxor x y))) in
+  Int32.add x
+    (Int32.logor (Int32.shift_left w s) (Int32.shift_right_logical w (32-s)))
+
+let step3 w x y z data s =
+  let w =
+    Int32.add (Int32.add w data)
+              (Int32.logxor x (Int32.logxor y z)) in
+  Int32.add x
+    (Int32.logor (Int32.shift_left w s) (Int32.shift_right_logical w (32-s)))
+
+let step4 w x y z data s =
+  let w =
+    Int32.add (Int32.add w data)
+              (Int32.logxor y (Int32.logor x (Int32.logxor z (-1l)))) in
+  Int32.add x
+    (Int32.logor (Int32.shift_left w s) (Int32.shift_right_logical w (32-s)))
+
+let transform ctx data =
+    let a = ctx.a and b = ctx.b and c = ctx.c and d = ctx.d in
+
+    let a = step1 a b c d (Int32.add data.(0) 0xd76aa478l) 7 in
+    let d = step1 d a b c (Int32.add data.(1) 0xe8c7b756l) 12 in
+    let c = step1 c d a b (Int32.add data.(2) 0x242070dbl) 17 in
+    let b = step1 b c d a (Int32.add data.(3) 0xc1bdceeel) 22 in
+    let a = step1 a b c d (Int32.add data.(4) 0xf57c0fafl) 7 in
+    let d = step1 d a b c (Int32.add data.(5) 0x4787c62al) 12 in
+    let c = step1 c d a b (Int32.add data.(6) 0xa8304613l) 17 in
+    let b = step1 b c d a (Int32.add data.(7) 0xfd469501l) 22 in
+    let a = step1 a b c d (Int32.add data.(8) 0x698098d8l) 7 in
+    let d = step1 d a b c (Int32.add data.(9) 0x8b44f7afl) 12 in
+    let c = step1 c d a b (Int32.add data.(10) 0xffff5bb1l) 17 in
+    let b = step1 b c d a (Int32.add data.(11) 0x895cd7bel) 22 in
+    let a = step1 a b c d (Int32.add data.(12) 0x6b901122l) 7 in
+    let d = step1 d a b c (Int32.add data.(13) 0xfd987193l) 12 in
+    let c = step1 c d a b (Int32.add data.(14) 0xa679438el) 17 in
+    let b = step1 b c d a (Int32.add data.(15) 0x49b40821l) 22 in
+
+    let a = step2 a b c d (Int32.add data.(1) 0xf61e2562l) 5 in
+    let d = step2 d a b c (Int32.add data.(6) 0xc040b340l) 9 in
+    let c = step2 c d a b (Int32.add data.(11) 0x265e5a51l) 14 in
+    let b = step2 b c d a (Int32.add data.(0) 0xe9b6c7aal) 20 in
+    let a = step2 a b c d (Int32.add data.(5) 0xd62f105dl) 5 in
+    let d = step2 d a b c (Int32.add data.(10) 0x02441453l) 9 in
+    let c = step2 c d a b (Int32.add data.(15) 0xd8a1e681l) 14 in
+    let b = step2 b c d a (Int32.add data.(4) 0xe7d3fbc8l) 20 in
+    let a = step2 a b c d (Int32.add data.(9) 0x21e1cde6l) 5 in
+    let d = step2 d a b c (Int32.add data.(14) 0xc33707d6l) 9 in
+    let c = step2 c d a b (Int32.add data.(3) 0xf4d50d87l) 14 in
+    let b = step2 b c d a (Int32.add data.(8) 0x455a14edl) 20 in
+    let a = step2 a b c d (Int32.add data.(13) 0xa9e3e905l) 5 in
+    let d = step2 d a b c (Int32.add data.(2) 0xfcefa3f8l) 9 in
+    let c = step2 c d a b (Int32.add data.(7) 0x676f02d9l) 14 in
+    let b = step2 b c d a (Int32.add data.(12) 0x8d2a4c8al) 20 in
+
+    let a = step3 a b c d (Int32.add data.(5) 0xfffa3942l) 4 in
+    let d = step3 d a b c (Int32.add data.(8) 0x8771f681l) 11 in
+    let c = step3 c d a b (Int32.add data.(11) 0x6d9d6122l) 16 in
+    let b = step3 b c d a (Int32.add data.(14) 0xfde5380cl) 23 in
+    let a = step3 a b c d (Int32.add data.(1) 0xa4beea44l) 4 in
+    let d = step3 d a b c (Int32.add data.(4) 0x4bdecfa9l) 11 in
+    let c = step3 c d a b (Int32.add data.(7) 0xf6bb4b60l) 16 in
+    let b = step3 b c d a (Int32.add data.(10) 0xbebfbc70l) 23 in
+    let a = step3 a b c d (Int32.add data.(13) 0x289b7ec6l) 4 in
+    let d = step3 d a b c (Int32.add data.(0) 0xeaa127fal) 11 in
+    let c = step3 c d a b (Int32.add data.(3) 0xd4ef3085l) 16 in
+    let b = step3 b c d a (Int32.add data.(6) 0x04881d05l) 23 in
+    let a = step3 a b c d (Int32.add data.(9) 0xd9d4d039l) 4 in
+    let d = step3 d a b c (Int32.add data.(12) 0xe6db99e5l) 11 in
+    let c = step3 c d a b (Int32.add data.(15) 0x1fa27cf8l) 16 in
+    let b = step3 b c d a (Int32.add data.(2) 0xc4ac5665l) 23 in
+
+    let a = step4 a b c d (Int32.add data.(0) 0xf4292244l) 6 in
+    let d = step4 d a b c (Int32.add data.(7) 0x432aff97l) 10 in
+    let c = step4 c d a b (Int32.add data.(14) 0xab9423a7l) 15 in
+    let b = step4 b c d a (Int32.add data.(5) 0xfc93a039l) 21 in
+    let a = step4 a b c d (Int32.add data.(12) 0x655b59c3l) 6 in
+    let d = step4 d a b c (Int32.add data.(3) 0x8f0ccc92l) 10 in
+    let c = step4 c d a b (Int32.add data.(10) 0xffeff47dl) 15 in
+    let b = step4 b c d a (Int32.add data.(1) 0x85845dd1l) 21 in
+    let a = step4 a b c d (Int32.add data.(8) 0x6fa87e4fl) 6 in
+    let d = step4 d a b c (Int32.add data.(15) 0xfe2ce6e0l) 10 in
+    let c = step4 c d a b (Int32.add data.(6) 0xa3014314l) 15 in
+    let b = step4 b c d a (Int32.add data.(13) 0x4e0811a1l) 21 in
+    let a = step4 a b c d (Int32.add data.(4) 0xf7537e82l) 6 in
+    let d = step4 d a b c (Int32.add data.(11) 0xbd3af235l) 10 in
+    let c = step4 c d a b (Int32.add data.(2) 0x2ad7d2bbl) 15 in
+    let b = step4 b c d a (Int32.add data.(9) 0xeb86d391l) 21 in
+
+    ctx.a <- Int32.add ctx.a a;
+    ctx.b <- Int32.add ctx.b b;
+    ctx.c <- Int32.add ctx.c c;
+    ctx.d <- Int32.add ctx.d d
+
+let string_to_data s =
+  let data = Array.make 16 0l in
+  for i = 0 to 15 do
+    let j = i lsl 2 in
+    data.(i) <-
+      Int32.logor (Int32.shift_left (Int32.of_int (Char.code s.[j+3])) 24)
+        (Int32.logor (Int32.shift_left (Int32.of_int (Char.code s.[j+2])) 16)
+          (Int32.logor (Int32.shift_left (Int32.of_int (Char.code s.[j+1])) 8)
+                       (Int32.of_int (Char.code s.[j]))))
+  done;
+  data
+
+let int32_to_string n s i =
+  s.[i+3] <- Char.chr (Int32.to_int (Int32.shift_right n 24) land 0xFF);
+  s.[i+2] <- Char.chr (Int32.to_int (Int32.shift_right n 16) land 0xFF);
+  s.[i+1] <- Char.chr (Int32.to_int (Int32.shift_right n 8) land 0xFF);
+  s.[i] <- Char.chr (Int32.to_int n land 0xFF)
+
+let init () =
+  { buf = String.create 64;
+    pos = 0;
+    a = 0x67452301l;
+    b = 0xefcdab89l;
+    c = 0x98badcfel;
+    d = 0x10325476l;
+    bits = 0L }
+
+let update ctx input ofs len =
+  let rec upd ofs len =
+    if len <= 0 then () else
+    if ctx.pos + len < 64 then begin
+      (* Just buffer the data *)
+      String.blit input ofs ctx.buf ctx.pos len;
+      ctx.pos <- ctx.pos + len
+    end else begin
+      (* Fill the buffer *)
+      let len' = 64 - ctx.pos in
+      if len' > 0 then String.blit input ofs ctx.buf ctx.pos len';
+      (* Transform 64 bytes *)
+      transform ctx (string_to_data ctx.buf);
+      ctx.pos <- 0;
+      upd (ofs + len') (len - len')
+    end in
+  upd ofs len;
+  ctx.bits <- Int64.add ctx.bits (Int64.of_int (len lsl 3))
+
+
+let finish ctx =
+  let padding = String.make 64 '\000' in
+  padding.[0] <- '\x80';
+  let numbits = ctx.bits in
+  if ctx.pos < 56 then begin
+    update ctx padding 0 (56 - ctx.pos)
+  end else begin
+    update ctx padding 0 (64 + 56 - ctx.pos)
+  end;
+  assert (ctx.pos = 56);
+  let data = string_to_data ctx.buf in
+  data.(14) <- (Int64.to_int32 numbits);
+  data.(15) <- (Int64.to_int32 (Int64.shift_right_logical numbits 32));
+  transform ctx data;
+  let res = String.create 16 in
+  int32_to_string ctx.a res 0;
+  int32_to_string ctx.b res 4;
+  int32_to_string ctx.c res 8;
+  int32_to_string ctx.d res 12;
+  res
+
+let test s =
+  let ctx = init() in
+  update ctx s 0 (String.length s);
+  let res = finish ctx in
+  let exp = Digest.string s in
+  let ok = (res = exp) in
+  if not ok then Printf.printf "Failure for '%s'\n" s;
+  ok
+
+let time msg iter fn =
+  let start = Sys.time() in
+  for i = 1 to iter do fn () done;
+  let stop = Sys.time() in
+  printf "%s: %.2f s\n" msg (stop -. start)
+
+let _ =
+  (* Test *)
+  if test ""
+  && test "a"
+  && test "abc"
+  && test "message digest"
+  && test "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
+  then printf "Test vectors passed.\n";
+  flush stdout;
+  (* Benchmark *)
+  let s = String.make 50000 'a' in
+  let num_iter = 1000 in
+  time "Caml implementation" num_iter
+    (fun () ->
+      let ctx = init() in
+      update ctx s 0 (String.length s);
+      ignore (finish ctx));
+  time "C implementation" num_iter
+    (fun () -> ignore (Digest.string s))
diff --git a/tools/dumpobj.ml b/tools/dumpobj.ml
index 7414bdeb71..5a6fa6d4ea 100644
--- a/tools/dumpobj.ml
+++ b/tools/dumpobj.ml
@@ -80,16 +80,14 @@ let print_float f =
 ;;
 
 let rec print_struct_const = function
-    Const_base(Const_int i) ->
-      printf "%d" i
-  | Const_base(Const_float f) ->
-      print_float f
-  | Const_base(Const_string s) ->
-      printf "%S" s
-  | Const_base(Const_char c) ->
-      printf "%C" c
-  | Const_pointer n ->
-      printf "%da" n
+    Const_base(Const_int i) -> printf "%d" i
+  | Const_base(Const_float f) -> print_float f
+  | Const_base(Const_string s) -> printf "%S" s
+  | Const_base(Const_char c) -> printf "%C" c
+  | Const_base(Const_int32 i) -> printf "%ldl" i
+  | Const_base(Const_nativeint i) -> printf "%ndn" i
+  | Const_base(Const_int64 i) -> printf "%LdL" i
+  | Const_pointer n -> printf "%da" n
   | Const_block(tag, args) ->
       printf "<%d>" tag;
       begin match args with
diff --git a/toplevel/genprintval.ml b/toplevel/genprintval.ml
index c5c0d9e885..4828019f7d 100644
--- a/toplevel/genprintval.ml
+++ b/toplevel/genprintval.ml
@@ -102,14 +102,11 @@ module Make(O : OBJ)(EVP : EVALPATH with type value = O.t) = struct
       Pident(Ident.create "print_string"), Predef.type_string,
         (fun x -> Oval_string (O.obj x : string));
       Pident(Ident.create "print_int32"), Predef.type_int32,
-        (fun x -> Oval_stuff ("<int32 " ^
-                              Int32.to_string (O.obj x : int32) ^ ">"));
+        (fun x -> Oval_int32 (O.obj x : int32));
       Pident(Ident.create "print_nativeint"), Predef.type_nativeint,
-        (fun x -> Oval_stuff ("<nativeint " ^
-                             Nativeint.to_string (O.obj x : nativeint) ^ ">"));
+        (fun x -> Oval_nativeint (O.obj x : nativeint));
       Pident(Ident.create "print_int64"), Predef.type_int64,
-        (fun x -> Oval_stuff ("<int64 " ^
-                              Int64.to_string (O.obj x : int64) ^ ">"))
+        (fun x -> Oval_int64 (O.obj x : int64))
     ] : (Path.t * type_expr * (O.t -> Outcometree.out_value)) list)
 
     let install_printer path ty fn =
diff --git a/typing/oprint.ml b/typing/oprint.ml
index 40490a2da6..879447a76d 100644
--- a/typing/oprint.ml
+++ b/typing/oprint.ml
@@ -40,6 +40,12 @@ let value_ident ppf name =
 
 (* Values *)
 
+let parenthesize_if_neg ppf fmt v zero =
+  let neg = (v < zero) in
+  if neg then pp_print_char ppf '(';
+  fprintf ppf fmt v;
+  if neg then pp_print_char ppf ')'
+
 let print_out_value ppf tree =
   let rec print_tree_1 ppf =
     function
@@ -52,14 +58,18 @@ let print_out_value ppf tree =
         fprintf ppf "@[<2>`%s@ %a@]" name print_simple_tree param
     | tree -> print_simple_tree ppf tree
   and print_constr_param ppf = function
-    | Oval_int i ->
-       if i < 0 then fprintf ppf "(%i)" i else fprintf ppf "%i" i
-    | Oval_float f ->
-       if f < 0.0 then fprintf ppf "(%F)" f else fprintf ppf "%F" f
+    | Oval_int i -> parenthesize_if_neg ppf "%i" i 0
+    | Oval_int32 i -> parenthesize_if_neg ppf "%lil" i 0l
+    | Oval_int64 i -> parenthesize_if_neg ppf "%LiL" i 0L
+    | Oval_nativeint i -> parenthesize_if_neg ppf "%nin" i 0n
+    | Oval_float f -> parenthesize_if_neg ppf "%F" f 0.0
     | tree -> print_simple_tree ppf tree
   and print_simple_tree ppf =
     function
       Oval_int i -> fprintf ppf "%i" i
+    | Oval_int32 i -> fprintf ppf "%lil" i
+    | Oval_int64 i -> fprintf ppf "%LiL" i
+    | Oval_nativeint i -> fprintf ppf "%nin" i
     | Oval_float f -> fprintf ppf "%F" f
     | Oval_char c -> fprintf ppf "%C" c
     | Oval_string s ->
diff --git a/typing/outcometree.mli b/typing/outcometree.mli
index 2a93cd7756..a6e7320270 100644
--- a/typing/outcometree.mli
+++ b/typing/outcometree.mli
@@ -33,6 +33,9 @@ type out_value =
   | Oval_ellipsis
   | Oval_float of float
   | Oval_int of int
+  | Oval_int32 of int32
+  | Oval_int64 of int64
+  | Oval_nativeint of nativeint
   | Oval_list of out_value list
   | Oval_printer of (Format.formatter -> unit)
   | Oval_record of (out_ident * out_value) list
diff --git a/typing/parmatch.ml b/typing/parmatch.ml
index 8ef2a1f224..ba68fe86e2 100644
--- a/typing/parmatch.ml
+++ b/typing/parmatch.ml
@@ -156,12 +156,12 @@ let rec pretty_val ppf v = match v.pat_desc with
   | Tpat_any -> fprintf ppf "_"
   | Tpat_var x -> Ident.print ppf x
   | Tpat_constant (Const_int i) -> fprintf ppf "%d" i
-  | Tpat_constant (Const_char c) ->
-      fprintf ppf "%C" c
-  | Tpat_constant (Const_string s) ->
-      fprintf ppf "%S" s
-  | Tpat_constant (Const_float s) ->
-      fprintf ppf "%s" s
+  | Tpat_constant (Const_char c) -> fprintf ppf "%C" c
+  | Tpat_constant (Const_string s) -> fprintf ppf "%S" s
+  | Tpat_constant (Const_float f) -> fprintf ppf "%s" f
+  | Tpat_constant (Const_int32 i) -> fprintf ppf "%ldl" i
+  | Tpat_constant (Const_int64 i) -> fprintf ppf "%LdL" i
+  | Tpat_constant (Const_nativeint i) -> fprintf ppf "%ndn" i
   | Tpat_tuple vs ->
       fprintf ppf "@[(%a)@]" (pretty_vals ",") vs
   | Tpat_construct ({cstr_tag=tag},[]) ->
@@ -633,6 +633,16 @@ with
 | _ -> fatal_error "Parmatch.complete_constr"
 
 
+(* Auxiliary for build_other *)
+
+let build_other_constant proj make first next p env =
+  let all = List.map (fun (p, _) -> proj p.pat_desc) env in
+  let rec try_const i =
+    if List.mem i all
+    then try_const (next i)
+    else make_pat (make i) p.pat_type p.pat_env
+  in try_const first
+
 (*
   Builds a pattern that is incompatible with all patterns in
   in the first column of env
@@ -709,47 +719,40 @@ let build_other env =  match env with
     try_chars
       [ 'a', 'z' ; 'A', 'Z' ; '0', '9' ;
         ' ', '~' ; Char.chr 0 , Char.chr 255]
+
 | ({pat_desc=(Tpat_constant (Const_int _))} as p,_) :: _ ->
-    let all_ints =
-      List.map
-        (fun (p,_) -> match p.pat_desc with
-        | Tpat_constant (Const_int i) -> i
-        | _ -> assert false)
-        env in
-    let rec try_ints i =
-      if List.mem i all_ints then try_ints (i+1)
-      else
-        make_pat
-          (Tpat_constant (Const_int i)) p.pat_type p.pat_env in
-    try_ints 0
+    build_other_constant
+      (function Tpat_constant(Const_int i) -> i | _ -> assert false)
+      (function i -> Tpat_constant(Const_int i))
+      0 succ p env
+| ({pat_desc=(Tpat_constant (Const_int32 _))} as p,_) :: _ ->
+    build_other_constant
+      (function Tpat_constant(Const_int32 i) -> i | _ -> assert false)
+      (function i -> Tpat_constant(Const_int32 i))
+      0l Int32.succ p env
+| ({pat_desc=(Tpat_constant (Const_int64 _))} as p,_) :: _ ->
+    build_other_constant
+      (function Tpat_constant(Const_int64 i) -> i | _ -> assert false)
+      (function i -> Tpat_constant(Const_int64 i))
+      0L Int64.succ p env
+| ({pat_desc=(Tpat_constant (Const_nativeint _))} as p,_) :: _ ->
+    build_other_constant
+      (function Tpat_constant(Const_nativeint i) -> i | _ -> assert false)
+      (function i -> Tpat_constant(Const_nativeint i))
+      0n Nativeint.succ p env
 | ({pat_desc=(Tpat_constant (Const_string _))} as p,_) :: _ ->
-    let all_lengths =
-      List.map
-        (fun (p,_) -> match p.pat_desc with
-        | Tpat_constant (Const_string s) -> String.length s
-        | _ -> assert false)
-        env in
-    let rec try_strings i =
-      if List.mem i all_lengths then try_strings (i+1)
-      else
-        make_pat
-          (Tpat_constant (Const_string (String.make i '*')))
-          p.pat_type p.pat_env in
-    try_strings 0
+    build_other_constant
+      (function Tpat_constant(Const_string s) -> String.length s
+              | _ -> assert false)
+      (function i -> Tpat_constant(Const_string(String.make i '*')))
+      0 succ p env
 | ({pat_desc=(Tpat_constant (Const_float _))} as p,_) :: _ ->
-    let all_floats =
-      List.map
-        (fun (p,_) -> match p.pat_desc with
-        | Tpat_constant (Const_float s) -> float_of_string s
-        | _ -> assert false)
-        env in
-    let rec try_floats f =
-      if List.mem f all_floats then try_floats (f +. 1.0)
-      else
-        make_pat
-          (Tpat_constant (Const_float (string_of_float f)))
-          p.pat_type p.pat_env in
-    try_floats 0.0
+    build_other_constant
+      (function Tpat_constant(Const_float f) -> float_of_string f
+              | _ -> assert false)
+      (function f -> Tpat_constant(Const_float (string_of_float f)))
+      0.0 (fun f -> f +. 1.0) p env
+
 | ({pat_desc = Tpat_array args} as p,_)::_ ->
     let all_lengths =
       List.map
diff --git a/typing/typecore.ml b/typing/typecore.ml
index 63e08c86b1..3cc8b86a8e 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -91,7 +91,10 @@ let type_constant = function
   | Const_char _ -> instance Predef.type_char
   | Const_string _ -> instance Predef.type_string
   | Const_float _ -> instance Predef.type_float
-
+  | Const_int32 _ -> instance Predef.type_int32
+  | Const_int64 _ -> instance Predef.type_int64
+  | Const_nativeint _ -> instance Predef.type_nativeint
+  
 (* Specific version of type_option, using newty rather than newgenty *)
 
 let type_option ty =