Merge commit 'e41dc9c44327f40c1ab0feea12f779c931c9e31e' into parallel_minor_gc_4_12

171 files changed, 1570 insertions, 1128 deletions

diff --git a/.depend b/.depend
index bedb57499f..8a16af0e65 100644
--- a/.depend
+++ b/.depend
@@ -2278,6 +2278,7 @@ asmcomp/cmm.cmo : \
     lambda/debuginfo.cmi \
     middle_end/backend_var.cmi \
     parsing/asttypes.cmi \
+    asmcomp/arch.cmo \
     asmcomp/cmm.cmi
 asmcomp/cmm.cmx : \
     utils/targetint.cmx \
@@ -2285,6 +2286,7 @@ asmcomp/cmm.cmx : \
     lambda/debuginfo.cmx \
     middle_end/backend_var.cmx \
     parsing/asttypes.cmi \
+    asmcomp/arch.cmx \
     asmcomp/cmm.cmi
 asmcomp/cmm.cmi : \
     utils/targetint.cmi \
@@ -2751,7 +2753,8 @@ asmcomp/proc.cmx : \
     asmcomp/proc.cmi
 asmcomp/proc.cmi : \
     asmcomp/reg.cmi \
-    asmcomp/mach.cmi
+    asmcomp/mach.cmi \
+    asmcomp/cmm.cmi
 asmcomp/reg.cmo : \
     asmcomp/cmm.cmi \
     middle_end/backend_var.cmi \
diff --git a/Changes b/Changes
index 63db8efec3..a4c70ce37c 100644
--- a/Changes
+++ b/Changes
@@ -103,8 +103,16 @@ Working version
    partially curried or tupled.
    (Xavier Leroy, review by Mark Shinwell)
 
+- #9752: Revised handling of calling conventions for external C functions.
+   Provide a more precise description of the types of unboxed arguments,
+   so that the ARM64 iOS/macOS calling conventions can be honored.
+   (Xavier Leroy, review by Mark Shinwell and Github user @EduardoRFS)
+
 ### Standard library:
 
+- #9781: add injectivity annotations to parameterized abstract types
+  (Jeremy Yallop, review by Nicolás Ojeda Bär)
+
 * #9554: add primitive __FUNCTION__ that returns the name of the current method
   or function, including any enclosing module or class.
   (Nicolás Ojeda Bär, Stephen Dolan, review by Stephen Dolan)
@@ -217,6 +225,12 @@ Working version
   (Xavier Van de Woestyne, report by whitequark, review by Florian Angeletti
   and Gabriel Scherer)
 
+- #9657: Warnings can now be referred to by their mnemonic name. The names are
+  displayed using `-warn-help` and can be utilized anywhere where a warning list
+  specification is expected, e.g. `[@@@ocaml.warning ...]`.
+  (Nicolás Ojeda Bär, review by Gabriel Scherer, Florian Angeletti and Leo
+  White)
+
 ### Internal/compiler-libs changes:
 
 - #9216: add Lambda.duplicate which refreshes bound identifiers
@@ -380,7 +394,7 @@ OCaml 4.11
 - #9280: Micro-optimise allocations on amd64 to save a register.
   (Stephen Dolan, review by Xavier Leroy)
 
-- #9316, #9443, #9463: Use typing information from Clambda
+- #9316, #9443, #9463, #9782: Use typing information from Clambda
   for mutable Cmm variables.
   (Stephen Dolan, review by Vincent Laviron, Guillaume Bury, Xavier Leroy,
   and Gabriel Scherer; temporary bug report by Richard Jones)
@@ -483,6 +497,10 @@ OCaml 4.11
 
 ### Other libraries:
 
+- #9338: Dynlink: make sure *_units () functions report accurate information
+  before the first load.
+  (Daniel Bünzli, review by Xavier Leroy and Nicolás Ojeda Bär)
+
 - #9106: Register printer for Unix_error in win32unix, as in unix.
   (Christopher Zimmermann, review by David Allsopp)
 
@@ -502,6 +520,10 @@ OCaml 4.11
 
 ### Tools:
 
+* #9299: ocamldep: do not process files during cli parsing. Fixes
+  various broken cli behaviours.
+  (Daniel Bünzli, review by Nicolás Ojeda Bär)
+
 - #6969: Argument -nocwd added to ocamldep
   (Muskan Garg, review by Florian Angeletti)
 
diff --git a/asmcomp/afl_instrument.ml b/asmcomp/afl_instrument.ml
index b8f2d9f7a5..9c21154e5d 100644
--- a/asmcomp/afl_instrument.ml
+++ b/asmcomp/afl_instrument.ml
@@ -103,7 +103,7 @@ let instrument_initialiser c dbg =
      calls *)
   with_afl_logging
     (Csequence
-       (Cop (Cextcall ("caml_setup_afl", typ_int, false, None),
+       (Cop (Cextcall ("caml_setup_afl", typ_int, [], false, None),
              [Cconst_int (0, dbg ())],
              dbg ()),
         c))
diff --git a/asmcomp/amd64/proc.ml b/asmcomp/amd64/proc.ml
index 61d55c7795..f82a7e41ac 100644
--- a/asmcomp/amd64/proc.ml
+++ b/asmcomp/amd64/proc.ml
@@ -165,7 +165,7 @@ let calling_conventions first_int last_int first_float last_float make_stack
   let float = ref first_float in
   let ofs = ref 0 in
   for i = 0 to Array.length arg - 1 do
-    match arg.(i).typ with
+    match arg.(i) with
     | Val | Int | Addr as ty ->
         if !int <= last_int then begin
           loc.(i) <- phys_reg !int;
@@ -234,7 +234,7 @@ let win64_loc_external_arguments arg =
   let reg = ref 0
   and ofs = ref 32 in
   for i = 0 to Array.length arg - 1 do
-    match arg.(i).typ with
+    match arg.(i) with
     | Val | Int | Addr as ty ->
         if !reg < 4 then begin
           loc.(i) <- phys_reg win64_int_external_arguments.(!reg);
@@ -254,15 +254,14 @@ let win64_loc_external_arguments arg =
   done;
   (loc, Misc.align !ofs 16)  (* keep stack 16-aligned *)
 
-let loc_external_arguments arg =
-  let arg =
-    Array.map (fun regs -> assert (Array.length regs = 1); regs.(0)) arg
-  in
-  let loc, alignment =
-    if win64 then win64_loc_external_arguments arg
+let loc_external_arguments ty_args =
+  let arg = Cmm.machtype_of_exttype_list ty_args in
+  let loc, stack_ofs =
+    if win64
+    then win64_loc_external_arguments arg
     else unix_loc_external_arguments arg
   in
-  Array.map (fun reg -> [|reg|]) loc, alignment
+  Array.map (fun reg -> [|reg|]) loc, stack_ofs
 
 let loc_exn_bucket = rax
 
diff --git a/asmcomp/amd64/selection.ml b/asmcomp/amd64/selection.ml
index 4ef5fec2e2..cbaeb72c78 100644
--- a/asmcomp/amd64/selection.ml
+++ b/asmcomp/amd64/selection.ml
@@ -135,7 +135,7 @@ method is_immediate_natint n = n <= 0x7FFFFFFFn && n >= -0x80000000n
 
 method! is_simple_expr e =
   match e with
-  | Cop(Cextcall (fn, _, _, _), args, _)
+  | Cop(Cextcall (fn, _, _, _, _), args, _)
     when List.mem fn inline_ops ->
       (* inlined ops are simple if their arguments are *)
       List.for_all self#is_simple_expr args
@@ -144,7 +144,7 @@ method! is_simple_expr e =
 
 method! effects_of e =
   match e with
-  | Cop(Cextcall(fn, _, _, _), args, _)
+  | Cop(Cextcall(fn, _, _, _, _), args, _)
     when List.mem fn inline_ops ->
       Selectgen.Effect_and_coeffect.join_list_map args self#effects_of
   | _ ->
@@ -197,7 +197,7 @@ method! select_operation op args dbg =
       self#select_floatarith true Imulf Ifloatmul args
   | Cdivf ->
       self#select_floatarith false Idivf Ifloatdiv args
-  | Cextcall("sqrt", _, false, _) ->
+  | Cextcall("sqrt", _, _, false, _) ->
      begin match args with
        [Cop(Cload {memory_chunk=(Double|Double_u as chunk)}, [loc], _dbg)] ->
          let (addr, arg) = self#select_addressing chunk loc in
@@ -217,12 +217,12 @@ method! select_operation op args dbg =
       | _ ->
           super#select_operation op args dbg
       end
-  | Cextcall("caml_bswap16_direct", _, _, _) ->
+  | Cextcall("caml_bswap16_direct", _, _, _, _) ->
       (Ispecific (Ibswap 16), args)
-  | Cextcall("caml_int32_direct_bswap", _, _, _) ->
+  | Cextcall("caml_int32_direct_bswap", _, _, _, _) ->
       (Ispecific (Ibswap 32), args)
-  | Cextcall("caml_int64_direct_bswap", _, _, _)
-  | Cextcall("caml_nativeint_direct_bswap", _, _, _) ->
+  | Cextcall("caml_int64_direct_bswap", _, _, _, _)
+  | Cextcall("caml_nativeint_direct_bswap", _, _, _, _) ->
       (Ispecific (Ibswap 64), args)
   (* AMD64 does not support immediate operands for multiply high signed *)
   | Cmulhi ->
diff --git a/asmcomp/arm/proc.ml b/asmcomp/arm/proc.ml
index 9ac9cf13a2..2c79f380f5 100644
--- a/asmcomp/arm/proc.ml
+++ b/asmcomp/arm/proc.ml
@@ -111,67 +111,58 @@ let loc_spacetime_node_hole = Reg.dummy  (* Spacetime unsupported *)
 
 (* Calling conventions *)
 
+let loc_int last_int make_stack int ofs =
+  if !int <= last_int then begin
+    let l = phys_reg !int in
+    incr int; l
+  end else begin
+    let l = stack_slot (make_stack !ofs) Int in
+    ofs := !ofs + size_int; l
+  end
+
+let loc_float last_float make_stack float ofs =
+  assert (abi = EABI_HF);
+  assert (!fpu >= VFPv2);
+  if !float <= last_float then begin
+    let l = phys_reg !float in
+    incr float; l
+  end else begin
+    ofs := Misc.align !ofs size_float;
+    let l = stack_slot (make_stack !ofs) Float in
+    ofs := !ofs + size_float; l
+  end
+
+let loc_int_pair last_int make_stack int ofs =
+  (* 64-bit quantities split across two registers must either be in a
+     consecutive pair of registers where the lowest numbered is an
+     even-numbered register; or in a stack slot that is 8-byte aligned. *)
+  int := Misc.align !int 2;
+  if !int <= last_int - 1 then begin
+    let reg_lower = phys_reg !int in
+    let reg_upper = phys_reg (1 + !int) in
+    int := !int + 2;
+    [| reg_lower; reg_upper |]
+  end else begin
+    let size_int64 = size_int * 2 in
+    ofs := Misc.align !ofs size_int64;
+    let stack_lower = stack_slot (make_stack !ofs) Int in
+    let stack_upper = stack_slot (make_stack (size_int + !ofs)) Int in
+    ofs := !ofs + size_int64;
+    [| stack_lower; stack_upper |]
+  end
+
 let calling_conventions first_int last_int first_float last_float make_stack
       arg =
-  let loc = Array.make (Array.length arg) [| Reg.dummy |] in
+  let loc = Array.make (Array.length arg) Reg.dummy in
   let int = ref first_int in
   let float = ref first_float in
   let ofs = ref 0 in
   for i = 0 to Array.length arg - 1 do
     match arg.(i) with
-    | [| arg |] ->
-      begin match arg.typ with
-      | Val | Int | Addr as ty ->
-          if !int <= last_int then begin
-            loc.(i) <- [| phys_reg !int |];
-            incr int
-          end else begin
-            loc.(i) <- [| stack_slot (make_stack !ofs) ty |];
-            ofs := !ofs + size_int
-          end
-      | Float ->
-          assert (abi = EABI_HF);
-          assert (!fpu >= VFPv2);
-          if !float <= last_float then begin
-            loc.(i) <- [| phys_reg !float |];
-            incr float
-          end else begin
-            ofs := Misc.align !ofs size_float;
-            loc.(i) <- [| stack_slot (make_stack !ofs) Float |];
-            ofs := !ofs + size_float
-          end
-      end
-    | [| arg1; arg2 |] ->
-      (* Passing of 64-bit quantities to external functions. *)
-      begin match arg1.typ, arg2.typ with
-      | Int, Int ->
-          (* 64-bit quantities split across two registers must either be in a
-             consecutive pair of registers where the lowest numbered is an
-             even-numbered register; or in a stack slot that is 8-byte
-             aligned. *)
-          int := Misc.align !int 2;
-          if !int <= last_int - 1 then begin
-            let reg_lower = phys_reg !int in
-            let reg_upper = phys_reg (1 + !int) in
-            loc.(i) <- [| reg_lower; reg_upper |];
-            int := !int + 2
-          end else begin
-            let size_int64 = size_int * 2 in
-            ofs := Misc.align !ofs size_int64;
-            let stack_lower = stack_slot (make_stack !ofs) Int in
-            let stack_upper = stack_slot (make_stack (size_int + !ofs)) Int in
-            loc.(i) <- [| stack_lower; stack_upper |];
-            ofs := !ofs + size_int64
-          end
-      | _, _ ->
-        let f = function Int -> "I" | Addr -> "A" | Val -> "V" | Float -> "F" in
-        fatal_error (Printf.sprintf "Proc.calling_conventions: bad register \
-            type(s) for multi-register argument: %s, %s"
-          (f arg1.typ) (f arg2.typ))
-      end
-    | _ ->
-      fatal_error "Proc.calling_conventions: bad number of registers for \
-        multi-register argument"
+    | Val | Int | Addr ->
+        loc.(i) <- loc_int last_int make_stack int ofs
+    | Float ->
+        loc.(i) <- loc_float last_float make_stack float ofs
   done;
   (loc, Misc.align !ofs 8)  (* keep stack 8-aligned *)
 
@@ -187,40 +178,50 @@ let not_supported _ofs = fatal_error "Proc.loc_results: cannot call"
 
 let max_arguments_for_tailcalls = 8
 
-let single_regs arg = Array.map (fun arg -> [| arg |]) arg
-let ensure_single_regs res =
-  Array.map (function
-      | [| res |] -> res
-      | _ -> failwith "Proc.ensure_single_regs")
-    res
-
 let loc_arguments arg =
-  let (loc, alignment) =
-    calling_conventions 0 7 100 115 outgoing (single_regs arg)
-  in
-  ensure_single_regs loc, alignment
+  calling_conventions 0 7 100 115 outgoing arg
+
 let loc_parameters arg =
-  let (loc, _) = calling_conventions 0 7 100 115 incoming (single_regs arg) in
-  ensure_single_regs loc
+  let (loc, _) = calling_conventions 0 7 100 115 incoming arg in loc
+
 let loc_results res =
-  let (loc, _) =
-    calling_conventions 0 7 100 115 not_supported (single_regs res)
-  in
-  ensure_single_regs loc
+  let (loc, _) = calling_conventions 0 7 100 115 not_supported res in loc
 
 (* C calling convention:
      first integer args in r0...r3
+     first 64-bit integer args in r0-r1, r2-r3
      first float args in d0...d7 (EABI+VFP)
+     first float args in r0-r1, r2-r3 (soft FP)
      remaining args on stack.
-   Return values in r0...r1 or d0. *)
+   Return values in r0, r0-r1, or d0. *)
+
+let external_calling_conventions first_int last_int first_float last_float
+                                 make_stack ty_args =
+  let loc = Array.make (List.length ty_args) [| Reg.dummy |] in
+  let int = ref first_int in
+  let float = ref first_float in
+  let ofs = ref 0 in
+  List.iteri
+    (fun i ty_arg ->
+      match ty_arg with
+      | XInt | XInt32 ->
+        loc.(i) <- [| loc_int last_int make_stack int ofs |]
+      | XInt64 ->
+        loc.(i) <- loc_int_pair last_int make_stack int ofs
+      | XFloat ->
+        loc.(i) <-
+         (if abi = EABI_HF
+          then [| loc_float last_float make_stack float ofs |]
+          else loc_int_pair last_int make_stack int ofs))
+    ty_args;
+  (loc, Misc.align !ofs 8)  (* keep stack 8-aligned *)
+
+let loc_external_arguments ty_args =
+  external_calling_conventions 0 3 100 107 outgoing ty_args
 
-let loc_external_arguments arg =
-  calling_conventions 0 3 100 107 outgoing arg
 let loc_external_results res =
-  let (loc, _) =
-    calling_conventions 0 1 100 100 not_supported (single_regs res)
-  in
-  ensure_single_regs loc
+  let (loc, _) = calling_conventions 0 1 100 100 not_supported res
+  in loc
 
 let loc_exn_bucket = phys_reg 0
 
diff --git a/asmcomp/arm/selection.ml b/asmcomp/arm/selection.ml
index ec4ec2b542..7659ea87af 100644
--- a/asmcomp/arm/selection.ml
+++ b/asmcomp/arm/selection.ml
@@ -79,7 +79,7 @@ let pseudoregs_for_operation op arg res =
       (arg', res)
   (* We use __aeabi_idivmod for Cmodi only, and hence we care only
      for the remainder in r1, so fix up the destination register. *)
-  | Iextcall { func = "__aeabi_idivmod"; alloc = false; } ->
+  | Iextcall { func = "__aeabi_idivmod"; _ } ->
       (arg, [|r1|])
   (* Other instructions are regular *)
   | _ -> raise Use_default
@@ -108,25 +108,25 @@ method is_immediate n =
 
 method! is_simple_expr = function
   (* inlined floating-point ops are simple if their arguments are *)
-  | Cop(Cextcall("sqrt", _, _, _), args, _) when !fpu >= VFPv2 ->
+  | Cop(Cextcall("sqrt", _, _, _, _), args, _) when !fpu >= VFPv2 ->
       List.for_all self#is_simple_expr args
   (* inlined byte-swap ops are simple if their arguments are *)
-  | Cop(Cextcall("caml_bswap16_direct", _, _, _), args, _)
+  | Cop(Cextcall("caml_bswap16_direct", _, _, _, _), args, _)
     when !arch >= ARMv6T2 ->
       List.for_all self#is_simple_expr args
-  | Cop(Cextcall("caml_int32_direct_bswap",_,_,_), args, _)
+  | Cop(Cextcall("caml_int32_direct_bswap", _, _, _, _), args, _)
     when !arch >= ARMv6 ->
       List.for_all self#is_simple_expr args
   | e -> super#is_simple_expr e
 
 method! effects_of e =
   match e with
-  | Cop(Cextcall("sqrt", _, _, _), args, _) when !fpu >= VFPv2 ->
+  | Cop(Cextcall("sqrt", _, _, _, _), args, _) when !fpu >= VFPv2 ->
       Selectgen.Effect_and_coeffect.join_list_map args self#effects_of
-  | Cop(Cextcall("caml_bswap16_direct", _, _, _), args, _)
+  | Cop(Cextcall("caml_bswap16_direct", _, _, _, _), args, _)
     when !arch >= ARMv6T2 ->
       Selectgen.Effect_and_coeffect.join_list_map args self#effects_of
-  | Cop(Cextcall("caml_int32_direct_bswap",_,_,_), args, _)
+  | Cop(Cextcall("caml_int32_direct_bswap",_ ,_ , _, _), args, _)
     when !arch >= ARMv6 ->
       Selectgen.Effect_and_coeffect.join_list_map args self#effects_of
   | e -> super#effects_of e
@@ -180,8 +180,9 @@ method select_shift_arith op dbg arithop arithrevop args =
       | op_args -> op_args
       end
 
-method private iextcall (func, alloc) =
-  Iextcall { func; alloc; label_after = Cmm.new_label (); }
+method private iextcall func ty_res ty_args =
+  Iextcall { func; ty_res; ty_args;
+             alloc = false; label_after = Cmm.new_label (); }
 
 method! select_operation op args dbg =
   match (op, args) with
@@ -216,15 +217,15 @@ method! select_operation op args dbg =
       (Iintop Imulh, args)
   (* Turn integer division/modulus into runtime ABI calls *)
   | (Cdivi, args) ->
-      (self#iextcall("__aeabi_idiv", false), args)
+      (self#iextcall "__aeabi_idiv" typ_int [], args)
   | (Cmodi, args) ->
       (* See above for fix up of return register *)
-      (self#iextcall("__aeabi_idivmod", false), args)
+      (self#iextcall "__aeabi_idivmod" typ_int [], args)
   (* Recognize 16-bit bswap instruction (ARMv6T2 because we need movt) *)
-  | (Cextcall("caml_bswap16_direct", _, _, _), args) when !arch >= ARMv6T2 ->
+  | (Cextcall("caml_bswap16_direct", _, _, _, _), args) when !arch >= ARMv6T2 ->
       (Ispecific(Ibswap 16), args)
   (* Recognize 32-bit bswap instructions (ARMv6 and above) *)
-  | (Cextcall("caml_int32_direct_bswap", _, _, _), args)
+  | (Cextcall("caml_int32_direct_bswap", _, _, _, _), args)
     when !arch >= ARMv6 ->
       (Ispecific(Ibswap 32), args)
   (* Turn floating-point operations into runtime ABI calls for softfp *)
@@ -235,12 +236,18 @@ method! select_operation op args dbg =
 method private select_operation_softfp op args dbg =
   match (op, args) with
   (* Turn floating-point operations into runtime ABI calls *)
-  | (Caddf, args) -> (self#iextcall("__aeabi_dadd", false), args)
-  | (Csubf, args) -> (self#iextcall("__aeabi_dsub", false), args)
-  | (Cmulf, args) -> (self#iextcall("__aeabi_dmul", false), args)
-  | (Cdivf, args) -> (self#iextcall("__aeabi_ddiv", false), args)
-  | (Cfloatofint, args) -> (self#iextcall("__aeabi_i2d", false), args)
-  | (Cintoffloat, args) -> (self#iextcall("__aeabi_d2iz", false), args)
+  | (Caddf, args) ->
+      (self#iextcall "__aeabi_dadd" typ_float [XFloat;XFloat], args)
+  | (Csubf, args) ->
+      (self#iextcall "__aeabi_dsub" typ_float [XFloat;XFloat], args)
+  | (Cmulf, args) ->
+      (self#iextcall "__aeabi_dmul" typ_float [XFloat;XFloat], args)
+  | (Cdivf, args) ->
+      (self#iextcall "__aeabi_ddiv" typ_float [XFloat;XFloat], args)
+  | (Cfloatofint, args) ->
+      (self#iextcall "__aeabi_i2d" typ_float [XInt], args)
+  | (Cintoffloat, args) ->
+      (self#iextcall "__aeabi_d2iz" typ_int [XFloat], args)
   | (Ccmpf comp, args) ->
       let comp, func =
         match comp with
@@ -256,14 +263,16 @@ method private select_operation_softfp op args dbg =
         | CFnge -> Ceq, "__aeabi_dcmpge"
       in
       (Iintop_imm(Icomp(Iunsigned comp), 0),
-       [Cop(Cextcall(func, typ_int, false, None), args, dbg)])
+       [Cop(Cextcall(func, typ_int, [XFloat;XFloat], false, None),
+            args, dbg)])
   (* Add coercions around loads and stores of 32-bit floats *)
   | (Cload {memory_chunk=Single; mutability; is_atomic=false}, args) ->
-      (self#iextcall("__aeabi_f2d", false),
+      (self#iextcall "__aeabi_f2d" typ_float [XInt],
         [Cop(Cload {memory_chunk=Word_int; mutability; is_atomic=false}, args, dbg)])
   | (Cstore (Single, init), [arg1; arg2]) ->
       let arg2' =
-        Cop(Cextcall("__aeabi_d2f", typ_int, false, None), [arg2], dbg) in
+        Cop(Cextcall("__aeabi_d2f", typ_int, [XFloat], false, None),
+            [arg2], dbg) in
       self#select_operation (Cstore (Word_int, init)) [arg1; arg2'] dbg
   (* Other operations are regular *)
   | (op, args) -> super#select_operation op args dbg
@@ -288,7 +297,7 @@ method private select_operation_vfpv3 op args dbg =
   | (Csubf, [Cop(Cmulf, args, _); arg]) ->
       (Ispecific Imulsubf, arg :: args)
   (* Recognize floating-point square root *)
-  | (Cextcall("sqrt", _, false, _), args) ->
+  | (Cextcall("sqrt", _, _, false, _), args) ->
       (Ispecific Isqrtf, args)
   (* Other operations are regular *)
   | (op, args) -> super#select_operation op args dbg
diff --git a/asmcomp/arm64/arch.ml b/asmcomp/arm64/arch.ml
index 9cf923c6c3..41edd3e4a6 100644
--- a/asmcomp/arm64/arch.ml
+++ b/asmcomp/arm64/arch.ml
@@ -19,6 +19,10 @@
 
 open Format
 
+let macosx = (Config.system = "macosx")
+
+(* Machine-specific command-line options *)
+
 let command_line_options = []
 
 (* Addressing modes *)
@@ -56,6 +60,7 @@ type specific_operation =
   | Inegmulsubf   (* floating-point negate, multiply and subtract *)
   | Isqrtf        (* floating-point square root *)
   | Ibswap of int (* endianness conversion *)
+  | Imove32       (* 32-bit integer move *)
 
 and arith_operation =
     Ishiftadd
@@ -65,7 +70,7 @@ let spacetime_node_hole_pointer_is_live_before = function
   | Ifar_alloc _ | Ifar_intop_checkbound _ | Ifar_intop_imm_checkbound _
   | Ishiftarith _ | Ishiftcheckbound _ | Ifar_shiftcheckbound _ -> false
   | Imuladd | Imulsub | Inegmulf | Imuladdf | Inegmuladdf | Imulsubf
-  | Inegmulsubf | Isqrtf | Ibswap _ -> false
+  | Inegmulsubf | Isqrtf | Ibswap _ | Imove32 -> false
 
 (* Sizes, endianness *)
 
@@ -170,3 +175,6 @@ let print_specific_operation printreg op ppf arg =
   | Ibswap n ->
       fprintf ppf "bswap%i %a" n
         printreg arg.(0)
+  | Imove32 ->
+      fprintf ppf "move32 %a"
+        printreg arg.(0)
diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp
index 7e789bb8e5..bccb8872e0 100644
--- a/asmcomp/arm64/emit.mlp
+++ b/asmcomp/arm64/emit.mlp
@@ -512,6 +512,7 @@ module BR = Branch_relaxation.Make (struct
     | Lop (Ispecific (Imuladd | Imulsub)) -> 1
     | Lop (Ispecific (Ibswap 16)) -> 2
     | Lop (Ispecific (Ibswap _)) -> 1
+    | Lop (Ispecific Imove32) -> 1
     | Lop (Iname_for_debugger _) -> 0
     | Lreloadretaddr -> 0
     | Lreturn -> epilogue_size ()
@@ -644,6 +645,19 @@ let emit_instr i =
           | _ ->
               assert false
         end
+    | Lop(Ispecific Imove32) ->
+        let src = i.arg.(0) and dst = i.res.(0) in
+        if src.loc <> dst.loc then begin
+          match (src, dst) with
+          | {loc = Reg _}, {loc = Reg _} ->
+              `	mov	{emit_wreg dst}, {emit_wreg src}\n`
+          | {loc = Reg _}, {loc = Stack _} ->
+              `	str	{emit_wreg src}, {emit_stack dst}\n`
+          | {loc = Stack _}, {loc = Reg _} ->
+              `	ldr	{emit_wreg dst}, {emit_stack src}\n`
+          | _ ->
+              assert false
+        end
     | Lop(Iconst_int n) ->
         emit_intconst i.res.(0) n
     | Lop(Iconst_float f) ->
diff --git a/asmcomp/arm64/proc.ml b/asmcomp/arm64/proc.ml
index a043fce178..e362b6b63b 100644
--- a/asmcomp/arm64/proc.ml
+++ b/asmcomp/arm64/proc.ml
@@ -111,6 +111,36 @@ let loc_spacetime_node_hole = Reg.dummy  (* Spacetime unsupported *)
 
 (* Calling conventions *)
 
+let loc_int last_int make_stack int ofs =
+  if !int <= last_int then begin
+    let l = phys_reg !int in
+    incr int; l
+  end else begin
+    ofs := Misc.align !ofs size_int;
+    let l = stack_slot (make_stack !ofs) Int in
+    ofs := !ofs + size_int; l
+  end
+
+let loc_float last_float make_stack float ofs =
+  if !float <= last_float then begin
+    let l = phys_reg !float in
+    incr float; l
+  end else begin
+    ofs := Misc.align !ofs size_float;
+    let l = stack_slot (make_stack !ofs) Float in
+    ofs := !ofs + size_float; l
+  end
+
+let loc_int32 last_int make_stack int ofs =
+  if !int <= last_int then begin
+    let l = phys_reg !int in
+    incr int; l
+  end else begin
+    let l = stack_slot (make_stack !ofs) Int in
+    ofs := !ofs + (if macosx then 4 else 8);
+    l
+  end
+
 let calling_conventions
     first_int last_int first_float last_float make_stack arg =
   let loc = Array.make (Array.length arg) Reg.dummy in
@@ -118,23 +148,11 @@ let calling_conventions
   let float = ref first_float in
   let ofs = ref 0 in
   for i = 0 to Array.length arg - 1 do
-    match arg.(i).typ with
-    | Val | Int | Addr as ty ->
-        if !int <= last_int then begin
-          loc.(i) <- phys_reg !int;
-          incr int
-        end else begin
-          loc.(i) <- stack_slot (make_stack !ofs) ty;
-          ofs := !ofs + size_int
-        end
+    match arg.(i) with
+    | Val | Int | Addr ->
+        loc.(i) <- loc_int last_int make_stack int ofs
     | Float ->
-        if !float <= last_float then begin
-          loc.(i) <- phys_reg !float;
-          incr float
-        end else begin
-          loc.(i) <- stack_slot (make_stack !ofs) Float;
-          ofs := !ofs + size_float
-        end
+        loc.(i) <- loc_float last_float make_stack float ofs
   done;
   (loc, Misc.align !ofs 16)  (* keep stack 16-aligned *)
 
@@ -163,14 +181,31 @@ let loc_results res =
      first integer args in x0...x7
      first float args in d0...d7
      remaining args on stack.
-   Return values in x0...x1 or d0. *)
-
-let loc_external_arguments arg =
-  let arg =
-    Array.map (fun regs -> assert (Array.length regs = 1); regs.(0)) arg
-  in
-  let loc, alignment = calling_conventions 0 7 100 107 outgoing arg in
-  Array.map (fun reg -> [|reg|]) loc, alignment
+   macOS/iOS peculiarity: int32 arguments passed on stack occupy 4 bytes,
+   while the AAPCS64 says 8 bytes.
+   Return values in r0...r1 or d0. *)
+
+let external_calling_conventions
+    first_int last_int first_float last_float make_stack ty_args =
+  let loc = Array.make (List.length ty_args) [| Reg.dummy |] in
+  let int = ref first_int in
+  let float = ref first_float in
+  let ofs = ref 0 in
+  List.iteri (fun i ty_arg ->
+    begin match ty_arg with
+    | XInt | XInt64 ->
+        loc.(i) <- [| loc_int last_int make_stack int ofs |]
+    | XInt32 ->
+        loc.(i) <- [| loc_int32 last_int make_stack int ofs |]
+    | XFloat ->
+        loc.(i) <- [| loc_float last_float make_stack float ofs |]
+    end)
+    ty_args;
+  (loc, Misc.align !ofs 16)  (* keep stack 16-aligned *)
+
+let loc_external_arguments ty_args =
+  external_calling_conventions 0 7 100 107 outgoing ty_args
+
 let loc_external_results res =
   let (loc, _) = calling_conventions 0 1 100 100 not_supported res in loc
 
diff --git a/asmcomp/arm64/reload.ml b/asmcomp/arm64/reload.ml
index 0c342b6448..7d27e0760a 100644
--- a/asmcomp/arm64/reload.ml
+++ b/asmcomp/arm64/reload.ml
@@ -15,5 +15,26 @@
 
 (* Reloading for the ARM 64 bits *)
 
+open Reg
+
+class reload = object (self)
+
+inherit Reloadgen.reload_generic as super
+
+method! reload_operation op arg res =
+  match op with
+  | Ispecific Imove32 ->
+      (* Like Imove: argument or result can be on stack but not both *)
+      begin match arg.(0), res.(0) with
+      | {loc = Stack s1}, {loc = Stack s2} when s1 <> s2 ->
+          ([| self#makereg arg.(0) |], res)
+      | _ ->
+          (arg, res)
+      end
+   | _ ->
+      super#reload_operation op arg res
+
+end
+
 let fundecl f num_stack_slots =
-  (new Reloadgen.reload_generic)#fundecl f num_stack_slots
+  (new reload)#fundecl f num_stack_slots
diff --git a/asmcomp/arm64/selection.ml b/asmcomp/arm64/selection.ml
index 90166141dd..8b1ce1b687 100644
--- a/asmcomp/arm64/selection.ml
+++ b/asmcomp/arm64/selection.ml
@@ -85,6 +85,11 @@ let inline_ops =
 let use_direct_addressing _symb =
   not !Clflags.dlcode
 
+let is_stack_slot rv =
+  Reg.(match rv with
+        | [| { loc = Stack _ } |] -> true
+        | _ -> false)
+
 (* Instruction selection *)
 
 class selector = object(self)
@@ -98,13 +103,13 @@ method is_immediate n =
 
 method! is_simple_expr = function
   (* inlined floating-point ops are simple if their arguments are *)
-  | Cop(Cextcall (fn, _, _, _), args, _) when List.mem fn inline_ops ->
+  | Cop(Cextcall (fn, _, _, _, _), args, _) when List.mem fn inline_ops ->
       List.for_all self#is_simple_expr args
   | e -> super#is_simple_expr e
 
 method! effects_of e =
   match e with
-  | Cop(Cextcall (fn, _, _, _), args, _) when List.mem fn inline_ops ->
+  | Cop(Cextcall (fn, _, _, _, _), args, _) when List.mem fn inline_ops ->
       Selectgen.Effect_and_coeffect.join_list_map args self#effects_of
   | e -> super#effects_of e
 
@@ -228,15 +233,15 @@ method! select_operation op args dbg =
           super#select_operation op args dbg
       end
   (* Recognize floating-point square root *)
-  | Cextcall("sqrt", _, _, _) ->
+  | Cextcall("sqrt", _, _, _, _) ->
       (Ispecific Isqrtf, args)
   (* Recognize bswap instructions *)
-  | Cextcall("caml_bswap16_direct", _, _, _) ->
+  | Cextcall("caml_bswap16_direct", _, _, _, _) ->
       (Ispecific(Ibswap 16), args)
-  | Cextcall("caml_int32_direct_bswap", _, _, _) ->
+  | Cextcall("caml_int32_direct_bswap", _, _, _, _) ->
       (Ispecific(Ibswap 32), args)
   | Cextcall(("caml_int64_direct_bswap"|"caml_nativeint_direct_bswap"),
-              _, _, _) ->
+              _, _, _, _) ->
       (Ispecific (Ibswap 64), args)
   (* Other operations are regular *)
   | _ ->
@@ -250,6 +255,10 @@ method select_logical op = function
   | args ->
       (Iintop op, args)
 
+method! insert_move_extcall_arg env ty_arg src dst =
+  if macosx && ty_arg = XInt32 && is_stack_slot dst
+  then self#insert env (Iop (Ispecific Imove32)) src dst
+  else self#insert_moves env src dst
 end
 
 let fundecl f = (new selector)#emit_fundecl f
diff --git a/asmcomp/cmm.ml b/asmcomp/cmm.ml
index d0fc52495e..249d1853ef 100644
--- a/asmcomp/cmm.ml
+++ b/asmcomp/cmm.ml
@@ -77,6 +77,21 @@ let ge_component comp1 comp2 =
   | Float, (Int | Addr | Val) ->
     assert false
 
+type exttype =
+  | XInt
+  | XInt32
+  | XInt64
+  | XFloat
+
+let machtype_of_exttype = function
+  | XInt -> typ_int
+  | XInt32 -> typ_int
+  | XInt64 -> if Arch.size_int = 4 then [|Int;Int|] else typ_int
+  | XFloat -> typ_float
+
+let machtype_of_exttype_list xtl =
+  Array.concat (List.map machtype_of_exttype xtl)
+
 type integer_comparison = Lambda.integer_comparison =
   | Ceq | Cne | Clt | Cgt | Cle | Cge
 
@@ -124,7 +139,7 @@ type memory_chunk =
 
 and operation =
     Capply of machtype
-  | Cextcall of string * machtype * bool * label option
+  | Cextcall of string * machtype * exttype list * bool * label option
     (** If specified, the given label will be placed immediately after the
         call (at the same place as any frame descriptor would reference). *)
   | Cload of
diff --git a/asmcomp/cmm.mli b/asmcomp/cmm.mli
index 2674717c7a..2dfe24f4e6 100644
--- a/asmcomp/cmm.mli
+++ b/asmcomp/cmm.mli
@@ -68,6 +68,17 @@ val ge_component
   -> machtype_component
   -> bool
 
+type exttype =
+  | XInt                                (**r OCaml value, word-sized integer *)
+  | XInt32                              (**r 32-bit integer *)
+  | XInt64                              (**r 64-bit integer  *)
+  | XFloat                              (**r double-precision FP number  *)
+(** A variant of [machtype] used to describe arguments
+    to external C functions *)
+
+val machtype_of_exttype: exttype -> machtype
+val machtype_of_exttype_list: exttype list -> machtype
+
 type integer_comparison = Lambda.integer_comparison =
   | Ceq | Cne | Clt | Cgt | Cle | Cge
 
@@ -127,7 +138,10 @@ type memory_chunk =
 
 and operation =
     Capply of machtype
-  | Cextcall of string * machtype * bool * label option
+  | Cextcall of string * machtype * exttype list * bool * label option
+      (** The [machtype] is the machine type of the result.
+          The [exttype list] describes the unboxing types of the arguments.
+          An empty list means "all arguments are machine words [XInt]". *)
   | Cload of
       { memory_chunk: memory_chunk
       ; mutability: Asttypes.mutable_flag
diff --git a/asmcomp/cmm_helpers.ml b/asmcomp/cmm_helpers.ml
index 54f745a8fe..367446e724 100644
--- a/asmcomp/cmm_helpers.ml
+++ b/asmcomp/cmm_helpers.ml
@@ -619,8 +619,8 @@ let rec remove_unit = function
       Clet(id, c1, remove_unit c2)
   | Cop(Capply _mty, args, dbg) ->
       Cop(Capply typ_void, args, dbg)
-  | Cop(Cextcall(proc, _mty, alloc, label_after), args, dbg) ->
-      Cop(Cextcall(proc, typ_void, alloc, label_after), args, dbg)
+  | Cop(Cextcall(proc, _ty_res, ty_args, alloc, label_after), args, dbg) ->
+      Cop(Cextcall(proc, typ_void, ty_args, alloc, label_after), args, dbg)
   | Cexit (_,_) as c -> c
   | Ctuple [] as c -> c
   | c -> Csequence(c, Ctuple [])
@@ -746,10 +746,10 @@ let float_array_ref arr ofs dbg =
   box_float dbg (unboxed_float_array_ref arr ofs dbg)
 
 let addr_array_set arr ofs newval dbg =
-  Cop(Cextcall("caml_modify_field", typ_void, false, None),
+  Cop(Cextcall("caml_modify_field", typ_void, [], false, None),
       [arr; untag_int ofs dbg; newval], dbg)
 let addr_array_initialize arr ofs newval dbg =
-  Cop(Cextcall("caml_initialize_field", typ_void, false, None),
+  Cop(Cextcall("caml_initialize_field", typ_void, [], false, None),
       [arr; untag_int ofs dbg; newval], dbg)
 let int_array_set arr ofs newval dbg =
   Cop(Cstore (Word_int, Lambda.Assignment),
@@ -785,7 +785,7 @@ let bigstring_length ba dbg =
 
 let lookup_tag obj tag dbg =
   bind "tag" tag (fun tag ->
-    Cop(Cextcall("caml_get_public_method", typ_val, false, None),
+    Cop(Cextcall("caml_get_public_method", typ_val, [], false, None),
         [obj; tag],
         dbg))
 
@@ -815,14 +815,14 @@ let make_alloc_generic set_fn dbg tag wordsize args =
     | e1::el -> Csequence(set_fn (Cvar id) (Cconst_int (idx, dbg)) e1 dbg,
                           fill_fields (idx + 2) el) in
     Clet(VP.create id,
-         Cop(Cextcall("caml_alloc", typ_val, true, None),
+         Cop(Cextcall("caml_alloc", typ_val, [], true, None),
                  [Cconst_int (wordsize, dbg); Cconst_int (tag, dbg)], dbg),
          fill_fields 1 args)
   end
 
 let make_alloc dbg tag args =
   let addr_array_init arr ofs newval dbg =
-    Cop(Cextcall("caml_initialize_field", typ_void, false, None),
+    Cop(Cextcall("caml_initialize_field", typ_void, [], false, None),
         [arr; untag_int ofs dbg; newval], dbg)
   in
   make_alloc_generic addr_array_init dbg tag (List.length args) args
@@ -2159,18 +2159,18 @@ let arraylength kind arg dbg =
       Cop(Cor, [float_array_length_shifted hdr dbg; Cconst_int (1, dbg)], dbg)
 
 let bbswap bi arg dbg =
-  let prim = match (bi : Primitive.boxed_integer) with
-    | Pnativeint -> "nativeint"
-    | Pint32 -> "int32"
-    | Pint64 -> "int64"
+  let prim, tyarg = match (bi : Primitive.boxed_integer) with
+    | Pnativeint -> "nativeint", XInt
+    | Pint32 -> "int32", XInt32
+    | Pint64 -> "int64", XInt64
   in
   Cop(Cextcall(Printf.sprintf "caml_%s_direct_bswap" prim,
-               typ_int, false, None),
+               typ_int, [tyarg], false, None),
       [arg],
       dbg)
 
 let bswap16 arg dbg =
-  (Cop(Cextcall("caml_bswap16_direct", typ_int, false, None),
+  (Cop(Cextcall("caml_bswap16_direct", typ_int, [], false, None),
        [arg],
        dbg))
 
@@ -2197,12 +2197,12 @@ let setfield n ptr init arg1 arg2 dbg =
   match assignment_kind ptr init with
   | Caml_modify ->
       return_unit dbg (Cop(Cextcall("caml_modify_field",
-                                    typ_void, false, None),
+                                    typ_void, [], false, None),
                       [arg1; Cconst_int (n, dbg); arg2],
                       dbg))
   | Caml_initialize ->
       return_unit dbg (Cop(Cextcall("caml_initialize_field",
-                                    typ_void, false, None),
+                                    typ_void, [], false, None),
                       [arg1; Cconst_int (n, dbg); arg2],
                       dbg))
   | Simple ->
diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
index 15cfd6c0b3..bea15d0b3f 100644
--- a/asmcomp/cmmgen.ml
+++ b/asmcomp/cmmgen.ml
@@ -729,7 +729,7 @@ and transl_catch env nfail ids body handler dbg =
 and transl_make_array dbg env kind args =
   match kind with
   | Pgenarray ->
-      Cop(Cextcall("caml_make_array", typ_val, true, None),
+      Cop(Cextcall("caml_make_array", typ_val, [], true, None),
           [make_alloc dbg 0 (List.map (transl env) args)], dbg)
   | Paddrarray | Pintarray ->
       make_alloc dbg 0 (List.map (transl env) args)
@@ -740,20 +740,32 @@ and transl_make_array dbg env kind args =
 and transl_ccall env prim args dbg =
   let transl_arg native_repr arg =
     match native_repr with
-    | Same_as_ocaml_repr -> transl env arg
-    | Unboxed_float -> transl_unbox_float dbg env arg
-    | Unboxed_integer bi -> transl_unbox_int dbg env bi arg
-    | Untagged_int -> untag_int (transl env arg) dbg
+    | Same_as_ocaml_repr ->
+        (XInt, transl env arg)
+    | Unboxed_float ->
+        (XFloat, transl_unbox_float dbg env arg)
+    | Unboxed_integer bi ->
+        let xty =
+          match bi with
+          | Pnativeint -> XInt
+          | Pint32 -> XInt32
+          | Pint64 -> XInt64 in
+        (xty, transl_unbox_int dbg env bi arg)
+    | Untagged_int ->
+        (XInt, untag_int (transl env arg) dbg)
   in
   let rec transl_args native_repr_args args =
     match native_repr_args, args with
     | [], args ->
         (* We don't require the two lists to be of the same length as
            [default_prim] always sets the arity to [0]. *)
-        List.map (transl env) args
-    | _, [] -> assert false
+        (List.map (fun _ -> XInt) args, List.map (transl env) args)
+    | _, [] ->
+        assert false
     | native_repr :: native_repr_args, arg :: args ->
-        transl_arg native_repr arg :: transl_args native_repr_args args
+        let (ty1, arg') = transl_arg native_repr arg in
+        let (tys, args') = transl_args native_repr_args args in
+        (ty1 :: tys, arg' :: args')
   in
   let typ_res, wrap_result =
     match prim.prim_native_repr_res with
@@ -764,10 +776,10 @@ and transl_ccall env prim args dbg =
     | Unboxed_integer bi -> (typ_int, box_int dbg bi)
     | Untagged_int -> (typ_int, (fun i -> tag_int i dbg))
   in
-  let args = transl_args prim.prim_native_repr_args args in
+  let typ_args, args = transl_args prim.prim_native_repr_args args in
   wrap_result
     (Cop(Cextcall(Primitive.native_name prim,
-                  typ_res, prim.prim_alloc, None), args, dbg))
+                  typ_res, typ_args, prim.prim_alloc, None), args, dbg))
 
 and transl_prim_1 env p arg dbg =
   match p with
@@ -1031,10 +1043,10 @@ and transl_prim_2 env p arg1 arg2 dbg =
                      [transl_unbox_int dbg env bi arg1;
                       transl_unbox_int dbg env bi arg2], dbg)) dbg
   | Patomic_exchange ->
-     Cop (Cextcall ("caml_atomic_exchange", typ_val, false, None),
+     Cop (Cextcall ("caml_atomic_exchange", typ_val, [], false, None),
           [transl env arg1; transl env arg2], dbg)
   | Patomic_fetch_add ->
-     Cop (Cextcall ("caml_atomic_fetch_add", typ_int, false, None),
+     Cop (Cextcall ("caml_atomic_fetch_add", typ_int, [], false, None),
           [transl env arg1; transl env arg2], dbg)
   | Prunstack | Pperform | Presume | Preperform | Ppoll | Pnop
   | Patomic_cas | Patomic_load _
@@ -1090,7 +1102,7 @@ and transl_prim_3 env p arg1 arg2 arg3 dbg =
         (transl_unbox_sized size dbg env arg3) dbg
 
   | Patomic_cas ->
-     Cop (Cextcall ("caml_atomic_cas", typ_int, false, None),
+     Cop (Cextcall ("caml_atomic_cas", typ_int, [], false, None),
           [transl env arg1; transl env arg2; transl env arg3], dbg)
 
   (* Effects *)
@@ -1351,7 +1363,7 @@ and transl_letrec env bindings cont =
       bindings
   in
   let op_alloc prim args =
-    Cop(Cextcall(prim, typ_val, true, None), args, dbg) in
+    Cop(Cextcall(prim, typ_val, [], true, None), args, dbg) in
   let rec init_blocks = function
     | [] -> fill_nonrec bsz
     | (id, _exp, RHS_block sz) :: rem ->
@@ -1377,7 +1389,7 @@ and transl_letrec env bindings cont =
     | [] -> cont
     | (id, exp, (RHS_block _ | RHS_infix _ | RHS_floatblock _)) :: rem ->
         let op =
-          Cop(Cextcall("caml_update_dummy", typ_void, false, None),
+          Cop(Cextcall("caml_update_dummy", typ_void, [], false, None),
               [Cvar (VP.var id); transl env exp], dbg) in
         Csequence(op, fill_blocks rem)
     | (_id, _exp, RHS_nonrec) :: rem ->
diff --git a/asmcomp/i386/proc.ml b/asmcomp/i386/proc.ml
index e3e114a688..5d3f0546cb 100644
--- a/asmcomp/i386/proc.ml
+++ b/asmcomp/i386/proc.ml
@@ -121,7 +121,7 @@ let calling_conventions first_int last_int first_float last_float make_stack
   let float = ref first_float in
   let ofs = ref (-64) in
   for i = 0 to Array.length arg - 1 do
-    match arg.(i).typ with
+    match arg.(i) with
       Val | Int | Addr as ty ->
         if !int <= last_int then begin
           loc.(i) <- phys_reg !int;
@@ -158,7 +158,7 @@ let loc_external_arguments _arg =
   fatal_error "Proc.loc_external_arguments"
 let loc_external_results res =
   match res with
-  | [|{typ=Int};{typ=Int}|] -> [|eax; edx|]
+  | [| Int; Int |] -> [|eax; edx|]
   | _ ->
       let (loc, _ofs) = calling_conventions 0 0 100 100 not_supported res in loc
 
diff --git a/asmcomp/i386/selection.ml b/asmcomp/i386/selection.ml
index 28049b7c0a..45bf40d9f3 100644
--- a/asmcomp/i386/selection.ml
+++ b/asmcomp/i386/selection.ml
@@ -89,7 +89,7 @@ let rec float_needs = function
       let n1 = float_needs arg1 in
       let n2 = float_needs arg2 in
       if n1 = n2 then 1 + n1 else if n1 > n2 then n1 else n2
-  | Cop(Cextcall(fn, _ty_res, _alloc, _label), args, _dbg)
+  | Cop(Cextcall(fn, _ty_res, _ty_args, _alloc, _label), args, _dbg)
     when !fast_math && List.mem fn inline_float_ops ->
       begin match args with
         [arg] -> float_needs arg
@@ -162,7 +162,7 @@ method is_immediate (_n : int) = true
 
 method! is_simple_expr e =
   match e with
-  | Cop(Cextcall(fn, _, _alloc, _), args, _)
+  | Cop(Cextcall(fn, _, _, _, _), args, _)
     when !fast_math && List.mem fn inline_float_ops ->
       (* inlined float ops are simple if their arguments are *)
       List.for_all self#is_simple_expr args
@@ -171,7 +171,7 @@ method! is_simple_expr e =
 
 method! effects_of e =
   match e with
-  | Cop(Cextcall(fn, _, _, _), args, _)
+  | Cop(Cextcall(fn, _, _, _, _), args, _)
     when !fast_math && List.mem fn inline_float_ops ->
       Selectgen.Effect_and_coeffect.join_list_map args self#effects_of
   | _ ->
@@ -233,7 +233,7 @@ method! select_operation op args dbg =
           super#select_operation op args dbg
       end
   (* Recognize inlined floating point operations *)
-  | Cextcall(fn, _ty_res, false, _label)
+  | Cextcall(fn, _ty_res, _ty_args, false, _label)
     when !fast_math && List.mem fn inline_float_ops ->
       (Ispecific(Ifloatspecial fn), args)
   (* i386 does not support immediate operands for multiply high signed *)
@@ -297,7 +297,7 @@ method select_push exp =
 method! mark_c_tailcall =
   contains_calls := true
 
-method! emit_extcall_args env args =
+method! emit_extcall_args env _ty_args args =
   let rec size_pushes = function
   | [] -> 0
   | e :: el -> Selectgen.size_expr env e + size_pushes el in
diff --git a/asmcomp/mach.ml b/asmcomp/mach.ml
index acd0e306ff..2383068a31 100644
--- a/asmcomp/mach.ml
+++ b/asmcomp/mach.ml
@@ -50,7 +50,10 @@ type operation =
   | Icall_imm of { func : string; label_after : label; }
   | Itailcall_ind of { label_after : label; }
   | Itailcall_imm of { func : string; label_after : label; }
-  | Iextcall of { func : string; alloc : bool; label_after : label; stack_ofs : int; }
+  | Iextcall of { func : string;
+                  ty_res : Cmm.machtype; ty_args : Cmm.exttype list;
+                  alloc : bool; label_after : label;
+                  stack_ofs : int; }
   | Istackoffset of int
   | Iload of Cmm.memory_chunk * Arch.addressing_mode
   | Istore of Cmm.memory_chunk * Arch.addressing_mode * bool
diff --git a/asmcomp/mach.mli b/asmcomp/mach.mli
index 96a16077e4..51276e2d11 100644
--- a/asmcomp/mach.mli
+++ b/asmcomp/mach.mli
@@ -57,8 +57,10 @@ type operation =
   | Icall_imm of { func : string; label_after : label; }
   | Itailcall_ind of { label_after : label; }
   | Itailcall_imm of { func : string; label_after : label; }
-  | Iextcall of { func : string; alloc : bool; label_after : label;
-                  stack_ofs : int}
+  | Iextcall of { func : string;
+                  ty_res : Cmm.machtype; ty_args : Cmm.exttype list;
+                  alloc : bool; label_after : label;
+                  stack_ofs : int; }
   | Istackoffset of int
   | Iload of Cmm.memory_chunk * Arch.addressing_mode
   | Istore of Cmm.memory_chunk * Arch.addressing_mode * bool
diff --git a/asmcomp/power/proc.ml b/asmcomp/power/proc.ml
index 3bcd12fcbf..5ee902f6ac 100644
--- a/asmcomp/power/proc.ml
+++ b/asmcomp/power/proc.ml
@@ -95,107 +95,81 @@ let loc_spacetime_node_hole = Reg.dummy  (* Spacetime unsupported *)
 
 (* Calling conventions *)
 
-let calling_conventions
-    first_int last_int first_float last_float
-    make_stack stack_ofs reg_use_stack arg =
-  let loc = Array.make (Array.length arg) [| Reg.dummy |] in
+let loc_int last_int make_stack reg_use_stack int ofs =
+  if !int <= last_int then begin
+    let l = phys_reg !int in
+    incr int;
+    if reg_use_stack then ofs := !ofs + size_int;
+    l
+  end else begin
+    let l = stack_slot (make_stack !ofs) Int in
+    ofs := !ofs + size_int; l
+  end
+
+let loc_float last_float make_stack reg_use_stack int float ofs =
+  if !float <= last_float then begin
+    let l = phys_reg !float in
+    incr float;
+    (* On 64-bit platforms, passing a float in a float register
+       reserves a normal register as well *)
+    if size_int = 8 then incr int;
+    if reg_use_stack then ofs := !ofs + size_float;
+    l
+  end else begin
+    ofs := Misc.align !ofs size_float;
+    let l = stack_slot (make_stack !ofs) Float in
+    ofs := !ofs + size_float; l
+  end
+
+let loc_int_pair last_int make_stack int ofs =
+  (* 64-bit quantities split across two registers must either be in a
+     consecutive pair of registers where the lowest numbered is an
+     even-numbered register; or in a stack slot that is 8-byte aligned. *)
+  int := Misc.align !int 2;
+  if !int <= last_int - 1 then begin
+    let reg_lower = phys_reg !int in
+    let reg_upper = phys_reg (1 + !int) in
+    int := !int + 2;
+    [| reg_lower; reg_upper |]
+  end else begin
+    ofs := Misc.align !ofs 8;
+    let stack_lower = stack_slot (make_stack !ofs) Int in
+    let stack_upper = stack_slot (make_stack (size_int + !ofs)) Int in
+    ofs := !ofs + 8;
+    [| stack_lower; stack_upper |]
+  end
+
+let calling_conventions first_int last_int first_float last_float make_stack
+      arg =
+  let loc = Array.make (Array.length arg) Reg.dummy in
   let int = ref first_int in
   let float = ref first_float in
-  let ofs = ref stack_ofs in
+  let ofs = ref 0 in
   for i = 0 to Array.length arg - 1 do
     match arg.(i) with
-    | [| arg |] ->
-      begin match arg.typ with
-      | Val | Int | Addr as ty ->
-          if !int <= last_int then begin
-            loc.(i) <- [| phys_reg !int |];
-            incr int;
-            if reg_use_stack then ofs := !ofs + size_int
-          end else begin
-            loc.(i) <- [| stack_slot (make_stack !ofs) ty |];
-            ofs := !ofs + size_int
-          end
-      | Float ->
-          if !float <= last_float then begin
-            loc.(i) <- [| phys_reg !float |];
-            incr float;
-            (* On 64-bit platforms, passing a float in a float register
-               reserves a normal register as well *)
-            if size_int = 8 then incr int;
-            if reg_use_stack then ofs := !ofs + size_float
-          end else begin
-            ofs := Misc.align !ofs size_float;
-            loc.(i) <- [| stack_slot (make_stack !ofs) Float |];
-            ofs := !ofs + size_float
-          end
-      end
-    | [| arg1; arg2 |] ->
-      (* Passing of 64-bit quantities to external functions
-         on 32-bit platform. *)
-      assert (size_int = 4);
-      begin match arg1.typ, arg2.typ with
-      | Int, Int ->
-          (* 64-bit quantities split across two registers must either be in a
-             consecutive pair of registers where the lowest numbered is an
-             even-numbered register; or in a stack slot that is 8-byte
-             aligned. *)
-          int := Misc.align !int 2;
-          if !int <= last_int - 1 then begin
-            let reg_lower = phys_reg !int in
-            let reg_upper = phys_reg (!int + 1) in
-            loc.(i) <- [| reg_lower; reg_upper |];
-            int := !int + 2
-          end else begin
-            let size_int64 = 8 in
-            ofs := Misc.align !ofs size_int64;
-            let ofs_lower = !ofs in
-            let ofs_upper = !ofs + size_int in
-            let stack_lower = stack_slot (make_stack ofs_lower) Int in
-            let stack_upper = stack_slot (make_stack ofs_upper) Int in
-            loc.(i) <- [| stack_lower; stack_upper |];
-            ofs := !ofs + size_int64
-          end
-      | _, _ ->
-        let f = function Int -> "I" | Addr -> "A" | Val -> "V" | Float -> "F" in
-        fatal_error (Printf.sprintf "Proc.calling_conventions: bad register \
-            type(s) for multi-register argument: %s, %s"
-          (f arg1.typ) (f arg2.typ))
-      end
-    | _ ->
-      fatal_error "Proc.calling_conventions: bad number of registers for \
-                   multi-register argument"
+    | Val | Int | Addr ->
+        loc.(i) <- loc_int last_int make_stack false int ofs
+    | Float ->
+        loc.(i) <- loc_float last_float make_stack false int float ofs
   done;
-  (loc, Misc.align !ofs 16)
-  (* Keep stack 16-aligned. *)
+  (loc, Misc.align !ofs 16)  (* keep stack 16-aligned *)
 
 let incoming ofs = Incoming ofs
 let outgoing ofs = Outgoing ofs
 let not_supported _ofs = fatal_error "Proc.loc_results: cannot call"
 
-let single_regs arg = Array.map (fun arg -> [| arg |]) arg
-let ensure_single_regs res =
-  Array.map (function
-      | [| res |] -> res
-      | _ -> failwith "Proc.ensure_single_regs")
-    res
-
 let max_arguments_for_tailcalls = 8
 
 let loc_arguments arg =
-  let (loc, ofs) =
-    calling_conventions 0 7 100 112 outgoing 0 false (single_regs arg)
-  in
-  (ensure_single_regs loc, ofs)
+    calling_conventions 0 7 100 112 outgoing arg
+
 let loc_parameters arg =
-  let (loc, _ofs) =
-    calling_conventions 0 7 100 112 incoming 0 false (single_regs arg)
-  in
-  ensure_single_regs loc
+  let (loc, _ofs) = calling_conventions 0 7 100 112 incoming arg
+  in loc
+
 let loc_results res =
-  let (loc, _ofs) =
-    calling_conventions 0 7 100 112 not_supported 0 false (single_regs res)
-  in
-  ensure_single_regs loc
+  let (loc, _ofs) = calling_conventions 0 7 100 112 not_supported res
+  in loc
 
 (* C calling conventions for ELF32:
      use GPR 3-10 and FPR 1-8 just like ML calling conventions.
@@ -223,19 +197,43 @@ let loc_results res =
      and need not appear here.
 *)
 
-let loc_external_arguments =
+let external_calling_conventions
+    first_int last_int first_float last_float
+    make_stack stack_ofs reg_use_stack ty_args =
+  let loc = Array.make (List.length ty_args) [| Reg.dummy |] in
+  let int = ref first_int in
+  let float = ref first_float in
+  let ofs = ref stack_ofs in
+  List.iteri
+    (fun i ty_arg ->
+      match ty_arg with
+      | XInt | XInt32 ->
+        loc.(i) <-
+          [| loc_int last_int make_stack reg_use_stack int ofs |]
+      | XInt64 ->
+          if size_int = 4 then begin
+            assert (not reg_use_stack);
+            loc.(i) <- loc_int_pair last_int make_stack int ofs
+          end else
+            loc.(i) <-
+              [| loc_int last_int make_stack reg_use_stack int ofs |]
+      | XFloat ->
+        loc.(i) <-
+          [| loc_float last_float make_stack reg_use_stack int float ofs |])
+    ty_args;
+  (loc, Misc.align !ofs 16) (* Keep stack 16-aligned *)
+
+let loc_external_arguments ty_args =
   match abi with
   | ELF32 ->
-      calling_conventions 0 7 100 107 outgoing 8 false
+      external_calling_conventions 0 7 100 107 outgoing 8 false ty_args
   | ELF64v1 ->
-      fun args ->
       let (loc, ofs) =
-        calling_conventions 0 7 100 112 outgoing 0 true args in
+        external_calling_conventions 0 7 100 112 outgoing 0 true ty_args in
       (loc, max ofs 64)
   | ELF64v2 ->
-      fun args ->
       let (loc, ofs) =
-        calling_conventions 0 7 100 112 outgoing 0 true args in
+        external_calling_conventions 0 7 100 112 outgoing 0 true ty_args in
       if Array.fold_left
            (fun stk r ->
               assert (Array.length r = 1);
@@ -249,10 +247,8 @@ let loc_external_arguments =
 (* Results are in GPR 3 and FPR 1 *)
 
 let loc_external_results res =
-  let (loc, _ofs) =
-    calling_conventions 0 1 100 100 not_supported 0 false (single_regs res)
-  in
-  ensure_single_regs loc
+  let (loc, _ofs) = calling_conventions 0 1 100 100 not_supported res
+  in loc
 
 (* Exceptions are in GPR 3 *)
 
diff --git a/asmcomp/printcmm.ml b/asmcomp/printcmm.ml
index 3f6178ec98..9814b42e1b 100644
--- a/asmcomp/printcmm.ml
+++ b/asmcomp/printcmm.ml
@@ -39,6 +39,21 @@ let machtype ppf mty =
            fprintf ppf "*%a" machtype_component mty.(i)
          done
 
+let exttype ppf = function
+  | XInt -> fprintf ppf "int"
+  | XInt32 -> fprintf ppf "int32"
+  | XInt64 -> fprintf ppf "int64"
+  | XFloat -> fprintf ppf "float"
+
+let extcall_signature ppf (ty_res, ty_args) =
+  begin match ty_args with
+  | [] -> ()
+  | ty_arg1 :: ty_args ->
+      exttype ppf ty_arg1;
+      List.iter (fun ty -> fprintf ppf ",%a" exttype ty) ty_args
+  end;
+  fprintf ppf "->%a" machtype ty_res
+
 let integer_comparison = function
   | Ceq -> "=="
   | Cne -> "!="
@@ -101,7 +116,7 @@ let location d =
 
 let operation d = function
   | Capply _ty -> "app" ^ location d
-  | Cextcall(lbl, _ty, _alloc, _) ->
+  | Cextcall(lbl, _ty_res, _ty_args, _alloc, _) ->
       Printf.sprintf "extcall \"%s\"%s" lbl (location d)
   | Cload {memory_chunk; mutability} -> (
     match mutability with
@@ -211,7 +226,8 @@ let rec expr ppf = function
       List.iter (fun e -> fprintf ppf "@ %a" expr e) el;
       begin match op with
       | Capply mty -> fprintf ppf "@ %a" machtype mty
-      | Cextcall(_, mty, _, _) -> fprintf ppf "@ %a" machtype mty
+      | Cextcall(_, ty_res, ty_args, _, _) ->
+          fprintf ppf "@ %a" extcall_signature (ty_res, ty_args)
       | _ -> ()
       end;
       fprintf ppf ")@]"
diff --git a/asmcomp/printcmm.mli b/asmcomp/printcmm.mli
index 462239ac82..f88d8866cb 100644
--- a/asmcomp/printcmm.mli
+++ b/asmcomp/printcmm.mli
@@ -19,7 +19,9 @@ open Format
 
 val rec_flag : formatter -> Cmm.rec_flag -> unit
 val machtype_component : formatter -> Cmm.machtype_component -> unit
-val machtype : formatter -> Cmm.machtype_component array -> unit
+val machtype : formatter -> Cmm.machtype -> unit
+val exttype : formatter -> Cmm.exttype -> unit
+val extcall_signature : formatter -> Cmm.machtype * Cmm.exttype list -> unit
 val integer_comparison : Cmm.integer_comparison -> string
 val float_comparison : Cmm.float_comparison -> string
 val chunk : Cmm.memory_chunk -> string
diff --git a/asmcomp/proc.mli b/asmcomp/proc.mli
index 91b15de45c..835ca1d0a6 100644
--- a/asmcomp/proc.mli
+++ b/asmcomp/proc.mli
@@ -28,16 +28,14 @@ val phys_reg: int -> Reg.t
 val rotate_registers: bool
 
 (* Calling conventions *)
-val loc_arguments: Reg.t array -> Reg.t array * int
-val loc_results: Reg.t array -> Reg.t array
-val loc_parameters: Reg.t array -> Reg.t array
+val loc_arguments: Cmm.machtype -> Reg.t array * int
+val loc_results: Cmm.machtype -> Reg.t array
+val loc_parameters: Cmm.machtype -> Reg.t array
 (* For argument number [n] split across multiple registers, the target-specific
    implementation of [loc_external_arguments] must return [regs] such that
-   [regs.(n).(0)] is to hold the part of the value at the lowest address.
-   (All that matters for the input to [loc_external_arguments] is the pattern
-   of lengths and register types of the various supplied arrays.) *)
-val loc_external_arguments: Reg.t array array -> Reg.t array array * int
-val loc_external_results: Reg.t array -> Reg.t array
+   [regs.(n).(0)] is to hold the part of the value at the lowest address. *)
+val loc_external_arguments: Cmm.exttype list -> Reg.t array array * int
+val loc_external_results: Cmm.machtype -> Reg.t array
 val loc_exn_bucket: Reg.t
 val loc_spacetime_node_hole: Reg.t
 
diff --git a/asmcomp/reg.ml b/asmcomp/reg.ml
index 3c9c09ac1f..bc36dc9962 100644
--- a/asmcomp/reg.ml
+++ b/asmcomp/reg.ml
@@ -117,6 +117,9 @@ let at_location ty loc =
   incr currstamp;
   r
 
+let typv rv =
+  Array.map (fun r -> r.typ) rv
+
 let anonymous t =
   match Raw_name.to_string t.raw_name with
   | None -> true
diff --git a/asmcomp/reg.mli b/asmcomp/reg.mli
index d89d02ce19..89b4e4220b 100644
--- a/asmcomp/reg.mli
+++ b/asmcomp/reg.mli
@@ -49,7 +49,7 @@ val createv: Cmm.machtype -> t array
 val createv_like: t array -> t array
 val clone: t -> t
 val at_location: Cmm.machtype_component -> location -> t
-
+val typv: t array -> Cmm.machtype
 val anonymous : t -> bool
 
 (* Name for printing *)
diff --git a/asmcomp/riscv/proc.ml b/asmcomp/riscv/proc.ml
index 4c7b586120..502cbb1588 100644
--- a/asmcomp/riscv/proc.ml
+++ b/asmcomp/riscv/proc.ml
@@ -127,7 +127,7 @@ let calling_conventions
   let float = ref first_float in
   let ofs = ref 0 in
   for i = 0 to Array.length arg - 1 do
-    match arg.(i).typ with
+    match arg.(i) with
     | Val | Int | Addr as ty ->
         if !int <= last_int then begin
           loc.(i) <- phys_reg !int;
@@ -161,13 +161,6 @@ let loc_spacetime_node_hole = Reg.dummy  (* Spacetime unsupported *)
      remaining args on stack.
    Return values in a0 .. a7, s2 .. s9 or fa0 .. fa7, fs2 .. fs9. *)
 
-let single_regs arg = Array.map (fun arg -> [| arg |]) arg
-let ensure_single_regs res =
-  Array.map (function
-      | [| res |] -> res
-      | _ -> failwith "proc.ensure_single_regs"
-    ) res
-
 let loc_arguments arg =
   calling_conventions 0 15 110 125 outgoing arg
 
@@ -199,42 +192,35 @@ let external_calling_conventions
   let ofs = ref 0 in
   for i = 0 to Array.length arg - 1 do
     match arg.(i) with
-    | [| arg |] ->
-        begin match arg.typ with
-        | Val | Int | Addr as ty ->
-            if !int <= last_int then begin
-              loc.(i) <- [| phys_reg !int |];
-              incr int
-            end else begin
-              loc.(i) <- [| stack_slot (make_stack !ofs) ty |];
-              ofs := !ofs + size_int
-            end
-        | Float ->
-            if !float <= last_float then begin
-              loc.(i) <- [| phys_reg !float |];
-              incr float
-            end else if !int <= last_int then begin
-              loc.(i) <- [| phys_reg !int |];
-              incr int
-            end else begin
-              loc.(i) <- [| stack_slot (make_stack !ofs) Float |];
-              ofs := !ofs + size_float
-            end
+    | Val | Int | Addr as ty ->
+        if !int <= last_int then begin
+          loc.(i) <- [| phys_reg !int |];
+          incr int
+        end else begin
+          loc.(i) <- [| stack_slot (make_stack !ofs) ty |];
+          ofs := !ofs + size_int
+        end
+    | Float ->
+        if !float <= last_float then begin
+          loc.(i) <- [| phys_reg !float |];
+          incr float
+        end else if !int <= last_int then begin
+          loc.(i) <- [| phys_reg !int |];
+          incr int
+        end else begin
+          loc.(i) <- [| stack_slot (make_stack !ofs) Float |];
+          ofs := !ofs + size_float
         end
-    | _ ->
-        fatal_error "Proc.calling_conventions: bad number of register for \
-                     multi-register argument"
   done;
   (loc, Misc.align !ofs 16) (* Keep stack 16-aligned. *)
 
-let loc_external_arguments arg =
+let loc_external_arguments ty_args =
+  let arg = Cmm.machtype_of_exttype_list ty_args in
   external_calling_conventions 0 7 110 117 outgoing arg
 
 let loc_external_results res =
-  let (loc, _ofs) =
-    external_calling_conventions 0 1 110 111 not_supported (single_regs res)
-  in
-  ensure_single_regs loc
+  let (loc, _ofs) = calling_conventions 0 1 110 111 not_supported res
+  in loc
 
 (* Exceptions are in a0 *)
 
diff --git a/asmcomp/s390x/proc.ml b/asmcomp/s390x/proc.ml
index 9f0dff2132..2c6c357338 100644
--- a/asmcomp/s390x/proc.ml
+++ b/asmcomp/s390x/proc.ml
@@ -105,7 +105,7 @@ let calling_conventions
   let float = ref first_float in
   let ofs = ref stack_ofs in
   for i = 0 to Array.length arg - 1 do
-    match arg.(i).typ with
+    match arg.(i) with
     | Val | Int | Addr as ty ->
         if !int <= last_int then begin
           loc.(i) <- phys_reg !int;
@@ -145,11 +145,9 @@ let loc_results res =
      Always reserve 160 bytes at bottom of stack, plus whatever is needed
      to hold the overflow arguments. *)
 
-let loc_external_arguments arg =
-  let arg =
-    Array.map (fun regs -> assert (Array.length regs = 1); regs.(0)) arg in
-  let (loc, ofs) =
-    calling_conventions 0 4 100 103 outgoing 160 arg in
+let loc_external_arguments ty_args =
+  let arg = Cmm.machtype_of_exttype_list ty_args in
+  let (loc, ofs) = calling_conventions 0 4 100 103 outgoing 160 arg in
   (Array.map (fun reg -> [|reg|]) loc, ofs)
 
 (* Results are in GPR 2 and FPR 0 *)
diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml
index 0299aca387..da8e003a5a 100644
--- a/asmcomp/selectgen.ml
+++ b/asmcomp/selectgen.ml
@@ -66,7 +66,7 @@ let env_empty = {
 
 let oper_result_type = function
     Capply ty -> ty
-  | Cextcall(_s, ty, _alloc, _) -> ty
+  | Cextcall(_s, ty_res, _ty_args, _alloc, _) -> ty_res
   | Cload {memory_chunk} ->
       begin match memory_chunk with
       | Word_val -> typ_val
@@ -448,13 +448,13 @@ method select_operation op args _dbg =
   | (Capply _, _) ->
     let label_after = Cmm.new_label () in
     (Icall_ind { label_after; }, args)
-  | (Cextcall(func, _ty, alloc, label_after), _) ->
+  | (Cextcall(func, ty_res, ty_args, alloc, label_after), _) ->
     let label_after =
       match label_after with
       | None -> Cmm.new_label ()
       | Some label_after -> label_after
     in
-    Iextcall { func; alloc; label_after; stack_ofs = -1}, args
+    Iextcall { func; alloc; ty_res; ty_args; label_after; stack_ofs = -1}, args
   | (Cload {memory_chunk}, [arg]) ->
       let (addr, eloc) = self#select_addressing memory_chunk arg in
       (Iload(memory_chunk, addr), [eloc])
@@ -722,8 +722,8 @@ method emit_expr (env:environment) exp =
               let r1 = self#emit_tuple env new_args in
               let rarg = Array.sub r1 1 (Array.length r1 - 1) in
               let rd = self#regs_for ty in
-              let (loc_arg, stack_ofs) = Proc.loc_arguments rarg in
-              let loc_res = Proc.loc_results rd in
+              let (loc_arg, stack_ofs) = Proc.loc_arguments (Reg.typv rarg) in
+              let loc_res = Proc.loc_results (Reg.typv rd) in
               let spacetime_reg =
                 self#about_to_emit_call env (Iop new_op) [| r1.(0) |] dbg
               in
@@ -736,8 +736,8 @@ method emit_expr (env:environment) exp =
           | Icall_imm _ ->
               let r1 = self#emit_tuple env new_args in
               let rd = self#regs_for ty in
-              let (loc_arg, stack_ofs) = Proc.loc_arguments r1 in
-              let loc_res = Proc.loc_results rd in
+              let (loc_arg, stack_ofs) = Proc.loc_arguments (Reg.typv r1) in
+              let loc_res = Proc.loc_results (Reg.typv rd) in
               let spacetime_reg =
                 self#about_to_emit_call env (Iop new_op) [| |] dbg
               in
@@ -748,14 +748,14 @@ method emit_expr (env:environment) exp =
               Some rd
           | Iextcall r ->
               let spacetime_reg =
-                self#about_to_emit_call env (Iop new_op) [| |] dbg
-              in
-              let (loc_arg, stack_ofs) = self#emit_extcall_args env new_args in
+                self#about_to_emit_call env (Iop new_op) [| |] dbg in
+              let (loc_arg, stack_ofs) =
+                self#emit_extcall_args env r.ty_args new_args in
               self#maybe_emit_spacetime_move env ~spacetime_reg;
               let rd = self#regs_for ty in
               let loc_res =
                 self#insert_op_debug env (Iextcall {r with stack_ofs = stack_ofs}) dbg
-                  loc_arg (Proc.loc_external_results rd) in
+                  loc_arg (Proc.loc_external_results (Reg.typv rd)) in
               self#insert_move_results env loc_res rd stack_ofs;
               Some rd
           | Ialloc { bytes = _; spacetime_index; label_after_call_gc; } ->
@@ -894,7 +894,7 @@ method private bind_let (env:environment) v r1 =
   end
 
 method private bind_let_mut (env:environment) v k r1 =
-  let rv = Reg.createv k in
+  let rv = self#regs_for k in
   name_regs v rv;
   self#insert_moves env r1 rv;
   env_add ~mut:Mutable v rv env
@@ -1003,19 +1003,26 @@ method private emit_tuple_not_flattened env exp_list =
 method private emit_tuple env exp_list =
   Array.concat (self#emit_tuple_not_flattened env exp_list)
 
-method emit_extcall_args env args =
+method emit_extcall_args env ty_args args =
   let args = self#emit_tuple_not_flattened env args in
-  let arg_hard_regs, stack_ofs =
-    Proc.loc_external_arguments (Array.of_list args)
-  in
-  (* Flattening [args] and [arg_hard_regs] causes parts of values split
-     across multiple registers to line up correctly, by virtue of the
-     semantics of [split_int64_for_32bit_target] in cmmgen.ml, and the
-     required semantics of [loc_external_arguments] (see proc.mli). *)
-  let args = Array.concat args in
-  let arg_hard_regs = Array.concat (Array.to_list arg_hard_regs) in
-  self#insert_move_args env args arg_hard_regs stack_ofs;
-  arg_hard_regs, stack_ofs
+  let ty_args =
+    if ty_args = [] then List.map (fun _ -> XInt) args else ty_args in
+  let locs, stack_ofs = Proc.loc_external_arguments ty_args in
+  let ty_args = Array.of_list ty_args in
+  if stack_ofs <> 0 then
+    self#insert env (Iop(Istackoffset stack_ofs)) [||] [||];
+  List.iteri
+    (fun i arg ->
+      self#insert_move_extcall_arg env ty_args.(i) arg locs.(i))
+    args;
+  Array.concat (Array.to_list locs), stack_ofs
+
+method insert_move_extcall_arg env _ty_arg src dst =
+  (* The default implementation is one or two ordinary moves.
+     (Two in the case of an int64 argument on a 32-bit platform.)
+     It can be overriden to use special move instructions,
+     for example a "32-bit move" instruction for int32 arguments. *)
+  self#insert_moves env src dst
 
 method emit_stores env data regs_addr =
   let a =
@@ -1047,7 +1054,7 @@ method private emit_return (env:environment) exp =
   match self#emit_expr env exp with
     None -> ()
   | Some r ->
-      let loc = Proc.loc_results r in
+      let loc = Proc.loc_results (Reg.typv r) in
       self#insert_moves env r loc;
       self#insert env Ireturn loc [||]
 
@@ -1074,7 +1081,7 @@ method emit_tail (env:environment) exp =
             Icall_ind { label_after; } ->
               let r1 = self#emit_tuple env new_args in
               let rarg = Array.sub r1 1 (Array.length r1 - 1) in
-              let (loc_arg, stack_ofs) = Proc.loc_arguments rarg in
+              let (loc_arg, stack_ofs) = Proc.loc_arguments (Reg.typv rarg) in
               if stack_ofs = 0 then begin
                 let call = Iop (Itailcall_ind { label_after; }) in
                 let spacetime_reg =
@@ -1086,7 +1093,7 @@ method emit_tail (env:environment) exp =
                             (Array.append [|r1.(0)|] loc_arg) [||];
               end else begin
                 let rd = self#regs_for ty in
-                let loc_res = Proc.loc_results rd in
+                let loc_res = Proc.loc_results (Reg.typv rd) in
                 let spacetime_reg =
                   self#about_to_emit_call env (Iop new_op) [| r1.(0) |] dbg
                 in
@@ -1099,7 +1106,7 @@ method emit_tail (env:environment) exp =
               end
           | Icall_imm { func; label_after; } ->
               let r1 = self#emit_tuple env new_args in
-              let (loc_arg, stack_ofs) = Proc.loc_arguments r1 in
+              let (loc_arg, stack_ofs) = Proc.loc_arguments (Reg.typv r1) in
               if stack_ofs = 0 then begin
                 let call = Iop (Itailcall_imm { func; label_after; }) in
                 let spacetime_reg =
@@ -1110,7 +1117,7 @@ method emit_tail (env:environment) exp =
                 self#insert_debug env call dbg loc_arg [||];
               end else if func = !current_function_name then begin
                 let call = Iop (Itailcall_imm { func; label_after; }) in
-                let loc_arg' = Proc.loc_parameters r1 in
+                let loc_arg' = Proc.loc_parameters (Reg.typv r1) in
                 let spacetime_reg =
                   self#about_to_emit_call env call [| |] dbg
                 in
@@ -1119,7 +1126,7 @@ method emit_tail (env:environment) exp =
                 self#insert_debug env call dbg loc_arg' [||];
               end else begin
                 let rd = self#regs_for ty in
-                let loc_res = Proc.loc_results rd in
+                let loc_res = Proc.loc_results (Reg.typv rd) in
                 let spacetime_reg =
                   self#about_to_emit_call env (Iop new_op) [| |] dbg
                 in
@@ -1194,7 +1201,7 @@ method emit_tail (env:environment) exp =
       begin match opt_r1 with
         None -> ()
       | Some r1 ->
-          let loc = Proc.loc_results r1 in
+          let loc = Proc.loc_results (Reg.typv r1) in
           self#insert_moves env r1 loc;
           self#insert env Ireturn loc [||]
       end
@@ -1229,7 +1236,7 @@ method emit_fundecl f =
       (fun (id, ty) -> let r = self#regs_for ty in name_regs id r; r)
       f.Cmm.fun_args in
   let rarg = Array.concat rargs in
-  let loc_arg = Proc.loc_parameters rarg in
+  let loc_arg = Proc.loc_parameters (Reg.typv rarg) in
   (* To make it easier to add the Spacetime instrumentation code, we
      first emit the body and extract the resulting instruction sequence;
      then we emit the prologue followed by any Spacetime instrumentation.  The
@@ -1273,9 +1280,8 @@ end
 *)
 
 let is_tail_call nargs =
-  assert (Reg.dummy.typ = Int);
-  let args = Array.make (nargs + 1) Reg.dummy in
-  let (_loc_arg, stack_ofs) = Proc.loc_arguments args in
+  let ty = Array.make (nargs + 1) Int in
+  let (_loc_arg, stack_ofs) = Proc.loc_arguments ty in
   stack_ofs = 0
 
 let _ =
diff --git a/asmcomp/selectgen.mli b/asmcomp/selectgen.mli
index 3e5b294ed1..bb21b5c10a 100644
--- a/asmcomp/selectgen.mli
+++ b/asmcomp/selectgen.mli
@@ -97,8 +97,13 @@ class virtual selector_generic : object
       -> Reg.t array -> Reg.t array
     (* Can be overridden to deal with 2-address instructions
        or instructions with hardwired input/output registers *)
+  method insert_move_extcall_arg :
+    environment -> Cmm.exttype -> Reg.t array -> Reg.t array -> unit
+    (* Can be overriden to deal with unusual unboxed calling conventions,
+       e.g. on a 64-bit platform, passing unboxed 32-bit arguments
+       in 32-bit stack slots. *)
   method emit_extcall_args :
-    environment -> Cmm.expression list -> Reg.t array * int
+    environment -> Cmm.exttype list -> Cmm.expression list -> Reg.t array * int
     (* Can be overridden to deal with stack-based calling conventions *)
   method emit_stores :
     environment -> Cmm.expression list -> Reg.t array -> unit
diff --git a/asmcomp/spacetime_profiling.ml b/asmcomp/spacetime_profiling.ml
index 21a9cb4955..9b6e649058 100644
--- a/asmcomp/spacetime_profiling.ml
+++ b/asmcomp/spacetime_profiling.ml
@@ -115,7 +115,7 @@ let code_for_function_prologue ~function_name ~fun_dbg:dbg ~node_hole =
           Clet (VP.create is_new_node,
             Clet (VP.create pc, cconst_symbol function_name,
               Cop (Cextcall ("caml_spacetime_allocate_node",
-                  [| Int |], false, None),
+                  typ_int, [], false, None),
                 [cconst_int (1 (* header *) + !index_within_node);
                 Cvar pc;
                 Cvar node_hole;
@@ -155,7 +155,7 @@ let code_for_blockheader ~value's_header ~node ~dbg =
        the latter table to be used for resolving a program counter at such
        a point to a location.
     *)
-    Cop (Cextcall ("caml_spacetime_generate_profinfo", [| Int |],
+    Cop (Cextcall ("caml_spacetime_generate_profinfo", typ_int, [],
         false, Some label),
       [Cvar address_of_profinfo;
        cconst_int (index_within_node + 1)],
@@ -276,7 +276,7 @@ let code_for_call ~node ~callee ~is_tail ~label dbg =
         else cconst_int 1  (* [Val_unit] *)
       in
       Cop (Cextcall ("caml_spacetime_indirect_node_hole_ptr",
-          [| Int |], false, None),
+           typ_int, [], false, None),
         [callee; Cvar place_within_node; caller_node],
         dbg))
 
@@ -340,7 +340,7 @@ class virtual instruction_selection = object (self)
         assert (Array.length arg = 1);
         self#instrument_indirect_call ~env ~callee:arg.(0)
           ~is_tail:true ~label_after dbg
-      | M.Iop (M.Iextcall { func; alloc = true; label_after; stack_ofs = _; }) ->
+      | M.Iop (M.Iextcall { func; alloc = true; label_after; _ }) ->
         (* N.B. No need to instrument "noalloc" external calls. *)
         assert (Array.length arg = 0);
         self#instrument_direct_call ~env ~func ~is_tail:false ~label_after dbg
diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml
index 00de894ea3..b8c874b234 100644
--- a/bytecomp/bytelink.ml
+++ b/bytecomp/bytelink.ml
@@ -188,7 +188,7 @@ let check_consistency file_name cu =
   begin try
     let source = List.assoc cu.cu_name !implementations_defined in
     Location.prerr_warning (Location.in_file file_name)
-      (Warnings.Multiple_definition(cu.cu_name,
+      (Warnings.Module_linked_twice(cu.cu_name,
                                     Location.show_filename file_name,
                                     Location.show_filename source))
   with Not_found -> ()
diff --git a/configure b/configure
index 4d86d02e7c..fc1f5a234b 100755
--- a/configure
+++ b/configure
@@ -13011,13 +13011,6 @@ if test "x$ac_cv_header_stdint_h" = xyes; then :
 fi
 
 
-ac_fn_c_check_header_mongrel "$LINENO" "sys/shm.h" "ac_cv_header_sys_shm_h" "$ac_includes_default"
-if test "x$ac_cv_header_sys_shm_h" = xyes; then :
-  $as_echo "#define HAS_SYS_SHM_H 1" >>confdefs.h
-
-fi
-
-
 ac_fn_c_check_header_compile "$LINENO" "dirent.h" "ac_cv_header_dirent_h" "#include <sys/types.h>
 "
 if test "x$ac_cv_header_dirent_h" = xyes; then :
@@ -15625,6 +15618,23 @@ if test "x$ac_cv_func_getauxval" = xyes; then :
 fi
 
 
+## shmat
+ac_fn_c_check_header_mongrel "$LINENO" "sys/shm.h" "ac_cv_header_sys_shm_h" "$ac_includes_default"
+if test "x$ac_cv_header_sys_shm_h" = xyes; then :
+
+    $as_echo "#define HAS_SYS_SHM_H 1" >>confdefs.h
+
+    ac_fn_c_check_func "$LINENO" "shmat" "ac_cv_func_shmat"
+if test "x$ac_cv_func_shmat" = xyes; then :
+  $as_echo "#define HAS_SHMAT 1" >>confdefs.h
+
+fi
+
+
+fi
+
+
+
 ## execvpe
 
 ac_fn_c_check_func "$LINENO" "execvpe" "ac_cv_func_execvpe"
@@ -16359,6 +16369,8 @@ if test "x$ax_pthread_ok" = "xyes"; then
     pthread_link="-lpthread -lposix4" ;; #(
   *-*-haiku*) :
     pthread_link="" ;; #(
+  *-*-android*) :
+    pthread_link="" ;; #(
   *) :
     pthread_link="-lpthread" ;;
 esac
diff --git a/configure.ac b/configure.ac
index a2cfd7e2c2..b2dfbf93a2 100644
--- a/configure.ac
+++ b/configure.ac
@@ -748,7 +748,6 @@ AS_IF([test "x$ac_cv_lib_m_cos" = xyes ], [mathlib="-lm"], [mathlib=""])
 AC_CHECK_HEADER([math.h])
 AC_CHECK_HEADERS([unistd.h],[AC_DEFINE([HAS_UNISTD])])
 AC_CHECK_HEADER([stdint.h],[AC_DEFINE([HAS_STDINT_H])])
-AC_CHECK_HEADER([sys/shm.h],[AC_DEFINE([HAS_SYS_SHM_H])])
 AC_CHECK_HEADER([dirent.h], [AC_DEFINE([HAS_DIRENT])], [],
   [#include <sys/types.h>])
 
@@ -1574,6 +1573,13 @@ AC_CHECK_FUNC([accept4], [AC_DEFINE([HAS_ACCEPT4])])
 
 AC_CHECK_FUNC([getauxval], [AC_DEFINE([HAS_GETAUXVAL])])
 
+## shmat
+AC_CHECK_HEADER([sys/shm.h],
+  [
+    AC_DEFINE([HAS_SYS_SHM_H])
+    AC_CHECK_FUNC([shmat], [AC_DEFINE([HAS_SHMAT])])
+  ])
+
 ## execvpe
 
 AC_CHECK_FUNC([execvpe], [AC_DEFINE([HAS_EXECVPE])])
@@ -1634,6 +1640,7 @@ AS_IF([test x"$enable_systhreads" = "xno"],
       AS_CASE([$host],
         [*-*-solaris*], [pthread_link="-lpthread -lposix4"],
         [*-*-haiku*], [pthread_link=""],
+        [*-*-android*], [pthread_link=""],
         [pthread_link="-lpthread"])
       common_cppflags="$common_cppflags -D_REENTRANT"
       AC_MSG_NOTICE([the POSIX threads library is supported])
diff --git a/driver/makedepend.ml b/driver/makedepend.ml
index 1c3af5d8a8..87ca0b3fdc 100644
--- a/driver/makedepend.ml
+++ b/driver/makedepend.ml
@@ -562,6 +562,18 @@ let parse_map fname =
   module_map := String.Map.add modname mm !module_map
 ;;
 
+(* Dependency processing *)
+
+type dep_arg =
+  | Map of Misc.filepath (* -map option *)
+  | Src of Misc.filepath * file_kind option (* -impl, -intf or anon arg *)
+
+let process_dep_arg = function
+  | Map file -> parse_map file
+  | Src (file, None) -> file_dependencies file
+  | Src (file, (Some file_kind)) -> file_dependencies_as file_kind file
+
+let process_dep_args dep_args = List.iter process_dep_arg dep_args
 
 (* Entry point *)
 
@@ -575,7 +587,10 @@ let print_version_num () =
   exit 0;
 ;;
 
+
 let run_main argv =
+  let dep_args_rev : dep_arg list ref = ref [] in
+  let add_dep_arg f s = dep_args_rev := (f s) :: !dep_args_rev in
   Clflags.classic := false;
   Compenv.readenv ppf Before_args;
   Clflags.reset_arguments (); (* reset arguments from ocamlc/ocamlopt *)
@@ -596,11 +611,11 @@ let run_main argv =
      "-nocwd", Arg.Set nocwd,
         " Do not add current working directory to \
           the list of include directories";
-     "-impl", Arg.String (file_dependencies_as ML),
+     "-impl", Arg.String (add_dep_arg (fun f -> Src (f, Some ML))),
         "<f>  Process <f> as a .ml file";
-     "-intf", Arg.String (file_dependencies_as MLI),
+     "-intf", Arg.String (add_dep_arg (fun f -> Src (f, Some MLI))),
         "<f>  Process <f> as a .mli file";
-     "-map", Arg.String parse_map,
+     "-map", Arg.String (add_dep_arg (fun f -> Map f)),
         "<f>  Read <f> and propagate delayed dependencies to following files";
      "-ml-synonym", Arg.String(add_to_synonym_list ml_synonyms),
         "<e>  Consider <e> as a synonym of the .ml extension";
@@ -643,7 +658,8 @@ let run_main argv =
     Printf.sprintf "Usage: %s [options] <source files>\nOptions are:"
                    (Filename.basename Sys.argv.(0))
   in
-  Clflags.parse_arguments argv file_dependencies usage;
+  Clflags.parse_arguments argv (add_dep_arg (fun f -> Src (f, None))) usage;
+  process_dep_args (List.rev !dep_args_rev);
   Compenv.readenv ppf Before_link;
   if !sort_files then sort_files_by_dependencies !files
   else List.iter print_file_dependencies (List.sort compare !files);
diff --git a/driver/pparse.ml b/driver/pparse.ml
index a5e98c0a4a..5991459d11 100644
--- a/driver/pparse.ml
+++ b/driver/pparse.ml
@@ -175,7 +175,7 @@ let file_aux ~tool_name inputfile (type a) parse_fun invariant_fun
         Location.input_name := (input_value ic : string);
         if !Clflags.unsafe then
           Location.prerr_warning (Location.in_file !Location.input_name)
-            Warnings.Unsafe_without_parsing;
+            Warnings.Unsafe_array_syntax_without_parsing;
         let ast = (input_value ic : a) in
         if !Clflags.all_ppx = [] then invariant_fun ast;
         (* if all_ppx <> [], invariant_fun will be called by apply_rewriters *)
diff --git a/lambda/simplif.ml b/lambda/simplif.ml
index 3ce1250837..e6a1c4d240 100644
--- a/lambda/simplif.ml
+++ b/lambda/simplif.ml
@@ -619,9 +619,9 @@ let rec emit_tail_infos is_tail lambda =
              But then this means getting different warnings depending
              on whether the native or bytecode compiler is used. *)
           if not is_tail
-          && Warnings.is_active Warnings.Expect_tailcall
+          && Warnings.is_active Warnings.Tailcall_expected
           then Location.prerr_warning (to_location ap.ap_loc)
-                 Warnings.Expect_tailcall;
+                 Warnings.Tailcall_expected;
       end;
       emit_tail_infos false ap.ap_func;
       list_emit_tail_infos false ap.ap_args
@@ -887,6 +887,6 @@ let simplify_lambda lam =
     |> simplify_exits
     |> simplify_lets
   in
-  if !Clflags.annotations || Warnings.is_active Warnings.Expect_tailcall
+  if !Clflags.annotations || Warnings.is_active Warnings.Tailcall_expected
     then emit_tail_infos true lam;
   lam
diff --git a/manual/manual/Makefile b/manual/manual/Makefile
index fbee1e022a..97aed4101b 100644
--- a/manual/manual/Makefile
+++ b/manual/manual/Makefile
@@ -147,12 +147,13 @@ warnings-help.etex: $(SRC)/utils/warnings.ml $(SRC)/ocamlc
 	 echo "% when a new warning is documented.";\
 	 echo "%";\
 	 $(SET_LD_PATH) $(SRC)/boot/ocamlrun $(SRC)/ocamlc -warn-help \
-	 | sed -e 's/^ *\([0-9A-Z][0-9]*\)\(.*\)/\\item[\1] \2/'\
+	 | sed -e 's/^ *\([0-9][0-9]*\) *\[\([a-z][a-z-]*\)\]\(.*\)/\\item[\1 "\2"] \3/' \
+               -e 's/^ *\([0-9A-Z][0-9]*\) *\([^]].*\)/\\item[\1] \2/'\
 	) >$@
 #	sed --inplace is not portable, emulate
 	for i in 52 57; do\
 	  sed\
-	    s'/\\item\['$$i'\]/\\item\['$$i' (see \\ref{ss:warn'$$i'})\]/'\
+	    s'/\\item\[\('$$i'[^]]*\)\]/\\item\[\1 (see \\ref{ss:warn'$$i'})\]/'\
 	    $@ > $@.tmp;\
 	  mv $@.tmp $@;\
 	done
diff --git a/manual/manual/cmds/intf-c.etex b/manual/manual/cmds/intf-c.etex
index 4323a89ffa..b47a680d9d 100644
--- a/manual/manual/cmds/intf-c.etex
+++ b/manual/manual/cmds/intf-c.etex
@@ -185,7 +185,7 @@ serialization and deserialization functions for custom blocks
 \entree{"caml/threads.h"}{operations for interfacing in the presence
   of multiple threads (see section~\ref{s:C-multithreading}).}
 \end{tableau}
-Before including any of these files, you should define the "OCAML_NAME_SPACE"
+Before including any of these files, you should define the "CAML_NAME_SPACE"
 macro. For instance,
 \begin{verbatim}
 #define CAML_NAME_SPACE
diff --git a/manual/manual/cmds/unified-options.etex b/manual/manual/cmds/unified-options.etex
index fe63611283..1a87635c6e 100644
--- a/manual/manual/cmds/unified-options.etex
+++ b/manual/manual/cmds/unified-options.etex
@@ -753,8 +753,18 @@ to \var{uppercase-letter}.
 to \var{lowercase-letter}.
 \end{options}
 
-Warning numbers and letters which are out of the range of warnings
-that are currently defined are ignored. The warnings are as follows.
+Alternatively, \var{warning-list} can specify a single warning using its
+mnemonic name (see below), as follows:
+
+\begin{options}
+\item["+"\var{name}] Enable warning \var{name}.
+\item["-"\var{name}] Disable warning \var{name}.
+\item["@"\var{name}] Enable and mark as fatal warning \var{name}.
+\end{options}
+
+Warning numbers, letters and names which are not currently defined are
+ignored. The warnings are as follows (the name following each number specifies
+the mnemonic for that warning).
 \begin{options}
 \input{warnings-help.tex}
 \end{options}
diff --git a/middle_end/flambda/inline_and_simplify.ml b/middle_end/flambda/inline_and_simplify.ml
index 538bf9ff3e..13349e42b7 100644
--- a/middle_end/flambda/inline_and_simplify.ml
+++ b/middle_end/flambda/inline_and_simplify.ml
@@ -1026,7 +1026,7 @@ and simplify_named env r (tree : Flambda.named) : Flambda.named * R.t =
         [block_approx; _field_approx; value_approx] ->
         if A.warn_on_mutation block_approx then begin
           Location.prerr_warning (Debuginfo.to_location dbg)
-            Warnings.Assignment_to_non_mutable_value
+            Warnings.Flambda_assignment_to_non_mutable_value
         end;
         let kind =
           let check () =
@@ -1055,7 +1055,7 @@ and simplify_named env r (tree : Flambda.named) : Flambda.named * R.t =
       | Psetfield _, _block::_, block_approx::_ ->
         if A.warn_on_mutation block_approx then begin
           Location.prerr_warning (Debuginfo.to_location dbg)
-            Warnings.Assignment_to_non_mutable_value
+            Warnings.Flambda_assignment_to_non_mutable_value
         end;
         tree, ret r (A.value_unknown Other)
       | (Psetfield _ | Parraysetu _ | Parraysets _), _, _ ->
diff --git a/ocamltest/ocaml_modifiers.ml b/ocamltest/ocaml_modifiers.ml
index ae3ad8d335..c65dafde65 100644
--- a/ocamltest/ocaml_modifiers.ml
+++ b/ocamltest/ocaml_modifiers.ml
@@ -18,51 +18,53 @@
 open Ocamltest_stdlib
 open Environments
 
+let wrap sl = " " ^ String.concat " " sl ^ " "
+let append var sl = Append (var, wrap sl)
+let add var s = Add (var, s)
+
 let principal =
 [
-  Append (Ocaml_variables.flags, " -principal ");
-  Add (Ocaml_variables.compiler_directory_suffix, ".principal");
-  Add (Ocaml_variables.compiler_reference_suffix, ".principal");
+  append Ocaml_variables.flags ["-principal"];
+  add Ocaml_variables.compiler_directory_suffix ".principal";
+  add Ocaml_variables.compiler_reference_suffix ".principal";
 ]
 
 let latex =
   [
-    Add (Ocaml_variables.ocamldoc_backend, "latex");
-    Append (Ocaml_variables.ocamldoc_flags, "-latex-type-prefix=TYP ");
-    Append (Ocaml_variables.ocamldoc_flags, "-latex-module-prefix= ");
-    Append (Ocaml_variables.ocamldoc_flags, "-latex-value-prefix=  ");
-    Append (Ocaml_variables.ocamldoc_flags, "-latex-module-type-prefix= ");
-    Append (Ocaml_variables.ocamldoc_flags, "-latextitle=1,subsection* ");
-    Append (Ocaml_variables.ocamldoc_flags, "-latextitle=2,subsubsection* ");
-    Append (Ocaml_variables.ocamldoc_flags, "-latextitle=6,subsection* ");
-    Append (Ocaml_variables.ocamldoc_flags, "-latextitle=7,subsubsection* ");
+    add Ocaml_variables.ocamldoc_backend "latex";
+    append Ocaml_variables.ocamldoc_flags ["-latex-type-prefix=TYP"];
+    append Ocaml_variables.ocamldoc_flags ["-latex-module-prefix="];
+    append Ocaml_variables.ocamldoc_flags ["-latex-value-prefix="];
+    append Ocaml_variables.ocamldoc_flags ["-latex-module-type-prefix="];
+    append Ocaml_variables.ocamldoc_flags ["-latextitle=1,subsection*"];
+    append Ocaml_variables.ocamldoc_flags ["-latextitle=2,subsubsection*"];
+    append Ocaml_variables.ocamldoc_flags ["-latextitle=6,subsection*"];
+    append Ocaml_variables.ocamldoc_flags ["-latextitle=7,subsubsection*"];
   ]
 
 
 let html =
   [
-    Add (Ocaml_variables.ocamldoc_backend, "html");
-    Append (Ocaml_variables.ocamldoc_flags, "-colorize-code ");
+    add Ocaml_variables.ocamldoc_backend "html";
+    append Ocaml_variables.ocamldoc_flags ["-colorize-code"];
   ]
 
 let man =
   [
-    Add (Ocaml_variables.ocamldoc_backend, "man");
+    add Ocaml_variables.ocamldoc_backend "man";
   ]
 
-let wrap str = (" " ^ str ^ " ")
-
-let make_library_modifier library directory =
+let make_library_modifier library directories =
 [
-  Append (Ocaml_variables.directories, (wrap directory));
-  Append (Ocaml_variables.libraries, (wrap library));
-  Append (Ocaml_variables.caml_ld_library_path, (wrap directory));
+  append Ocaml_variables.directories directories;
+  append Ocaml_variables.libraries [library];
+  append Ocaml_variables.caml_ld_library_path directories;
 ]
 
 let make_module_modifier unit_name directory =
 [
-  Append (Ocaml_variables.directories, (wrap directory));
-  Append (Ocaml_variables.binary_modules, (wrap unit_name));
+  append Ocaml_variables.directories [directory];
+  append Ocaml_variables.binary_modules [unit_name];
 ]
 
 let compiler_subdir subdir =
@@ -70,11 +72,11 @@ let compiler_subdir subdir =
 
 let config =
 [
-  Append (Ocaml_variables.directories, (wrap (compiler_subdir ["utils"])));
+  append Ocaml_variables.directories [compiler_subdir ["utils"]];
 ]
 
 let testing = make_library_modifier
-  "testing" (compiler_subdir ["testsuite"; "lib"])
+  "testing" [compiler_subdir ["testsuite"; "lib"]]
 
 let tool_ocaml_lib = make_module_modifier
   "lib" (compiler_subdir ["testsuite"; "lib"])
@@ -82,18 +84,20 @@ let tool_ocaml_lib = make_module_modifier
 let unixlibdir = if Sys.win32 then "win32unix" else "unix"
 
 let unix = make_library_modifier
-  "unix" (compiler_subdir ["otherlibs"; unixlibdir])
+  "unix" [compiler_subdir ["otherlibs"; unixlibdir]]
 
 let dynlink =
-  make_library_modifier "dynlink" (compiler_subdir ["otherlibs"; "dynlink"])
+  make_library_modifier "dynlink"
+    [compiler_subdir ["otherlibs"; "dynlink"];
+     compiler_subdir ["otherlibs"; "dynlink"; "native"]]
 
 let str = make_library_modifier
-  "str" (compiler_subdir ["otherlibs"; "str"])
+  "str" [compiler_subdir ["otherlibs"; "str"]]
 
 let systhreads =
   unix @
   (make_library_modifier
-    "threads" (compiler_subdir ["otherlibs"; "systhreads"]))
+    "threads" [compiler_subdir ["otherlibs"; "systhreads"]])
 
 let compilerlibs_subdirs =
 [
@@ -111,11 +115,11 @@ let compilerlibs_subdirs =
 ]
 
 let add_compiler_subdir subdir =
-  Append (Ocaml_variables.directories, (wrap (compiler_subdir [subdir])))
+  append Ocaml_variables.directories [compiler_subdir [subdir]]
 
 let compilerlibs_archive archive =
-  (Append (Ocaml_variables.libraries, wrap archive)) ::
-  (List.map add_compiler_subdir compilerlibs_subdirs)
+  append Ocaml_variables.libraries [archive] ::
+  List.map add_compiler_subdir compilerlibs_subdirs
 
 let debugger = [add_compiler_subdir "debugger"]
 
diff --git a/otherlibs/dynlink/dynlink_common.ml b/otherlibs/dynlink/dynlink_common.ml
index 3a362fd1e7..3264ac4b93 100644
--- a/otherlibs/dynlink/dynlink_common.ml
+++ b/otherlibs/dynlink/dynlink_common.ml
@@ -316,12 +316,15 @@ module Make (P : Dynlink_platform_intf.S) = struct
     global_state := state
 
   let main_program_units () =
+    init ();
     String.Set.elements (!global_state).main_program_units
 
   let public_dynamically_loaded_units () =
+    init ();
     String.Set.elements (!global_state).public_dynamically_loaded_units
 
   let all_units () =
+    init ();
     String.Set.elements (String.Set.union
       (!global_state).main_program_units
       (!global_state).public_dynamically_loaded_units)
diff --git a/parsing/docstrings.ml b/parsing/docstrings.ml
index 987365aab6..a39f75d259 100644
--- a/parsing/docstrings.ml
+++ b/parsing/docstrings.ml
@@ -44,18 +44,18 @@ let docstrings : docstring list ref = ref []
 (* Warn for unused and ambiguous docstrings *)
 
 let warn_bad_docstrings () =
-  if Warnings.is_active (Warnings.Bad_docstring true) then begin
+  if Warnings.is_active (Warnings.Unexpected_docstring true) then begin
     List.iter
       (fun ds ->
          match ds.ds_attached with
          | Info -> ()
          | Unattached ->
-           prerr_warning ds.ds_loc (Warnings.Bad_docstring true)
+           prerr_warning ds.ds_loc (Warnings.Unexpected_docstring true)
          | Docs ->
              match ds.ds_associated with
              | Zero | One -> ()
              | Many ->
-               prerr_warning ds.ds_loc (Warnings.Bad_docstring false))
+               prerr_warning ds.ds_loc (Warnings.Unexpected_docstring false))
       (List.rev !docstrings)
 end
 
diff --git a/runtime/afl.c b/runtime/afl.c
index 582449ef63..bc6c9826b4 100644
--- a/runtime/afl.c
+++ b/runtime/afl.c
@@ -15,7 +15,7 @@
 /* Runtime support for afl-fuzz */
 #include "caml/config.h"
 
-#if !defined(HAS_SYS_SHM_H)
+#if !defined(HAS_SYS_SHM_H) || !defined(HAS_SHMAT)
 
 #include "caml/mlvalues.h"
 
diff --git a/runtime/caml/s.h.in b/runtime/caml/s.h.in
index 25dbda567c..9f4049386e 100644
--- a/runtime/caml/s.h.in
+++ b/runtime/caml/s.h.in
@@ -249,6 +249,8 @@
 
 #undef HAS_SYS_SHM_H
 
+#undef HAS_SHMAT
+
 #undef HAS_EXECVPE
 
 #undef HAS_POSIX_SPAWN
diff --git a/stdlib/bigarray.ml b/stdlib/bigarray.ml
index 86c737ae86..157881f974 100644
--- a/stdlib/bigarray.ml
+++ b/stdlib/bigarray.ml
@@ -92,7 +92,7 @@ let c_layout = C_layout
 let fortran_layout = Fortran_layout
 
 module Genarray = struct
-  type ('a, 'b, 'c) t
+  type (!'a, !'b, !'c) t
   external create: ('a, 'b) kind -> 'c layout -> int array -> ('a, 'b, 'c) t
      = "caml_ba_create"
   external get: ('a, 'b, 'c) t -> int array -> 'a
@@ -132,7 +132,7 @@ module Genarray = struct
 end
 
 module Array0 = struct
-  type ('a, 'b, 'c) t = ('a, 'b, 'c) Genarray.t
+  type (!'a, !'b, !'c) t = ('a, 'b, 'c) Genarray.t
   let create kind layout =
     Genarray.create kind layout [||]
   let get arr = Genarray.get arr [||]
@@ -155,7 +155,7 @@ module Array0 = struct
 end
 
 module Array1 = struct
-  type ('a, 'b, 'c) t = ('a, 'b, 'c) Genarray.t
+  type (!'a, !'b, !'c) t = ('a, 'b, 'c) Genarray.t
   let create kind layout dim =
     Genarray.create kind layout [|dim|]
   external get: ('a, 'b, 'c) t -> int -> 'a = "%caml_ba_ref_1"
@@ -192,7 +192,7 @@ module Array1 = struct
 end
 
 module Array2 = struct
-  type ('a, 'b, 'c) t = ('a, 'b, 'c) Genarray.t
+  type (!'a, !'b, !'c) t = ('a, 'b, 'c) Genarray.t
   let create kind layout dim1 dim2 =
     Genarray.create kind layout [|dim1; dim2|]
   external get: ('a, 'b, 'c) t -> int -> int -> 'a = "%caml_ba_ref_2"
@@ -242,7 +242,7 @@ module Array2 = struct
 end
 
 module Array3 = struct
-  type ('a, 'b, 'c) t = ('a, 'b, 'c) Genarray.t
+  type (!'a, !'b, !'c) t = ('a, 'b, 'c) Genarray.t
   let create kind layout dim1 dim2 dim3 =
     Genarray.create kind layout [|dim1; dim2; dim3|]
   external get: ('a, 'b, 'c) t -> int -> int -> int -> 'a = "%caml_ba_ref_3"
diff --git a/stdlib/bigarray.mli b/stdlib/bigarray.mli
index a474d559e3..68eacf4882 100644
--- a/stdlib/bigarray.mli
+++ b/stdlib/bigarray.mli
@@ -255,7 +255,7 @@ val fortran_layout : fortran_layout layout
 
 module Genarray :
   sig
-  type ('a, 'b, 'c) t
+  type (!'a, !'b, !'c) t
   (** The type [Genarray.t] is the type of Bigarrays with variable
      numbers of dimensions.  Any number of dimensions between 0 and 16
      is supported.
@@ -477,7 +477,7 @@ module Genarray :
    faster operations, and more precise static type-checking.
    @since 4.05.0 *)
 module Array0 : sig
-  type ('a, 'b, 'c) t
+  type (!'a, !'b, !'c) t
   (** The type of zero-dimensional Bigarrays whose elements have
      OCaml type ['a], representation kind ['b], and memory layout ['c]. *)
 
@@ -535,7 +535,7 @@ end
    Statically knowing the number of dimensions of the array allows
    faster operations, and more precise static type-checking. *)
 module Array1 : sig
-  type ('a, 'b, 'c) t
+  type (!'a, !'b, !'c) t
   (** The type of one-dimensional Bigarrays whose elements have
      OCaml type ['a], representation kind ['b], and memory layout ['c]. *)
 
@@ -632,7 +632,7 @@ end
    case of two-dimensional arrays. *)
 module Array2 :
   sig
-  type ('a, 'b, 'c) t
+  type (!'a, !'b, !'c) t
   (** The type of two-dimensional Bigarrays whose elements have
      OCaml type ['a], representation kind ['b], and memory layout ['c]. *)
 
@@ -748,7 +748,7 @@ end
    of three-dimensional arrays. *)
 module Array3 :
   sig
-  type ('a, 'b, 'c) t
+  type (!'a, !'b, !'c) t
   (** The type of three-dimensional Bigarrays whose elements have
      OCaml type ['a], representation kind ['b], and memory layout ['c]. *)
 
diff --git a/stdlib/hashtbl.ml b/stdlib/hashtbl.ml
index 954c683cf5..0976456aca 100644
--- a/stdlib/hashtbl.ml
+++ b/stdlib/hashtbl.ml
@@ -287,7 +287,7 @@ module type SeededHashedType =
 module type S =
   sig
     type key
-    type 'a t
+    type !'a t
     val create: int -> 'a t
     val clear : 'a t -> unit
     val reset : 'a t -> unit
@@ -315,7 +315,7 @@ module type S =
 module type SeededS =
   sig
     type key
-    type 'a t
+    type !'a t
     val create : ?random:bool -> int -> 'a t
     val clear : 'a t -> unit
     val reset : 'a t -> unit
diff --git a/stdlib/hashtbl.mli b/stdlib/hashtbl.mli
index 1111b7d058..3b34ff8a03 100644
--- a/stdlib/hashtbl.mli
+++ b/stdlib/hashtbl.mli
@@ -22,7 +22,7 @@
 (** {1 Generic interface} *)
 
 
-type ('a, 'b) t
+type (!'a, !'b) t
 (** The type of hash tables from type ['a] to type ['b]. *)
 
 val create : ?random:bool -> int -> ('a, 'b) t
@@ -327,7 +327,7 @@ module type HashedType =
 module type S =
   sig
     type key
-    type 'a t
+    type !'a t
     val create : int -> 'a t
     val clear : 'a t -> unit
     val reset : 'a t -> unit (** @since 4.00.0 *)
@@ -403,7 +403,7 @@ module type SeededHashedType =
 module type SeededS =
   sig
     type key
-    type 'a t
+    type !'a t
     val create : ?random:bool -> int -> 'a t
     val clear : 'a t -> unit
     val reset : 'a t -> unit
diff --git a/stdlib/map.ml b/stdlib/map.ml
index aca7040a20..236aaa5b36 100644
--- a/stdlib/map.ml
+++ b/stdlib/map.ml
@@ -22,7 +22,7 @@ module type OrderedType =
 module type S =
   sig
     type key
-    type +'a t
+    type !+'a t
     val empty: 'a t
     val is_empty: 'a t -> bool
     val mem:  key -> 'a t -> bool
diff --git a/stdlib/map.mli b/stdlib/map.mli
index 2053f6adf9..a31496372d 100644
--- a/stdlib/map.mli
+++ b/stdlib/map.mli
@@ -64,7 +64,7 @@ module type S =
     type key
     (** The type of the map keys. *)
 
-    type (+'a) t
+    type !+'a t
     (** The type of maps from type [key] to type ['a]. *)
 
     val empty: 'a t
diff --git a/stdlib/moreLabels.mli b/stdlib/moreLabels.mli
index 4ac0dd5ff9..4581011916 100644
--- a/stdlib/moreLabels.mli
+++ b/stdlib/moreLabels.mli
@@ -59,7 +59,7 @@ module Hashtbl : sig
   module type S =
     sig
       type key
-      and 'a t
+      and !'a t
       val create : int -> 'a t
       val clear : 'a t -> unit
       val reset : 'a t -> unit
@@ -89,7 +89,7 @@ module Hashtbl : sig
   module type SeededS =
     sig
       type key
-      and 'a t
+      and !'a t
       val create : ?random:bool -> int -> 'a t
       val clear : 'a t -> unit
       val reset : 'a t -> unit
@@ -133,7 +133,7 @@ module Map : sig
   module type S =
     sig
       type key
-      and (+'a) t
+      and (!+'a) t
       val empty : 'a t
       val is_empty: 'a t -> bool
       val mem : key -> 'a t -> bool
diff --git a/stdlib/queue.mli b/stdlib/queue.mli
index 12c99f3f27..0eaf1a5088 100644
--- a/stdlib/queue.mli
+++ b/stdlib/queue.mli
@@ -22,7 +22,7 @@
    Failure to do so can lead to a crash.
 *)
 
-type 'a t
+type !'a t
 (** The type of queues containing elements of type ['a]. *)
 
 
diff --git a/stdlib/stack.mli b/stdlib/stack.mli
index 26ea3cc694..b2d19cdc7a 100644
--- a/stdlib/stack.mli
+++ b/stdlib/stack.mli
@@ -18,7 +18,7 @@
    This module implements stacks (LIFOs), with in-place modification.
 *)
 
-type 'a t
+type !'a t
 (** The type of stacks containing elements of type ['a]. *)
 
 exception Empty
diff --git a/stdlib/stream.mli b/stdlib/stream.mli
index 93c2c31517..ea7d293a13 100644
--- a/stdlib/stream.mli
+++ b/stdlib/stream.mli
@@ -15,7 +15,7 @@
 
 (** Streams and parsers. *)
 
-type 'a t
+type !'a t
 (** The type of streams holding values of type ['a]. *)
 
 exception Failure
diff --git a/stdlib/weak.ml b/stdlib/weak.ml
index 3184b938da..dd438d5170 100644
--- a/stdlib/weak.ml
+++ b/stdlib/weak.ml
@@ -15,7 +15,7 @@
 
 (** Weak array operations *)
 
-type 'a t
+type !'a t
 
 external create : int -> 'a t = "caml_weak_create"
 
diff --git a/stdlib/weak.mli b/stdlib/weak.mli
index 878e590a0d..bf74525b49 100644
--- a/stdlib/weak.mli
+++ b/stdlib/weak.mli
@@ -18,7 +18,7 @@
 
 (** {1 Low-level functions} *)
 
-type 'a t
+type !'a t
 (** The type of arrays of weak pointers (weak arrays).  A weak
    pointer is a value that the garbage collector may erase whenever
    the value is not used any more (through normal pointers) by the
diff --git a/testsuite/tests/asmcomp/0001-test.compilers.reference b/testsuite/tests/asmcomp/0001-test.compilers.reference
index c2c5166b9c..caa67d4cbc 100644
--- a/testsuite/tests/asmcomp/0001-test.compilers.reference
+++ b/testsuite/tests/asmcomp/0001-test.compilers.reference
@@ -1,2 +1,2 @@
 File "0001-test.ml", line 1:
-Warning 24: bad source file name: "0001-test" is not a valid module name.
+Warning 24 [bad-module-name]: bad source file name: "0001-test" is not a valid module name.
diff --git a/testsuite/tests/basic-more/morematch.compilers.reference b/testsuite/tests/basic-more/morematch.compilers.reference
index 2fde3df8e8..ce9a2d3131 100644
--- a/testsuite/tests/basic-more/morematch.compilers.reference
+++ b/testsuite/tests/basic-more/morematch.compilers.reference
@@ -1,60 +1,60 @@
 File "morematch.ml", line 67, characters 2-5:
 67 | | 4|5|7 -> 100
        ^^^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
 File "morematch.ml", line 68, characters 2-3:
 68 | | 7 | 8 -> 6
        ^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
 File "morematch.ml", line 219, characters 33-47:
 219 | let f = function (([]|[_]) as x)|(_::([] as x))|(_::_::x)  -> x
                                        ^^^^^^^^^^^^^^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
 File "morematch.ml", line 388, characters 2-15:
 388 | | A,_,(100|103) -> 5
         ^^^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
 File "morematch.ml", line 401, characters 2-20:
 401 | | [],_,(100|103|104) -> 5
         ^^^^^^^^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
 File "morematch.ml", line 402, characters 2-16:
 402 | | [],_,(100|103) -> 6
         ^^^^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
 File "morematch.ml", line 403, characters 2-29:
 403 | | [],_,(1000|1001|1002|20000) -> 7
         ^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
 File "morematch.ml", line 413, characters 5-12:
 413 |   | (100|103|101) -> 2
            ^^^^^^^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
 File "morematch.ml", line 432, characters 43-44:
 432 | | (J,J,((C|D) as x |E x|F (_,x))) | (J,_,((C|J) as x)) -> autre (x,x,x)
                                                  ^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
 File "morematch.ml", line 455, characters 7-8:
 455 | | _,_,(X|U _) -> 8
              ^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
 File "morematch.ml", line 456, characters 2-7:
 456 | | _,_,Y -> 5
         ^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
 File "morematch.ml", lines 1050-1053, characters 8-10:
 1050 | ........function
 1051 |   | A (`A|`C) -> 0
 1052 |   | B (`B,`D) -> 1
 1053 |   | C -> 2
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 A `D
 File "morematch.ml", line 1084, characters 5-51:
 1084 |   |  _, _, _, _, _, A, _, _, _, _, B, _, _, _, _, _ -> "11"
             ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
 File "morematch.ml", line 1086, characters 5-51:
 1086 |   |  _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ -> "13"
             ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
diff --git a/testsuite/tests/basic-more/robustmatch.compilers.reference b/testsuite/tests/basic-more/robustmatch.compilers.reference
index fc5801975f..241b7395ab 100644
--- a/testsuite/tests/basic-more/robustmatch.compilers.reference
+++ b/testsuite/tests/basic-more/robustmatch.compilers.reference
@@ -4,7 +4,7 @@ File "robustmatch.ml", lines 33-37, characters 6-23:
 35 |       | MAB, _, A -> ()
 36 |       | _,  AB, B -> ()
 37 |       | _, MAB, B -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (AB, MAB, A)
 File "robustmatch.ml", lines 43-47, characters 4-21:
@@ -13,42 +13,42 @@ File "robustmatch.ml", lines 43-47, characters 4-21:
 45 |     | MAB, _, A -> ()
 46 |     | _,  AB, B -> ()
 47 |     | _, MAB, B -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (AB, MAB, A)
 File "robustmatch.ml", lines 54-56, characters 4-27:
 54 | ....match r1, r2, a with
 55 |     | R1, _, 0 -> ()
 56 |     | _, R2, "coucou" -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R1, R1, 1)
 File "robustmatch.ml", lines 64-66, characters 4-27:
 64 | ....match r1, r2, a with
 65 |     | R1, _, A -> ()
 66 |     | _, R2, "coucou" -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R1, R1, (B|C))
 File "robustmatch.ml", lines 69-71, characters 4-20:
 69 | ....match r1, r2, a with
 70 |     | _, R2, "coucou" -> ()
 71 |     | R1, _, A -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R1, R1, (B|C))
 File "robustmatch.ml", lines 74-76, characters 4-20:
 74 | ....match r1, r2, a with
 75 |     | _, R2, "coucou" -> ()
 76 |     | R1, _, _ -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R2, R2, "")
 File "robustmatch.ml", lines 85-87, characters 4-20:
 85 | ....match r1, r2, a with
 86 |     | R1, _, A -> ()
 87 |     | _, R2, X -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R1, R1, (B|C))
 File "robustmatch.ml", lines 90-93, characters 4-20:
@@ -56,35 +56,35 @@ File "robustmatch.ml", lines 90-93, characters 4-20:
 91 |     | R1, _, A -> ()
 92 |     | _, R2, X -> ()
 93 |     | R1, _, _ -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R2, R2, (Y|Z))
 File "robustmatch.ml", lines 96-98, characters 4-20:
 96 | ....match r1, r2, a with
 97 |     | R1, _, _ -> ()
 98 |     | _, R2, X -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R2, R2, (Y|Z))
 File "robustmatch.ml", lines 107-109, characters 4-20:
 107 | ....match r1, r2, a with
 108 |     | R1, _, A -> ()
 109 |     | _, R2, X -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R1, R1, (B|C))
 File "robustmatch.ml", lines 129-131, characters 4-20:
 129 | ....match r1, r2, a with
 130 |     | R1, _, A -> ()
 131 |     | _, R2, X -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R1, R1, B)
 File "robustmatch.ml", lines 151-153, characters 4-20:
 151 | ....match r1, r2, a with
 152 |     | R1, _, A -> ()
 153 |     | _, R2, X -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R1, R1, B)
 File "robustmatch.ml", lines 156-159, characters 4-20:
@@ -92,21 +92,21 @@ File "robustmatch.ml", lines 156-159, characters 4-20:
 157 |     | R1, _, A -> ()
 158 |     | _, R2, X -> ()
 159 |     | R1, _, _ -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R2, R2, Y)
 File "robustmatch.ml", lines 162-164, characters 4-20:
 162 | ....match r1, r2, a with
 163 |     | R1, _, _ -> ()
 164 |     | _, R2, X -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R2, R2, Y)
 File "robustmatch.ml", lines 167-169, characters 4-20:
 167 | ....match r1, r2, a with
 168 |     | R1, _, C -> ()
 169 |     | _, R2, Y -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R1, R1, A)
 File "robustmatch.ml", lines 176-179, characters 4-20:
@@ -114,14 +114,14 @@ File "robustmatch.ml", lines 176-179, characters 4-20:
 177 |     | _, R1, 0 -> ()
 178 |     | R2, _, [||] -> ()
 179 |     | _, R1, 1 -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R2, R2, [| _ |])
 File "robustmatch.ml", lines 182-184, characters 4-23:
 182 | ....match r1, r2, a with
 183 |     | R1, _, _ -> ()
 184 |     | _, R2, [||] -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R2, R2, [| _ |])
 File "robustmatch.ml", lines 187-190, characters 4-20:
@@ -129,7 +129,7 @@ File "robustmatch.ml", lines 187-190, characters 4-20:
 188 |     | _, R2, [||] -> ()
 189 |     | R1, _, 0 -> ()
 190 |     | R1, _, _ -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R2, R2, [| _ |])
 File "robustmatch.ml", lines 200-203, characters 4-19:
@@ -137,62 +137,62 @@ File "robustmatch.ml", lines 200-203, characters 4-19:
 201 |     | _, R2, [||] -> ()
 202 |     | R1, _, 0 -> ()
 203 |     | _, _, _ -> ()
-Warning 4: this pattern-matching is fragile.
+Warning 4 [fragile-match]: this pattern-matching is fragile.
 It will remain exhaustive when constructors are added to type repr.
 File "robustmatch.ml", lines 210-212, characters 4-27:
 210 | ....match r1, r2, a with
 211 |     | R1, _, 'c' -> ()
 212 |     | _, R2, "coucou" -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R1, R1, 'a')
 File "robustmatch.ml", lines 219-221, characters 4-27:
 219 | ....match r1, r2, a with
 220 |     | R1, _, `A -> ()
 221 |     | _, R2, "coucou" -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R1, R1, `B)
 File "robustmatch.ml", lines 228-230, characters 4-37:
 228 | ....match r1, r2, a with
 229 |     | R1, _, (3, "") -> ()
 230 |     | _, R2, (1, "coucou", 'a') -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R1, R1, (3, "*"))
 File "robustmatch.ml", lines 239-241, characters 4-51:
 239 | ....match r1, r2, a with
 240 |     | R1, _, { x = 3; y = "" } -> ()
 241 |     | _, R2, { a = 1; b = "coucou"; c = 'a' } -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R1, R1, {x=3; y="*"})
 File "robustmatch.ml", lines 244-246, characters 4-36:
 244 | ....match r1, r2, a with
 245 |     | R2, _, { a = 1; b = "coucou"; c = 'a' } -> ()
 246 |     | _, R1, { x = 3; y = "" } -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R2, R2, {a=1; b="coucou"; c='b'})
 File "robustmatch.ml", lines 253-255, characters 4-20:
 253 | ....match r1, r2, a with
 254 |     | R1, _, (3, "") -> ()
 255 |     | _, R2, 1 -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R1, R1, (3, "*"))
 File "robustmatch.ml", lines 263-265, characters 4-20:
 263 | ....match r1, r2, a with
 264 |     | R1, _, { x = 3; y = "" } -> ()
 265 |     | _, R2, 1 -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R1, R1, {x=3; y="*"})
 File "robustmatch.ml", lines 272-274, characters 4-20:
 272 | ....match r1, r2, a with
 273 |     | R1, _, lazy 1 -> ()
 274 |     | _, R2, 1 -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R1, R1, lazy 0)
 File "robustmatch.ml", lines 281-284, characters 4-24:
@@ -200,6 +200,6 @@ File "robustmatch.ml", lines 281-284, characters 4-24:
 282 |     | R1, _, () -> ()
 283 |     | _, R2, "coucou" -> ()
 284 |     | _, R2, "foo" -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (R2, R2, "")
diff --git a/testsuite/tests/basic/patmatch_incoherence.ml b/testsuite/tests/basic/patmatch_incoherence.ml
index c54fd918a1..584b4c2a89 100644
--- a/testsuite/tests/basic/patmatch_incoherence.ml
+++ b/testsuite/tests/basic/patmatch_incoherence.ml
@@ -39,7 +39,7 @@ Lines 1-3, characters 0-20:
 1 | match { x = assert false } with
 2 | | { x = 3 } -> ()
 3 | | { x = None } -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 {x=Some _}
 Exception: Assert_failure ("", 1, 12).
@@ -54,7 +54,7 @@ Lines 1-3, characters 0-18:
 1 | match { x = assert false } with
 2 | | { x = None } -> ()
 3 | | { x = "" } -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 {x="*"}
 Exception: Assert_failure ("", 1, 12).
@@ -69,7 +69,7 @@ Lines 1-3, characters 0-18:
 1 | match { x = assert false } with
 2 | | { x = None } -> ()
 3 | | { x = `X } -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 {x=`AnyOtherTag}
 Exception: Assert_failure ("", 1, 12).
@@ -84,7 +84,7 @@ Lines 1-3, characters 0-17:
 1 | match { x = assert false } with
 2 | | { x = [||] } -> ()
 3 | | { x = 3 } -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 {x=0}
 Exception: Assert_failure ("", 1, 12).
@@ -99,7 +99,7 @@ Lines 1-3, characters 0-17:
 1 | match { x = assert false } with
 2 | | { x = `X } -> ()
 3 | | { x = 3 } -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 {x=0}
 Exception: Assert_failure ("", 1, 12).
@@ -114,7 +114,7 @@ Lines 1-3, characters 0-17:
 1 | match { x = assert false } with
 2 | | { x = `X "lol" } -> ()
 3 | | { x = 3 } -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 {x=0}
 Exception: Assert_failure ("", 1, 12).
@@ -131,7 +131,7 @@ Lines 1-4, characters 0-17:
 2 | | { x = (2., "") } -> ()
 3 | | { x = None } -> ()
 4 | | { x = 3 } -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 {x=0}
 Exception: Assert_failure ("", 1, 12).
diff --git a/testsuite/tests/let-syntax/let_syntax.ml b/testsuite/tests/let-syntax/let_syntax.ml
index 502aac6a45..787c5b33ee 100644
--- a/testsuite/tests/let-syntax/let_syntax.ml
+++ b/testsuite/tests/let-syntax/let_syntax.ml
@@ -587,7 +587,7 @@ val let_not_principal : unit = ()
 Line 3, characters 9-10:
 3 |     let+ A = A.A in
              ^
-Warning 18: this type-based constructor disambiguation is not principal.
+Warning 18 [not-principal]: this type-based constructor disambiguation is not principal.
 val let_not_principal : unit = ()
 |}];;
 
@@ -616,7 +616,7 @@ val and_not_principal : A.t -> A.t -> unit = <fun>
 Line 5, characters 11-12:
 5 |       and+ A = y in
                ^
-Warning 18: this type-based constructor disambiguation is not principal.
+Warning 18 [not-principal]: this type-based constructor disambiguation is not principal.
 val and_not_principal : A.t -> A.t -> unit = <fun>
 |}];;
 
@@ -718,7 +718,7 @@ val bad_location : 'a GADT_ordering.is_point -> 'a -> int = <fun>
 Line 4, characters 11-19:
 4 |       let+ Is_point = is_point
                ^^^^^^^^
-Warning 18: typing this pattern requires considering GADT_ordering.point and a as equal.
+Warning 18 [not-principal]: typing this pattern requires considering GADT_ordering.point and a as equal.
 But the knowledge of these types is not principal.
 Line 5, characters 13-14:
 5 |       and+ { x; y } = a in
diff --git a/testsuite/tests/letrec-check/pr7231.ocaml.reference b/testsuite/tests/letrec-check/pr7231.ocaml.reference
index 9b1a5a138b..5257588c72 100644
--- a/testsuite/tests/letrec-check/pr7231.ocaml.reference
+++ b/testsuite/tests/letrec-check/pr7231.ocaml.reference
@@ -1,7 +1,7 @@
 Line 5, characters 58-64:
 5 | let rec r = let rec x () = r and y () = x () in y () in r "oops";;
                                                               ^^^^^^
-Warning 20: this argument will not be used by the function.
+Warning 20 [ignored-extra-argument]: this argument will not be used by the function.
 Line 5, characters 12-52:
 5 | let rec r = let rec x () = r and y () = x () in y () in r "oops";;
                 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
diff --git a/testsuite/tests/lexing/escape.ocaml.reference b/testsuite/tests/lexing/escape.ocaml.reference
index 2e9d9fd543..0b716cb114 100644
--- a/testsuite/tests/lexing/escape.ocaml.reference
+++ b/testsuite/tests/lexing/escape.ocaml.reference
@@ -1,7 +1,7 @@
 Line 7, characters 15-17:
 7 | let invalid = "\99" ;;
                    ^^
-Warning 14: illegal backslash escape in string.
+Warning 14 [illegal-backslash]: illegal backslash escape in string.
 val invalid : string = "\\99"
 Line 1, characters 15-19:
 1 | let invalid = "\999" ;;
@@ -14,11 +14,11 @@ Error: Illegal backslash escape in string or character (\o777): o777 (=511) is o
 Line 1, characters 15-17:
 1 | let invalid = "\o77" ;;
                    ^^
-Warning 14: illegal backslash escape in string.
+Warning 14 [illegal-backslash]: illegal backslash escape in string.
 val invalid : string = "\\o77"
 Line 1, characters 15-17:
 1 | let invalid = "\o99" ;;
                    ^^
-Warning 14: illegal backslash escape in string.
+Warning 14 [illegal-backslash]: illegal backslash escape in string.
 val invalid : string = "\\o99"
 
diff --git a/testsuite/tests/lexing/uchar_esc.ocaml.reference b/testsuite/tests/lexing/uchar_esc.ocaml.reference
index 953104ae27..1873a4d790 100644
--- a/testsuite/tests/lexing/uchar_esc.ocaml.reference
+++ b/testsuite/tests/lexing/uchar_esc.ocaml.reference
@@ -25,11 +25,11 @@ Error: Illegal backslash escape in string or character (\u{01234567}): too many
 Line 1, characters 21-23:
 1 | let no_hex_digits = "\u{}" ;;
                          ^^
-Warning 14: illegal backslash escape in string.
+Warning 14 [illegal-backslash]: illegal backslash escape in string.
 val no_hex_digits : string = "\\u{}"
 Line 1, characters 25-27:
 1 | let illegal_hex_digit = "\u{u}" ;;
                              ^^
-Warning 14: illegal backslash escape in string.
+Warning 14 [illegal-backslash]: illegal backslash escape in string.
 val illegal_hex_digit : string = "\\u{u}"
 
diff --git a/testsuite/tests/lib-dynlink-init-info/test.ml b/testsuite/tests/lib-dynlink-init-info/test.ml
new file mode 100644
index 0000000000..c6105dd752
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-init-info/test.ml
@@ -0,0 +1,13 @@
+(* TEST
+   include dynlink
+*)
+
+(* Make sure dynlink state info is accurate before any load
+   occurs #9338. *)
+
+let test () =
+  assert (List.mem "Dynlink" (Dynlink.main_program_units ()));
+  assert (List.mem "Dynlink" (Dynlink.all_units ()));
+  ()
+
+let () = test (); print_endline "OK"
diff --git a/testsuite/tests/lib-dynlink-init-info/test.reference b/testsuite/tests/lib-dynlink-init-info/test.reference
new file mode 100644
index 0000000000..d86bac9de5
--- /dev/null
+++ b/testsuite/tests/lib-dynlink-init-info/test.reference
@@ -0,0 +1 @@
+OK
diff --git a/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference b/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference
index 97ec42cd8d..a947322d02 100755
--- a/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference
+++ b/testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference
@@ -5,8 +5,8 @@ Called from Test10_plugin.f in file "test10_plugin.ml", line 6, characters 2-6
 Called from Test10_plugin in file "test10_plugin.ml", line 10, characters 2-6
 Called from Dynlink.Bytecode.run in file "otherlibs/dynlink/dynlink.ml", line 137, characters 16-25
 Re-raised at Dynlink.Bytecode.run in file "otherlibs/dynlink/dynlink.ml", line 139, characters 6-137
-Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 344, characters 13-44
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 347, characters 13-44
 Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 342, characters 8-240
-Re-raised at Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 352, characters 8-17
+Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 345, characters 8-240
+Re-raised at Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 355, characters 8-17
 Called from Test10_main in file "test10_main.ml", line 51, characters 13-69
diff --git a/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference b/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference
index 0461c18707..0e84488d01 100755
--- a/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference
+++ b/testsuite/tests/lib-dynlink-initializers/test10_main.native.reference
@@ -2,9 +2,9 @@ Error: Failure("Plugin error")
 Raised by primitive operation at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 85, characters 12-29
 Re-raised at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 87, characters 10-149
 Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 344, characters 13-44
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 347, characters 13-44
 Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 342, characters 8-240
-Re-raised at Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 352, characters 8-17
-Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 354, characters 26-45
-Called from Test10_main in file "test10_main.ml", line 49, characters 30-87
\ No newline at end of file
+Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 345, characters 8-240
+Re-raised at Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 355, characters 8-17
+Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 357, characters 26-45
+Called from Test10_main in file "test10_main.ml", line 49, characters 30-87
diff --git a/testsuite/tests/match-exception-warnings/exhaustiveness_warnings.ml b/testsuite/tests/match-exception-warnings/exhaustiveness_warnings.ml
index 4a16ada8ec..d6bcd397ca 100644
--- a/testsuite/tests/match-exception-warnings/exhaustiveness_warnings.ml
+++ b/testsuite/tests/match-exception-warnings/exhaustiveness_warnings.ml
@@ -21,7 +21,7 @@ Lines 8-11, characters 4-16:
  9 |     | exception e -> ()
 10 |     | Some false -> ()
 11 |     | None -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Some true
 val test_match_exhaustiveness : unit -> unit = <fun>
@@ -39,7 +39,7 @@ Lines 2-4, characters 4-30:
 2 | ....match None with
 3 |     | Some false -> ()
 4 |     | None | exception _ -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Some true
 val test_match_exhaustiveness_nest1 : unit -> unit = <fun>
@@ -57,7 +57,7 @@ Lines 2-4, characters 4-16:
 2 | ....match None with
 3 |     | Some false | exception _ -> ()
 4 |     | None -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Some true
 val test_match_exhaustiveness_nest2 : unit -> unit = <fun>
@@ -77,17 +77,17 @@ Lines 2-5, characters 4-30:
 3 |     | exception e -> ()
 4 |     | Some false | exception _ -> ()
 5 |     | None | exception _ -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Some true
 Line 4, characters 29-30:
 4 |     | Some false | exception _ -> ()
                                  ^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
 Line 5, characters 23-24:
 5 |     | None | exception _ -> ()
                            ^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
 val test_match_exhaustiveness_full : unit -> unit = <fun>
 |}]
 ;;
diff --git a/testsuite/tests/messages/precise_locations.ml b/testsuite/tests/messages/precise_locations.ml
index efbc15a46d..aecd8a5ab3 100644
--- a/testsuite/tests/messages/precise_locations.ml
+++ b/testsuite/tests/messages/precise_locations.ml
@@ -86,7 +86,7 @@ end);;
 Line 2, characters 0-9:
 2 | open List
     ^^^^^^^^^
-Error (warning 33): unused open Stdlib.List.
+Error (warning 33 [unused-open]): unused open Stdlib.List.
 |}];;
 
 type unknown += Foo;;
diff --git a/testsuite/tests/no-alias-deps/aliases.compilers.reference b/testsuite/tests/no-alias-deps/aliases.compilers.reference
index 16b8ef9860..5e421986cd 100644
--- a/testsuite/tests/no-alias-deps/aliases.compilers.reference
+++ b/testsuite/tests/no-alias-deps/aliases.compilers.reference
@@ -1,9 +1,9 @@
 File "aliases.ml", line 17, characters 12-13:
 17 | module A' = A (* missing a.cmi *)
                  ^
-Warning 49: no cmi file was found in path for module A
+Warning 49 [no-cmi-file]: no cmi file was found in path for module A
 File "aliases.ml", line 18, characters 12-13:
 18 | module B' = B (* broken b.cmi *)
                  ^
-Warning 49: no valid cmi file was found in path for module B. b.cmi
+Warning 49 [no-cmi-file]: no valid cmi file was found in path for module B. b.cmi
 is not a compiled interface
diff --git a/testsuite/tests/tool-caml-tex/redirections.reference b/testsuite/tests/tool-caml-tex/redirections.reference
index 538b45f9c9..d03e110bdc 100644
--- a/testsuite/tests/tool-caml-tex/redirections.reference
+++ b/testsuite/tests/tool-caml-tex/redirections.reference
@@ -18,7 +18,7 @@ $\:$         int
 $\?$let f <<x>> = () ;;
 \end{camlinput}
 \begin{camlwarn}
-$\:$Warning 27: unused variable x.
+$\:$Warning 27 [unused-var-strict]: unused variable x.
 $\:$val f : 'a -> unit = <fun>
 \end{camlwarn}
 \end{caml}
diff --git a/testsuite/tests/tool-ocamlc-open/tool-ocamlc-open-error.compilers.reference b/testsuite/tests/tool-ocamlc-open/tool-ocamlc-open-error.compilers.reference
index 4c75c9feab..dcf6f4f96d 100644
--- a/testsuite/tests/tool-ocamlc-open/tool-ocamlc-open-error.compilers.reference
+++ b/testsuite/tests/tool-ocamlc-open/tool-ocamlc-open-error.compilers.reference
@@ -1,4 +1,4 @@
 File "tool-ocamlc-open-error.ml", line 1:
-Warning 24: bad source file name: "Tool-ocamlc-open-error" is not a valid module name.
+Warning 24 [bad-module-name]: bad source file name: "Tool-ocamlc-open-error" is not a valid module name.
 File "command line argument: -open "F("", line 1, characters 1-2:
 Error: Syntax error
diff --git a/testsuite/tests/tool-toplevel/pr6468.compilers.reference b/testsuite/tests/tool-toplevel/pr6468.compilers.reference
index 2f942ec658..6c2ab2ff20 100644
--- a/testsuite/tests/tool-toplevel/pr6468.compilers.reference
+++ b/testsuite/tests/tool-toplevel/pr6468.compilers.reference
@@ -3,7 +3,7 @@ val f : unit -> 'a = <fun>
 Line 1, characters 11-15:
 1 | let g () = f (); 1;;
                ^^^^
-Warning 21: this statement never returns (or has an unsound type.)
+Warning 21 [nonreturning-statement]: this statement never returns (or has an unsound type.)
 val g : unit -> int = <fun>
 Exception: Not_found.
 Raised at f in file "//toplevel//", line 2, characters 11-26
diff --git a/testsuite/tests/tool-toplevel/pr7060.compilers.reference b/testsuite/tests/tool-toplevel/pr7060.compilers.reference
index 3538e00799..9f661b83f8 100644
--- a/testsuite/tests/tool-toplevel/pr7060.compilers.reference
+++ b/testsuite/tests/tool-toplevel/pr7060.compilers.reference
@@ -3,7 +3,7 @@ type u = C of t
 Line 1, characters 18-54:
 1 | let print_t out = function A -> Format.fprintf out "A";;
                       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 B
 val print_t : Format.formatter -> t -> unit = <fun>
diff --git a/testsuite/tests/typing-deprecated/alerts.ml b/testsuite/tests/typing-deprecated/alerts.ml
index 016ccf55a0..e909858edc 100644
--- a/testsuite/tests/typing-deprecated/alerts.ml
+++ b/testsuite/tests/typing-deprecated/alerts.ml
@@ -257,17 +257,17 @@ end
 Line 2, characters 13-25:
 2 |   val x: int [@@alert 42]
                  ^^^^^^^^^^^^
-Warning 47: illegal payload for attribute 'alert'.
+Warning 47 [attribute-payload]: illegal payload for attribute 'alert'.
 Invalid payload
 Line 3, characters 13-29:
 3 |   val y: int [@@alert bla 42]
                  ^^^^^^^^^^^^^^^^
-Warning 47: illegal payload for attribute 'alert'.
+Warning 47 [attribute-payload]: illegal payload for attribute 'alert'.
 Invalid payload
 Line 4, characters 13-28:
 4 |   val z: int [@@alert "bla"]
                  ^^^^^^^^^^^^^^^
-Warning 47: illegal payload for attribute 'alert'.
+Warning 47 [attribute-payload]: illegal payload for attribute 'alert'.
 Ill-formed list of alert settings
 module X : sig val x : int val y : int val z : int end
 |}]
diff --git a/testsuite/tests/typing-deprecated/deprecated.ml b/testsuite/tests/typing-deprecated/deprecated.ml
index 8429df43e0..56ac05d53f 100644
--- a/testsuite/tests/typing-deprecated/deprecated.ml
+++ b/testsuite/tests/typing-deprecated/deprecated.ml
@@ -530,7 +530,7 @@ type t = [ `A of X.t | `B of X.s | `C of X.u ]
 Line 1, characters 20-33:
 1 | [@@@ocaml.ppwarning "Pp warning!"]
                         ^^^^^^^^^^^^^
-Warning 22: Pp warning!
+Warning 22 [preprocessor]: Pp warning!
 |}]
 
 
@@ -541,11 +541,11 @@ let x = () [@ocaml.ppwarning "Pp warning 1!"]
 Line 2, characters 24-39:
 2 |     [@@ocaml.ppwarning  "Pp warning 2!"]
                             ^^^^^^^^^^^^^^^
-Warning 22: Pp warning 2!
+Warning 22 [preprocessor]: Pp warning 2!
 Line 1, characters 29-44:
 1 | let x = () [@ocaml.ppwarning "Pp warning 1!"]
                                  ^^^^^^^^^^^^^^^
-Warning 22: Pp warning 1!
+Warning 22 [preprocessor]: Pp warning 1!
 val x : unit = ()
 |}]
 
@@ -556,7 +556,7 @@ type t = unit
 Line 2, characters 22-35:
 2 |     [@ocaml.ppwarning "Pp warning!"]
                           ^^^^^^^^^^^^^
-Warning 22: Pp warning!
+Warning 22 [preprocessor]: Pp warning!
 type t = unit
 |}]
 
@@ -574,7 +574,7 @@ end
 Line 8, characters 22-36:
 8 |   [@@@ocaml.ppwarning "Pp warning2!"]
                           ^^^^^^^^^^^^^^
-Warning 22: Pp warning2!
+Warning 22 [preprocessor]: Pp warning2!
 module X : sig end
 |}]
 
@@ -586,7 +586,7 @@ let x =
 Line 3, characters 23-38:
 3 |     [@ocaml.ppwarning  "Pp warning 2!"]
                            ^^^^^^^^^^^^^^^
-Warning 22: Pp warning 2!
+Warning 22 [preprocessor]: Pp warning 2!
 val x : unit = ()
 |}]
 
@@ -599,11 +599,11 @@ type t =
 Line 4, characters 21-36:
 4 |   [@@ocaml.ppwarning "Pp warning 3!"]
                          ^^^^^^^^^^^^^^^
-Warning 22: Pp warning 3!
+Warning 22 [preprocessor]: Pp warning 3!
 Line 3, characters 21-36:
 3 |   [@ocaml.ppwarning  "Pp warning 2!"]
                          ^^^^^^^^^^^^^^^
-Warning 22: Pp warning 2!
+Warning 22 [preprocessor]: Pp warning 2!
 type t = unit
 |}]
 
@@ -613,11 +613,11 @@ let ([][@ocaml.ppwarning "XX"]) = []
 Line 1, characters 25-29:
 1 | let ([][@ocaml.ppwarning "XX"]) = []
                              ^^^^
-Warning 22: XX
+Warning 22 [preprocessor]: XX
 Line 1, characters 4-31:
 1 | let ([][@ocaml.ppwarning "XX"]) = []
         ^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 _::_
 |}]
diff --git a/testsuite/tests/typing-extensions/disambiguation.ml b/testsuite/tests/typing-extensions/disambiguation.ml
index feae4c7116..9b0a7c3af0 100644
--- a/testsuite/tests/typing-extensions/disambiguation.ml
+++ b/testsuite/tests/typing-extensions/disambiguation.ml
@@ -242,7 +242,7 @@ type b = Unique
 Line 7, characters 8-14:
 7 | let x = Unique;;
             ^^^^^^
-Warning 41: Unique belongs to several types: b M.s t a
+Warning 41 [ambiguous-name]: Unique belongs to several types: b M.s t a
 The first one was selected. Please disambiguate if this is wrong.
 val x : b = Unique
 |}]
diff --git a/testsuite/tests/typing-extensions/open_types.ml b/testsuite/tests/typing-extensions/open_types.ml
index dd5ed13854..210254418b 100644
--- a/testsuite/tests/typing-extensions/open_types.ml
+++ b/testsuite/tests/typing-extensions/open_types.ml
@@ -306,7 +306,7 @@ type foo += Foo
 Line 3, characters 8-26:
 3 | let f = function Foo -> ()
             ^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 *extension*
 Matching over values of extensible variant types (the *extension* above)
@@ -327,7 +327,7 @@ Lines 1-4, characters 8-11:
 2 |   | [Foo] -> 1
 3 |   | _::_::_ -> 3
 4 |   | [] -> 2
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 *extension*::[]
 Matching over values of extensible variant types (the *extension* above)
@@ -350,7 +350,7 @@ let f = function IPair (i, j) -> Format.sprintf "(%d, %d)" i j ;;
 Line 1, characters 8-62:
 1 | let f = function IPair (i, j) -> Format.sprintf "(%d, %d)" i j ;;
             ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 *extension*
 Matching over values of extensible variant types (the *extension* above)
diff --git a/testsuite/tests/typing-gadts/didier.ml b/testsuite/tests/typing-gadts/didier.ml
index 7c13cb4f69..3ede931224 100644
--- a/testsuite/tests/typing-gadts/didier.ml
+++ b/testsuite/tests/typing-gadts/didier.ml
@@ -15,7 +15,7 @@ type 'a ty = Int : int ty | Bool : bool ty
 Lines 6-7, characters 2-13:
 6 | ..match tag with
 7 |   | Bool -> x
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Int
 val fbool : 't -> 't ty -> 't = <fun>
@@ -31,7 +31,7 @@ let fint (type t) (x : t) (tag : t ty) =
 Lines 2-3, characters 2-16:
 2 | ..match tag with
 3 |   | Int -> x > 0
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Bool
 val fint : 't -> 't ty -> bool = <fun>
diff --git a/testsuite/tests/typing-gadts/pr5785.ml b/testsuite/tests/typing-gadts/pr5785.ml
index a5f2d22439..aebad418d0 100644
--- a/testsuite/tests/typing-gadts/pr5785.ml
+++ b/testsuite/tests/typing-gadts/pr5785.ml
@@ -17,7 +17,7 @@ Lines 7-9, characters 43-24:
 7 | ...........................................function
 8 |     | One, One -> "two"
 9 |     | Two, Two -> "four"
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (One, Two)
 module Add :
diff --git a/testsuite/tests/typing-gadts/pr5906.ml b/testsuite/tests/typing-gadts/pr5906.ml
index c722ec27c2..048c6ef4bf 100644
--- a/testsuite/tests/typing-gadts/pr5906.ml
+++ b/testsuite/tests/typing-gadts/pr5906.ml
@@ -33,7 +33,7 @@ Lines 12-16, characters 2-36:
 14 |   | Leq, Int x, Int y -> Bool (x <= y)
 15 |   | Leq, Bool x, Bool y -> Bool (x <= y)
 16 |   | Add, Int x, Int y -> Int (x + y)
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (Eq, Int _, _)
 val eval : ('a, 'b, 'c) binop -> 'a constant -> 'b constant -> 'c constant =
diff --git a/testsuite/tests/typing-gadts/pr5981.ml b/testsuite/tests/typing-gadts/pr5981.ml
index 9431a1ca1b..7462a02e86 100644
--- a/testsuite/tests/typing-gadts/pr5981.ml
+++ b/testsuite/tests/typing-gadts/pr5981.ml
@@ -15,7 +15,7 @@ end;;
 Lines 7-8, characters 47-21:
 7 | ...............................................match l, r with
 8 |     | A, B -> "f A B"
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (A, A)
 module F :
@@ -42,7 +42,7 @@ end;;
 Lines 10-11, characters 15-21:
 10 | ...............match l, r with
 11 |     | A, B -> "f A B"
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (A, A)
 module F :
diff --git a/testsuite/tests/typing-gadts/pr5985.ml b/testsuite/tests/typing-gadts/pr5985.ml
index c8a9c6f25a..ca9d793e71 100644
--- a/testsuite/tests/typing-gadts/pr5985.ml
+++ b/testsuite/tests/typing-gadts/pr5985.ml
@@ -70,16 +70,15 @@ Error: In this definition, a type variable cannot be deduced
 (* It is not OK to allow modules exported by other compilation units *)
 type (_,_) eq = Eq : ('a,'a) eq;;
 let eq = Obj.magic Eq;;
-(* pretend that Queue.t is not injective *)
-let eq : ('a Queue.t, 'b Queue.t) eq = eq;;
-type _ t = T : 'a -> 'a Queue.t t;; (* fail *)
+let eq : (('a, 'b) Ephemeron.K1.t, ('c, 'd) Ephemeron.K1.t) eq = eq;;
+type _ t = T : 'a -> ('a, 'b) Ephemeron.K1.t t;; (* fail *)
 [%%expect{|
 type (_, _) eq = Eq : ('a, 'a) eq
 val eq : 'a = <poly>
-val eq : ('a Queue.t, 'b Queue.t) eq = Eq
-Line 5, characters 0-33:
-5 | type _ t = T : 'a -> 'a Queue.t t;; (* fail *)
-    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+val eq : (('a, 'b) Ephemeron.K1.t, ('c, 'd) Ephemeron.K1.t) eq = Eq
+Line 4, characters 0-46:
+4 | type _ t = T : 'a -> ('a, 'b) Ephemeron.K1.t t;; (* fail *)
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: In this definition, a type variable cannot be deduced
        from the type parameters.
 |}];;
diff --git a/testsuite/tests/typing-gadts/pr5989.ml b/testsuite/tests/typing-gadts/pr5989.ml
index def3e533f5..3911e77a52 100644
--- a/testsuite/tests/typing-gadts/pr5989.ml
+++ b/testsuite/tests/typing-gadts/pr5989.ml
@@ -28,7 +28,7 @@ module M : sig type s = private [> `A ] val eq : (s, [ `A | `B ]) t end
 Lines 16-17, characters 39-16:
 16 | .......................................function
 17 |   | Any -> "Any"
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Eq
 val f : (M.s, [ `A | `B ]) t -> string = <fun>
@@ -58,7 +58,7 @@ module N :
 Lines 12-13, characters 49-16:
 12 | .................................................function
 13 |   | Any -> "Any"
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Eq
 val f : (N.s, < a : int; b : bool >) t -> string = <fun>
diff --git a/testsuite/tests/typing-gadts/pr5997.ml b/testsuite/tests/typing-gadts/pr5997.ml
index 27e35b3579..d2e0f3c2be 100644
--- a/testsuite/tests/typing-gadts/pr5997.ml
+++ b/testsuite/tests/typing-gadts/pr5997.ml
@@ -25,7 +25,7 @@ module M : sig type t = T val comp : (U.t, t) comp end
 Line 16, characters 0-33:
 16 | match M.comp with | Diff -> false;;
      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Eq
 Exception: Match_failure ("", 16, 0).
@@ -48,7 +48,7 @@ module M : sig type t = { x : int; } val comp : (U.t, t) comp end
 Line 11, characters 0-33:
 11 | match M.comp with | Diff -> false;;
      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Eq
 Exception: Match_failure ("", 11, 0).
diff --git a/testsuite/tests/typing-gadts/pr6241.ml b/testsuite/tests/typing-gadts/pr6241.ml
index 330965f7f1..bd9e295c1a 100644
--- a/testsuite/tests/typing-gadts/pr6241.ml
+++ b/testsuite/tests/typing-gadts/pr6241.ml
@@ -24,7 +24,7 @@ type (_, _) t = A : ('a, 'a) t | B : string -> ('a, 'b) t
 Lines 8-9, characters 52-13:
 8 | ....................................................function
 9 |    | B s -> s
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 A
 module M :
diff --git a/testsuite/tests/typing-gadts/pr6993_bad.ml b/testsuite/tests/typing-gadts/pr6993_bad.ml
index e33808a73c..7f71417e1f 100644
--- a/testsuite/tests/typing-gadts/pr6993_bad.ml
+++ b/testsuite/tests/typing-gadts/pr6993_bad.ml
@@ -20,7 +20,7 @@ type (_, _) eqp = Y : ('a, 'a) eqp | N : string -> ('a, 'b) eqp
 Line 2, characters 36-66:
 2 | let f : ('a list, 'a) eqp -> unit = function N s -> print_string s;;
                                         ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Y
 val f : ('a list, 'a) eqp -> unit = <fun>
diff --git a/testsuite/tests/typing-gadts/pr7016.ml b/testsuite/tests/typing-gadts/pr7016.ml
index 8d3a862a75..a0b92fab18 100644
--- a/testsuite/tests/typing-gadts/pr7016.ml
+++ b/testsuite/tests/typing-gadts/pr7016.ml
@@ -14,7 +14,7 @@ type (_, _) t =
 Line 5, characters 9-43:
 5 | let get1 (Cons (x, _) : (_ * 'a, 'a) t) = x ;; (* warn, cf PR#6993 *)
              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Nil
 val get1 : ('b * 'a, 'a) t -> 'b = <fun>
diff --git a/testsuite/tests/typing-gadts/pr7234.ml b/testsuite/tests/typing-gadts/pr7234.ml
index ae98e02c66..fa7fb742db 100644
--- a/testsuite/tests/typing-gadts/pr7234.ml
+++ b/testsuite/tests/typing-gadts/pr7234.ml
@@ -11,7 +11,7 @@ type 'a t
 Line 3, characters 15-40:
 3 | let f (type a) (Neq n : (a, a t) eq) = n;;   (* warn! *)
                    ^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Eq
 val f : ('a, 'a t) eq -> int = <fun>
@@ -24,7 +24,7 @@ end;;
 Line 2, characters 16-43:
 2 |  let f (type a) (Neq n : (a, a T.t) eq) = n  (* warn! *)
                     ^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Eq
 module F :
diff --git a/testsuite/tests/typing-gadts/pr7269.ml b/testsuite/tests/typing-gadts/pr7269.ml
index 9293eb3b83..a3b967ad48 100644
--- a/testsuite/tests/typing-gadts/pr7269.ml
+++ b/testsuite/tests/typing-gadts/pr7269.ml
@@ -14,7 +14,7 @@ type +'a t = T : [< `Conj of 'a & sub | `Other of string ] -> 'a t
 Line 4, characters 6-47:
 4 | let f (T (`Other msg) : s t) = print_string msg;;
           ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 T (`Conj _)
 val f : s t -> unit = <fun>
@@ -42,7 +42,7 @@ module M :
 Line 11, characters 12-59:
 11 | let () = M.(match x with T (`Other msg) -> print_string msg);; (* warn *)
                  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 T (`Conj _)
 Exception: Match_failure ("", 11, 12).
@@ -74,7 +74,7 @@ module M :
 Line 13, characters 21-57:
 13 | let () = M.(e { ex = fun (`Other msg) -> print_string msg });; (* warn *)
                           ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 `Conj _
 Exception: Match_failure ("", 13, 21).
diff --git a/testsuite/tests/typing-gadts/pr7390.ml b/testsuite/tests/typing-gadts/pr7390.ml
index 2a988e1ceb..4c7b65b328 100644
--- a/testsuite/tests/typing-gadts/pr7390.ml
+++ b/testsuite/tests/typing-gadts/pr7390.ml
@@ -24,7 +24,7 @@ let f (* : filled either -> string *) =
 Line 2, characters 2-28:
 2 |   fun (Either (Y a, N)) -> a;;
       ^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Either (N, Y _)
 val f : filled either -> string = <fun>
diff --git a/testsuite/tests/typing-gadts/pr7432.ml b/testsuite/tests/typing-gadts/pr7432.ml
index 014fd7e447..f7efea65fe 100644
--- a/testsuite/tests/typing-gadts/pr7432.ml
+++ b/testsuite/tests/typing-gadts/pr7432.ml
@@ -24,7 +24,7 @@ let f : [`L of (s, t) eql | `R of silly] -> 'a =
 Line 2, characters 2-30:
 2 |   function `R {silly} -> silly
       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 `L Refl
 val f : [ `L of (s, t) eql | `R of silly ] -> 'a = <fun>
diff --git a/testsuite/tests/typing-gadts/pr9019.ml b/testsuite/tests/typing-gadts/pr9019.ml
index 7a946bfb12..f90cd23299 100644
--- a/testsuite/tests/typing-gadts/pr9019.ml
+++ b/testsuite/tests/typing-gadts/pr9019.ml
@@ -36,7 +36,7 @@ Lines 4-8, characters 2-18:
 6 |   | MAB, _, A -> 2
 7 |   | _,  AB, B -> 3
 8 |   | _, MAB, B -> 4
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (AB, MAB, A)
 val f : 'x M.t -> 'x M.t -> 'x -> int = <fun>
@@ -137,7 +137,7 @@ let f (type x) (t1 : x t) (t2 : x t) (x : x) =
 Line 7, characters 4-22:
 7 |   | _,  AB,  { a = _ } -> 3
         ^^^^^^^^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
 val f : 'x M.t -> 'x M.t -> 'x -> int = <fun>
 |}]
 
@@ -167,7 +167,7 @@ Lines 9-11, characters 2-37:
  9 | ..match a, a_or_b, x with
 10 |   | Not_A, A_or_B, `B i -> print_int i
 11 |   | _, A_or_B, `A s -> print_string s
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (A, A_or_B, `B _)
 val f : 'x a -> 'x a_or_b -> 'x -> unit = <fun>
@@ -198,7 +198,7 @@ Lines 9-11, characters 2-18:
  9 | ..match b, x, y with
 10 |   | B, `B String_option, Some s -> print_string s
 11 |   | A, `A, _ -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (B, `B String_option, None)
 val f : ('x, 'y ty) b -> 'x -> 'y -> unit = <fun>
@@ -218,7 +218,7 @@ type 'a a = private [< `A of 'a ]
 Line 2, characters 18-44:
 2 | let f (x : _ a) = match x with `A None -> ();;
                       ^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 `A (Some _)
 val f : 'a option a -> unit = <fun>
@@ -229,7 +229,7 @@ let f (x : [> `A] a) = match x with `A `B -> ();;
 Line 1, characters 23-47:
 1 | let f (x : [> `A] a) = match x with `A `B -> ();;
                            ^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 `A `A
 val f : [< `A | `B > `A ] a -> unit = <fun>
diff --git a/testsuite/tests/typing-gadts/principality-and-gadts.ml b/testsuite/tests/typing-gadts/principality-and-gadts.ml
index d4e3b9b16c..1798cda08b 100644
--- a/testsuite/tests/typing-gadts/principality-and-gadts.ml
+++ b/testsuite/tests/typing-gadts/principality-and-gadts.ml
@@ -21,7 +21,7 @@ let f = function Sigma (M, A) -> ();;
 Line 1, characters 8-35:
 1 | let f = function Sigma (M, A) -> ();;
             ^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Sigma (M, B)
 val f : dyn -> unit = <fun>
@@ -46,12 +46,12 @@ val f : 'a t -> 'a -> int = <fun>
 Line 4, characters 4-10:
 4 |   | IntLit, n -> n+1
         ^^^^^^
-Warning 18: typing this pattern requires considering int and a as equal.
+Warning 18 [not-principal]: typing this pattern requires considering int and a as equal.
 But the knowledge of these types is not principal.
 Line 5, characters 4-11:
 5 |   | BoolLit, b -> 1
         ^^^^^^^
-Warning 18: typing this pattern requires considering bool and a as equal.
+Warning 18 [not-principal]: typing this pattern requires considering bool and a as equal.
 But the knowledge of these types is not principal.
 val f : 'a t -> 'a -> int = <fun>
 |}]
@@ -68,7 +68,7 @@ val f : 'a t -> 'a -> int = <fun>
 Line 4, characters 4-10:
 4 |   | IntLit, n -> n+1
         ^^^^^^
-Warning 18: typing this pattern requires considering int and a as equal.
+Warning 18 [not-principal]: typing this pattern requires considering int and a as equal.
 But the knowledge of these types is not principal.
 val f : 'a t -> 'a -> int = <fun>
 |}]
@@ -136,7 +136,7 @@ val f1 : unit ab M.t -> bool = <fun>
 Line 4, characters 4-7:
 4 |   | MAB -> false;;
         ^^^
-Warning 18: typing this pattern requires considering unit M.mab and unit ab as equal.
+Warning 18 [not-principal]: typing this pattern requires considering unit M.mab and unit ab as equal.
 But the knowledge of these types is not principal.
 val f1 : unit ab M.t -> bool = <fun>
 |}]
@@ -152,12 +152,12 @@ val f2 : 'x M.t -> bool = <fun>
 Line 4, characters 4-6:
 4 |   | AB -> true
         ^^
-Warning 18: typing this pattern requires considering unit ab and x as equal.
+Warning 18 [not-principal]: typing this pattern requires considering unit ab and x as equal.
 But the knowledge of these types is not principal.
 Line 5, characters 4-7:
 5 |   | MAB -> false;;
         ^^^
-Warning 18: typing this pattern requires considering unit M.mab and x as equal.
+Warning 18 [not-principal]: typing this pattern requires considering unit M.mab and x as equal.
 But the knowledge of these types is not principal.
 val f2 : 'x M.t -> bool = <fun>
 |}]
@@ -174,7 +174,7 @@ val f3 : unit ab M.t -> bool = <fun>
 Line 5, characters 4-7:
 5 |   | MAB -> false;;
         ^^^
-Warning 18: typing this pattern requires considering unit M.mab and unit ab as equal.
+Warning 18 [not-principal]: typing this pattern requires considering unit M.mab and unit ab as equal.
 But the knowledge of these types is not principal.
 val f3 : unit ab M.t -> bool = <fun>
 |}]
@@ -201,7 +201,7 @@ val g2 : ('x, int option) eq -> 'x -> int option = <fun>
 Line 3, characters 7-11:
 3 |    let Refl = e in x;;
            ^^^^
-Warning 18: typing this pattern requires considering x and int option as equal.
+Warning 18 [not-principal]: typing this pattern requires considering x and int option as equal.
 But the knowledge of these types is not principal.
 val g2 : ('x, int option) eq -> 'x -> int option = <fun>
 |}]
@@ -232,7 +232,7 @@ let () =
 Line 3, characters 27-28:
 3 |   | [ { a = 3; _ } ; { b = F; _ }] -> ()
                                ^
-Warning 18: typing this pattern requires considering Foo.t and int as equal.
+Warning 18 [not-principal]: typing this pattern requires considering Foo.t and int as equal.
 But the knowledge of these types is not principal.
 |}]
 
@@ -267,7 +267,7 @@ let () =
 Line 3, characters 26-31:
 3 |   | [ { a = 3; _ }; { b = Refl3 ; _ }] -> ()
                               ^^^^^
-Warning 18: typing this pattern requires considering int and Foo.t as equal.
+Warning 18 [not-principal]: typing this pattern requires considering int and Foo.t as equal.
 But the knowledge of these types is not principal.
 |}]
 
@@ -281,7 +281,7 @@ let () =
 Line 3, characters 12-17:
 3 |   | [ { b = Refl3 ; _ }; { a = 3; _ } ] -> ()
                 ^^^^^
-Warning 18: typing this pattern requires considering int and Foo.t as equal.
+Warning 18 [not-principal]: typing this pattern requires considering int and Foo.t as equal.
 But the knowledge of these types is not principal.
 |}]
 
@@ -302,7 +302,7 @@ let () =
 Line 3, characters 26-31:
 3 |   | [ { a = 3; _ }; { b = Refl3 ; _ }] -> ()
                               ^^^^^
-Warning 18: typing this pattern requires considering int and Foo.t as equal.
+Warning 18 [not-principal]: typing this pattern requires considering int and Foo.t as equal.
 But the knowledge of these types is not principal.
 |}]
 
@@ -315,7 +315,7 @@ let () =
 Line 3, characters 12-17:
 3 |   | [ { b = Refl3 ; _ }; { a = 3; _ } ] -> ()
                 ^^^^^
-Warning 18: typing this pattern requires considering int and Foo.t as equal.
+Warning 18 [not-principal]: typing this pattern requires considering int and Foo.t as equal.
 But the knowledge of these types is not principal.
 |}]
 
@@ -347,7 +347,7 @@ val foo : M.t foo -> M.t = <fun>
 Line 3, characters 18-23:
 3 |   | { x = x; eq = Refl3 } -> x
                       ^^^^^
-Warning 18: typing this pattern requires considering M.t and N.t as equal.
+Warning 18 [not-principal]: typing this pattern requires considering M.t and N.t as equal.
 But the knowledge of these types is not principal.
 val foo : M.t foo -> M.t = <fun>
 |}]
@@ -362,7 +362,7 @@ val foo : int foo -> int = <fun>
 Line 3, characters 26-31:
 3 |   | { x = (x : int); eq = Refl3 } -> x
                               ^^^^^
-Warning 18: typing this pattern requires considering M.t and int as equal.
+Warning 18 [not-principal]: typing this pattern requires considering M.t and int as equal.
 But the knowledge of these types is not principal.
 val foo : int foo -> int = <fun>
 |}]
@@ -383,7 +383,7 @@ Error: This pattern matches values of type N.t foo
 Line 3, characters 26-31:
 3 |   | { x = (x : N.t); eq = Refl3 } -> x
                               ^^^^^
-Warning 18: typing this pattern requires considering M.t and N.t as equal.
+Warning 18 [not-principal]: typing this pattern requires considering M.t and N.t as equal.
 But the knowledge of these types is not principal.
 Line 3, characters 4-33:
 3 |   | { x = (x : N.t); eq = Refl3 } -> x
@@ -404,7 +404,7 @@ val foo : string foo -> string = <fun>
 Line 3, characters 29-34:
 3 |   | { x = (x : string); eq = Refl3 } -> x
                                  ^^^^^
-Warning 18: typing this pattern requires considering M.t and string as equal.
+Warning 18 [not-principal]: typing this pattern requires considering M.t and string as equal.
 But the knowledge of these types is not principal.
 val foo : string foo -> string = <fun>
 |}]
diff --git a/testsuite/tests/typing-gadts/test.ml b/testsuite/tests/typing-gadts/test.ml
index a5293d7854..d210724ac3 100644
--- a/testsuite/tests/typing-gadts/test.ml
+++ b/testsuite/tests/typing-gadts/test.ml
@@ -106,14 +106,14 @@ module Nonexhaustive =
 Lines 11-12, characters 6-19:
 11 | ......function
 12 |         | C2 x -> x
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 C1 _
 Lines 24-26, characters 6-30:
 24 | ......function
 25 |         | Foo _ , Foo _ -> true
 26 |         | Bar _, Bar _ -> true
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (Foo _, Bar _)
 module Nonexhaustive :
@@ -160,13 +160,13 @@ end;;
 Line 2, characters 10-18:
 2 |   class c (Some x) = object method x : int = x end
               ^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 None
 Line 4, characters 10-18:
 4 |   class d (Just x) = object method x : int = x end
               ^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Nothing
 module PR6862 :
@@ -195,7 +195,7 @@ end;;
 Line 4, characters 43-44:
 4 |   let g : int t -> int = function I -> 1 | _ -> 2 (* warn *)
                                                ^
-Warning 56: this match case is unreachable.
+Warning 56 [unreachable-case]: this match case is unreachable.
 Consider replacing it with a refutation case '<pat> -> .'
 module PR6220 :
   sig
@@ -263,7 +263,7 @@ end;;
 Lines 8-9, characters 4-33:
 8 | ....match x with
 9 |     | String s -> print_endline s.................
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Any
 module PR6801 :
@@ -918,7 +918,7 @@ Lines 2-8, characters 2-16:
 6 |   | TE TC, D [|1.0|] -> 14
 7 |   | TA, D 0 -> -1
 8 |   | TA, D z -> z
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (TE TC, D [| 0. |])
 val f : 'a ty -> 'a t -> int = <fun>
@@ -982,7 +982,7 @@ Lines 4-10, characters 2-29:
  8 |   | {left=TE TC; right=D [|1.0|]} -> 14
  9 |   | {left=TA; right=D 0} -> -1
 10 |   | {left=TA; right=D z} -> z
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 {left=TE TC; right=D [| 0. |]}
 val f : 'a ty -> 'a t -> int = <fun>
diff --git a/testsuite/tests/typing-gadts/yallop_bugs.ml b/testsuite/tests/typing-gadts/yallop_bugs.ml
index 7418faae73..7cbaf3ec72 100644
--- a/testsuite/tests/typing-gadts/yallop_bugs.ml
+++ b/testsuite/tests/typing-gadts/yallop_bugs.ml
@@ -60,7 +60,7 @@ Lines 5-7, characters 39-23:
 5 | .......................................function
 6 |   | BoolLit, false -> false
 7 |   | IntLit , 6 -> false
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (BoolLit, true)
 val check : 's t * 's -> bool = <fun>
@@ -78,7 +78,7 @@ Lines 3-5, characters 45-38:
 3 | .............................................function
 4 |   | {fst = BoolLit; snd = false} -> false
 5 |   | {fst = IntLit ; snd =  6} -> false
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 {fst=BoolLit; snd=true}
 val check : ('s t, 's) pair -> bool = <fun>
diff --git a/testsuite/tests/typing-implicit_unpack/implicit_unpack.ml b/testsuite/tests/typing-implicit_unpack/implicit_unpack.ml
index 2cc8cf634c..7589fa1d40 100644
--- a/testsuite/tests/typing-implicit_unpack/implicit_unpack.ml
+++ b/testsuite/tests/typing-implicit_unpack/implicit_unpack.ml
@@ -303,7 +303,7 @@ end
 module type MapT =
   sig
     type key
-    type +'a t
+    type +!'a t
     val empty : 'a t
     val is_empty : 'a t -> bool
     val mem : key -> 'a t -> bool
diff --git a/testsuite/tests/typing-misc/build_as_type.ml b/testsuite/tests/typing-misc/build_as_type.ml
index 03aa0bfa31..6e5efcb1b0 100644
--- a/testsuite/tests/typing-misc/build_as_type.ml
+++ b/testsuite/tests/typing-misc/build_as_type.ml
@@ -72,7 +72,7 @@ Lines 5-7, characters 4-7:
 5 | ....begin match x with
 6 |     | `A -> ()
 7 |     end
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 `B
 val f : t -> unit = <fun>
@@ -128,7 +128,7 @@ Lines 5-7, characters 4-7:
 5 | ....begin match x with
 6 |     | `A -> ()
 7 |     end
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 `B
 val f : t -> unit = <fun>
@@ -148,7 +148,7 @@ Lines 5-7, characters 4-7:
 5 | ....begin match x with
 6 |     | `A -> ()
 7 |     end
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 `B
 val f : t -> unit = <fun>
diff --git a/testsuite/tests/typing-misc/constraints.ml b/testsuite/tests/typing-misc/constraints.ml
index 0fe7387a29..c0115162bd 100644
--- a/testsuite/tests/typing-misc/constraints.ml
+++ b/testsuite/tests/typing-misc/constraints.ml
@@ -134,7 +134,7 @@ module PR6505b :
 Line 6, characters 23-57:
 6 | let () = print_endline (match PR6505b.x with `Bar s -> s);; (* fails *)
                            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 `Foo _
 Exception: Match_failure ("", 6, 23).
diff --git a/testsuite/tests/typing-misc/disambiguate_principality.ml b/testsuite/tests/typing-misc/disambiguate_principality.ml
index 3148ef360b..8fb2154557 100644
--- a/testsuite/tests/typing-misc/disambiguate_principality.ml
+++ b/testsuite/tests/typing-misc/disambiguate_principality.ml
@@ -37,7 +37,7 @@ let after_a =
 Line 3, characters 2-20:
 3 |   { x with lbl = 4 }
       ^^^^^^^^^^^^^^^^^^
-Warning 23: all the fields are explicitly listed in this record:
+Warning 23 [useless-record-with]: all the fields are explicitly listed in this record:
 the 'with' clause is useless.
 val after_a : M.r = {M.lbl = 4}
 |}]
@@ -52,7 +52,7 @@ val b : unit = ()
 Line 3, characters 7-18:
 3 |   x := { lbl = 4 }
            ^^^^^^^^^^^
-Warning 18: this type-based record disambiguation is not principal.
+Warning 18 [not-principal]: this type-based record disambiguation is not principal.
 val b : unit = ()
 |}]
 
@@ -110,17 +110,17 @@ let h x =
 Line 4, characters 4-15:
 4 |   | { lbl = _ } -> ()
         ^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
 val h : M.r -> unit = <fun>
 |}, Principal{|
 Line 4, characters 4-15:
 4 |   | { lbl = _ } -> ()
         ^^^^^^^^^^^
-Warning 18: this type-based record disambiguation is not principal.
+Warning 18 [not-principal]: this type-based record disambiguation is not principal.
 Line 4, characters 4-15:
 4 |   | { lbl = _ } -> ()
         ^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
 val h : M.r -> unit = <fun>
 |}]
 
@@ -145,17 +145,17 @@ let j x =
 Line 4, characters 4-15:
 4 |   | { lbl = _ } -> ()
         ^^^^^^^^^^^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
 val j : M.r -> unit = <fun>
 |}, Principal{|
 Line 4, characters 4-15:
 4 |   | { lbl = _ } -> ()
         ^^^^^^^^^^^
-Warning 18: this type-based record disambiguation is not principal.
+Warning 18 [not-principal]: this type-based record disambiguation is not principal.
 Line 4, characters 4-15:
 4 |   | { lbl = _ } -> ()
         ^^^^^^^^^^^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
 val j : M.r -> unit = <fun>
 |}]
 
@@ -199,17 +199,17 @@ let n x =
 Line 4, characters 4-30:
 4 |   | { contents = { lbl = _ } } -> ()
         ^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
 val n : M.r ref -> unit = <fun>
 |}, Principal{|
 Line 4, characters 17-28:
 4 |   | { contents = { lbl = _ } } -> ()
                      ^^^^^^^^^^^
-Warning 18: this type-based record disambiguation is not principal.
+Warning 18 [not-principal]: this type-based record disambiguation is not principal.
 Line 4, characters 4-30:
 4 |   | { contents = { lbl = _ } } -> ()
         ^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
 val n : M.r ref -> unit = <fun>
 |}]
 
@@ -234,17 +234,17 @@ let p x =
 Line 4, characters 4-30:
 4 |   | { contents = { lbl = _ } } -> ()
         ^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
 val p : M.r ref -> unit = <fun>
 |}, Principal{|
 Line 4, characters 17-28:
 4 |   | { contents = { lbl = _ } } -> ()
                      ^^^^^^^^^^^
-Warning 18: this type-based record disambiguation is not principal.
+Warning 18 [not-principal]: this type-based record disambiguation is not principal.
 Line 4, characters 4-30:
 4 |   | { contents = { lbl = _ } } -> ()
         ^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
 val p : M.r ref -> unit = <fun>
 |}]
 
@@ -280,7 +280,7 @@ val s : M.r ref -> unit = <fun>
 Line 4, characters 9-20:
 4 |     x := { lbl = 4 }
              ^^^^^^^^^^^
-Warning 18: this type-based record disambiguation is not principal.
+Warning 18 [not-principal]: this type-based record disambiguation is not principal.
 val s : M.r ref -> unit = <fun>
 |}]
 
@@ -294,7 +294,7 @@ val t : M.r ref -> unit = <fun>
 Line 3, characters 9-20:
 3 |     x := { lbl = 4 }
              ^^^^^^^^^^^
-Warning 18: this type-based record disambiguation is not principal.
+Warning 18 [not-principal]: this type-based record disambiguation is not principal.
 val t : M.r ref -> unit = <fun>
 |}]
 
@@ -344,7 +344,7 @@ val b : unit = ()
 Line 3, characters 7-8:
 3 |   x := B
            ^
-Warning 18: this type-based constructor disambiguation is not principal.
+Warning 18 [not-principal]: this type-based constructor disambiguation is not principal.
 val b : unit = ()
 |}]
 
@@ -388,7 +388,7 @@ val h : M.t -> unit = <fun>
 Line 4, characters 4-5:
 4 |   | B -> ()
         ^
-Warning 18: this type-based constructor disambiguation is not principal.
+Warning 18 [not-principal]: this type-based constructor disambiguation is not principal.
 val h : M.t -> unit = <fun>
 |}]
 
@@ -415,7 +415,7 @@ val j : M.t -> unit = <fun>
 Line 4, characters 4-5:
 4 |   | B -> ()
         ^
-Warning 18: this type-based constructor disambiguation is not principal.
+Warning 18 [not-principal]: this type-based constructor disambiguation is not principal.
 val j : M.t -> unit = <fun>
 |}]
 
@@ -459,17 +459,17 @@ let n x =
 Line 4, characters 4-20:
 4 |   | { contents = A } -> ()
         ^^^^^^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
 val n : M.t ref -> unit = <fun>
 |}, Principal{|
 Line 4, characters 17-18:
 4 |   | { contents = A } -> ()
                      ^
-Warning 18: this type-based constructor disambiguation is not principal.
+Warning 18 [not-principal]: this type-based constructor disambiguation is not principal.
 Line 4, characters 4-20:
 4 |   | { contents = A } -> ()
         ^^^^^^^^^^^^^^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
 val n : M.t ref -> unit = <fun>
 |}]
 
@@ -494,17 +494,17 @@ let p x =
 Line 4, characters 4-20:
 4 |   | { contents = A } -> ()
         ^^^^^^^^^^^^^^^^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
 val p : M.t ref -> unit = <fun>
 |}, Principal{|
 Line 4, characters 17-18:
 4 |   | { contents = A } -> ()
                      ^
-Warning 18: this type-based constructor disambiguation is not principal.
+Warning 18 [not-principal]: this type-based constructor disambiguation is not principal.
 Line 4, characters 4-20:
 4 |   | { contents = A } -> ()
         ^^^^^^^^^^^^^^^^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
 val p : M.t ref -> unit = <fun>
 |}]
 
@@ -531,7 +531,7 @@ val s : M.t ref -> unit = <fun>
 Line 4, characters 9-10:
 4 |     x := A
              ^
-Warning 18: this type-based constructor disambiguation is not principal.
+Warning 18 [not-principal]: this type-based constructor disambiguation is not principal.
 val s : M.t ref -> unit = <fun>
 |}]
 
@@ -544,7 +544,7 @@ Lines 1-3, characters 8-10:
 1 | ........function
 2 |   | ({ contents = M.A } : M.t ref) as x ->
 3 |     x := B
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 {contents=B}
 val t : M.t ref -> unit = <fun>
@@ -552,12 +552,12 @@ val t : M.t ref -> unit = <fun>
 Line 3, characters 9-10:
 3 |     x := B
              ^
-Warning 18: this type-based constructor disambiguation is not principal.
+Warning 18 [not-principal]: this type-based constructor disambiguation is not principal.
 Lines 1-3, characters 8-10:
 1 | ........function
 2 |   | ({ contents = M.A } : M.t ref) as x ->
 3 |     x := B
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 {contents=B}
 val t : M.t ref -> unit = <fun>
diff --git a/testsuite/tests/typing-misc/empty_variant.ml b/testsuite/tests/typing-misc/empty_variant.ml
index 40a8160299..aaa1f0d61e 100644
--- a/testsuite/tests/typing-misc/empty_variant.ml
+++ b/testsuite/tests/typing-misc/empty_variant.ml
@@ -57,7 +57,7 @@ module Runner : sig val ac : f:((unit, 'a, unit) t -> unit) -> unit end
 Lines 16-17, characters 8-18:
 16 | ........match abc with
 17 |         | A _ -> 1
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 C ()
 val f : unit -> unit = <fun>
@@ -72,7 +72,7 @@ type 'b t = A | B of 'b | C
 Line 3, characters 22-42:
 3 | let g (x:nothing t) = match x with A -> ()
                           ^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 C
 val g : nothing t -> unit = <fun>
diff --git a/testsuite/tests/typing-misc/injectivity.ml b/testsuite/tests/typing-misc/injectivity.ml
index 8660f82579..69bef6e134 100644
--- a/testsuite/tests/typing-misc/injectivity.ml
+++ b/testsuite/tests/typing-misc/injectivity.ml
@@ -309,7 +309,7 @@ val d : dyn = Dyn (Vec (Vec Int), <poly>)
 Line 47, characters 4-11:
 47 | let Some v' = undyn int_vec_vec d
          ^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 None
 val v' : int Vec.t Vec.t = <abstr>
@@ -340,7 +340,7 @@ val coe : ('a, 'b) eq -> 'a ty -> 'b ty = <fun>
 Line 17, characters 2-30:
 17 |   let Vec Int = vec_ty in Refl
        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Vec (Vec Int)
 val eq_int_any : (int, 'a) eq = Refl
diff --git a/testsuite/tests/typing-misc/labels.ml b/testsuite/tests/typing-misc/labels.ml
index 5192f4114a..3a00e3846a 100644
--- a/testsuite/tests/typing-misc/labels.ml
+++ b/testsuite/tests/typing-misc/labels.ml
@@ -10,7 +10,7 @@ val f : x:int -> int = <fun>
 Line 2, characters 5-6:
 2 | f ?x:0;;
          ^
-Warning 43: the label x is not optional.
+Warning 43 [nonoptional-label]: the label x is not optional.
 - : int = 1
 |}];;
 
@@ -65,7 +65,7 @@ val f : (?x:int -> unit -> int) -> int = <fun>
 Line 1, characters 51-52:
 1 | let f g = ignore (g : ?x:int -> unit -> int); g ~x:3 () ;;
                                                        ^
-Warning 18: using an optional argument here is not principal.
+Warning 18 [not-principal]: using an optional argument here is not principal.
 val f : (?x:int -> unit -> int) -> int = <fun>
 |}];;
 
@@ -76,7 +76,7 @@ val f : (?x:int -> unit -> int) -> int = <fun>
 Line 1, characters 46-47:
 1 | let f g = ignore (g : ?x:int -> unit -> int); g ();;
                                                   ^
-Warning 19: eliminated optional argument without principality.
+Warning 19 [non-principal-labels]: eliminated optional argument without principality.
 val f : (?x:int -> unit -> int) -> int = <fun>
 |}];;
 
@@ -87,6 +87,6 @@ val f : (x:int -> unit -> int) -> x:int -> int = <fun>
 Line 1, characters 45-46:
 1 | let f g = ignore (g : x:int -> unit -> int); g ();;
                                                  ^
-Warning 19: commuted an argument without principality.
+Warning 19 [non-principal-labels]: commuted an argument without principality.
 val f : (x:int -> unit -> int) -> x:int -> int = <fun>
 |}];;
diff --git a/testsuite/tests/typing-misc/polyvars.ml b/testsuite/tests/typing-misc/polyvars.ml
index 52bc178fa5..e5647f61af 100644
--- a/testsuite/tests/typing-misc/polyvars.ml
+++ b/testsuite/tests/typing-misc/polyvars.ml
@@ -37,7 +37,7 @@ let f (x : [< `A | `B]) = match x with `A | `B | `C -> 0;; (* warn *)
 Line 1, characters 49-51:
 1 | let f (x : [< `A | `B]) = match x with `A | `B | `C -> 0;; (* warn *)
                                                      ^^
-Warning 12: this sub-pattern is unused.
+Warning 12 [redundant-subpat]: this sub-pattern is unused.
 val f : [< `A | `B ] -> int = <fun>
 |}];;
 let f (x : [`A | `B]) = match x with `A | `B | `C -> 0;; (* fail *)
@@ -73,31 +73,31 @@ type t = A | B
 Line 9, characters 0-41:
 9 | function (`A|`B), _ -> 0 | _,(`A|`B) -> 1;;
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (`AnyOtherTag, `AnyOtherTag)
 - : [> `A | `B ] * [> `A | `B ] -> int = <fun>
 Line 10, characters 0-29:
 10 | function `B,1 -> 1 | _,1 -> 2;;
      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (_, 0)
 Line 10, characters 21-24:
 10 | function `B,1 -> 1 | _,1 -> 2;;
                           ^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
 - : [< `B ] * int -> int = <fun>
 Line 11, characters 0-29:
 11 | function 1,`B -> 1 | 1,_ -> 2;;
      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (0, _)
 Line 11, characters 21-24:
 11 | function 1,`B -> 1 | 1,_ -> 2;;
                           ^^^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
 - : int * [< `B ] -> int = <fun>
 |}];;
 
@@ -138,7 +138,7 @@ type t = private [> `A of string ]
 Line 2, characters 0-24:
 2 | function (`A x : t) -> x;;
     ^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 `<some private tag>
 - : t -> string = <fun>
@@ -149,7 +149,7 @@ let f = function `AnyOtherTag, _ -> 1 | _, (`AnyOtherTag|`AnyOtherTag') -> 2;;
 Line 1, characters 8-76:
 1 | let f = function `AnyOtherTag, _ -> 1 | _, (`AnyOtherTag|`AnyOtherTag') -> 2;;
             ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (`AnyOtherTag', `AnyOtherTag'')
 val f : [> `AnyOtherTag ] * [> `AnyOtherTag | `AnyOtherTag' ] -> int = <fun>
diff --git a/testsuite/tests/typing-misc/pr6416.ml b/testsuite/tests/typing-misc/pr6416.ml
index bda17f1d1c..43edff68bb 100644
--- a/testsuite/tests/typing-misc/pr6416.ml
+++ b/testsuite/tests/typing-misc/pr6416.ml
@@ -385,7 +385,7 @@ module Foo : sig type info = { doc : unit; } type t = { info : info; } end
 Line 5, characters 38-41:
 5 | let add_extra_info arg = arg.Foo.info.doc
                                           ^^^
-Warning 40: doc was selected from type Foo.info.
+Warning 40 [name-out-of-scope]: doc was selected from type Foo.info.
 It is not visible in the current scope, and will not
 be selected if the type becomes unknown.
 val add_extra_info : Foo.t -> unit = <fun>
@@ -407,7 +407,7 @@ module Bar : sig end
 Line 8, characters 38-41:
 8 | let add_extra_info arg = arg.Foo.info.doc
                                           ^^^
-Warning 40: doc was selected from type Bar/2.info.
+Warning 40 [name-out-of-scope]: doc was selected from type Bar/2.info.
 It is not visible in the current scope, and will not
 be selected if the type becomes unknown.
 val add_extra_info : Foo.t -> unit = <fun>
diff --git a/testsuite/tests/typing-misc/pr6939-flat-float-array.ml b/testsuite/tests/typing-misc/pr6939-flat-float-array.ml
index 2fe2fcd56f..d869300c3a 100644
--- a/testsuite/tests/typing-misc/pr6939-flat-float-array.ml
+++ b/testsuite/tests/typing-misc/pr6939-flat-float-array.ml
@@ -8,7 +8,7 @@ let rec x = [| x |]; 1.;;
 Line 1, characters 12-19:
 1 | let rec x = [| x |]; 1.;;
                 ^^^^^^^
-Warning 10: this expression should have type unit.
+Warning 10 [non-unit-statement]: this expression should have type unit.
 Line 1, characters 12-23:
 1 | let rec x = [| x |]; 1.;;
                 ^^^^^^^^^^^
diff --git a/testsuite/tests/typing-misc/pr6939-no-flat-float-array.ml b/testsuite/tests/typing-misc/pr6939-no-flat-float-array.ml
index a08bb57ac2..1450efc75c 100644
--- a/testsuite/tests/typing-misc/pr6939-no-flat-float-array.ml
+++ b/testsuite/tests/typing-misc/pr6939-no-flat-float-array.ml
@@ -8,7 +8,7 @@ let rec x = [| x |]; 1.;;
 Line 1, characters 12-19:
 1 | let rec x = [| x |]; 1.;;
                 ^^^^^^^
-Warning 10: this expression should have type unit.
+Warning 10 [non-unit-statement]: this expression should have type unit.
 val x : float = 1.
 |}];;
 
@@ -17,7 +17,7 @@ let rec x = let u = [|y|] in 10. and y = 1.;;
 Line 1, characters 16-17:
 1 | let rec x = let u = [|y|] in 10. and y = 1.;;
                     ^
-Warning 26: unused variable u.
+Warning 26 [unused-var]: unused variable u.
 val x : float = 10.
 val y : float = 1.
 |}];;
diff --git a/testsuite/tests/typing-misc/records.ml b/testsuite/tests/typing-misc/records.ml
index d11f1b4e38..51623ef2cf 100644
--- a/testsuite/tests/typing-misc/records.ml
+++ b/testsuite/tests/typing-misc/records.ml
@@ -171,7 +171,7 @@ let r = { (assert false) with contents = 1 } ;;
 Line 1, characters 8-44:
 1 | let r = { (assert false) with contents = 1 } ;;
             ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 23: all the fields are explicitly listed in this record:
+Warning 23 [useless-record-with]: all the fields are explicitly listed in this record:
 the 'with' clause is useless.
 Exception: Assert_failure ("", 1, 10).
 |}]
diff --git a/testsuite/tests/typing-objects-bugs/pr7284_bad.compilers.reference b/testsuite/tests/typing-objects-bugs/pr7284_bad.compilers.reference
index de957e79e1..648d3fea9c 100644
--- a/testsuite/tests/typing-objects-bugs/pr7284_bad.compilers.reference
+++ b/testsuite/tests/typing-objects-bugs/pr7284_bad.compilers.reference
@@ -1,6 +1,6 @@
 File "pr7284_bad.ml", line 35, characters 30-62:
 35 |    let f : X.v1 wit -> unit = function V1 s -> print_endline s
                                    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error (warning 8): this pattern-matching is not exhaustive.
+Error (warning 8 [partial-match]): this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 V2 _
diff --git a/testsuite/tests/typing-objects/Exemples.ml b/testsuite/tests/typing-objects/Exemples.ml
index 00cbde533d..dca5d1b859 100644
--- a/testsuite/tests/typing-objects/Exemples.ml
+++ b/testsuite/tests/typing-objects/Exemples.ml
@@ -289,7 +289,7 @@ end;;
 Line 3, characters 10-27:
 3 |   inherit printable_point y as super
               ^^^^^^^^^^^^^^^^^
-Warning 13: the following instance variables are overridden by the class printable_point :
+Warning 13 [instance-variable-override]: the following instance variables are overridden by the class printable_point :
   x
 The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
 class printable_color_point :
@@ -618,7 +618,7 @@ let pr l =
 Line 2, characters 2-69:
 2 |   List.map (fun c -> Format.print_int c#x; Format.print_string " ") l;
       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 10: this expression should have type unit.
+Warning 10 [non-unit-statement]: this expression should have type unit.
 val pr : < x : int; .. > list -> unit = <fun>
 |}];;
 let l = [new int_comparable 5; (new int_comparable3 2 :> int_comparable);
diff --git a/testsuite/tests/typing-objects/Tests.ml b/testsuite/tests/typing-objects/Tests.ml
index 82a2bbc9ce..7bd13f19c7 100644
--- a/testsuite/tests/typing-objects/Tests.ml
+++ b/testsuite/tests/typing-objects/Tests.ml
@@ -472,24 +472,24 @@ end;;
 Line 3, characters 10-13:
 3 |   inherit c 5
               ^^^
-Warning 13: the following instance variables are overridden by the class c :
+Warning 13 [instance-variable-override]: the following instance variables are overridden by the class c :
   x
 The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
 Line 4, characters 6-7:
 4 |   val y = 3
           ^
-Warning 13: the instance variable y is overridden.
+Warning 13 [instance-variable-override]: the instance variable y is overridden.
 The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
 Line 6, characters 10-13:
 6 |   inherit d 7
               ^^^
-Warning 13: the following instance variables are overridden by the class d :
+Warning 13 [instance-variable-override]: the following instance variables are overridden by the class d :
   t z
 The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
 Line 7, characters 6-7:
 7 |   val u = 3
           ^
-Warning 13: the instance variable u is overridden.
+Warning 13 [instance-variable-override]: the instance variable u is overridden.
 The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
 class e :
   unit ->
@@ -791,7 +791,7 @@ fun (x : 'a t) -> (x : 'a); ();;
 Line 1, characters 18-26:
 1 | fun (x : 'a t) -> (x : 'a); ();;
                       ^^^^^^^^
-Warning 10: this expression should have type unit.
+Warning 10 [non-unit-statement]: this expression should have type unit.
 - : ('a t as 'a) t -> unit = <fun>
 |}];;
 
diff --git a/testsuite/tests/typing-ocamlc-i/pervasives_leitmotiv.compilers.reference b/testsuite/tests/typing-ocamlc-i/pervasives_leitmotiv.compilers.reference
index def5d74867..ec49bdc0ae 100644
--- a/testsuite/tests/typing-ocamlc-i/pervasives_leitmotiv.compilers.reference
+++ b/testsuite/tests/typing-ocamlc-i/pervasives_leitmotiv.compilers.reference
@@ -1,5 +1,5 @@
 File "pervasives_leitmotiv.ml", line 1:
-Warning 63: The printed interface differs from the inferred interface.
+Warning 63 [erroneous-printed-signature]: The printed interface differs from the inferred interface.
 The inferred interface contained items which could not be printed
 properly due to name collisions between identifiers.
 File "pervasives_leitmotiv.ml", lines 10-12, characters 0-3:
diff --git a/testsuite/tests/typing-ocamlc-i/pr4791.compilers.reference b/testsuite/tests/typing-ocamlc-i/pr4791.compilers.reference
index b4938f16e9..0ea6e282a2 100644
--- a/testsuite/tests/typing-ocamlc-i/pr4791.compilers.reference
+++ b/testsuite/tests/typing-ocamlc-i/pr4791.compilers.reference
@@ -1,5 +1,5 @@
 File "pr4791.ml", line 1:
-Warning 63: The printed interface differs from the inferred interface.
+Warning 63 [erroneous-printed-signature]: The printed interface differs from the inferred interface.
 The inferred interface contained items which could not be printed
 properly due to name collisions between identifiers.
 File "pr4791.ml", line 11, characters 2-12:
diff --git a/testsuite/tests/typing-ocamlc-i/pr6323.compilers.reference b/testsuite/tests/typing-ocamlc-i/pr6323.compilers.reference
index c06cebec34..29e3342fad 100644
--- a/testsuite/tests/typing-ocamlc-i/pr6323.compilers.reference
+++ b/testsuite/tests/typing-ocamlc-i/pr6323.compilers.reference
@@ -1,5 +1,5 @@
 File "pr6323.ml", line 1:
-Warning 63: The printed interface differs from the inferred interface.
+Warning 63 [erroneous-printed-signature]: The printed interface differs from the inferred interface.
 The inferred interface contained items which could not be printed
 properly due to name collisions between identifiers.
 File "pr6323.ml", line 15, characters 2-24:
diff --git a/testsuite/tests/typing-ocamlc-i/pr7402.compilers.reference b/testsuite/tests/typing-ocamlc-i/pr7402.compilers.reference
index 46811961d7..df578593ff 100644
--- a/testsuite/tests/typing-ocamlc-i/pr7402.compilers.reference
+++ b/testsuite/tests/typing-ocamlc-i/pr7402.compilers.reference
@@ -1,5 +1,5 @@
 File "pr7402.ml", line 1:
-Warning 63: The printed interface differs from the inferred interface.
+Warning 63 [erroneous-printed-signature]: The printed interface differs from the inferred interface.
 The inferred interface contained items which could not be printed
 properly due to name collisions between identifiers.
 File "pr7402.ml", lines 14-16, characters 0-5:
diff --git a/testsuite/tests/typing-poly/poly.ml b/testsuite/tests/typing-poly/poly.ml
index 3509427869..0b82bf456e 100644
--- a/testsuite/tests/typing-poly/poly.ml
+++ b/testsuite/tests/typing-poly/poly.ml
@@ -52,7 +52,7 @@ Lines 1-4, characters 0-24:
 2 | | {pv=[]} -> "OK"
 3 | | {pv=5::_} -> "int"
 4 | | {pv=true::_} -> "bool"
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 {pv=false::_}
 - : string = "OK"
@@ -69,7 +69,7 @@ Lines 1-4, characters 0-20:
 2 | | {pv=[]} -> "OK"
 3 | | {pv=true::_} -> "bool"
 4 | | {pv=5::_} -> "int"
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 {pv=0::_}
 - : string = "OK"
@@ -304,7 +304,7 @@ class ['a] ostream1 :
 Line 8, characters 4-16:
 8 |     self#tl#fold ~f ~init:(f self#hd init)
         ^^^^^^^^^^^^
-Warning 18: this use of a polymorphic method is not principal.
+Warning 18 [not-principal]: this use of a polymorphic method is not principal.
 class ['a] ostream1 :
   hd:'a ->
   tl:'b ->
@@ -1090,7 +1090,7 @@ val f : unit -> c = <fun>
 Line 4, characters 11-60:
 4 | let f () = object method private n = 1 method m = {<>}#n end;;
                ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 15: the following private methods were made public implicitly:
+Warning 15 [implicit-public-methods]: the following private methods were made public implicitly:
  n.
 val f : unit -> < m : int; n : int > = <fun>
 Line 5, characters 11-56:
@@ -1260,19 +1260,19 @@ val f : < m : 'a. 'a -> 'a > -> < m : 'a. 'a -> 'a > = <fun>
 Line 2, characters 9-16:
 2 | fun x -> (f x)#m;; (* Warning 18 *)
              ^^^^^^^
-Warning 18: this use of a polymorphic method is not principal.
+Warning 18 [not-principal]: this use of a polymorphic method is not principal.
 - : < m : 'a. 'a -> 'a > -> 'b -> 'b = <fun>
 val f : < m : 'a. 'a -> 'a > * 'b -> < m : 'a. 'a -> 'a > = <fun>
 Line 4, characters 9-20:
 4 | fun x -> (f (x,x))#m;; (* Warning 18 *)
              ^^^^^^^^^^^
-Warning 18: this use of a polymorphic method is not principal.
+Warning 18 [not-principal]: this use of a polymorphic method is not principal.
 - : < m : 'a. 'a -> 'a > -> 'b -> 'b = <fun>
 val f : < m : 'a. 'a -> 'a > -> < m : 'a. 'a -> 'a > array = <fun>
 Line 6, characters 9-20:
 6 | fun x -> (f x).(0)#m;; (* Warning 18 *)
              ^^^^^^^^^^^
-Warning 18: this use of a polymorphic method is not principal.
+Warning 18 [not-principal]: this use of a polymorphic method is not principal.
 - : < m : 'a. 'a -> 'a > -> 'b -> 'b = <fun>
 |}];;
 
@@ -1301,12 +1301,12 @@ val just : 'a option -> 'a = <fun>
 Line 4, characters 42-62:
 4 | let f x = let l = [Some x; (None : u)] in (just(List.hd l))#id;;
                                               ^^^^^^^^^^^^^^^^^^^^
-Warning 18: this use of a polymorphic method is not principal.
+Warning 18 [not-principal]: this use of a polymorphic method is not principal.
 val f : c -> 'a -> 'a = <fun>
 Line 7, characters 36-47:
 7 |   let x = List.hd [Some x; none] in (just x)#id;;
                                         ^^^^^^^^^^^
-Warning 18: this use of a polymorphic method is not principal.
+Warning 18 [not-principal]: this use of a polymorphic method is not principal.
 val g : c -> 'a -> 'a = <fun>
 val h : < id : 'a; .. > -> 'a = <fun>
 |}];;
diff --git a/testsuite/tests/typing-polyvariants-bugs/pr7824.ml b/testsuite/tests/typing-polyvariants-bugs/pr7824.ml
index a4484494f1..0af60a0cb3 100644
--- a/testsuite/tests/typing-polyvariants-bugs/pr7824.ml
+++ b/testsuite/tests/typing-polyvariants-bugs/pr7824.ml
@@ -40,7 +40,7 @@ let f x =
 Lines 4-5, characters 2-38:
 4 | ..match [] with
 5 |   | _::_ -> (x :> [`A | `C] Element.t)
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 []
 val f : [ `A ] Element.t -> [ `A | `C ] Element.t = <fun>
diff --git a/testsuite/tests/typing-safe-linking/b_bad.compilers.reference b/testsuite/tests/typing-safe-linking/b_bad.compilers.reference
index 4f9cd7e5d8..8911d38448 100644
--- a/testsuite/tests/typing-safe-linking/b_bad.compilers.reference
+++ b/testsuite/tests/typing-safe-linking/b_bad.compilers.reference
@@ -1,7 +1,7 @@
 File "b_bad.ml", lines 13-14, characters 29-28:
 13 | .............................function
 14 |     A.X s -> print_endline s
-Error (warning 8): this pattern-matching is not exhaustive.
+Error (warning 8 [partial-match]): this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Y
 File "b_bad.ml", line 18, characters 11-14:
diff --git a/testsuite/tests/typing-unboxed/test.ml b/testsuite/tests/typing-unboxed/test.ml
index 741ac3d9ca..fb1ecb82b6 100644
--- a/testsuite/tests/typing-unboxed/test.ml
+++ b/testsuite/tests/typing-unboxed/test.ml
@@ -413,7 +413,7 @@ type i = I of int
 Line 2, characters 0-34:
 2 | external id : i -> i = "%identity";;
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 61: This primitive declaration uses type i, whose representation
+Warning 61 [unboxable-type-in-prim-decl]: This primitive declaration uses type i, whose representation
 may be either boxed or unboxed. Without an annotation to indicate
 which representation is intended, the boxed representation has been
 selected by default. This default choice may change in future
@@ -433,7 +433,7 @@ type j = J of int
 Line 3, characters 0-34:
 3 | external id : i -> j = "%identity";;
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 61: This primitive declaration uses type i, whose representation
+Warning 61 [unboxable-type-in-prim-decl]: This primitive declaration uses type i, whose representation
 may be either boxed or unboxed. Without an annotation to indicate
 which representation is intended, the boxed representation has been
 selected by default. This default choice may change in future
@@ -444,7 +444,7 @@ remains stable in the future.
 Line 3, characters 0-34:
 3 | external id : i -> j = "%identity";;
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 61: This primitive declaration uses type j, whose representation
+Warning 61 [unboxable-type-in-prim-decl]: This primitive declaration uses type j, whose representation
 may be either boxed or unboxed. Without an annotation to indicate
 which representation is intended, the boxed representation has been
 selected by default. This default choice may change in future
diff --git a/testsuite/tests/typing-warnings/ambiguous_guarded_disjunction.ml b/testsuite/tests/typing-warnings/ambiguous_guarded_disjunction.ml
index 90f50623ed..ef472aec0d 100644
--- a/testsuite/tests/typing-warnings/ambiguous_guarded_disjunction.ml
+++ b/testsuite/tests/typing-warnings/ambiguous_guarded_disjunction.ml
@@ -27,7 +27,7 @@ let ambiguous_typical_example = function
 Line 2, characters 4-29:
 2 |   | ((Val x, _) | (_, Val x)) when x < 0 -> ()
         ^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
 variable x may match different arguments. (See manual section 9.5)
 val ambiguous_typical_example : expr * expr -> unit = <fun>
 |}]
@@ -94,7 +94,7 @@ let ambiguous__y = function
 Line 2, characters 4-43:
 2 |   | (`B (x, _, Some y) | `B (x, Some y, _)) when y -> ignore x
         ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
 variable y may match different arguments. (See manual section 9.5)
 val ambiguous__y : [> `B of 'a * bool option * bool option ] -> unit = <fun>
 |}]
@@ -125,7 +125,7 @@ let ambiguous__x_y = function
 Line 2, characters 4-43:
 2 |   | (`B (x, _, Some y) | `B (x, Some y, _)) when x < y -> ()
         ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
 variable y may match different arguments. (See manual section 9.5)
 val ambiguous__x_y : [> `B of 'a * 'a option * 'a option ] -> unit = <fun>
 |}]
@@ -138,7 +138,7 @@ let ambiguous__x_y_z = function
 Line 2, characters 4-43:
 2 |   | (`B (x, z, Some y) | `B (x, Some y, z)) when x < y || Some x = z -> ()
         ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
 variables y,z may match different arguments. (See manual section 9.5)
 val ambiguous__x_y_z : [> `B of 'a * 'a option * 'a option ] -> unit = <fun>
 |}]
@@ -169,7 +169,7 @@ let ambiguous__in_depth = function
 Line 2, characters 4-40:
 2 |   | `A (`B (Some x, _) | `B (_, Some x)) when x -> ()
         ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
 variable x may match different arguments. (See manual section 9.5)
 val ambiguous__in_depth :
   [> `A of [> `B of bool option * bool option ] ] -> unit = <fun>
@@ -200,7 +200,7 @@ let ambiguous__first_orpat = function
 Lines 2-3, characters 4-58:
 2 | ....`A ((`B (Some x, _) | `B (_, Some x)),
 3 |         (`C (Some y, Some _, _) | `C (Some y, _, Some _))).................
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
 variable x may match different arguments. (See manual section 9.5)
 val ambiguous__first_orpat :
   [> `A of
@@ -218,7 +218,7 @@ let ambiguous__second_orpat = function
 Lines 2-3, characters 4-42:
 2 | ....`A ((`B (Some x, Some _, _) | `B (Some x, _, Some _)),
 3 |         (`C (Some y, _) | `C (_, Some y))).................
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
 variable y may match different arguments. (See manual section 9.5)
 val ambiguous__second_orpat :
   [> `A of
@@ -311,7 +311,7 @@ let ambiguous__amoi a = match a with
 Lines 2-3, characters 2-17:
 2 | ..X (Z x,Y (y,0))
 3 | | X (Z y,Y (x,_))
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
 variables x,y may match different arguments. (See manual section 9.5)
 val ambiguous__amoi : amoi -> int = <fun>
 |}]
@@ -331,7 +331,7 @@ let ambiguous__module_variable x b =  match x with
 Lines 2-3, characters 4-24:
 2 | ....(module M:S),_,(1,_)
 3 |   | _,(module M:S),(_,1)...................
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
 variable M may match different arguments. (See manual section 9.5)
 val ambiguous__module_variable :
   (module S) * (module S) * (int * int) -> bool -> int = <fun>
@@ -346,7 +346,7 @@ let not_ambiguous__module_variable x b =  match x with
 Line 2, characters 12-13:
 2 |   | (module M:S),_,(1,_)
                 ^
-Warning 60: unused module M.
+Warning 60 [unused-module]: unused module M.
 val not_ambiguous__module_variable :
   (module S) * (module S) * (int * int) -> bool -> int = <fun>
 |}]
@@ -367,18 +367,18 @@ let ambiguous_xy_but_not_ambiguous_z g = function
 Line 2, characters 4-5:
 2 |   | A (x as z,(0 as y))|A (0 as y as z,x)|B (x,(y as z)) when g x (y+z) -> 1
         ^
-Warning 41: A belongs to several types: t2 t
+Warning 41 [ambiguous-name]: A belongs to several types: t2 t
 The first one was selected. Please disambiguate if this is wrong.
 Lines 1-3, characters 41-10:
 1 | .........................................function
 2 |   | A (x as z,(0 as y))|A (0 as y as z,x)|B (x,(y as z)) when g x (y+z) -> 1
 3 |   | _ -> 2
-Warning 4: this pattern-matching is fragile.
+Warning 4 [fragile-match]: this pattern-matching is fragile.
 It will remain exhaustive when constructors are added to type t2.
 Line 2, characters 4-56:
 2 |   | A (x as z,(0 as y))|A (0 as y as z,x)|B (x,(y as z)) when g x (y+z) -> 1
         ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
 variables x,y may match different arguments. (See manual section 9.5)
 val ambiguous_xy_but_not_ambiguous_z : (int -> int -> bool) -> t2 -> int =
   <fun>
@@ -386,28 +386,28 @@ val ambiguous_xy_but_not_ambiguous_z : (int -> int -> bool) -> t2 -> int =
 Line 2, characters 4-5:
 2 |   | A (x as z,(0 as y))|A (0 as y as z,x)|B (x,(y as z)) when g x (y+z) -> 1
         ^
-Warning 41: A belongs to several types: t2 t
+Warning 41 [ambiguous-name]: A belongs to several types: t2 t
 The first one was selected. Please disambiguate if this is wrong.
 Line 2, characters 24-25:
 2 |   | A (x as z,(0 as y))|A (0 as y as z,x)|B (x,(y as z)) when g x (y+z) -> 1
                             ^
-Warning 41: A belongs to several types: t2 t
+Warning 41 [ambiguous-name]: A belongs to several types: t2 t
 The first one was selected. Please disambiguate if this is wrong.
 Line 2, characters 42-43:
 2 |   | A (x as z,(0 as y))|A (0 as y as z,x)|B (x,(y as z)) when g x (y+z) -> 1
                                               ^
-Warning 41: B belongs to several types: t2 t
+Warning 41 [ambiguous-name]: B belongs to several types: t2 t
 The first one was selected. Please disambiguate if this is wrong.
 Lines 1-3, characters 41-10:
 1 | .........................................function
 2 |   | A (x as z,(0 as y))|A (0 as y as z,x)|B (x,(y as z)) when g x (y+z) -> 1
 3 |   | _ -> 2
-Warning 4: this pattern-matching is fragile.
+Warning 4 [fragile-match]: this pattern-matching is fragile.
 It will remain exhaustive when constructors are added to type t2.
 Line 2, characters 4-56:
 2 |   | A (x as z,(0 as y))|A (0 as y as z,x)|B (x,(y as z)) when g x (y+z) -> 1
         ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
 variables x,y may match different arguments. (See manual section 9.5)
 val ambiguous_xy_but_not_ambiguous_z : (int -> int -> bool) -> t2 -> int =
   <fun>
@@ -466,7 +466,7 @@ let guarded_ambiguity = function
 Line 3, characters 4-29:
 3 |   | ((Val y, _) | (_, Val y)) when y < 0 -> ()
         ^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
 variable y may match different arguments. (See manual section 9.5)
 val guarded_ambiguity : expr * expr -> unit = <fun>
 |}]
@@ -495,7 +495,7 @@ let cmp (pred : a -> bool) (x : a alg) (y : a alg) =
 Line 4, characters 4-29:
 4 |   | ((Val x, _) | (_, Val x)) when pred x -> ()
         ^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 57: Ambiguous or-pattern variables under guard;
+Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
 variable x may match different arguments. (See manual section 9.5)
 val cmp : (a -> bool) -> a alg -> a alg -> unit = <fun>
 |}]
diff --git a/testsuite/tests/typing-warnings/application.ml b/testsuite/tests/typing-warnings/application.ml
index 7022eb80bb..0ba9f75f4c 100644
--- a/testsuite/tests/typing-warnings/application.ml
+++ b/testsuite/tests/typing-warnings/application.ml
@@ -19,7 +19,7 @@ let _ = Array.get [||];;
 Line 1, characters 8-22:
 1 | let _ = Array.get [||];;
             ^^^^^^^^^^^^^^
-Warning 5: this function application is partial,
+Warning 5 [ignored-partial-application]: this function application is partial,
 maybe some arguments are missing.
 - : int -> 'a = <fun>
 |}]
@@ -33,7 +33,7 @@ let () = ignore (Array.get [||]);;
 Line 1, characters 16-32:
 1 | let () = ignore (Array.get [||]);;
                     ^^^^^^^^^^^^^^^^
-Warning 5: this function application is partial,
+Warning 5 [ignored-partial-application]: this function application is partial,
 maybe some arguments are missing.
 |}]
 
@@ -48,7 +48,7 @@ let _ = if true then Array.get [||] else (fun _ -> 12);;
 Line 1, characters 21-35:
 1 | let _ = if true then Array.get [||] else (fun _ -> 12);;
                          ^^^^^^^^^^^^^^
-Warning 5: this function application is partial,
+Warning 5 [ignored-partial-application]: this function application is partial,
 maybe some arguments are missing.
 - : int -> int = <fun>
 |}]
@@ -71,7 +71,7 @@ let f x = let _ = x.r 1 in ();;
 Line 1, characters 18-23:
 1 | let f x = let _ = x.r 1 in ();;
                       ^^^^^
-Warning 5: this function application is partial,
+Warning 5 [ignored-partial-application]: this function application is partial,
 maybe some arguments are missing.
 val f : t -> unit = <fun>
 |}]
@@ -81,7 +81,7 @@ let _ = raise Exit 3;;
 Line 1, characters 19-20:
 1 | let _ = raise Exit 3;;
                        ^
-Warning 20: this argument will not be used by the function.
+Warning 20 [ignored-extra-argument]: this argument will not be used by the function.
 Exception: Stdlib.Exit.
 |}]
 
@@ -96,7 +96,7 @@ val g : int -> int = <fun>
 Line 2, characters 10-15:
 2 | let _ = g (f 1);;
               ^^^^^
-Warning 5: this function application is partial,
+Warning 5 [ignored-partial-application]: this function application is partial,
 maybe some arguments are missing.
 Line 2, characters 10-15:
 2 | let _ = g (f 1);;
diff --git a/testsuite/tests/typing-warnings/coercions.ml b/testsuite/tests/typing-warnings/coercions.ml
index ac238befda..0900975c36 100644
--- a/testsuite/tests/typing-warnings/coercions.ml
+++ b/testsuite/tests/typing-warnings/coercions.ml
@@ -12,7 +12,7 @@ fun b -> if b then format_of_string "x" else "y"
 Line 1, characters 45-48:
 1 | fun b -> if b then format_of_string "x" else "y"
                                                  ^^^
-Warning 18: this coercion to format6 is not principal.
+Warning 18 [not-principal]: this coercion to format6 is not principal.
 - : bool -> ('a, 'b, 'c, 'd, 'd, 'a) format6 = <fun>
 |}]
 ;;
@@ -65,6 +65,6 @@ module Test1 : sig type t = private int val f : t -> int end
 Line 3, characters 49-59:
 3 |   let f x = let y = if true then x else (x:t) in (y :> int)
                                                      ^^^^^^^^^^
-Warning 18: this ground coercion is not principal.
+Warning 18 [not-principal]: this ground coercion is not principal.
 module Test1 : sig type t = private int val f : t -> int end
 |}]
diff --git a/testsuite/tests/typing-warnings/exhaustiveness.ml b/testsuite/tests/typing-warnings/exhaustiveness.ml
index 732033c08d..888034aad7 100644
--- a/testsuite/tests/typing-warnings/exhaustiveness.ml
+++ b/testsuite/tests/typing-warnings/exhaustiveness.ml
@@ -11,7 +11,7 @@ Lines 1-3, characters 8-23:
 1 | ........function
 2 |     None, None -> 1
 3 |   | Some _, Some _ -> 2..
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (None, Some _)
 val f : 'a option * 'b option -> int = <fun>
@@ -34,12 +34,12 @@ let f (x : int t) = match x with A -> 1 | _ -> 2;; (* warn *)
 Line 1, characters 20-48:
 1 | let f (x : int t) = match x with A -> 1 | _ -> 2;; (* warn *)
                         ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 4: this pattern-matching is fragile.
+Warning 4 [fragile-match]: this pattern-matching is fragile.
 It will remain exhaustive when constructors are added to type t.
 Line 1, characters 42-43:
 1 | let f (x : int t) = match x with A -> 1 | _ -> 2;; (* warn *)
                                               ^
-Warning 56: this match case is unreachable.
+Warning 56 [unreachable-case]: this match case is unreachable.
 Consider replacing it with a refutation case '<pat> -> .'
 val f : int t -> int = <fun>
 |}]
@@ -49,7 +49,7 @@ let f (x : unit t option) = match x with None -> 1 | _ -> 2 ;; (* warn? *)
 Line 1, characters 53-54:
 1 | let f (x : unit t option) = match x with None -> 1 | _ -> 2 ;; (* warn? *)
                                                          ^
-Warning 56: this match case is unreachable.
+Warning 56 [unreachable-case]: this match case is unreachable.
 Consider replacing it with a refutation case '<pat> -> .'
 val f : unit t option -> int = <fun>
 |}]
@@ -59,7 +59,7 @@ let f (x : unit t option) = match x with None -> 1 | Some _ -> 2 ;; (* warn *)
 Line 1, characters 53-59:
 1 | let f (x : unit t option) = match x with None -> 1 | Some _ -> 2 ;; (* warn *)
                                                          ^^^^^^
-Warning 56: this match case is unreachable.
+Warning 56 [unreachable-case]: this match case is unreachable.
 Consider replacing it with a refutation case '<pat> -> .'
 val f : unit t option -> int = <fun>
 |}]
@@ -74,7 +74,7 @@ let f (x : int t option) = match x with None -> 1;; (* warn *)
 Line 1, characters 27-49:
 1 | let f (x : int t option) = match x with None -> 1;; (* warn *)
                                ^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Some A
 val f : int t option -> int = <fun>
@@ -94,7 +94,7 @@ let f : (int t box pair * bool) option -> unit = function None -> ();;
 Line 1, characters 49-68:
 1 | let f : (int t box pair * bool) option -> unit = function None -> ();;
                                                      ^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Some ({left=Box A; right=Box A}, _)
 val f : (int t box pair * bool) option -> unit = <fun>
@@ -110,7 +110,7 @@ let f = function {left=Box 0; _ } -> ();;
 Line 1, characters 8-39:
 1 | let f = function {left=Box 0; _ } -> ();;
             ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 {left=Box 1; _ }
 val f : int box pair -> unit = <fun>
@@ -121,7 +121,7 @@ let f = function {left=Box 0;right=Box 1} -> ();;
 Line 1, characters 8-47:
 1 | let f = function {left=Box 0;right=Box 1} -> ();;
             ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 {left=Box 0; right=Box 0}
 val f : int box pair -> unit = <fun>
@@ -178,7 +178,7 @@ let f : (A.a, A.b) cmp -> unit = function Any -> ()
 Line 1, characters 33-51:
 1 | let f : (A.a, A.b) cmp -> unit = function Any -> ()
                                      ^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Eq
 val f : (A.a, A.b) cmp -> unit = <fun>
@@ -231,7 +231,7 @@ let harder : (zero succ, zero succ, zero succ) plus option -> bool =
 Line 2, characters 2-24:
 2 |   function None -> false
       ^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Some (PlusS _)
 val harder : (zero succ, zero succ, zero succ) plus option -> bool = <fun>
@@ -308,7 +308,7 @@ let f x y = match 1 with 1 when x = y -> 1;;
 Line 1, characters 12-42:
 1 | let f x y = match 1 with 1 when x = y -> 1;;
                 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 All clauses in this pattern-matching are guarded.
 val f : 'a -> 'a -> int = <fun>
 |}]
@@ -319,7 +319,7 @@ let f = function {contents=_}, 0 -> 0;;
 Line 1, characters 8-37:
 1 | let f = function {contents=_}, 0 -> 0;;
             ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 (_, 1)
 val f : 'a ref * int -> int = <fun>
@@ -337,7 +337,7 @@ Lines 1-4, characters 8-28:
 2 |   | None -> ()
 3 |   | Some x when x > 0 -> ()
 4 |   | Some x when x <= 0 -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Some _
 (However, some guarded clause may match this value.)
@@ -373,7 +373,7 @@ Lines 20-22, characters 45-49:
 20 | .............................................function
 21 | | A, A, A, A -> ()
 22 | | (A|B), (A|B), (A|B), A (*missing B here*) -> ()
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 ((A|B), (A|B), (A|B), B)
 module Single_row_optim :
diff --git a/testsuite/tests/typing-warnings/never_returns.ml b/testsuite/tests/typing-warnings/never_returns.ml
index 6b5aac602b..8ee4127f95 100644
--- a/testsuite/tests/typing-warnings/never_returns.ml
+++ b/testsuite/tests/typing-warnings/never_returns.ml
@@ -8,7 +8,7 @@ let () = (let module L = List in raise Exit); () ;;
 Line 1, characters 33-43:
 1 | let () = (let module L = List in raise Exit); () ;;
                                      ^^^^^^^^^^
-Warning 21: this statement never returns (or has an unsound type.)
+Warning 21 [nonreturning-statement]: this statement never returns (or has an unsound type.)
 Exception: Stdlib.Exit.
 |}]
 let () = (let exception E in raise Exit); ();;
@@ -16,7 +16,7 @@ let () = (let exception E in raise Exit); ();;
 Line 1, characters 29-39:
 1 | let () = (let exception E in raise Exit); ();;
                                  ^^^^^^^^^^
-Warning 21: this statement never returns (or has an unsound type.)
+Warning 21 [nonreturning-statement]: this statement never returns (or has an unsound type.)
 Exception: Stdlib.Exit.
 |}]
 let () = (raise Exit : _); ();;
@@ -24,7 +24,7 @@ let () = (raise Exit : _); ();;
 Line 1, characters 10-20:
 1 | let () = (raise Exit : _); ();;
               ^^^^^^^^^^
-Warning 21: this statement never returns (or has an unsound type.)
+Warning 21 [nonreturning-statement]: this statement never returns (or has an unsound type.)
 Exception: Stdlib.Exit.
 |}]
 let () = (let open Stdlib in raise Exit); ();;
@@ -32,6 +32,6 @@ let () = (let open Stdlib in raise Exit); ();;
 Line 1, characters 29-39:
 1 | let () = (let open Stdlib in raise Exit); ();;
                                  ^^^^^^^^^^
-Warning 21: this statement never returns (or has an unsound type.)
+Warning 21 [nonreturning-statement]: this statement never returns (or has an unsound type.)
 Exception: Stdlib.Exit.
 |}]
diff --git a/testsuite/tests/typing-warnings/open_warnings.ml b/testsuite/tests/typing-warnings/open_warnings.ml
index e6c656910d..299809516b 100644
--- a/testsuite/tests/typing-warnings/open_warnings.ml
+++ b/testsuite/tests/typing-warnings/open_warnings.ml
@@ -10,11 +10,11 @@ end;;
 Line 2, characters 20-26:
 2 |   module M = struct type t end  (* unused type t *)
                         ^^^^^^
-Warning 34: unused type t.
+Warning 34 [unused-type-declaration]: unused type t.
 Line 3, characters 2-8:
 3 |   open M  (* unused open *)
       ^^^^^^
-Warning 33: unused open M.
+Warning 33 [unused-open]: unused open M.
 module T1 : sig end
 |}]
 
@@ -38,15 +38,15 @@ end;;
 Line 4, characters 2-8:
 4 |   open M (* used by line below; shadow constructor A *)
       ^^^^^^
-Warning 45: this open statement shadows the constructor A (which is later used)
+Warning 45 [open-shadow-label-constructor]: this open statement shadows the constructor A (which is later used)
 Line 2, characters 2-13:
 2 |   type t0 = A  (* unused type and constructor *)
       ^^^^^^^^^^^
-Warning 34: unused type t0.
+Warning 34 [unused-type-declaration]: unused type t0.
 Line 2, characters 12-13:
 2 |   type t0 = A  (* unused type and constructor *)
                 ^
-Warning 37: unused constructor A.
+Warning 37 [unused-constructor]: unused constructor A.
 module T3 : sig end
 |}]
 
@@ -60,15 +60,15 @@ end;;
 Line 3, characters 20-30:
 3 |   module M = struct type t = A end (* unused type and constructor *)
                         ^^^^^^^^^^
-Warning 34: unused type t.
+Warning 34 [unused-type-declaration]: unused type t.
 Line 3, characters 29-30:
 3 |   module M = struct type t = A end (* unused type and constructor *)
                                  ^
-Warning 37: unused constructor A.
+Warning 37 [unused-constructor]: unused constructor A.
 Line 4, characters 2-8:
 4 |   open M (* unused open; no shadowing (A below refers to the one in t0) *)
       ^^^^^^
-Warning 33: unused open M.
+Warning 33 [unused-open]: unused open M.
 module T4 : sig end
 |}]
 
@@ -82,15 +82,15 @@ end;;
 Line 4, characters 2-8:
 4 |   open M (* shadow constructor A *)
       ^^^^^^
-Warning 45: this open statement shadows the constructor A (which is later used)
+Warning 45 [open-shadow-label-constructor]: this open statement shadows the constructor A (which is later used)
 Line 2, characters 2-13:
 2 |   type t0 = A (* unused type and constructor *)
       ^^^^^^^^^^^
-Warning 34: unused type t0.
+Warning 34 [unused-type-declaration]: unused type t0.
 Line 2, characters 12-13:
 2 |   type t0 = A (* unused type and constructor *)
                 ^
-Warning 37: unused constructor A.
+Warning 37 [unused-constructor]: unused constructor A.
 module T5 : sig end
 |}]
 
@@ -103,11 +103,11 @@ end;;
 Line 2, characters 20-26:
 2 |   module M = struct type t end  (* unused type t *)
                         ^^^^^^
-Warning 34: unused type t.
+Warning 34 [unused-type-declaration]: unused type t.
 Line 3, characters 2-9:
 3 |   open! M  (* unused open *)
       ^^^^^^^
-Warning 66: unused open! M.
+Warning 66 [unused-open-bang]: unused open! M.
 module T1_bis : sig end
 |}]
 
@@ -130,11 +130,11 @@ end;;
 Line 2, characters 2-13:
 2 |   type t0 = A  (* unused type and constructor *)
       ^^^^^^^^^^^
-Warning 34: unused type t0.
+Warning 34 [unused-type-declaration]: unused type t0.
 Line 2, characters 12-13:
 2 |   type t0 = A  (* unused type and constructor *)
                 ^
-Warning 37: unused constructor A.
+Warning 37 [unused-constructor]: unused constructor A.
 module T3_bis : sig end
 |}]
 
@@ -148,15 +148,15 @@ end;;
 Line 3, characters 20-30:
 3 |   module M = struct type t = A end (* unused type and constructor *)
                         ^^^^^^^^^^
-Warning 34: unused type t.
+Warning 34 [unused-type-declaration]: unused type t.
 Line 3, characters 29-30:
 3 |   module M = struct type t = A end (* unused type and constructor *)
                                  ^
-Warning 37: unused constructor A.
+Warning 37 [unused-constructor]: unused constructor A.
 Line 4, characters 2-9:
 4 |   open! M (* unused open; no shadowing (A below refers to the one in t0) *)
       ^^^^^^^
-Warning 66: unused open! M.
+Warning 66 [unused-open-bang]: unused open! M.
 module T4_bis : sig end
 |}]
 
@@ -170,11 +170,11 @@ end;;
 Line 2, characters 2-13:
 2 |   type t0 = A (* unused type and constructor *)
       ^^^^^^^^^^^
-Warning 34: unused type t0.
+Warning 34 [unused-type-declaration]: unused type t0.
 Line 2, characters 12-13:
 2 |   type t0 = A (* unused type and constructor *)
                 ^
-Warning 37: unused constructor A.
+Warning 37 [unused-constructor]: unused constructor A.
 module T5_bis : sig end
 |}]
 
diff --git a/testsuite/tests/typing-warnings/pr5892.ml b/testsuite/tests/typing-warnings/pr5892.ml
index 46213d74ec..5b318ef40b 100644
--- a/testsuite/tests/typing-warnings/pr5892.ml
+++ b/testsuite/tests/typing-warnings/pr5892.ml
@@ -17,7 +17,7 @@ let f : label choice -> bool = function Left -> true;; (* warn *)
 Line 1, characters 31-52:
 1 | let f : label choice -> bool = function Left -> true;; (* warn *)
                                    ^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Right
 val f : CamlinternalOO.label choice -> bool = <fun>
diff --git a/testsuite/tests/typing-warnings/pr6872.ml b/testsuite/tests/typing-warnings/pr6872.ml
index 80859124b3..3ca374336b 100644
--- a/testsuite/tests/typing-warnings/pr6872.ml
+++ b/testsuite/tests/typing-warnings/pr6872.ml
@@ -27,7 +27,7 @@ A
 Line 1, characters 0-1:
 1 | A
     ^
-Warning 41: A belongs to several types: a exn
+Warning 41 [ambiguous-name]: A belongs to several types: a exn
 The first one was selected. Please disambiguate if this is wrong.
 - : a = A
 |}]
@@ -38,7 +38,7 @@ raise A
 Line 1, characters 6-7:
 1 | raise A
           ^
-Warning 42: this use of A relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of A relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Exception: A.
 |}]
@@ -55,18 +55,18 @@ function Not_found -> 1 | A -> 2 | _ -> 3
 Line 1, characters 26-27:
 1 | function Not_found -> 1 | A -> 2 | _ -> 3
                               ^
-Warning 42: this use of A relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of A relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 - : exn -> int = <fun>
 |}, Principal{|
 Line 1, characters 26-27:
 1 | function Not_found -> 1 | A -> 2 | _ -> 3
                               ^
-Warning 18: this type-based constructor disambiguation is not principal.
+Warning 18 [not-principal]: this type-based constructor disambiguation is not principal.
 Line 1, characters 26-27:
 1 | function Not_found -> 1 | A -> 2 | _ -> 3
                               ^
-Warning 42: this use of A relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of A relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 - : exn -> int = <fun>
 |}]
@@ -77,12 +77,12 @@ try raise A with A -> 2
 Line 1, characters 10-11:
 1 | try raise A with A -> 2
               ^
-Warning 42: this use of A relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of A relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 1, characters 17-18:
 1 | try raise A with A -> 2
                      ^
-Warning 42: this use of A relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of A relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 - : int = 2
 |}]
diff --git a/testsuite/tests/typing-warnings/pr7085.ml b/testsuite/tests/typing-warnings/pr7085.ml
index 0307b4684c..3516ee4daa 100644
--- a/testsuite/tests/typing-warnings/pr7085.ml
+++ b/testsuite/tests/typing-warnings/pr7085.ml
@@ -31,7 +31,7 @@ module type T =
 Line 17, characters 5-35:
 17 |      match M.is_t () with None -> 0
           ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Some (Is Eq)
 module Make : functor (M : T) -> sig val f : unit -> int end
diff --git a/testsuite/tests/typing-warnings/pr7115.ml b/testsuite/tests/typing-warnings/pr7115.ml
index f4f5c35bcf..43e06cad52 100644
--- a/testsuite/tests/typing-warnings/pr7115.ml
+++ b/testsuite/tests/typing-warnings/pr7115.ml
@@ -16,7 +16,7 @@ end;;
 Line 2, characters 10-11:
 2 |   let _f ~x (* x unused argument *) = function
               ^
-Warning 27: unused variable x.
+Warning 27 [unused-var-strict]: unused variable x.
 module X1 : sig end
 |}]
 
@@ -29,7 +29,7 @@ end;;
 Line 2, characters 6-7:
 2 |   let x = 42 (* unused value *)
           ^
-Warning 32: unused value x.
+Warning 32 [unused-value-declaration]: unused value x.
 module X2 : sig end
 |}]
 
@@ -44,10 +44,10 @@ end;;
 Line 2, characters 24-25:
 2 |   module O = struct let x = 42 (* unused *) end
                             ^
-Warning 32: unused value x.
+Warning 32 [unused-value-declaration]: unused value x.
 Line 3, characters 2-8:
 3 |   open O (* unused open *)
       ^^^^^^
-Warning 33: unused open O.
+Warning 33 [unused-open]: unused open O.
 module X3 : sig end
 |}]
diff --git a/testsuite/tests/typing-warnings/pr7261.compilers.reference b/testsuite/tests/typing-warnings/pr7261.compilers.reference
index 671e51d87f..57b4173004 100644
--- a/testsuite/tests/typing-warnings/pr7261.compilers.reference
+++ b/testsuite/tests/typing-warnings/pr7261.compilers.reference
@@ -5,6 +5,6 @@ Error: Syntax error
 Line 2, characters 35-49:
 2 |     Foo: 'b * 'b -> foo constraint 'b = [> `Bla ];;
                                        ^^^^^^^^^^^^^^
-Warning 62: Type constraints do not apply to GADT cases of variant types.
+Warning 62 [constraint-on-gadt]: Type constraints do not apply to GADT cases of variant types.
 type foo = Foo : 'b * 'b -> foo
 
diff --git a/testsuite/tests/typing-warnings/pr7297.ml b/testsuite/tests/typing-warnings/pr7297.ml
index 9913127463..08a2a4be6d 100644
--- a/testsuite/tests/typing-warnings/pr7297.ml
+++ b/testsuite/tests/typing-warnings/pr7297.ml
@@ -14,6 +14,6 @@ let () = raise Exit; () ;; (* warn *)
 Line 1, characters 9-19:
 1 | let () = raise Exit; () ;; (* warn *)
              ^^^^^^^^^^
-Warning 21: this statement never returns (or has an unsound type.)
+Warning 21 [nonreturning-statement]: this statement never returns (or has an unsound type.)
 Exception: Stdlib.Exit.
 |}]
diff --git a/testsuite/tests/typing-warnings/pr7553.ml b/testsuite/tests/typing-warnings/pr7553.ml
index d479c41907..a76f19d4aa 100644
--- a/testsuite/tests/typing-warnings/pr7553.ml
+++ b/testsuite/tests/typing-warnings/pr7553.ml
@@ -23,7 +23,7 @@ end = C;;
 Line 2, characters 2-8:
 2 |   open A
       ^^^^^^
-Warning 33: unused open A.
+Warning 33 [unused-open]: unused open A.
 module rec C : sig end
 |}]
 
@@ -39,12 +39,12 @@ end = D;;
 Line 5, characters 10-14:
 5 |       let None = None
               ^^^^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 Some _
 Line 4, characters 6-12:
 4 |       open A
           ^^^^^^
-Warning 33: unused open A.
+Warning 33 [unused-open]: unused open A.
 module rec D : sig module M : sig module X : sig end end end
 |}]
diff --git a/testsuite/tests/typing-warnings/pr9244.ml b/testsuite/tests/typing-warnings/pr9244.ml
index 01b9d08e96..28bf91ff0c 100644
--- a/testsuite/tests/typing-warnings/pr9244.ml
+++ b/testsuite/tests/typing-warnings/pr9244.ml
@@ -22,7 +22,7 @@ end
 Line 5, characters 8-9:
 5 |     let x = 13
             ^
-Warning 32: unused value x.
+Warning 32 [unused-value-declaration]: unused value x.
 module M : sig module F2 : U -> U end
 |}]
 
@@ -40,7 +40,7 @@ end
 Line 5, characters 8-9:
 5 |     let x = 13
             ^
-Warning 32: unused value x.
+Warning 32 [unused-value-declaration]: unused value x.
 module N : sig module F2 : U -> U end
 |}]
 
@@ -50,6 +50,6 @@ module F (X : sig type t type s end) = struct type t = X.t end
 Line 1, characters 25-31:
 1 | module F (X : sig type t type s end) = struct type t = X.t end
                              ^^^^^^
-Warning 34: unused type s.
+Warning 34 [unused-type-declaration]: unused type s.
 module F : functor (X : sig type t type s end) -> sig type t = X.t end
 |}]
diff --git a/testsuite/tests/typing-warnings/records.ml b/testsuite/tests/typing-warnings/records.ml
index 7977693f07..73938fc70b 100644
--- a/testsuite/tests/typing-warnings/records.ml
+++ b/testsuite/tests/typing-warnings/records.ml
@@ -25,58 +25,58 @@ end;;
 Line 3, characters 19-20:
 3 |   let f1 (r:t) = r.x (* ok *)
                        ^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 4, characters 29-30:
 4 |   let f2 r = ignore (r:t); r.x (* non principal *)
                                  ^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 7, characters 18-19:
 7 |     match r with {x; y} -> y + y (* ok *)
                       ^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 7, characters 21-22:
 7 |     match r with {x; y} -> y + y (* ok *)
                          ^
-Warning 42: this use of y relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of y relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 7, characters 18-19:
 7 |     match r with {x; y} -> y + y (* ok *)
                       ^
-Warning 27: unused variable x.
+Warning 27 [unused-var-strict]: unused variable x.
 module OK :
   sig val f1 : M1.t -> int val f2 : M1.t -> int val f3 : M1.t -> int end
 |}, Principal{|
 Line 3, characters 19-20:
 3 |   let f1 (r:t) = r.x (* ok *)
                        ^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 4, characters 29-30:
 4 |   let f2 r = ignore (r:t); r.x (* non principal *)
                                  ^
-Warning 18: this type-based field disambiguation is not principal.
+Warning 18 [not-principal]: this type-based field disambiguation is not principal.
 Line 4, characters 29-30:
 4 |   let f2 r = ignore (r:t); r.x (* non principal *)
                                  ^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 7, characters 18-19:
 7 |     match r with {x; y} -> y + y (* ok *)
                       ^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 7, characters 21-22:
 7 |     match r with {x; y} -> y + y (* ok *)
                          ^
-Warning 42: this use of y relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of y relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 7, characters 18-19:
 7 |     match r with {x; y} -> y + y (* ok *)
                       ^
-Warning 27: unused variable x.
+Warning 27 [unused-var-strict]: unused variable x.
 module OK :
   sig val f1 : M1.t -> int val f2 : M1.t -> int val f3 : M1.t -> int end
 |}]
@@ -89,7 +89,7 @@ end;; (* fails *)
 Line 3, characters 25-31:
 3 |   let f r = match r with {x; y} -> y + y
                              ^^^^^^
-Warning 41: these field labels belong to several types: M1.u M1.t
+Warning 41 [ambiguous-name]: these field labels belong to several types: M1.u M1.t
 The first one was selected. Please disambiguate if this is wrong.
 Line 3, characters 35-36:
 3 |   let f r = match r with {x; y} -> y + y
@@ -109,37 +109,37 @@ end;; (* fails for -principal *)
 Line 6, characters 8-9:
 6 |        {x; y} -> y + y
             ^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 6, characters 11-12:
 6 |        {x; y} -> y + y
                ^
-Warning 42: this use of y relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of y relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 6, characters 8-9:
 6 |        {x; y} -> y + y
             ^
-Warning 27: unused variable x.
+Warning 27 [unused-var-strict]: unused variable x.
 module F2 : sig val f : M1.t -> int end
 |}, Principal{|
 Line 6, characters 8-9:
 6 |        {x; y} -> y + y
             ^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 6, characters 11-12:
 6 |        {x; y} -> y + y
                ^
-Warning 42: this use of y relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of y relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 6, characters 7-13:
 6 |        {x; y} -> y + y
            ^^^^^^
-Warning 18: this type-based record disambiguation is not principal.
+Warning 18 [not-principal]: this type-based record disambiguation is not principal.
 Line 6, characters 8-9:
 6 |        {x; y} -> y + y
             ^
-Warning 27: unused variable x.
+Warning 27 [unused-var-strict]: unused variable x.
 module F2 : sig val f : M1.t -> int end
 |}]
 
@@ -156,7 +156,7 @@ let f (r:M.t) = r.M.x;; (* ok *)
 Line 1, characters 18-21:
 1 | let f (r:M.t) = r.M.x;; (* ok *)
                       ^^^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 val f : M.t -> int = <fun>
 |}]
@@ -165,13 +165,13 @@ let f (r:M.t) = r.x;; (* warning *)
 Line 1, characters 18-19:
 1 | let f (r:M.t) = r.x;; (* warning *)
                       ^
-Warning 40: x was selected from type M.t.
+Warning 40 [name-out-of-scope]: x was selected from type M.t.
 It is not visible in the current scope, and will not
 be selected if the type becomes unknown.
 Line 1, characters 18-19:
 1 | let f (r:M.t) = r.x;; (* warning *)
                       ^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 val f : M.t -> int = <fun>
 |}]
@@ -180,12 +180,12 @@ let f ({x}:M.t) = x;; (* warning *)
 Line 1, characters 8-9:
 1 | let f ({x}:M.t) = x;; (* warning *)
             ^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 1, characters 7-10:
 1 | let f ({x}:M.t) = x;; (* warning *)
            ^^^
-Warning 40: this record of type M.t contains fields that are
+Warning 40 [name-out-of-scope]: this record of type M.t contains fields that are
 not visible in the current scope: x.
 They will not be selected if the type becomes unknown.
 val f : M.t -> int = <fun>
@@ -212,12 +212,12 @@ end;;
 Line 4, characters 20-21:
 4 |   let f (r:M.t) = r.x
                         ^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 3, characters 2-8:
 3 |   open N
       ^^^^^^
-Warning 33: unused open N.
+Warning 33 [unused-open]: unused open N.
 module OK : sig val f : M.t -> int end
 |}]
 
@@ -262,12 +262,12 @@ end;; (* ok *)
 Line 3, characters 9-10:
 3 |   let f {x;z} = x,z
              ^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 3, characters 8-13:
 3 |   let f {x;z} = x,z
             ^^^^^
-Warning 9: the following labels are not bound in this record pattern:
+Warning 9 [missing-record-field-pattern]: the following labels are not bound in this record pattern:
 y
 Either bind these labels explicitly or add '; _' to the pattern.
 module OK : sig val f : M.u -> bool * char end
@@ -280,7 +280,7 @@ end;; (* fail for missing label *)
 Line 3, characters 11-12:
 3 |   let r = {x=true;z='z'}
                ^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 3, characters 10-24:
 3 |   let r = {x=true;z='z'}
@@ -297,12 +297,12 @@ end;; (* ok *)
 Line 4, characters 11-12:
 4 |   let r = {x=3; y=true}
                ^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 4, characters 16-17:
 4 |   let r = {x=3; y=true}
                     ^
-Warning 42: this use of y relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of y relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 module OK :
   sig
@@ -363,12 +363,12 @@ let r = {MN.x = 3; NM.y = 4};; (* error: type would change with order *)
 Line 1, characters 8-28:
 1 | let r = {MN.x = 3; NM.y = 4};; (* error: type would change with order *)
             ^^^^^^^^^^^^^^^^^^^^
-Warning 41: x belongs to several types: MN.bar MN.foo
+Warning 41 [ambiguous-name]: x belongs to several types: MN.bar MN.foo
 The first one was selected. Please disambiguate if this is wrong.
 Line 1, characters 8-28:
 1 | let r = {MN.x = 3; NM.y = 4};; (* error: type would change with order *)
             ^^^^^^^^^^^^^^^^^^^^
-Warning 41: y belongs to several types: NM.foo NM.bar
+Warning 41 [ambiguous-name]: y belongs to several types: NM.foo NM.bar
 The first one was selected. Please disambiguate if this is wrong.
 Line 1, characters 19-23:
 1 | let r = {MN.x = 3; NM.y = 4};; (* error: type would change with order *)
@@ -398,7 +398,7 @@ end;;
 Line 3, characters 37-38:
 3 |   let f r = ignore (r: foo); {r with x = 2; z = 3}
                                          ^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 3, characters 44-45:
 3 |   let f r = ignore (r: foo); {r with x = 2; z = 3}
@@ -426,7 +426,7 @@ end;;
 Line 3, characters 38-39:
 3 |   let f r = ignore (r: foo); { r with x = 3; a = 4 }
                                           ^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 3, characters 45-46:
 3 |   let f r = ignore (r: foo); { r with x = 3; a = 4 }
@@ -443,12 +443,12 @@ end;;
 Line 3, characters 11-12:
 3 |   let r = {x=1; y=2}
                ^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 3, characters 16-17:
 3 |   let r = {x=1; y=2}
                     ^
-Warning 42: this use of y relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of y relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 4, characters 18-19:
 4 |   let r: other = {x=1; y=2}
@@ -505,7 +505,7 @@ class f (_ : 'a) (_ : 'a) = object end;;
 Line 1, characters 12-13:
 1 | class g = f A;; (* ok *)
                 ^
-Warning 42: this use of A relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of A relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 class g : f
 class f : 'a -> 'a -> object  end
@@ -515,28 +515,28 @@ class g = f (A : t) A;; (* warn with -principal *)
 Line 1, characters 13-14:
 1 | class g = f (A : t) A;; (* warn with -principal *)
                  ^
-Warning 42: this use of A relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of A relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 1, characters 20-21:
 1 | class g = f (A : t) A;; (* warn with -principal *)
                         ^
-Warning 42: this use of A relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of A relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 class g : f
 |}, Principal{|
 Line 1, characters 13-14:
 1 | class g = f (A : t) A;; (* warn with -principal *)
                  ^
-Warning 42: this use of A relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of A relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 1, characters 20-21:
 1 | class g = f (A : t) A;; (* warn with -principal *)
                         ^
-Warning 18: this type-based constructor disambiguation is not principal.
+Warning 18 [not-principal]: this type-based constructor disambiguation is not principal.
 Line 1, characters 20-21:
 1 | class g = f (A : t) A;; (* warn with -principal *)
                         ^
-Warning 42: this use of A relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of A relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 class g : f
 |}]
@@ -556,12 +556,12 @@ end;;
 Line 7, characters 15-16:
 7 |   let y : t = {x = 0}
                    ^
-Warning 42: this use of x relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of x relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 6, characters 2-8:
 6 |   open M  (* this open is unused, it isn't reported as shadowing 'x' *)
       ^^^^^^
-Warning 33: unused open M.
+Warning 33 [unused-open]: unused open M.
 module Shadow1 :
   sig
     type t = { x : int; }
@@ -581,11 +581,11 @@ end;;
 Line 6, characters 2-8:
 6 |   open M  (* this open shadows label 'x' *)
       ^^^^^^
-Warning 45: this open statement shadows the label x (which is later used)
+Warning 45 [open-shadow-label-constructor]: this open statement shadows the label x (which is later used)
 Line 7, characters 10-18:
 7 |   let y = {x = ""}
               ^^^^^^^^
-Warning 41: these field labels belong to several types: M.s t
+Warning 41 [ambiguous-name]: these field labels belong to several types: M.s t
 The first one was selected. Please disambiguate if this is wrong.
 module Shadow2 :
   sig
@@ -607,7 +607,7 @@ end;;
 Line 5, characters 37-40:
 5 |   let f (u : u) = match u with `Key {loc} -> loc
                                          ^^^
-Warning 42: this use of loc relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of loc relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 module P6235 :
   sig
@@ -632,7 +632,7 @@ end;;
 Line 7, characters 11-14:
 7 |     |`Key {loc} -> loc
                ^^^
-Warning 42: this use of loc relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of loc relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 module P6235' :
   sig
@@ -645,12 +645,12 @@ module P6235' :
 Line 7, characters 11-14:
 7 |     |`Key {loc} -> loc
                ^^^
-Warning 42: this use of loc relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of loc relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 7, characters 10-15:
 7 |     |`Key {loc} -> loc
               ^^^^^
-Warning 18: this type-based record disambiguation is not principal.
+Warning 18 [not-principal]: this type-based record disambiguation is not principal.
 module P6235' :
   sig
     type t = { loc : string; }
@@ -689,47 +689,47 @@ module M : sig type t = { x : int; y : char; } end
 Line 2, characters 27-28:
 2 | let f (x : M.t) = { x with y = 'a' }
                                ^
-Warning 42: this use of y relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of y relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 2, characters 18-36:
 2 | let f (x : M.t) = { x with y = 'a' }
                       ^^^^^^^^^^^^^^^^^^
-Warning 40: this record of type M.t contains fields that are
+Warning 40 [name-out-of-scope]: this record of type M.t contains fields that are
 not visible in the current scope: y.
 They will not be selected if the type becomes unknown.
 val f : M.t -> M.t = <fun>
 Line 3, characters 27-28:
 3 | let g (x : M.t) = { x with y = 'a' } :: []
                                ^
-Warning 42: this use of y relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of y relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 3, characters 18-36:
 3 | let g (x : M.t) = { x with y = 'a' } :: []
                       ^^^^^^^^^^^^^^^^^^
-Warning 40: this record of type M.t contains fields that are
+Warning 40 [name-out-of-scope]: this record of type M.t contains fields that are
 not visible in the current scope: y.
 They will not be selected if the type becomes unknown.
 val g : M.t -> M.t list = <fun>
 Line 4, characters 27-28:
 4 | let h (x : M.t) = { x with y = 'a' } :: { x with y = 'b' } :: [];;
                                ^
-Warning 42: this use of y relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of y relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 4, characters 18-36:
 4 | let h (x : M.t) = { x with y = 'a' } :: { x with y = 'b' } :: [];;
                       ^^^^^^^^^^^^^^^^^^
-Warning 40: this record of type M.t contains fields that are
+Warning 40 [name-out-of-scope]: this record of type M.t contains fields that are
 not visible in the current scope: y.
 They will not be selected if the type becomes unknown.
 Line 4, characters 49-50:
 4 | let h (x : M.t) = { x with y = 'a' } :: { x with y = 'b' } :: [];;
                                                      ^
-Warning 42: this use of y relies on type-directed disambiguation,
+Warning 42 [disambiguated-name]: this use of y relies on type-directed disambiguation,
 it will not compile with OCaml 4.00 or earlier.
 Line 4, characters 40-58:
 4 | let h (x : M.t) = { x with y = 'a' } :: { x with y = 'b' } :: [];;
                                             ^^^^^^^^^^^^^^^^^^
-Warning 40: this record of type M.t contains fields that are
+Warning 40 [name-out-of-scope]: this record of type M.t contains fields that are
 not visible in the current scope: y.
 They will not be selected if the type becomes unknown.
 val h : M.t -> M.t list = <fun>
diff --git a/testsuite/tests/typing-warnings/unused_functor_parameter.ml b/testsuite/tests/typing-warnings/unused_functor_parameter.ml
index c8691af992..997fca26ed 100644
--- a/testsuite/tests/typing-warnings/unused_functor_parameter.ml
+++ b/testsuite/tests/typing-warnings/unused_functor_parameter.ml
@@ -8,7 +8,7 @@ module Foo(Unused : sig end) = struct end;;
 Line 1, characters 11-17:
 1 | module Foo(Unused : sig end) = struct end;;
                ^^^^^^
-Warning 60: unused module Unused.
+Warning 60 [unused-module]: unused module Unused.
 module Foo : functor (Unused : sig end) -> sig end
 |}]
 
@@ -17,7 +17,7 @@ module type S = functor (Unused : sig end) -> sig end;;
 Line 1, characters 25-31:
 1 | module type S = functor (Unused : sig end) -> sig end;;
                              ^^^^^^
-Warning 67: unused functor parameter Unused.
+Warning 67 [unused-functor-parameter]: unused functor parameter Unused.
 module type S = functor (Unused : sig end) -> sig end
 |}]
 
@@ -28,6 +28,6 @@ end;;
 Line 2, characters 12-18:
 2 |   module M (Unused : sig end) : sig end
                 ^^^^^^
-Warning 67: unused functor parameter Unused.
+Warning 67 [unused-functor-parameter]: unused functor parameter Unused.
 module type S = sig module M : functor (Unused : sig end) -> sig end end
 |}]
diff --git a/testsuite/tests/typing-warnings/unused_rec.ml b/testsuite/tests/typing-warnings/unused_rec.ml
index 0ba9849f0d..5f5dc4e232 100644
--- a/testsuite/tests/typing-warnings/unused_rec.ml
+++ b/testsuite/tests/typing-warnings/unused_rec.ml
@@ -9,7 +9,7 @@ let rec f () = 3;;
 Line 3, characters 8-9:
 3 | let rec f () = 3;;
             ^
-Warning 39: unused rec flag.
+Warning 39 [unused-rec-flag]: unused rec flag.
 val f : unit -> int = <fun>
 |}];;
 
@@ -23,7 +23,7 @@ let[@warning "+39"] rec h () = 3;;
 Line 1, characters 24-25:
 1 | let[@warning "+39"] rec h () = 3;;
                             ^
-Warning 39: unused rec flag.
+Warning 39 [unused-rec-flag]: unused rec flag.
 val h : unit -> int = <fun>
 |}];;
 
@@ -44,6 +44,6 @@ let[@warning "+39"] rec h () = 3;;
 Line 1, characters 24-25:
 1 | let[@warning "+39"] rec h () = 3;;
                             ^
-Warning 39: unused rec flag.
+Warning 39 [unused-rec-flag]: unused rec flag.
 val h : unit -> int = <fun>
 |}];;
diff --git a/testsuite/tests/typing-warnings/unused_recmodule.ml b/testsuite/tests/typing-warnings/unused_recmodule.ml
index 78ce42effe..223de358c4 100644
--- a/testsuite/tests/typing-warnings/unused_recmodule.ml
+++ b/testsuite/tests/typing-warnings/unused_recmodule.ml
@@ -26,6 +26,6 @@ end;;
 Line 14, characters 4-10:
 14 |     type t
          ^^^^^^
-Warning 34: unused type t.
+Warning 34 [unused-type-declaration]: unused type t.
 module M : sig end
 |}];;
diff --git a/testsuite/tests/typing-warnings/unused_types.ml b/testsuite/tests/typing-warnings/unused_types.ml
index a7385e76d3..3522069f12 100644
--- a/testsuite/tests/typing-warnings/unused_types.ml
+++ b/testsuite/tests/typing-warnings/unused_types.ml
@@ -12,7 +12,7 @@ end
 Line 3, characters 2-19:
 3 |   type unused = int
       ^^^^^^^^^^^^^^^^^
-Warning 34: unused type unused.
+Warning 34 [unused-type-declaration]: unused type unused.
 module Unused : sig end
 |}]
 
@@ -26,7 +26,7 @@ end
 Line 4, characters 2-27:
 4 |   type nonrec unused = used
       ^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 34: unused type unused.
+Warning 34 [unused-type-declaration]: unused type unused.
 module Unused_nonrec : sig end
 |}]
 
@@ -39,11 +39,11 @@ end
 Line 3, characters 2-27:
 3 |   type unused = A of unused
       ^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 34: unused type unused.
+Warning 34 [unused-type-declaration]: unused type unused.
 Line 3, characters 16-27:
 3 |   type unused = A of unused
                     ^^^^^^^^^^^
-Warning 37: unused constructor A.
+Warning 37 [unused-constructor]: unused constructor A.
 module Unused_rec : sig end
 |}]
 
@@ -69,7 +69,7 @@ end
 Line 4, characters 11-12:
 4 |   type t = T
                ^
-Warning 37: unused constructor T.
+Warning 37 [unused-constructor]: unused constructor T.
 module Unused_constructor : sig type t end
 |}]
 
@@ -86,7 +86,7 @@ end
 Line 5, characters 11-12:
 5 |   type t = T
                ^
-Warning 37: constructor T is never used to build values.
+Warning 37 [unused-constructor]: constructor T is never used to build values.
 (However, this constructor appears in patterns.)
 module Unused_constructor_outside_patterns :
   sig type t val nothing : t -> unit end
@@ -102,7 +102,7 @@ end
 Line 4, characters 11-12:
 4 |   type t = T
                ^
-Warning 37: constructor T is never used to build values.
+Warning 37 [unused-constructor]: constructor T is never used to build values.
 Its type is exported as a private type.
 module Unused_constructor_exported_private : sig type t = private T end
 |}]
@@ -130,7 +130,7 @@ end
 Line 4, characters 19-20:
 4 |   type t = private T
                        ^
-Warning 37: unused constructor T.
+Warning 37 [unused-constructor]: unused constructor T.
 module Unused_private_constructor : sig type t end
 |}]
 
@@ -177,7 +177,7 @@ end
 Line 3, characters 2-26:
 3 |   exception Nobody_uses_me
       ^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 38: unused exception Nobody_uses_me
+Warning 38 [unused-extension]: unused exception Nobody_uses_me
 module Unused_exception : sig end
 |}]
 
@@ -192,7 +192,7 @@ end
 Line 5, characters 12-26:
 5 |   type t += Nobody_uses_me
                 ^^^^^^^^^^^^^^
-Warning 38: unused extension constructor Nobody_uses_me
+Warning 38 [unused-extension]: unused extension constructor Nobody_uses_me
 module Unused_extension_constructor : sig type t = .. end
 |}]
 
@@ -209,7 +209,7 @@ end
 Line 4, characters 2-32:
 4 |   exception Nobody_constructs_me
       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 38: exception Nobody_constructs_me is never used to build values.
+Warning 38 [unused-extension]: exception Nobody_constructs_me is never used to build values.
 (However, this constructor appears in patterns.)
 module Unused_exception_outside_patterns : sig val falsity : exn -> bool end
 |}]
@@ -229,7 +229,7 @@ end
 Line 6, characters 12-27:
 6 |   type t += Noone_builds_me
                 ^^^^^^^^^^^^^^^
-Warning 38: extension constructor Noone_builds_me is never used to build values.
+Warning 38 [unused-extension]: extension constructor Noone_builds_me is never used to build values.
 (However, this constructor appears in patterns.)
 module Unused_extension_outside_patterns :
   sig type t = .. val falsity : t -> bool end
@@ -245,7 +245,7 @@ end
 Line 4, characters 2-23:
 4 |   exception Private_exn
       ^^^^^^^^^^^^^^^^^^^^^
-Warning 38: exception Private_exn is never used to build values.
+Warning 38 [unused-extension]: exception Private_exn is never used to build values.
 It is exported or rebound as a private extension.
 module Unused_exception_exported_private :
   sig type exn += private Private_exn end
@@ -263,7 +263,7 @@ end
 Line 6, characters 12-23:
 6 |   type t += Private_ext
                 ^^^^^^^^^^^
-Warning 38: extension constructor Private_ext is never used to build values.
+Warning 38 [unused-extension]: extension constructor Private_ext is never used to build values.
 It is exported or rebound as a private extension.
 module Unused_extension_exported_private :
   sig type t = .. type t += private Private_ext end
@@ -294,7 +294,7 @@ end
 Line 5, characters 20-31:
 5 |   type t += private Private_ext
                         ^^^^^^^^^^^
-Warning 38: unused extension constructor Private_ext
+Warning 38 [unused-extension]: unused extension constructor Private_ext
 module Unused_private_extension : sig type t end
 |}]
 
@@ -330,7 +330,7 @@ end;;
 Line 3, characters 11-12:
 3 |   type t = A [@@warning "-34"]
                ^
-Warning 37: unused constructor A.
+Warning 37 [unused-constructor]: unused constructor A.
 module Unused_type_disable_warning : sig end
 |}]
 
@@ -342,6 +342,6 @@ end;;
 Line 3, characters 2-30:
 3 |   type t = A [@@warning "-37"]
       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 34: unused type t.
+Warning 34 [unused-type-declaration]: unused type t.
 module Unused_constructor_disable_warning : sig end
 |}]
diff --git a/testsuite/tests/warnings/mnemonics.mll b/testsuite/tests/warnings/mnemonics.mll
new file mode 100644
index 0000000000..1071c3a12d
--- /dev/null
+++ b/testsuite/tests/warnings/mnemonics.mll
@@ -0,0 +1,84 @@
+(* TEST
+
+ocamllex_flags = "-q"
+
+*)
+
+{
+}
+
+let ws = [' ''\t']
+let nl = '\n'
+let constr = ['A'-'Z']['a'-'z''A'-'Z''0'-'9''_']*
+let int = ['0'-'9']+
+let mnemo = ['a'-'z']['a'-'z''-']*['a'-'z']
+
+rule seek_let_number_function = parse
+| ws* "let" ws+ "number" ws* "=" ws* "function" ws* '\n'
+  { () }
+| [^'\n']* '\n'
+  { seek_let_number_function lexbuf }
+
+and constructors = parse
+| ws* '|' ws* (constr as c) (ws* '_')? ws* "->" ws* (int as n) [^'\n']* '\n'
+  { (c, int_of_string n) :: constructors lexbuf }
+| ws* ";;" ws* '\n'
+  { [] }
+
+and mnemonics = parse
+| ws* (int as n) ws+ '[' (mnemo as s) ']' [^'\n']* '\n'
+  { (s, int_of_string n) :: mnemonics lexbuf }
+| [^'\n']* '\n'
+  { mnemonics lexbuf }
+| eof
+  { [] }
+
+{
+let ocamlsrcdir = Sys.getenv "ocamlsrcdir"
+
+let ocamlrun = Sys.getenv "ocamlrun"
+
+let constructors =
+  let ic = open_in Filename.(concat ocamlsrcdir (concat "utils" "warnings.ml")) in
+  Fun.protect ~finally:(fun () -> close_in_noerr ic)
+    (fun () ->
+       let lexbuf = Lexing.from_channel ic in
+       seek_let_number_function lexbuf;
+       constructors lexbuf
+    )
+
+let mnemonics =
+  let stdout = "warn-help.out" in
+  let n =
+    Sys.command
+      Filename.(quote_command ~stdout
+                  ocamlrun [concat ocamlsrcdir "ocamlc"; "-warn-help"])
+  in
+  assert (n = 0);
+  let ic = open_in stdout in
+  Fun.protect ~finally:(fun () -> close_in_noerr ic)
+    (fun () ->
+       let lexbuf = Lexing.from_channel ic in
+       mnemonics lexbuf
+    )
+
+let mnemonic_of_constructor s =
+  String.map (function '_' -> '-' | c -> Char.lowercase_ascii c) s
+
+let () =
+  List.iter (fun (s, n) ->
+      let f (c, m) = mnemonic_of_constructor c = s && n = m in
+      if not (List.exists f constructors) then
+        Printf.printf "Could not find constructor corresponding to mnemonic %S (%d)\n%!" s n
+    ) mnemonics
+
+let _ =
+  List.fold_left (fun first (c, m) ->
+      if List.mem (mnemonic_of_constructor c, m) mnemonics then first
+      else begin
+        if first then print_endline "Constructors without associated mnemonic:";
+        print_endline c;
+        false
+      end
+    ) true constructors
+}
diff --git a/testsuite/tests/warnings/mnemonics.reference b/testsuite/tests/warnings/mnemonics.reference
new file mode 100644
index 0000000000..3cd3dfa2e5
--- /dev/null
+++ b/testsuite/tests/warnings/mnemonics.reference
@@ -0,0 +1,2 @@
+Constructors without associated mnemonic:
+All_clauses_guarded
diff --git a/testsuite/tests/warnings/w01.compilers.reference b/testsuite/tests/warnings/w01.compilers.reference
index 6973f4d580..e46fa9de26 100644
--- a/testsuite/tests/warnings/w01.compilers.reference
+++ b/testsuite/tests/warnings/w01.compilers.reference
@@ -1,27 +1,27 @@
 File "w01.ml", line 14, characters 12-14:
 14 | let foo = ( *);;
                  ^^
-Warning 2: this is not the end of a comment.
+Warning 2 [comment-not-end]: this is not the end of a comment.
 File "w01.ml", line 20, characters 0-3:
 20 | f 1; f 1;;
      ^^^
-Warning 5: this function application is partial,
+Warning 5 [ignored-partial-application]: this function application is partial,
 maybe some arguments are missing.
 File "w01.ml", line 30, characters 4-5:
 30 | let 1 = 1;;
          ^
-Warning 8: this pattern-matching is not exhaustive.
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
 Here is an example of a case that is not matched:
 0
 File "w01.ml", line 35, characters 0-1:
 35 | 1; 1;;
      ^
-Warning 10: this expression should have type unit.
+Warning 10 [non-unit-statement]: this expression should have type unit.
 File "w01.ml", line 42, characters 2-3:
 42 | | 1 -> ()
        ^
-Warning 11: this match case is unused.
+Warning 11 [redundant-case]: this match case is unused.
 File "w01.ml", line 19, characters 8-9:
 19 | let f x y = x;;
              ^
-Warning 27: unused variable y.
+Warning 27 [unused-var-strict]: unused variable y.
diff --git a/testsuite/tests/warnings/w03.compilers.reference b/testsuite/tests/warnings/w03.compilers.reference
index 3e75b2ef1e..fc79e8cc5d 100644
--- a/testsuite/tests/warnings/w03.compilers.reference
+++ b/testsuite/tests/warnings/w03.compilers.reference
@@ -5,4 +5,4 @@ Alert deprecated: A
 File "w03.ml", line 17, characters 12-26:
 17 | exception B [@@deprecated]
                  ^^^^^^^^^^^^^^
-Warning 53: the "deprecated" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "deprecated" attribute cannot appear in this context
diff --git a/testsuite/tests/warnings/w04.compilers.reference b/testsuite/tests/warnings/w04.compilers.reference
index bb39fb4d9e..1c6cc55ce6 100644
--- a/testsuite/tests/warnings/w04.compilers.reference
+++ b/testsuite/tests/warnings/w04.compilers.reference
@@ -2,5 +2,5 @@ File "w04.ml", lines 21-23, characters 10-8:
 21 | ..........match x with
 22 | | A -> 0
 23 | | _ -> 1
-Warning 4: this pattern-matching is fragile.
+Warning 4 [fragile-match]: this pattern-matching is fragile.
 It will remain exhaustive when constructors are added to type t.
diff --git a/testsuite/tests/warnings/w04_failure.compilers.reference b/testsuite/tests/warnings/w04_failure.compilers.reference
index d0fac4daf4..8b24c6307d 100644
--- a/testsuite/tests/warnings/w04_failure.compilers.reference
+++ b/testsuite/tests/warnings/w04_failure.compilers.reference
@@ -3,19 +3,19 @@ File "w04_failure.ml", lines 20-23, characters 2-17:
 21 |   | AB, _, A -> ()
 22 |   | _, XY, X -> ()
 23 |   | _, _, _ -> ()
-Warning 4: this pattern-matching is fragile.
+Warning 4 [fragile-match]: this pattern-matching is fragile.
 It will remain exhaustive when constructors are added to type repr.
 File "w04_failure.ml", lines 20-23, characters 2-17:
 20 | ..match r1, r2, t with
 21 |   | AB, _, A -> ()
 22 |   | _, XY, X -> ()
 23 |   | _, _, _ -> ()
-Warning 4: this pattern-matching is fragile.
+Warning 4 [fragile-match]: this pattern-matching is fragile.
 It will remain exhaustive when constructors are added to type ab.
 File "w04_failure.ml", lines 20-23, characters 2-17:
 20 | ..match r1, r2, t with
 21 |   | AB, _, A -> ()
 22 |   | _, XY, X -> ()
 23 |   | _, _, _ -> ()
-Warning 4: this pattern-matching is fragile.
+Warning 4 [fragile-match]: this pattern-matching is fragile.
 It will remain exhaustive when constructors are added to type xy.
diff --git a/testsuite/tests/warnings/w06.compilers.reference b/testsuite/tests/warnings/w06.compilers.reference
index 4a118e202c..3d46d10e9f 100644
--- a/testsuite/tests/warnings/w06.compilers.reference
+++ b/testsuite/tests/warnings/w06.compilers.reference
@@ -1,8 +1,8 @@
 File "w06.ml", line 16, characters 9-12:
 16 | let () = foo 2
               ^^^
-Warning 6: label bar was omitted in the application of this function.
+Warning 6 [labels-omitted]: label bar was omitted in the application of this function.
 File "w06.ml", line 17, characters 9-12:
 17 | let () = bar 4 2
               ^^^
-Warning 6: labels foo, baz were omitted in the application of this function.
+Warning 6 [labels-omitted]: labels foo, baz were omitted in the application of this function.
diff --git a/testsuite/tests/warnings/w32.compilers.reference b/testsuite/tests/warnings/w32.compilers.reference
index 6cf44b0b50..749342940b 100644
--- a/testsuite/tests/warnings/w32.compilers.reference
+++ b/testsuite/tests/warnings/w32.compilers.reference
@@ -1,63 +1,63 @@
 File "w32.mli", line 12, characters 10-11:
 12 | module F (X : sig val x : int end) : sig end
                ^
-Warning 67: unused functor parameter X.
+Warning 67 [unused-functor-parameter]: unused functor parameter X.
 File "w32.mli", line 14, characters 10-11:
 14 | module G (X : sig val x : int end) : sig end
                ^
-Warning 67: unused functor parameter X.
+Warning 67 [unused-functor-parameter]: unused functor parameter X.
 File "w32.mli", line 16, characters 10-11:
 16 | module H (X : sig val x : int end) : sig val x : int end
                ^
-Warning 67: unused functor parameter X.
+Warning 67 [unused-functor-parameter]: unused functor parameter X.
 File "w32.ml", line 40, characters 24-25:
 40 | let[@warning "-32"] rec q x = x
                              ^
-Warning 39: unused rec flag.
+Warning 39 [unused-rec-flag]: unused rec flag.
 File "w32.ml", line 43, characters 24-25:
 43 | let[@warning "-32"] rec s x = x
                              ^
-Warning 39: unused rec flag.
+Warning 39 [unused-rec-flag]: unused rec flag.
 File "w32.ml", line 20, characters 4-5:
 20 | let h x = x
          ^
-Warning 32: unused value h.
+Warning 32 [unused-value-declaration]: unused value h.
 File "w32.ml", line 26, characters 4-5:
 26 | and j x = x
          ^
-Warning 32: unused value j.
+Warning 32 [unused-value-declaration]: unused value j.
 File "w32.ml", line 28, characters 4-5:
 28 | let k x = x
          ^
-Warning 32: unused value k.
+Warning 32 [unused-value-declaration]: unused value k.
 File "w32.ml", line 41, characters 4-5:
 41 | and r x = x
          ^
-Warning 32: unused value r.
+Warning 32 [unused-value-declaration]: unused value r.
 File "w32.ml", line 44, characters 20-21:
 44 | and[@warning "-39"] t x = x
                          ^
-Warning 32: unused value t.
+Warning 32 [unused-value-declaration]: unused value t.
 File "w32.ml", line 46, characters 24-25:
 46 | let[@warning "-39"] rec u x = x
                              ^
-Warning 32: unused value u.
+Warning 32 [unused-value-declaration]: unused value u.
 File "w32.ml", line 47, characters 4-5:
 47 | and v x = v x
          ^
-Warning 32: unused value v.
+Warning 32 [unused-value-declaration]: unused value v.
 File "w32.ml", line 55, characters 22-23:
 55 |   let[@warning "+32"] g x = x
                            ^
-Warning 32: unused value g.
+Warning 32 [unused-value-declaration]: unused value g.
 File "w32.ml", line 56, characters 22-23:
 56 |   let[@warning "+32"] h x = x
                            ^
-Warning 32: unused value h.
+Warning 32 [unused-value-declaration]: unused value h.
 File "w32.ml", line 59, characters 22-23:
 59 |   and[@warning "+32"] k x = x
                            ^
-Warning 32: unused value k.
+Warning 32 [unused-value-declaration]: unused value k.
 File "w32.ml", lines 52-60, characters 0-3:
 52 | module M = struct
 53 |   [@@@warning "-32"]
@@ -68,16 +68,16 @@ File "w32.ml", lines 52-60, characters 0-3:
 58 |   let j x = x
 59 |   and[@warning "+32"] k x = x
 60 | end
-Warning 60: unused module M.
+Warning 60 [unused-module]: unused module M.
 File "w32.ml", line 63, characters 18-29:
 63 | module F (X : sig val x : int end) = struct end
                        ^^^^^^^^^^^
-Warning 32: unused value x.
+Warning 32 [unused-value-declaration]: unused value x.
 File "w32.ml", line 63, characters 10-11:
 63 | module F (X : sig val x : int end) = struct end
                ^
-Warning 60: unused module X.
+Warning 60 [unused-module]: unused module X.
 File "w32.ml", line 65, characters 18-29:
 65 | module G (X : sig val x : int end) = X
                        ^^^^^^^^^^^
-Warning 32: unused value x.
+Warning 32 [unused-value-declaration]: unused value x.
diff --git a/testsuite/tests/warnings/w32b.compilers.reference b/testsuite/tests/warnings/w32b.compilers.reference
index 79ba5c8527..fdaa92e5bb 100644
--- a/testsuite/tests/warnings/w32b.compilers.reference
+++ b/testsuite/tests/warnings/w32b.compilers.reference
@@ -1,8 +1,8 @@
 File "w32b.ml", line 13, characters 18-24:
 13 | module Q (M : sig type t end) = struct end
                        ^^^^^^
-Warning 34: unused type t.
+Warning 34 [unused-type-declaration]: unused type t.
 File "w32b.ml", line 13, characters 10-11:
 13 | module Q (M : sig type t end) = struct end
                ^
-Warning 60: unused module M.
+Warning 60 [unused-module]: unused module M.
diff --git a/testsuite/tests/warnings/w33.compilers.reference b/testsuite/tests/warnings/w33.compilers.reference
index 52b77b10c5..6931c1356d 100644
--- a/testsuite/tests/warnings/w33.compilers.reference
+++ b/testsuite/tests/warnings/w33.compilers.reference
@@ -1,12 +1,12 @@
 File "w33.ml", line 19, characters 6-11:
 19 | let f M.(x) = x (* useless open *)
            ^^^^^
-Warning 33: unused open M.
+Warning 33 [unused-open]: unused open M.
 File "w33.ml", line 26, characters 0-7:
 26 | open! M (* useless open! *)
      ^^^^^^^
-Warning 66: unused open! M.
+Warning 66 [unused-open-bang]: unused open! M.
 File "w33.ml", line 27, characters 0-6:
 27 | open M (* useless open *)
      ^^^^^^
-Warning 33: unused open M.
+Warning 33 [unused-open]: unused open M.
diff --git a/testsuite/tests/warnings/w45.compilers.reference b/testsuite/tests/warnings/w45.compilers.reference
index 74830f680d..93640dd3ee 100644
--- a/testsuite/tests/warnings/w45.compilers.reference
+++ b/testsuite/tests/warnings/w45.compilers.reference
@@ -1,13 +1,13 @@
 File "w45.ml", line 24, characters 2-9:
 24 |   open T2 (* shadow X, which is later used; but not A, see #6762 *)
        ^^^^^^^
-Warning 45: this open statement shadows the constructor X (which is later used)
+Warning 45 [open-shadow-label-constructor]: this open statement shadows the constructor X (which is later used)
 File "w45.ml", line 26, characters 14-15:
 26 |   let _ = (A, X) (* X belongs to several types *)
                    ^
-Warning 41: X belongs to several types: T2.s T1.s
+Warning 41 [ambiguous-name]: X belongs to several types: T2.s T1.s
 The first one was selected. Please disambiguate if this is wrong.
 File "w45.ml", line 23, characters 2-9:
 23 |   open T1 (* unused open *)
        ^^^^^^^
-Warning 33: unused open T1.
+Warning 33 [unused-open]: unused open T1.
diff --git a/testsuite/tests/warnings/w47_inline.compilers.reference b/testsuite/tests/warnings/w47_inline.compilers.reference
index c9048adc3e..f8478ff2f8 100644
--- a/testsuite/tests/warnings/w47_inline.compilers.reference
+++ b/testsuite/tests/warnings/w47_inline.compilers.reference
@@ -1,42 +1,42 @@
 File "w47_inline.ml", line 30, characters 20-22:
 30 |   let[@local never] f2 x = x (* ok *) in
                          ^^
-Warning 26: unused variable f2.
+Warning 26 [unused-var]: unused variable f2.
 File "w47_inline.ml", line 31, characters 24-26:
 31 |   let[@local malformed] f3 x = x (* bad payload *) in
                              ^^
-Warning 26: unused variable f3.
+Warning 26 [unused-var]: unused variable f3.
 File "w47_inline.ml", line 15, characters 23-29:
 15 | let d = (fun x -> x) [@inline malformed attribute] (* rejected *)
                             ^^^^^^
-Warning 47: illegal payload for attribute 'inline'.
+Warning 47 [attribute-payload]: illegal payload for attribute 'inline'.
 It must be either 'never', 'always', 'hint' or empty
 File "w47_inline.ml", line 16, characters 23-29:
 16 | let e = (fun x -> x) [@inline malformed_attribute] (* rejected *)
                             ^^^^^^
-Warning 47: illegal payload for attribute 'inline'.
+Warning 47 [attribute-payload]: illegal payload for attribute 'inline'.
 It must be either 'never', 'always', 'hint' or empty
 File "w47_inline.ml", line 17, characters 23-29:
 17 | let f = (fun x -> x) [@inline : malformed_attribute] (* rejected *)
                             ^^^^^^
-Warning 47: illegal payload for attribute 'inline'.
+Warning 47 [attribute-payload]: illegal payload for attribute 'inline'.
 It must be either 'never', 'always', 'hint' or empty
 File "w47_inline.ml", line 18, characters 23-29:
 18 | let g = (fun x -> x) [@inline ? malformed_attribute] (* rejected *)
                             ^^^^^^
-Warning 47: illegal payload for attribute 'inline'.
+Warning 47 [attribute-payload]: illegal payload for attribute 'inline'.
 It must be either 'never', 'always', 'hint' or empty
 File "w47_inline.ml", line 23, characters 15-22:
 23 | let k x = (a [@inlined malformed]) x (* rejected *)
                     ^^^^^^^
-Warning 47: illegal payload for attribute 'inlined'.
+Warning 47 [attribute-payload]: illegal payload for attribute 'inlined'.
 It must be either 'never', 'always', 'hint' or empty
 File "w47_inline.ml", line 31, characters 7-12:
 31 |   let[@local malformed] f3 x = x (* bad payload *) in
             ^^^^^
-Warning 47: illegal payload for attribute 'local'.
+Warning 47 [attribute-payload]: illegal payload for attribute 'local'.
 It must be either 'never', 'always', 'maybe' or empty
 File "w47_inline.ml", line 32, characters 17-26:
 32 |   let[@local] f4 x = 2 * x (* not local *) in
                       ^^^^^^^^^
-Warning 55: Cannot inline: This function cannot be compiled into a static continuation
+Warning 55 [inlining-impossible]: Cannot inline: This function cannot be compiled into a static continuation
diff --git a/testsuite/tests/warnings/w50.compilers.reference b/testsuite/tests/warnings/w50.compilers.reference
index 5b41948c0e..13c026e39d 100644
--- a/testsuite/tests/warnings/w50.compilers.reference
+++ b/testsuite/tests/warnings/w50.compilers.reference
@@ -1,8 +1,8 @@
 File "w50.ml", line 13, characters 2-17:
 13 |   module L = List
        ^^^^^^^^^^^^^^^
-Warning 60: unused module L.
+Warning 60 [unused-module]: unused module L.
 File "w50.ml", line 17, characters 2-16:
 17 |   module Y1 = X1
        ^^^^^^^^^^^^^^
-Warning 60: unused module Y1.
+Warning 60 [unused-module]: unused module Y1.
diff --git a/testsuite/tests/warnings/w51.compilers.reference b/testsuite/tests/warnings/w51.compilers.reference
index b09e55a9e2..93c13ac0ad 100644
--- a/testsuite/tests/warnings/w51.compilers.reference
+++ b/testsuite/tests/warnings/w51.compilers.reference
@@ -1,4 +1,4 @@
 File "w51.ml", line 14, characters 13-37:
 14 |   | n -> n * (fact [@tailcall]) (n-1)
                   ^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 51: expected tailcall
+Warning 51 [tailcall-expected]: expected tailcall
diff --git a/testsuite/tests/warnings/w51_bis.compilers.reference b/testsuite/tests/warnings/w51_bis.compilers.reference
index 791631121e..9a3b4056cf 100644
--- a/testsuite/tests/warnings/w51_bis.compilers.reference
+++ b/testsuite/tests/warnings/w51_bis.compilers.reference
@@ -1,4 +1,4 @@
 File "w51_bis.ml", line 15, characters 12-48:
 15 |         try (foldl [@tailcall]) op (op x acc) xs
                  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 51: expected tailcall
+Warning 51 [tailcall-expected]: expected tailcall
diff --git a/testsuite/tests/warnings/w52.ml b/testsuite/tests/warnings/w52.ml
index 2f9e77be79..bf6bd6843d 100644
--- a/testsuite/tests/warnings/w52.ml
+++ b/testsuite/tests/warnings/w52.ml
@@ -8,7 +8,7 @@ let () = try () with Invalid_argument "Any" -> ();;
 Line 1, characters 38-43:
 1 | let () = try () with Invalid_argument "Any" -> ();;
                                           ^^^^^
-Warning 52: Code should not depend on the actual values of
+Warning 52 [fragile-literal-pattern]: Code should not depend on the actual values of
 this constructor's arguments. They are only for information
 and may change in future versions. (See manual section 9.5)
 |}];;
@@ -18,7 +18,7 @@ let () = try () with Match_failure ("Any",_,_) -> ();;
 Line 1, characters 35-46:
 1 | let () = try () with Match_failure ("Any",_,_) -> ();;
                                        ^^^^^^^^^^^
-Warning 52: Code should not depend on the actual values of
+Warning 52 [fragile-literal-pattern]: Code should not depend on the actual values of
 this constructor's arguments. They are only for information
 and may change in future versions. (See manual section 9.5)
 |}];;
@@ -28,7 +28,7 @@ let () = try () with Match_failure (_,0,_) -> ();;
 Line 1, characters 35-42:
 1 | let () = try () with Match_failure (_,0,_) -> ();;
                                        ^^^^^^^
-Warning 52: Code should not depend on the actual values of
+Warning 52 [fragile-literal-pattern]: Code should not depend on the actual values of
 this constructor's arguments. They are only for information
 and may change in future versions. (See manual section 9.5)
 |}];;
@@ -53,7 +53,7 @@ let f = function
 Line 2, characters 7-17:
 2 | | Warn "anything" -> ()
            ^^^^^^^^^^
-Warning 52: Code should not depend on the actual values of
+Warning 52 [fragile-literal-pattern]: Code should not depend on the actual values of
 this constructor's arguments. They are only for information
 and may change in future versions. (See manual section 9.5)
 val f : t -> unit = <fun>
@@ -66,7 +66,7 @@ let g = function
 Line 2, characters 8-10:
 2 | | Warn' 0n -> ()
             ^^
-Warning 52: Code should not depend on the actual values of
+Warning 52 [fragile-literal-pattern]: Code should not depend on the actual values of
 this constructor's arguments. They are only for information
 and may change in future versions. (See manual section 9.5)
 val g : t -> unit = <fun>
@@ -93,7 +93,7 @@ let j = function
 Line 2, characters 7-34:
 2 | | Deep (_ :: _ :: ("deep",_) :: _) -> ()
            ^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 52: Code should not depend on the actual values of
+Warning 52 [fragile-literal-pattern]: Code should not depend on the actual values of
 this constructor's arguments. They are only for information
 and may change in future versions. (See manual section 9.5)
 val j : t -> unit = <fun>
diff --git a/testsuite/tests/warnings/w53.compilers.reference b/testsuite/tests/warnings/w53.compilers.reference
index e8ee95f3d6..51fde7ad91 100644
--- a/testsuite/tests/warnings/w53.compilers.reference
+++ b/testsuite/tests/warnings/w53.compilers.reference
@@ -1,52 +1,52 @@
 File "w53.ml", line 12, characters 4-5:
 12 | let h x = x [@inline] (* rejected *)
          ^
-Warning 32: unused value h.
+Warning 32 [unused-value-declaration]: unused value h.
 File "w53.ml", line 12, characters 14-20:
 12 | let h x = x [@inline] (* rejected *)
                    ^^^^^^
-Warning 53: the "inline" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "inline" attribute cannot appear in this context
 File "w53.ml", line 13, characters 14-26:
 13 | let h x = x [@ocaml.inline] (* rejected *)
                    ^^^^^^^^^^^^
-Warning 53: the "ocaml.inline" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "ocaml.inline" attribute cannot appear in this context
 File "w53.ml", line 15, characters 14-21:
 15 | let i x = x [@inlined] (* rejected *)
                    ^^^^^^^
-Warning 53: the "inlined" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "inlined" attribute cannot appear in this context
 File "w53.ml", line 16, characters 14-27:
 16 | let j x = x [@ocaml.inlined] (* rejected *)
                    ^^^^^^^^^^^^^
-Warning 53: the "ocaml.inlined" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "ocaml.inlined" attribute cannot appear in this context
 File "w53.ml", line 19, characters 16-23:
 19 | let l x = h x [@inlined] (* rejected *)
                      ^^^^^^^
-Warning 53: the "inlined" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "inlined" attribute cannot appear in this context
 File "w53.ml", line 21, characters 14-22:
 21 | let m x = x [@tailcall] (* rejected *)
                    ^^^^^^^^
-Warning 53: the "tailcall" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "tailcall" attribute cannot appear in this context
 File "w53.ml", line 22, characters 14-28:
 22 | let n x = x [@ocaml.tailcall] (* rejected *)
                    ^^^^^^^^^^^^^^
-Warning 53: the "ocaml.tailcall" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "ocaml.tailcall" attribute cannot appear in this context
 File "w53.ml", line 25, characters 16-24:
 25 | let q x = h x [@tailcall] (* rejected *)
                      ^^^^^^^^
-Warning 53: the "tailcall" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "tailcall" attribute cannot appear in this context
 File "w53.ml", line 33, characters 0-32:
 33 | module C = struct end [@@inline] (* rejected *)
      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 53: the "inline" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "inline" attribute cannot appear in this context
 File "w53.ml", line 34, characters 0-39:
 34 | module C' = struct end [@@ocaml.inline] (* rejected *)
      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 53: the "inline" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "inline" attribute cannot appear in this context
 File "w53.ml", line 40, characters 16-22:
 40 | module G = (A [@inline])(struct end) (* rejected *)
                      ^^^^^^
-Warning 53: the "inline" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "inline" attribute cannot appear in this context
 File "w53.ml", line 41, characters 17-29:
 41 | module G' = (A [@ocaml.inline])(struct end) (* rejected *)
                       ^^^^^^^^^^^^
-Warning 53: the "ocaml.inline" attribute cannot appear in this context
+Warning 53 [misplaced-attribute]: the "ocaml.inline" attribute cannot appear in this context
diff --git a/testsuite/tests/warnings/w54.compilers.reference b/testsuite/tests/warnings/w54.compilers.reference
index e476122c78..110da823ae 100644
--- a/testsuite/tests/warnings/w54.compilers.reference
+++ b/testsuite/tests/warnings/w54.compilers.reference
@@ -1,16 +1,16 @@
 File "w54.ml", line 12, characters 33-39:
 12 | let f = (fun x -> x) [@inline] [@inline never]
                                       ^^^^^^
-Warning 54: the "inline" attribute is used more than once on this expression
+Warning 54 [duplicated-attribute]: the "inline" attribute is used more than once on this expression
 File "w54.ml", line 13, characters 51-63:
 13 | let g = (fun x -> x) [@inline] [@something_else] [@ocaml.inline]
                                                         ^^^^^^^^^^^^
-Warning 54: the "ocaml.inline" attribute is used more than once on this expression
+Warning 54 [duplicated-attribute]: the "ocaml.inline" attribute is used more than once on this expression
 File "w54.ml", line 15, characters 26-39:
 15 | let h x = (g [@inlined] [@ocaml.inlined never]) x
                                ^^^^^^^^^^^^^
-Warning 54: the "ocaml.inlined" attribute is used more than once on this expression
+Warning 54 [duplicated-attribute]: the "ocaml.inlined" attribute is used more than once on this expression
 File "w54.ml", line 19, characters 0-43:
 19 | let i = ((fun x -> x) [@inline]) [@@inline]
      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 54: the "inline" attribute is used more than once on this expression
+Warning 54 [duplicated-attribute]: the "inline" attribute is used more than once on this expression
diff --git a/testsuite/tests/warnings/w55.flambda.reference b/testsuite/tests/warnings/w55.flambda.reference
index 1601214508..00bd36c074 100644
--- a/testsuite/tests/warnings/w55.flambda.reference
+++ b/testsuite/tests/warnings/w55.flambda.reference
@@ -1,12 +1,12 @@
 File "w55.ml", line 33, characters 10-26:
 33 | let h x = (j [@inlined]) x
                ^^^^^^^^^^^^^^^^
-Warning 55: Cannot inline: [@inlined] attributes may not be used on partial applications
+Warning 55 [inlining-impossible]: Cannot inline: [@inlined] attributes may not be used on partial applications
 File "w55.ml", line 29, characters 10-27:
 29 | let i x = (!r [@inlined]) x
                ^^^^^^^^^^^^^^^^^
-Warning 55: Cannot inline: [@inlined] attribute was not used on this function application (the optimizer did not know what function was being applied)
+Warning 55 [inlining-impossible]: Cannot inline: [@inlined] attribute was not used on this function application (the optimizer did not know what function was being applied)
 File "w55.ml", line 39, characters 12-30:
 39 | let b x y = (a [@inlined]) x y
                  ^^^^^^^^^^^^^^^^^^
-Warning 55: Cannot inline: [@inlined] attribute was not used on this function application (the optimizer did not know what function was being applied)
+Warning 55 [inlining-impossible]: Cannot inline: [@inlined] attribute was not used on this function application (the optimizer did not know what function was being applied)
diff --git a/testsuite/tests/warnings/w55.native.reference b/testsuite/tests/warnings/w55.native.reference
index 9ffb78f099..d701efcb87 100644
--- a/testsuite/tests/warnings/w55.native.reference
+++ b/testsuite/tests/warnings/w55.native.reference
@@ -1,24 +1,24 @@
 File "w55.ml", line 25, characters 10-26:
 25 | let g x = (f [@inlined]) x
                ^^^^^^^^^^^^^^^^
-Warning 55: Cannot inline: Function information unavailable
+Warning 55 [inlining-impossible]: Cannot inline: Function information unavailable
 File "w55.ml", line 29, characters 10-27:
 29 | let i x = (!r [@inlined]) x
                ^^^^^^^^^^^^^^^^^
-Warning 55: Cannot inline: Unknown function
+Warning 55 [inlining-impossible]: Cannot inline: Unknown function
 File "w55.ml", line 33, characters 10-26:
 33 | let h x = (j [@inlined]) x
                ^^^^^^^^^^^^^^^^
-Warning 55: Cannot inline: Partial application
+Warning 55 [inlining-impossible]: Cannot inline: Partial application
 File "w55.ml", line 39, characters 12-30:
 39 | let b x y = (a [@inlined]) x y
                  ^^^^^^^^^^^^^^^^^^
-Warning 55: Cannot inline: Over-application
+Warning 55 [inlining-impossible]: Cannot inline: Over-application
 File "w55.ml", line 39, characters 12-30:
 39 | let b x y = (a [@inlined]) x y
                  ^^^^^^^^^^^^^^^^^^
-Warning 55: Cannot inline: Function information unavailable
+Warning 55 [inlining-impossible]: Cannot inline: Function information unavailable
 File "w55.ml", line 42, characters 10-26:
 42 | let d x = (c [@inlined]) x
                ^^^^^^^^^^^^^^^^
-Warning 55: Cannot inline: Function information unavailable
+Warning 55 [inlining-impossible]: Cannot inline: Function information unavailable
diff --git a/testsuite/tests/warnings/w58.native.reference b/testsuite/tests/warnings/w58.native.reference
index f913ef9485..4fb0badf34 100644
--- a/testsuite/tests/warnings/w58.native.reference
+++ b/testsuite/tests/warnings/w58.native.reference
@@ -1,2 +1,2 @@
 File "_none_", line 1:
-Warning 58: no cmx file was found in path for module Module_without_cmx, and its interface was not compiled with -opaque
+Warning 58 [no-cmx-file]: no cmx file was found in path for module Module_without_cmx, and its interface was not compiled with -opaque
diff --git a/testsuite/tests/warnings/w59.flambda.reference b/testsuite/tests/warnings/w59.flambda.reference
index 912da659c5..8277d94858 100644
--- a/testsuite/tests/warnings/w59.flambda.reference
+++ b/testsuite/tests/warnings/w59.flambda.reference
@@ -1,30 +1,30 @@
 File "w59.ml", line 46, characters 2-43:
 46 |   Obj.set_field (Obj.repr o) 0 (Obj.repr 3);
        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 59: A potential assignment to a non-mutable value was detected 
+Warning 59 [flambda-assignment-to-non-mutable-value]: A potential assignment to a non-mutable value was detected 
 in this source file.  Such assignments may generate incorrect code 
 when using Flambda.
 File "w59.ml", line 47, characters 2-43:
 47 |   Obj.set_field (Obj.repr p) 0 (Obj.repr 3);
        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 59: A potential assignment to a non-mutable value was detected 
+Warning 59 [flambda-assignment-to-non-mutable-value]: A potential assignment to a non-mutable value was detected 
 in this source file.  Such assignments may generate incorrect code 
 when using Flambda.
 File "w59.ml", line 48, characters 2-43:
 48 |   Obj.set_field (Obj.repr q) 0 (Obj.repr 3);
        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 59: A potential assignment to a non-mutable value was detected 
+Warning 59 [flambda-assignment-to-non-mutable-value]: A potential assignment to a non-mutable value was detected 
 in this source file.  Such assignments may generate incorrect code 
 when using Flambda.
 File "w59.ml", line 49, characters 2-43:
 49 |   Obj.set_field (Obj.repr r) 0 (Obj.repr 3)
        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Warning 59: A potential assignment to a non-mutable value was detected 
+Warning 59 [flambda-assignment-to-non-mutable-value]: A potential assignment to a non-mutable value was detected 
 in this source file.  Such assignments may generate incorrect code 
 when using Flambda.
 File "w59.ml", line 56, characters 2-7:
 56 |   set o
        ^^^^^
-Warning 59: A potential assignment to a non-mutable value was detected 
+Warning 59 [flambda-assignment-to-non-mutable-value]: A potential assignment to a non-mutable value was detected 
 in this source file.  Such assignments may generate incorrect code 
 when using Flambda.
diff --git a/testsuite/tests/warnings/w60.compilers.reference b/testsuite/tests/warnings/w60.compilers.reference
index 9eec5d1ec5..6eec1357a3 100644
--- a/testsuite/tests/warnings/w60.compilers.reference
+++ b/testsuite/tests/warnings/w60.compilers.reference
@@ -1,4 +1,4 @@
 File "w60.ml", line 40, characters 13-14:
 40 |   let module M = struct end in
                   ^
-Warning 60: unused module M.
+Warning 60 [unused-module]: unused module M.
diff --git a/testsuite/tools/parsecmm.mly b/testsuite/tools/parsecmm.mly
index f7b96df6a9..9697c10148 100644
--- a/testsuite/tools/parsecmm.mly
+++ b/testsuite/tools/parsecmm.mly
@@ -218,7 +218,8 @@ expr:
   | LPAREN APPLY location expr exprlist machtype RPAREN
                 { Cop(Capply $6, $4 :: List.rev $5, debuginfo ?loc:$3 ()) }
   | LPAREN EXTCALL STRING exprlist machtype RPAREN
-               {Cop(Cextcall($3, $5, false, None), List.rev $4, debuginfo ())}
+               {Cop(Cextcall($3, $5, [], false, None),
+                    List.rev $4, debuginfo ())}
   | LPAREN ALLOC exprlist RPAREN { Cop(Calloc, List.rev $3, debuginfo ()) }
   | LPAREN SUBF expr RPAREN { Cop(Cnegf, [$3], debuginfo ()) }
   | LPAREN SUBF expr expr RPAREN { Cop(Csubf, [$3; $4], debuginfo ()) }
diff --git a/tools/caml_tex.ml b/tools/caml_tex.ml
index ae89477d9b..79fb3c28db 100644
--- a/tools/caml_tex.ml
+++ b/tools/caml_tex.ml
@@ -352,7 +352,7 @@ module Output = struct
   let catch_warning =
     function
     | [] -> None
-    | s :: _ when string_match ~!{|Warning \([0-9]+\):|} s 0 ->
+    | s :: _ when string_match ~!{|Warning \([0-9]+\)\( \[[a-z-]+\]\)?:|} s 0 ->
         Some (Warning (int_of_string @@ matched_group 1 s))
     | _ -> None
 
diff --git a/tools/ci/inria/main b/tools/ci/inria/main
index ebed3e694b..30db36e9ae 100755
--- a/tools/ci/inria/main
+++ b/tools/ci/inria/main
@@ -226,7 +226,8 @@ export LC_ALL=C
 git clean -q -f -d -x
 
 if $flambda; then
-  confoptions="$confoptions --enable-flambda --enable-flambda-invariants"
+  confoptions="$confoptions --enable-flambda --enable-flambda-invariants \
+--disable-naked-pointers"
 fi
 
 eval ./configure "$CCOMP" $build $host --prefix='$instdir' $confoptions
diff --git a/typing/parmatch.ml b/typing/parmatch.ml
index 5fb40907f0..57834d3db3 100644
--- a/typing/parmatch.ml
+++ b/typing/parmatch.ml
@@ -2083,7 +2083,7 @@ let do_check_fragile loc casel pss =
 (********************************)
 
 let check_unused pred casel =
-  if Warnings.is_active Warnings.Unused_match
+  if Warnings.is_active Warnings.Redundant_case
   || List.exists (fun c -> c.c_rhs.exp_desc = Texp_unreachable) casel then
     let rec do_rec pref = function
       | [] -> ()
@@ -2134,12 +2134,12 @@ let check_unused pred casel =
               match r with
               | Unused ->
                   Location.prerr_warning
-                    q.pat_loc Warnings.Unused_match
+                    q.pat_loc Warnings.Redundant_case
               | Upartial ps ->
                   List.iter
                     (fun p ->
                       Location.prerr_warning
-                        p.pat_loc Warnings.Unused_pat)
+                        p.pat_loc Warnings.Redundant_subpat)
                     ps
               | Used -> ()
             with Empty | Not_found -> assert false
@@ -2478,7 +2478,7 @@ let all_rhs_idents exp =
 
 let check_ambiguous_bindings =
   let open Warnings in
-  let warn0 = Ambiguous_pattern [] in
+  let warn0 = Ambiguous_var_in_pattern_guard [] in
   fun cases ->
     if is_active warn0 then
       let check_case ns case = match case with
@@ -2494,7 +2494,7 @@ let check_ambiguous_bindings =
                   if not (Ident.Set.is_empty ambiguous) then begin
                     let pps =
                       Ident.Set.elements ambiguous |> List.map Ident.name in
-                    let warn = Ambiguous_pattern pps in
+                    let warn = Ambiguous_var_in_pattern_guard pps in
                     Location.prerr_warning p.pat_loc warn
                   end
             end;
diff --git a/typing/typecore.ml b/typing/typecore.ml
index face26c429..93291d06c6 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -991,7 +991,7 @@ let check_recordpat_labels loc lbl_pat_list closed =
         else defined.(label.lbl_pos) <- true in
       List.iter check_defined lbl_pat_list;
       if closed = Closed
-      && Warnings.is_active (Warnings.Non_closed_record_pattern "")
+      && Warnings.is_active (Warnings.Missing_record_field_pattern "")
       then begin
         let undefined = ref [] in
         for i = 0 to Array.length all - 1 do
@@ -999,7 +999,7 @@ let check_recordpat_labels loc lbl_pat_list closed =
         done;
         if !undefined <> [] then begin
           let u = String.concat ", " (List.rev !undefined) in
-          Location.prerr_warning loc (Warnings.Non_closed_record_pattern u)
+          Location.prerr_warning loc (Warnings.Missing_record_field_pattern u)
         end
       end
 
@@ -2394,7 +2394,7 @@ let check_partial_application statement exp =
                     | Some (_, loc, _) -> loc
                     | None -> exp_loc
                   in
-                  Location.prerr_warning loc Warnings.Statement_type
+                  Location.prerr_warning loc Warnings.Non_unit_statement
             in
             loop exp
     in
@@ -2428,7 +2428,8 @@ let check_partial_application statement exp =
             | Texp_letexception (_, e) | Texp_letmodule (_, _, _, _, e) ->
                 check e
             | Texp_apply _ | Texp_send _ | Texp_new _ | Texp_letop _ ->
-                Location.prerr_warning exp_loc Warnings.Partial_application
+                Location.prerr_warning exp_loc
+                  Warnings.Ignored_partial_application
           end
         in
         check exp
@@ -4287,7 +4288,7 @@ and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected =
         (Warnings.Eliminated_optional_arguments
            (List.map (fun (l, _) -> Printtyp.string_of_label l) args));
       if warn then Location.prerr_warning texp.exp_loc
-          (Warnings.Without_principality "eliminated optional argument");
+          (Warnings.Non_principal_labels "eliminated optional argument");
       (* let-expand to have side effects *)
       let let_pat, let_var = var_pair "arg" texp.exp_type in
       re { texp with exp_type = ty_fun; exp_desc =
@@ -4325,7 +4326,8 @@ and type_application env funct sargs =
           if ty_fun.level >= t1.level &&
              not (is_prim ~name:"%identity" funct)
           then
-            Location.prerr_warning sarg.pexp_loc Warnings.Unused_argument;
+            Location.prerr_warning sarg.pexp_loc
+              Warnings.Ignored_extra_argument;
           unify env ty_fun (newty (Tarrow(lbl,t1,t2,Clink(ref Cunknown))));
           (t1, t2)
       | Tarrow (l,t1,t2,_) when l = lbl
@@ -4403,7 +4405,7 @@ and type_application env funct sargs =
         in
         let eliminate_optional_arg () =
           may_warn funct.exp_loc
-            (Warnings.Without_principality "eliminated optional argument");
+            (Warnings.Non_principal_labels "eliminated optional argument");
           eliminated_optional_arguments :=
             (l,ty,lv) :: !eliminated_optional_arguments;
           Some (fun () -> option_none env (instance ty) Location.none)
@@ -4448,7 +4450,7 @@ and type_application env funct sargs =
                   (* No argument was given for this parameter, we abstract over
                      it. *)
                   may_warn funct.exp_loc
-                    (Warnings.Without_principality "commuted an argument");
+                    (Warnings.Non_principal_labels "commuted an argument");
                   omitted_parameters := (l,ty,lv) :: !omitted_parameters;
                   None
                 end
diff --git a/utils/warnings.ml b/utils/warnings.ml
index 7adb349504..21d29d0bcd 100644
--- a/utils/warnings.ml
+++ b/utils/warnings.ml
@@ -29,22 +29,22 @@ type t =
   | Comment_not_end                         (*  2 *)
 (*| Deprecated --> alert "deprecated" *)    (*  3 *)
   | Fragile_match of string                 (*  4 *)
-  | Partial_application                     (*  5 *)
+  | Ignored_partial_application             (*  5 *)
   | Labels_omitted of string list           (*  6 *)
   | Method_override of string list          (*  7 *)
   | Partial_match of string                 (*  8 *)
-  | Non_closed_record_pattern of string     (*  9 *)
-  | Statement_type                          (* 10 *)
-  | Unused_match                            (* 11 *)
-  | Unused_pat                              (* 12 *)
+  | Missing_record_field_pattern of string  (*  9 *)
+  | Non_unit_statement                      (* 10 *)
+  | Redundant_case                          (* 11 *)
+  | Redundant_subpat                        (* 12 *)
   | Instance_variable_override of string list (* 13 *)
   | Illegal_backslash                       (* 14 *)
   | Implicit_public_methods of string list  (* 15 *)
   | Unerasable_optional_argument            (* 16 *)
   | Undeclared_virtual_method of string     (* 17 *)
   | Not_principal of string                 (* 18 *)
-  | Without_principality of string          (* 19 *)
-  | Unused_argument                         (* 20 *)
+  | Non_principal_labels of string          (* 19 *)
+  | Ignored_extra_argument                  (* 20 *)
   | Nonreturning_statement                  (* 21 *)
   | Preprocessor of string                  (* 22 *)
   | Useless_record_with                     (* 23 *)
@@ -55,7 +55,7 @@ type t =
   | Wildcard_arg_to_constant_constr         (* 28 *)
   | Eol_in_string                           (* 29 *)
   | Duplicate_definitions of string * string * string * string (*30 *)
-  | Multiple_definition of string * string * string (* 31 *)
+  | Module_linked_twice of string * string * string (* 31 *)
   | Unused_value_declaration of string      (* 32 *)
   | Unused_open of string                   (* 33 *)
   | Unused_type_declaration of string       (* 34 *)
@@ -74,21 +74,21 @@ type t =
   | Attribute_payload of string * string    (* 47 *)
   | Eliminated_optional_arguments of string list (* 48 *)
   | No_cmi_file of string * string option   (* 49 *)
-  | Bad_docstring of bool                   (* 50 *)
-  | Expect_tailcall                         (* 51 *)
+  | Unexpected_docstring of bool            (* 50 *)
+  | Tailcall_expected                       (* 51 *)
   | Fragile_literal_pattern                 (* 52 *)
   | Misplaced_attribute of string           (* 53 *)
   | Duplicated_attribute of string          (* 54 *)
   | Inlining_impossible of string           (* 55 *)
   | Unreachable_case                        (* 56 *)
-  | Ambiguous_pattern of string list        (* 57 *)
+  | Ambiguous_var_in_pattern_guard of string list (* 57 *)
   | No_cmx_file of string                   (* 58 *)
-  | Assignment_to_non_mutable_value         (* 59 *)
+  | Flambda_assignment_to_non_mutable_value (* 59 *)
   | Unused_module of string                 (* 60 *)
   | Unboxable_type_in_prim_decl of string   (* 61 *)
   | Constraint_on_gadt                      (* 62 *)
   | Erroneous_printed_signature of string   (* 63 *)
-  | Unsafe_without_parsing                  (* 64 *)
+  | Unsafe_array_syntax_without_parsing     (* 64 *)
   | Redefining_unit of string               (* 65 *)
   | Unused_open_bang of string              (* 66 *)
   | Unused_functor_parameter of string      (* 67 *)
@@ -102,27 +102,26 @@ type t =
 
 type alert = {kind:string; message:string; def:loc; use:loc}
 
-
 let number = function
   | Comment_start -> 1
   | Comment_not_end -> 2
   | Fragile_match _ -> 4
-  | Partial_application -> 5
+  | Ignored_partial_application -> 5
   | Labels_omitted _ -> 6
   | Method_override _ -> 7
   | Partial_match _ -> 8
-  | Non_closed_record_pattern _ -> 9
-  | Statement_type -> 10
-  | Unused_match -> 11
-  | Unused_pat -> 12
+  | Missing_record_field_pattern _ -> 9
+  | Non_unit_statement -> 10
+  | Redundant_case -> 11
+  | Redundant_subpat -> 12
   | Instance_variable_override _ -> 13
   | Illegal_backslash -> 14
   | Implicit_public_methods _ -> 15
   | Unerasable_optional_argument -> 16
   | Undeclared_virtual_method _ -> 17
   | Not_principal _ -> 18
-  | Without_principality _ -> 19
-  | Unused_argument -> 20
+  | Non_principal_labels _ -> 19
+  | Ignored_extra_argument -> 20
   | Nonreturning_statement -> 21
   | Preprocessor _ -> 22
   | Useless_record_with -> 23
@@ -133,7 +132,7 @@ let number = function
   | Wildcard_arg_to_constant_constr -> 28
   | Eol_in_string -> 29
   | Duplicate_definitions _ -> 30
-  | Multiple_definition _ -> 31
+  | Module_linked_twice _ -> 31
   | Unused_value_declaration _ -> 32
   | Unused_open _ -> 33
   | Unused_type_declaration _ -> 34
@@ -152,21 +151,21 @@ let number = function
   | Attribute_payload _ -> 47
   | Eliminated_optional_arguments _ -> 48
   | No_cmi_file _ -> 49
-  | Bad_docstring _ -> 50
-  | Expect_tailcall -> 51
+  | Unexpected_docstring _ -> 50
+  | Tailcall_expected -> 51
   | Fragile_literal_pattern -> 52
   | Misplaced_attribute _ -> 53
   | Duplicated_attribute _ -> 54
   | Inlining_impossible _ -> 55
   | Unreachable_case -> 56
-  | Ambiguous_pattern _ -> 57
+  | Ambiguous_var_in_pattern_guard _ -> 57
   | No_cmx_file _ -> 58
-  | Assignment_to_non_mutable_value -> 59
+  | Flambda_assignment_to_non_mutable_value -> 59
   | Unused_module _ -> 60
   | Unboxable_type_in_prim_decl _ -> 61
   | Constraint_on_gadt -> 62
   | Erroneous_printed_signature _ -> 63
-  | Unsafe_without_parsing -> 64
+  | Unsafe_array_syntax_without_parsing -> 64
   | Redefining_unit _ -> 65
   | Unused_open_bang _ -> 66
   | Unused_functor_parameter _ -> 67
@@ -175,6 +174,170 @@ let number = function
 let last_warning_number = 67
 ;;
 
+(* Third component of each tuple is the list of names for each warning. The
+   first element of the list is the current name, any following ones are
+   deprecated. The current name should always be derived mechanically from the
+   constructor name. *)
+
+let descriptions =
+  [
+    1, "Suspicious-looking start-of-comment mark.",
+    ["comment-start"];
+    2, "Suspicious-looking end-of-comment mark.",
+    ["comment-not-end"];
+    3, "Deprecated synonym for the 'deprecated' alert.",
+    [];
+    4, "Fragile pattern matching: matching that will remain complete even\n\
+       \    if additional constructors are added to one of the variant types\n\
+       \    matched.",
+    ["fragile-match"];
+    5, "Partially applied function: expression whose result has function\n\
+       \    type and is ignored.",
+    ["ignored-partial-application"];
+    6, "Label omitted in function application.",
+    ["labels-omitted"];
+    7, "Method overridden.",
+    ["method-override"];
+    8, "Partial match: missing cases in pattern-matching.",
+    ["partial-match"];
+    9, "Missing fields in a record pattern.",
+    ["missing-record-field-pattern"];
+    10,
+    "Expression on the left-hand side of a sequence that doesn't have type\n\
+    \    \"unit\" (and that is not a function, see warning number 5).",
+    ["non-unit-statement"];
+    11, "Redundant case in a pattern matching (unused match case).",
+    ["redundant-case"];
+    12, "Redundant sub-pattern in a pattern-matching.",
+    ["redundant-subpat"];
+    13, "Instance variable overridden.",
+    ["instance-variable-override"];
+    14, "Illegal backslash escape in a string constant.",
+    ["illegal-backslash"];
+    15, "Private method made public implicitly.",
+    ["implicit-public-methods"];
+    16, "Unerasable optional argument.",
+    ["unerasable-optional-argument"];
+    17, "Undeclared virtual method.",
+    ["undeclared-virtual-method"];
+    18, "Non-principal type.",
+    ["not-principal"];
+    19, "Type without principality.",
+    ["non-principal-labels"];
+    20, "Unused function argument.",
+    ["ignored-extra-argument"];
+    21, "Non-returning statement.",
+    ["nonreturning-statement"];
+    22, "Preprocessor warning.",
+    ["preprocessor"];
+    23, "Useless record \"with\" clause.",
+    ["useless-record-with"];
+    24,
+    "Bad module name: the source file name is not a valid OCaml module name.",
+    ["bad-module-name"];
+    25, "Ignored: now part of warning 8.",
+    [];
+    26,
+    "Suspicious unused variable: unused variable that is bound\n\
+    \    with \"let\" or \"as\", and doesn't start with an underscore (\"_\")\n\
+    \    character.",
+    ["unused-var"];
+    27, "Innocuous unused variable: unused variable that is not bound with\n\
+        \    \"let\" nor \"as\", and doesn't start with an underscore (\"_\")\n\
+        \    character.",
+    ["unused-var-strict"];
+    28, "Wildcard pattern given as argument to a constant constructor.",
+    ["wildcard-arg-to-constant-constr"];
+    29, "Unescaped end-of-line in a string constant (non-portable code).",
+    ["eol-in-string"];
+    30, "Two labels or constructors of the same name are defined in two\n\
+        \    mutually recursive types.",
+    ["duplicate-definitions"];
+    31, "A module is linked twice in the same executable.",
+    ["module-linked-twice"];
+    32, "Unused value declaration.",
+    ["unused-value-declaration"];
+    33, "Unused open statement.",
+    ["unused-open"];
+    34, "Unused type declaration.",
+    ["unused-type-declaration"];
+    35, "Unused for-loop index.",
+    ["unused-for-index"];
+    36, "Unused ancestor variable.",
+    ["unused-ancestor"];
+    37, "Unused constructor.",
+    ["unused-constructor"];
+    38, "Unused extension constructor.",
+    ["unused-extension"];
+    39, "Unused rec flag.",
+    ["unused-rec-flag"];
+    40, "Constructor or label name used out of scope.",
+    ["name-out-of-scope"];
+    41, "Ambiguous constructor or label name.",
+    ["ambiguous-name"];
+    42, "Disambiguated constructor or label name (compatibility warning).",
+    ["disambiguated-name"];
+    43, "Nonoptional label applied as optional.",
+    ["nonoptional-label"];
+    44, "Open statement shadows an already defined identifier.",
+    ["open-shadow-identifier"];
+    45, "Open statement shadows an already defined label or constructor.",
+    ["open-shadow-label-constructor"];
+    46, "Error in environment variable.",
+    ["bad-env-variable"];
+    47, "Illegal attribute payload.",
+    ["attribute-payload"];
+    48, "Implicit elimination of optional arguments.",
+    ["eliminated-optional-arguments"];
+    49, "Absent cmi file when looking up module alias.",
+    ["no-cmi-file"];
+    50, "Unexpected documentation comment.",
+    ["unexpected-docstring"];
+    51, "Warning on non-tail calls if @tailcall present.",
+    ["tailcall-expected"];
+    52, "Fragile constant pattern.",
+    ["fragile-literal-pattern"];
+    53, "Attribute cannot appear in this context.",
+    ["misplaced-attribute"];
+    54, "Attribute used more than once on an expression.",
+    ["duplicated-attribute"];
+    55, "Inlining impossible.",
+    ["inlining-impossible"];
+    56, "Unreachable case in a pattern-matching (based on type information).",
+    ["unreachable-case"];
+    57, "Ambiguous or-pattern variables under guard.",
+    ["ambiguous-var-in-pattern-guard"];
+    58, "Missing cmx file.",
+    ["no-cmx-file"];
+    59, "Assignment to non-mutable value.",
+    ["flambda-assignment-to-non-mutable-value"];
+    60, "Unused module declaration.",
+    ["unused-module"];
+    61, "Unboxable type in primitive declaration.",
+    ["unboxable-type-in-prim-decl"];
+    62, "Type constraint on GADT type declaration.",
+    ["constraint-on-gadt"];
+    63, "Erroneous printed signature.",
+    ["erroneous-printed-signature"];
+    64, "-unsafe used with a preprocessor returning a syntax tree.",
+    ["unsafe-array-syntax-without-parsing"];
+    65, "Type declaration defining a new '()' constructor.",
+    ["redefining-unit"];
+    66, "Unused open! statement.",
+    ["unused-open-bang"];
+    67, "Unused functor parameter.",
+    ["unused-functor-parameter"];
+  ]
+;;
+
+let name_to_number =
+  let h = Hashtbl.create last_warning_number in
+  List.iter (fun (num, _, names) ->
+      List.iter (fun name -> Hashtbl.add h name num) names
+    ) descriptions;
+  fun s -> Hashtbl.find_opt h s
+;;
+
 (* Must be the max number returned by the [number] function. *)
 
 let letter = function
@@ -383,7 +546,18 @@ let parse_opt error active errflag s =
        loop (i+1)
     | _ -> error ()
   in
-  loop 0
+  match name_to_number s with
+  | Some n -> set n
+  | None ->
+      if s = "" then loop 0
+      else begin
+        let rest = String.sub s 1 (String.length s - 1) in
+        match s.[0], name_to_number rest with
+        | '+', Some n -> set n
+        | '-', Some n -> clear n
+        | '@', Some n -> set_all n
+        | _ -> loop 0
+      end
 ;;
 
 let parse_options errflag s =
@@ -415,7 +589,7 @@ let message = function
   | Fragile_match s ->
       "this pattern-matching is fragile.\n\
        It will remain exhaustive when constructors are added to type " ^ s ^ "."
-  | Partial_application ->
+  | Ignored_partial_application ->
       "this function application is partial,\n\
        maybe some arguments are missing."
   | Labels_omitted [] -> assert false
@@ -435,13 +609,13 @@ let message = function
   | Partial_match s ->
       "this pattern-matching is not exhaustive.\n\
        Here is an example of a case that is not matched:\n" ^ s
-  | Non_closed_record_pattern s ->
+  | Missing_record_field_pattern s ->
       "the following labels are not bound in this record pattern:\n" ^ s ^
       "\nEither bind these labels explicitly or add '; _' to the pattern."
-  | Statement_type ->
+  | Non_unit_statement ->
       "this expression should have type unit."
-  | Unused_match -> "this match case is unused."
-  | Unused_pat   -> "this sub-pattern is unused."
+  | Redundant_case -> "this match case is unused."
+  | Redundant_subpat -> "this sub-pattern is unused."
   | Instance_variable_override [lab] ->
       "the instance variable " ^ lab ^ " is overridden.\n" ^
       "The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)"
@@ -458,8 +632,8 @@ let message = function
   | Unerasable_optional_argument -> "this optional argument cannot be erased."
   | Undeclared_virtual_method m -> "the virtual method "^m^" is not declared."
   | Not_principal s -> s^" is not principal."
-  | Without_principality s -> s^" without principality."
-  | Unused_argument -> "this argument will not be used by the function."
+  | Non_principal_labels s -> s^" without principality."
+  | Ignored_extra_argument -> "this argument will not be used by the function."
   | Nonreturning_statement ->
       "this statement never returns (or has an unsound type.)"
   | Preprocessor s -> s
@@ -479,7 +653,7 @@ let message = function
   | Duplicate_definitions (kind, cname, tc1, tc2) ->
       Printf.sprintf "the %s %s is defined in both types %s and %s."
         kind cname tc1 tc2
-  | Multiple_definition(modname, file1, file2) ->
+  | Module_linked_twice(modname, file1, file2) ->
       Printf.sprintf
         "files %s and %s both define a module named %s"
         file1 file2 modname
@@ -562,10 +736,10 @@ let message = function
       Printf.sprintf
         "no valid cmi file was found in path for module %s. %s"
         name msg
-  | Bad_docstring unattached ->
+  | Unexpected_docstring unattached ->
       if unattached then "unattached documentation comment (ignored)"
       else "ambiguous documentation comment"
-  | Expect_tailcall ->
+  | Tailcall_expected ->
       Printf.sprintf "expected tailcall"
   | Fragile_literal_pattern ->
       Printf.sprintf
@@ -583,7 +757,7 @@ let message = function
         attr_name
   | Inlining_impossible reason ->
       Printf.sprintf "Cannot inline: %s" reason
-  | Ambiguous_pattern vars ->
+  | Ambiguous_var_in_pattern_guard vars ->
       let msg =
         let vars = List.sort String.compare vars in
         match vars with
@@ -599,7 +773,7 @@ let message = function
       Printf.sprintf
         "no cmx file was found in path for module %s, \
          and its interface was not compiled with -opaque" name
-  | Assignment_to_non_mutable_value ->
+  | Flambda_assignment_to_non_mutable_value ->
       "A potential assignment to a non-mutable value was detected \n\
         in this source file.  Such assignments may generate incorrect code \n\
         when using Flambda."
@@ -623,7 +797,7 @@ let message = function
      ^ s
      ^ "\nBeware that this warning is purely informational and will not catch\n\
         all instances of erroneous printed interface."
-  | Unsafe_without_parsing ->
+  | Unsafe_array_syntax_without_parsing ->
      "option -unsafe used with a preprocessor returning a syntax tree"
   | Redefining_unit name ->
       Printf.sprintf
@@ -642,13 +816,21 @@ type reporting_information =
   ; sub_locs : (loc * string) list;
   }
 
+let id_name w =
+  let n = number w in
+  match List.find_opt (fun (m, _, _) -> m = n) descriptions with
+  | Some (_, _, s :: _) ->
+      Printf.sprintf "%d [%s]" n s
+  | _ ->
+      string_of_int n
+
 let report w =
   match is_active w with
   | false -> `Inactive
   | true ->
      if is_error w then incr nerrors;
      `Active
-       { id = string_of_int (number w);
+       { id = id_name w;
          message = message w;
          is_error = is_error w;
          sub_locs = [];
@@ -696,91 +878,16 @@ let check_fatal () =
   end;
 ;;
 
-let descriptions =
-  [
-    1, "Suspicious-looking start-of-comment mark.";
-    2, "Suspicious-looking end-of-comment mark.";
-    3, "Deprecated synonym for the 'deprecated' alert.";
-    4, "Fragile pattern matching: matching that will remain complete even\n\
-   \    if additional constructors are added to one of the variant types\n\
-   \    matched.";
-    5, "Partially applied function: expression whose result has function\n\
-   \    type and is ignored.";
-    6, "Label omitted in function application.";
-    7, "Method overridden.";
-    8, "Partial match: missing cases in pattern-matching.";
-    9, "Missing fields in a record pattern.";
-   10, "Expression on the left-hand side of a sequence that doesn't have \
-      type\n\
-   \    \"unit\" (and that is not a function, see warning number 5).";
-   11, "Redundant case in a pattern matching (unused match case).";
-   12, "Redundant sub-pattern in a pattern-matching.";
-   13, "Instance variable overridden.";
-   14, "Illegal backslash escape in a string constant.";
-   15, "Private method made public implicitly.";
-   16, "Unerasable optional argument.";
-   17, "Undeclared virtual method.";
-   18, "Non-principal type.";
-   19, "Type without principality.";
-   20, "Unused function argument.";
-   21, "Non-returning statement.";
-   22, "Preprocessor warning.";
-   23, "Useless record \"with\" clause.";
-   24, "Bad module name: the source file name is not a valid OCaml module \
-        name.";
-   25, "Deprecated: now part of warning 8.";
-   26, "Suspicious unused variable: unused variable that is bound\n\
-   \    with \"let\" or \"as\", and doesn't start with an underscore (\"_\")\n\
-   \    character.";
-   27, "Innocuous unused variable: unused variable that is not bound with\n\
-   \    \"let\" nor \"as\", and doesn't start with an underscore (\"_\")\n\
-   \    character.";
-   28, "Wildcard pattern given as argument to a constant constructor.";
-   29, "Unescaped end-of-line in a string constant (non-portable code).";
-   30, "Two labels or constructors of the same name are defined in two\n\
-   \    mutually recursive types.";
-   31, "A module is linked twice in the same executable.";
-   32, "Unused value declaration.";
-   33, "Unused open statement.";
-   34, "Unused type declaration.";
-   35, "Unused for-loop index.";
-   36, "Unused ancestor variable.";
-   37, "Unused constructor.";
-   38, "Unused extension constructor.";
-   39, "Unused rec flag.";
-   40, "Constructor or label name used out of scope.";
-   41, "Ambiguous constructor or label name.";
-   42, "Disambiguated constructor or label name (compatibility warning).";
-   43, "Nonoptional label applied as optional.";
-   44, "Open statement shadows an already defined identifier.";
-   45, "Open statement shadows an already defined label or constructor.";
-   46, "Error in environment variable.";
-   47, "Illegal attribute payload.";
-   48, "Implicit elimination of optional arguments.";
-   49, "Absent cmi file when looking up module alias.";
-   50, "Unexpected documentation comment.";
-   51, "Warning on non-tail calls if @tailcall present.";
-   52, "Fragile constant pattern.";
-   53, "Attribute cannot appear in this context.";
-   54, "Attribute used more than once on an expression.";
-   55, "Inlining impossible.";
-   56, "Unreachable case in a pattern-matching (based on type information).";
-   57, "Ambiguous or-pattern variables under guard.";
-   58, "Missing cmx file.";
-   59, "Assignment to non-mutable value.";
-   60, "Unused module declaration.";
-   61, "Unboxable type in primitive declaration.";
-   62, "Type constraint on GADT type declaration.";
-   63, "Erroneous printed signature.";
-   64, "-unsafe used with a preprocessor returning a syntax tree.";
-   65, "Type declaration defining a new '()' constructor.";
-   66, "Unused open! statement.";
-   67, "Unused functor parameter.";
-  ]
-;;
-
 let help_warnings () =
-  List.iter (fun (i, s) -> Printf.printf "%3i %s\n" i s) descriptions;
+  List.iter
+    (fun (i, s, names) ->
+       let name =
+         match names with
+         | s :: _ -> " [" ^ s ^ "]"
+         | [] -> ""
+       in
+       Printf.printf "%3i%s %s\n" i name s)
+    descriptions;
   print_endline "  A all warnings";
   for i = Char.code 'b' to Char.code 'z' do
     let c = Char.chr i in
diff --git a/utils/warnings.mli b/utils/warnings.mli
index b80ab34cbb..82e8b613be 100644
--- a/utils/warnings.mli
+++ b/utils/warnings.mli
@@ -31,22 +31,22 @@ type t =
   | Comment_not_end                         (*  2 *)
 (*| Deprecated --> alert "deprecated" *)    (*  3 *)
   | Fragile_match of string                 (*  4 *)
-  | Partial_application                     (*  5 *)
+  | Ignored_partial_application             (*  5 *)
   | Labels_omitted of string list           (*  6 *)
   | Method_override of string list          (*  7 *)
   | Partial_match of string                 (*  8 *)
-  | Non_closed_record_pattern of string     (*  9 *)
-  | Statement_type                          (* 10 *)
-  | Unused_match                            (* 11 *)
-  | Unused_pat                              (* 12 *)
+  | Missing_record_field_pattern of string  (*  9 *)
+  | Non_unit_statement                      (* 10 *)
+  | Redundant_case                          (* 11 *)
+  | Redundant_subpat                        (* 12 *)
   | Instance_variable_override of string list (* 13 *)
   | Illegal_backslash                       (* 14 *)
   | Implicit_public_methods of string list  (* 15 *)
   | Unerasable_optional_argument            (* 16 *)
   | Undeclared_virtual_method of string     (* 17 *)
   | Not_principal of string                 (* 18 *)
-  | Without_principality of string          (* 19 *)
-  | Unused_argument                         (* 20 *)
+  | Non_principal_labels of string          (* 19 *)
+  | Ignored_extra_argument                  (* 20 *)
   | Nonreturning_statement                  (* 21 *)
   | Preprocessor of string                  (* 22 *)
   | Useless_record_with                     (* 23 *)
@@ -57,7 +57,7 @@ type t =
   | Wildcard_arg_to_constant_constr         (* 28 *)
   | Eol_in_string                           (* 29 *)
   | Duplicate_definitions of string * string * string * string (* 30 *)
-  | Multiple_definition of string * string * string (* 31 *)
+  | Module_linked_twice of string * string * string (* 31 *)
   | Unused_value_declaration of string      (* 32 *)
   | Unused_open of string                   (* 33 *)
   | Unused_type_declaration of string       (* 34 *)
@@ -76,21 +76,21 @@ type t =
   | Attribute_payload of string * string    (* 47 *)
   | Eliminated_optional_arguments of string list (* 48 *)
   | No_cmi_file of string * string option   (* 49 *)
-  | Bad_docstring of bool                   (* 50 *)
-  | Expect_tailcall                         (* 51 *)
+  | Unexpected_docstring of bool            (* 50 *)
+  | Tailcall_expected                       (* 51 *)
   | Fragile_literal_pattern                 (* 52 *)
   | Misplaced_attribute of string           (* 53 *)
   | Duplicated_attribute of string          (* 54 *)
   | Inlining_impossible of string           (* 55 *)
   | Unreachable_case                        (* 56 *)
-  | Ambiguous_pattern of string list        (* 57 *)
+  | Ambiguous_var_in_pattern_guard of string list (* 57 *)
   | No_cmx_file of string                   (* 58 *)
-  | Assignment_to_non_mutable_value         (* 59 *)
+  | Flambda_assignment_to_non_mutable_value (* 59 *)
   | Unused_module of string                 (* 60 *)
   | Unboxable_type_in_prim_decl of string   (* 61 *)
   | Constraint_on_gadt                      (* 62 *)
   | Erroneous_printed_signature of string   (* 63 *)
-  | Unsafe_without_parsing                  (* 64 *)
+  | Unsafe_array_syntax_without_parsing     (* 64 *)
   | Redefining_unit of string               (* 65 *)
   | Unused_open_bang of string              (* 66 *)
   | Unused_functor_parameter of string      (* 67 *)