diff --git a/Changes b/Changes
index aa92b6546..e998e065f 100644
--- a/Changes
+++ b/Changes
@@ -59,6 +59,9 @@ Bug fixes:
 - PR#6650: Cty_constr not handled correctly by Subst
 - PR#6651: Failing component lookup
 
+Features wishes:
+- PR#6367: introduce Asttypes.arg_label to encode labelled arguments
+
 OCaml 4.02.2:
 -------------
 
diff --git a/boot/ocamlc b/boot/ocamlc
index 6a2dc3590..3285cfbbf 100755
Binary files a/boot/ocamlc and b/boot/ocamlc differ
diff --git a/boot/ocamldep b/boot/ocamldep
index cf7beac25..161190658 100755
Binary files a/boot/ocamldep and b/boot/ocamldep differ
diff --git a/boot/ocamllex b/boot/ocamllex
index 78b32802a..860642f9f 100755
Binary files a/boot/ocamllex and b/boot/ocamllex differ
diff --git a/bytecomp/translcore.mli b/bytecomp/translcore.mli
index 203afceb1..0c0355b3a 100644
--- a/bytecomp/translcore.mli
+++ b/bytecomp/translcore.mli
@@ -18,7 +18,7 @@ open Typedtree
 open Lambda
 
 val transl_exp: expression -> lambda
-val transl_apply: lambda -> (label * expression option * optional) list
+val transl_apply: lambda -> (arg_label * expression option * optional) list
                   -> Location.t -> lambda
 val transl_let: rec_flag -> value_binding list -> lambda -> lambda
 val transl_primitive: Location.t -> Primitive.description -> Env.t
diff --git a/ocamldoc/odoc_info.mli b/ocamldoc/odoc_info.mli
index d1b98e224..451315543 100644
--- a/ocamldoc/odoc_info.mli
+++ b/ocamldoc/odoc_info.mli
@@ -780,11 +780,11 @@ val create_index_lists : 'a list -> ('a -> string) -> 'a list list
 val remove_option : Types.type_expr -> Types.type_expr
 
 (** Return [true] if the given label is optional.*)
-val is_optional : string -> bool
+val is_optional : Asttypes.arg_label -> bool
 
 (** Return the label name for the given label,
    i.e. removes the beginning '?' if present.*)
-val label_name : string -> string
+val label_name : Asttypes.arg_label -> string
 
 (** Return the given name where the module name or
    part of it was removed, according to the list of modules
diff --git a/ocamldoc/odoc_misc.mli b/ocamldoc/odoc_misc.mli
index 5958be91d..dd5a7fcb9 100644
--- a/ocamldoc/odoc_misc.mli
+++ b/ocamldoc/odoc_misc.mli
@@ -107,8 +107,8 @@ val search_string_backward : pat: string -> s: string -> int
 val remove_option : Types.type_expr -> Types.type_expr
 
 (** Return [true] if the given label is optional.*)
-val is_optional : string -> bool
+val is_optional : Asttypes.arg_label -> bool
 
 (** Return the label name for the given label,
    i.e. removes the beginning '?' if present.*)
-val label_name : string -> string
+val label_name : Asttypes.arg_label -> string
diff --git a/ocamldoc/odoc_str.ml b/ocamldoc/odoc_str.ml
index 1536640e5..281496bb3 100644
--- a/ocamldoc/odoc_str.ml
+++ b/ocamldoc/odoc_str.ml
@@ -148,8 +148,8 @@ let string_of_class_params c =
         Printf.bprintf b "%s%s%s%s -> "
           (
            match label with
-             "" -> ""
-           | s -> s^":"
+             Asttypes.Nolabel -> ""
+           | s -> Printtyp.string_of_label s ^":"
           )
           (if parent then "(" else "")
           (Odoc_print.string_of_type_expr
diff --git a/ocamldoc/odoc_value.ml b/ocamldoc/odoc_value.ml
index b35f2c6b5..7caedb360 100644
--- a/ocamldoc/odoc_value.ml
+++ b/ocamldoc/odoc_value.ml
@@ -95,22 +95,16 @@ let parameter_list_from_arrows typ =
    so there is nothing to merge. With this dummy list we can merge the
    parameter names from the .ml and the type from the .mli file. *)
 let dummy_parameter_list typ =
-  let normal_name s =
-    match s with
-      "" -> s
-    | _ ->
-        match s.[0] with
-          '?' -> String.sub s 1 ((String.length s) - 1)
-        | _ -> s
-  in
+  let normal_name = Odoc_misc.label_name in
   Printtyp.mark_loops typ;
   let liste_param = parameter_list_from_arrows typ in
   let rec iter (label, t) =
     match t.Types.desc with
     | Types.Ttuple l ->
-        if label = "" then
+        let open Asttypes in
+        if label = Nolabel then
           Odoc_parameter.Tuple
-            (List.map (fun t2 -> iter ("", t2)) l, t)
+            (List.map (fun t2 -> iter (Nolabel, t2)) l, t)
         else
           (* if there is a label, then we don't want to decompose the tuple *)
           Odoc_parameter.Simple_name
diff --git a/parsing/ast_helper.mli b/parsing/ast_helper.mli
index 847d428f6..e8de67b47 100644
--- a/parsing/ast_helper.mli
+++ b/parsing/ast_helper.mli
@@ -38,7 +38,7 @@ module Typ :
 
     val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type
     val var: ?loc:loc -> ?attrs:attrs -> string -> core_type
-    val arrow: ?loc:loc -> ?attrs:attrs -> label -> core_type -> core_type
+    val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type
                -> core_type
     val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type
     val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
@@ -93,11 +93,11 @@ module Exp:
     val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression
     val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list
               -> expression -> expression
-    val fun_: ?loc:loc -> ?attrs:attrs -> label -> expression option -> pattern
+    val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> pattern
               -> expression -> expression
     val function_: ?loc:loc -> ?attrs:attrs -> case list -> expression
     val apply: ?loc:loc -> ?attrs:attrs -> expression
-               -> (label * expression) list -> expression
+               -> (arg_label * expression) list -> expression
     val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list
                 -> expression
     val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression
@@ -293,7 +293,7 @@ module Cty:
 
     val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type
     val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type
-    val arrow: ?loc:loc -> ?attrs:attrs -> label -> core_type -> class_type -> class_type
+    val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> class_type -> class_type
     val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type
   end
 
@@ -319,9 +319,12 @@ module Cl:
 
     val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr
     val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr
-    val fun_: ?loc:loc -> ?attrs:attrs -> label -> expression option -> pattern -> class_expr -> class_expr
-    val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> (label * expression) list -> class_expr
-    val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> class_expr -> class_expr
+    val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> pattern ->
+              class_expr -> class_expr
+    val apply:
+        ?loc:loc -> ?attrs:attrs -> class_expr -> (arg_label * expression) list -> class_expr
+    val let_:
+        ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> class_expr -> class_expr
     val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> class_expr
     val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr
   end
diff --git a/parsing/asttypes.mli b/parsing/asttypes.mli
index b212a2b9a..a0d636162 100644
--- a/parsing/asttypes.mli
+++ b/parsing/asttypes.mli
@@ -37,6 +37,11 @@ type closed_flag = Closed | Open
 
 type label = string
 
+type arg_label =
+    Nolabel
+  | Labelled of string (*  label:T -> ... *)
+  | Optional of string (* ?label:T -> ... *)
+
 type 'a loc = 'a Location.loc = {
   txt : 'a;
   loc : Location.t;
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 3a0663898..b3c4454a3 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -73,7 +73,7 @@ let ghunit () =
   ghexp (Pexp_construct (mknoloc (Lident "()"), None))
 
 let mkinfix arg1 name arg2 =
-  mkexp(Pexp_apply(mkoperator name 2, ["", arg1; "", arg2]))
+  mkexp(Pexp_apply(mkoperator name 2, [Nolabel, arg1; Nolabel, arg2]))
 
 let neg_float_string f =
   if String.length f > 0 && f.[0] = '-'
@@ -93,7 +93,7 @@ let mkuminus name arg =
   | ("-" | "-."), Pexp_constant(Const_float f) ->
       mkexp(Pexp_constant(Const_float(neg_float_string f)))
   | _ ->
-      mkexp(Pexp_apply(mkoperator ("~" ^ name) 1, ["", arg]))
+      mkexp(Pexp_apply(mkoperator ("~" ^ name) 1, [Nolabel, arg]))
 
 let mkuplus name arg =
   let desc = arg.pexp_desc in
@@ -104,7 +104,7 @@ let mkuplus name arg =
   | "+", Pexp_constant(Const_nativeint _)
   | ("+" | "+."), Pexp_constant(Const_float _) -> mkexp desc
   | _ ->
-      mkexp(Pexp_apply(mkoperator ("~" ^ name) 1, ["", arg]))
+      mkexp(Pexp_apply(mkoperator ("~" ^ name) 1, [Nolabel, arg]))
 
 let mkexp_cons consloc args loc =
   Exp.mk ~loc (Pexp_construct(mkloc (Lident "::") consloc, Some args))
@@ -186,34 +186,34 @@ let bigarray_get arr arg =
   match bigarray_untuplify arg with
     [c1] ->
       mkexp(Pexp_apply(ghexp(Pexp_ident(get 1)),
-                       ["", arr; "", c1]))
+                       [Nolabel, arr; Nolabel, c1]))
   | [c1;c2] ->
       mkexp(Pexp_apply(ghexp(Pexp_ident(get 2)),
-                       ["", arr; "", c1; "", c2]))
+                       [Nolabel, arr; Nolabel, c1; Nolabel, c2]))
   | [c1;c2;c3] ->
       mkexp(Pexp_apply(ghexp(Pexp_ident(get 3)),
-                       ["", arr; "", c1; "", c2; "", c3]))
+                       [Nolabel, arr; Nolabel, c1; Nolabel, c2; Nolabel, c3]))
   | coords ->
       mkexp(Pexp_apply(ghexp(Pexp_ident(get 0)),
-                       ["", arr; "", ghexp(Pexp_array coords)]))
+                       [Nolabel, arr; Nolabel, ghexp(Pexp_array coords)]))
 
 let bigarray_set arr arg newval =
   let set order = bigarray_function order true in
   match bigarray_untuplify arg with
     [c1] ->
       mkexp(Pexp_apply(ghexp(Pexp_ident(set 1)),
-                       ["", arr; "", c1; "", newval]))
+                       [Nolabel, arr; Nolabel, c1; Nolabel, newval]))
   | [c1;c2] ->
       mkexp(Pexp_apply(ghexp(Pexp_ident(set 2)),
-                       ["", arr; "", c1; "", c2; "", newval]))
+                       [Nolabel, arr; Nolabel, c1; Nolabel, c2; Nolabel, newval]))
   | [c1;c2;c3] ->
       mkexp(Pexp_apply(ghexp(Pexp_ident(set 3)),
-                       ["", arr; "", c1; "", c2; "", c3; "", newval]))
+                       [Nolabel, arr; Nolabel, c1; Nolabel, c2; Nolabel, c3; Nolabel, newval]))
   | coords ->
       mkexp(Pexp_apply(ghexp(Pexp_ident(set 0)),
-                       ["", arr;
-                        "", ghexp(Pexp_array coords);
-                        "", newval]))
+                       [Nolabel, arr;
+                        Nolabel, ghexp(Pexp_array coords);
+                        Nolabel, newval]))
 
 let lapply p1 p2 =
   if !Clflags.applicative_functors
@@ -948,13 +948,13 @@ class_type:
       { $1 }
   | QUESTION LIDENT COLON simple_core_type_or_tuple_no_attr MINUSGREATER
     class_type
-      { mkcty(Pcty_arrow("?" ^ $2 , mkoption $4, $6)) }
+      { mkcty(Pcty_arrow(Optional $2 , mkoption $4, $6)) }
   | OPTLABEL simple_core_type_or_tuple_no_attr MINUSGREATER class_type
-      { mkcty(Pcty_arrow("?" ^ $1, mkoption $2, $4)) }
+      { mkcty(Pcty_arrow(Optional $1, mkoption $2, $4)) }
   | LIDENT COLON simple_core_type_or_tuple_no_attr MINUSGREATER class_type
-      { mkcty(Pcty_arrow($1, $3, $5)) }
+      { mkcty(Pcty_arrow(Labelled $1, $3, $5)) }
   | simple_core_type_or_tuple_no_attr MINUSGREATER class_type
-      { mkcty(Pcty_arrow("", $1, $3)) }
+      { mkcty(Pcty_arrow(Nolabel, $1, $3)) }
  ;
 class_signature:
     LBRACKET core_type_comma_list RBRACKET clty_longident
@@ -1051,21 +1051,21 @@ seq_expr:
 ;
 labeled_simple_pattern:
     QUESTION LPAREN label_let_pattern opt_default RPAREN
-      { ("?" ^ fst $3, $4, snd $3) }
+      { (Optional (fst $3), $4, snd $3) }
   | QUESTION label_var
-      { ("?" ^ fst $2, None, snd $2) }
+      { (Optional (fst $2), None, snd $2) }
   | OPTLABEL LPAREN let_pattern opt_default RPAREN
-      { ("?" ^ $1, $4, $3) }
+      { (Optional $1, $4, $3) }
   | OPTLABEL pattern_var
-      { ("?" ^ $1, None, $2) }
+      { (Optional $1, None, $2) }
   | TILDE LPAREN label_let_pattern RPAREN
-      { (fst $3, None, snd $3) }
+      { (Labelled (fst $3), None, snd $3) }
   | TILDE label_var
-      { (fst $2, None, snd $2) }
+      { (Labelled (fst $2), None, snd $2) }
   | LABEL simple_pattern
-      { ($1, None, $2) }
+      { (Labelled $1, None, $2) }
   | simple_pattern
-      { ("", None, $1) }
+      { (Nolabel, None, $1) }
 ;
 pattern_var:
     LIDENT            { mkpat(Ppat_var (mkrhs $1 1)) }
@@ -1181,10 +1181,10 @@ expr:
       { mkexp(Pexp_setfield($1, mkrhs $3 3, $5)) }
   | simple_expr DOT LPAREN seq_expr RPAREN LESSMINUS expr
       { mkexp(Pexp_apply(ghexp(Pexp_ident(array_function ".()" true)),
-                         ["",$1; "",$4; "",$7])) }
+                         [Nolabel,$1; Nolabel,$4; Nolabel,$7])) }
   | simple_expr DOT LBRACKET seq_expr RBRACKET LESSMINUS expr
       { mkexp(Pexp_apply(ghexp(Pexp_ident(array_function ".[]" true)),
-                         ["",$1; "",$4; "",$7])) }
+                         [Nolabel,$1; Nolabel,$4; Nolabel,$7])) }
   | simple_expr DOT LBRACE expr RBRACE LESSMINUS expr
       { bigarray_set $1 $4 $7 }
   | label LESSMINUS expr
@@ -1230,12 +1230,12 @@ simple_expr:
       { unclosed "(" 3 ")" 5 }
   | simple_expr DOT LPAREN seq_expr RPAREN
       { mkexp(Pexp_apply(ghexp(Pexp_ident(array_function ".()" false)),
-                         ["",$1; "",$4])) }
+                         [Nolabel,$1; Nolabel,$4])) }
   | simple_expr DOT LPAREN seq_expr error
       { unclosed "(" 3 ")" 5 }
   | simple_expr DOT LBRACKET seq_expr RBRACKET
       { mkexp(Pexp_apply(ghexp(Pexp_ident(array_function ".[]" false)),
-                         ["",$1; "",$4])) }
+                         [Nolabel,$1; Nolabel,$4])) }
   | simple_expr DOT LBRACKET seq_expr error
       { unclosed "[" 3 "]" 5 }
   | simple_expr DOT LBRACE expr RBRACE
@@ -1272,9 +1272,9 @@ simple_expr:
   | mod_longident DOT LBRACKET expr_semi_list opt_semi error
       { unclosed "[" 3 "]" 6 }
   | PREFIXOP simple_expr
-      { mkexp(Pexp_apply(mkoperator $1 1, ["",$2])) }
+      { mkexp(Pexp_apply(mkoperator $1 1, [Nolabel,$2])) }
   | BANG simple_expr
-      { mkexp(Pexp_apply(mkoperator "!" 1, ["",$2])) }
+      { mkexp(Pexp_apply(mkoperator "!" 1, [Nolabel,$2])) }
   | NEW ext_attributes class_longident
       { mkexp_attrs (Pexp_new(mkrhs $3 3)) $2 }
   | LBRACELESS field_expr_list GREATERRBRACE
@@ -1313,19 +1313,19 @@ simple_labeled_expr_list:
 ;
 labeled_simple_expr:
     simple_expr %prec below_SHARP
-      { ("", $1) }
+      { (Nolabel, $1) }
   | label_expr
       { $1 }
 ;
 label_expr:
     LABEL simple_expr %prec below_SHARP
-      { ($1, $2) }
+      { (Labelled $1, $2) }
   | TILDE label_ident
-      { $2 }
+      { (Labelled (fst $2), snd $2) }
   | QUESTION label_ident
-      { ("?" ^ fst $2, snd $2) }
+      { (Optional (fst $2), snd $2) }
   | OPTLABEL simple_expr %prec below_SHARP
-      { ("?" ^ $1, $2) }
+      { (Optional $1, $2) }
 ;
 label_ident:
     LIDENT   { ($1, mkexp(Pexp_ident(mkrhs (Lident $1) 1))) }
@@ -1794,13 +1794,13 @@ core_type2:
     simple_core_type_or_tuple
       { $1 }
   | QUESTION LIDENT COLON core_type2 MINUSGREATER core_type2
-      { mktyp(Ptyp_arrow("?" ^ $2 , mkoption $4, $6)) }
+      { mktyp(Ptyp_arrow(Optional $2 , mkoption $4, $6)) }
   | OPTLABEL core_type2 MINUSGREATER core_type2
-      { mktyp(Ptyp_arrow("?" ^ $1 , mkoption $2, $4)) }
+      { mktyp(Ptyp_arrow(Optional $1 , mkoption $2, $4)) }
   | LIDENT COLON core_type2 MINUSGREATER core_type2
-      { mktyp(Ptyp_arrow($1, $3, $5)) }
+      { mktyp(Ptyp_arrow(Labelled $1, $3, $5)) }
   | core_type2 MINUSGREATER core_type2
-      { mktyp(Ptyp_arrow("", $1, $3)) }
+      { mktyp(Ptyp_arrow(Nolabel, $1, $3)) }
 ;
 
 simple_core_type:
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index 7bce27ad5..5d9162bbf 100644
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -54,10 +54,10 @@ and core_type_desc =
         (*  _ *)
   | Ptyp_var of string
         (* 'a *)
-  | Ptyp_arrow of label * core_type * core_type
-        (* T1 -> T2       (label = "")
-           ~l:T1 -> T2    (label = "l")
-           ?l:T1 -> T2    (label = "?l")
+  | Ptyp_arrow of arg_label * core_type * core_type
+        (* T1 -> T2       Simple
+           ~l:T1 -> T2    Labelled
+           ?l:T1 -> T2    Otional
          *)
   | Ptyp_tuple of core_type list
         (* T1 * ... * Tn
@@ -219,18 +219,18 @@ and expression_desc =
          *)
   | Pexp_function of case list
         (* function P1 -> E1 | ... | Pn -> En *)
-  | Pexp_fun of label * expression option * pattern * expression
-        (* fun P -> E1                          (lab = "", None)
-           fun ~l:P -> E1                       (lab = "l", None)
-           fun ?l:P -> E1                       (lab = "?l", None)
-           fun ?l:(P = E0) -> E1                (lab = "?l", Some E0)
+  | Pexp_fun of arg_label * expression option * pattern * expression
+        (* fun P -> E1                          (Simple, None)
+           fun ~l:P -> E1                       (Labelled l, None)
+           fun ?l:P -> E1                       (Optional l, None)
+           fun ?l:(P = E0) -> E1                (Optional l, Some E0)
 
            Notes:
-           - If E0 is provided, lab must start with '?'.
+           - If E0 is provided, only Optional is allowed.
            - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun.
            - "let f P = E" is represented using Pexp_fun.
          *)
-  | Pexp_apply of expression * (label * expression) list
+  | Pexp_apply of expression * (arg_label * expression) list
         (* E0 ~l1:E1 ... ~ln:En
            li can be empty (non labeled argument) or start with '?'
            (optional argument).
@@ -464,10 +464,10 @@ and class_type_desc =
            ['a1, ..., 'an] c *)
   | Pcty_signature of class_signature
         (* object ... end *)
-  | Pcty_arrow of label * core_type * class_type
-        (* T -> CT       (label = "")
-           ~l:T -> CT    (label = "l")
-           ?l:T -> CT    (label = "?l")
+  | Pcty_arrow of arg_label * core_type * class_type
+        (* T -> CT       Simple
+           ~l:T -> CT    Labelled l
+           ?l:T -> CT    Optional l
          *)
   | Pcty_extension of extension
         (* [%id] *)
@@ -540,13 +540,13 @@ and class_expr_desc =
            ['a1, ..., 'an] c *)
   | Pcl_structure of class_structure
         (* object ... end *)
-  | Pcl_fun of label * expression option * pattern * class_expr
-        (* fun P -> CE                          (lab = "", None)
-           fun ~l:P -> CE                       (lab = "l", None)
-           fun ?l:P -> CE                       (lab = "?l", None)
-           fun ?l:(P = E0) -> CE                (lab = "?l", Some E0)
+  | Pcl_fun of arg_label * expression option * pattern * class_expr
+        (* fun P -> CE                          (Simple, None)
+           fun ~l:P -> CE                       (Labelled l, None)
+           fun ?l:P -> CE                       (Optional l, None)
+           fun ?l:(P = E0) -> CE                (Optional l, Some E0)
          *)
-  | Pcl_apply of class_expr * (label * expression) list
+  | Pcl_apply of class_expr * (arg_label * expression) list
         (* CE ~l1:E1 ... ~ln:En
            li can be empty (non labeled argument) or start with '?'
            (optional argument).
diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml
index 97067465d..6d1d22c14 100644
--- a/parsing/pprintast.ml
+++ b/parsing/pprintast.ml
@@ -220,15 +220,15 @@ class printer  ()= object(self:'self)
 
   method type_with_label f (label,({ptyp_desc;_}as c) ) =
     match label with
-    | "" ->  self#core_type1 f c (* otherwise parenthesize *)
-    | s  ->
-        if s.[0]='?' then
-          match ptyp_desc with
-          | Ptyp_constr ({txt;_}, l) ->
-              assert (is_predef_option txt);
-              pp f "%s:%a" s (self#list self#core_type1) l
-          | _ -> failwith "invalid input in print_type_with_label"
-        else pp f "%s:%a" s self#core_type1 c
+    | Nolabel ->  self#core_type1 f c (* otherwise parenthesize *)
+    | Labelled s -> pp f "%s:%a" s self#core_type1 c
+    | Optional s  ->
+        begin match ptyp_desc with
+        | Ptyp_constr ({txt;_}, l) ->
+            assert (is_predef_option txt);
+            pp f "?%s:%a" s (self#list self#core_type1) l
+        | _ -> failwith "invalid input in print_type_with_label"
+        end
   method core_type f x =
     if x.ptyp_attributes <> [] then begin
       pp f "((%a)%a)" self#core_type {x with ptyp_attributes=[]}
@@ -401,13 +401,11 @@ class printer  ()= object(self:'self)
     | _ -> self#paren true self#pattern f x
 
   method label_exp f (l,opt,p) =
-    if l = "" then
+    match l with
+    | Nolabel ->
       pp f "%a@ " self#simple_pattern p (*single case pattern parens needed here *)
-    else
-      if l.[0] = '?' then
-        let len = String.length l - 1 in
-        let rest = String.sub l 1 len in begin
-          match p.ppat_desc with
+    | Optional rest ->
+        begin match p.ppat_desc with
           | Ppat_var {txt;_} when txt = rest ->
               (match opt with
                | Some o -> pp f "?(%s=@;%a)@;" rest  self#expression o
@@ -415,10 +413,10 @@ class printer  ()= object(self:'self)
           | _ ->
               (match opt with
                | Some o ->
-                   pp f "%s:(%a=@;%a)@;" l self#pattern1 p self#expression o
-               | None -> pp f "%s:%a@;" l self#simple_pattern p)
+                   pp f "?%s:(%a=@;%a)@;" rest self#pattern1 p self#expression o
+               | None -> pp f "?%s:%a@;" rest self#simple_pattern p)
         end
-      else
+    | Labelled l ->
         (match p.ppat_desc with
         | Ppat_var {txt;_} when txt = l ->
             pp f "~%s@;" l
@@ -1058,7 +1056,7 @@ class printer  ()= object(self:'self)
       if x.pexp_attributes <> [] then pp f "=@;%a" self#expression x
       else match x.pexp_desc with
       | Pexp_fun (label, eo, p, e) ->
-          if label="" then
+          if label=Nolabel then
             pp f "%a@ %a" self#simple_pattern p pp_print_pexp_function e
           else
             pp f "%a@ %a" self#label_exp (label,eo,p) pp_print_pexp_function e
@@ -1353,19 +1351,17 @@ class printer  ()= object(self:'self)
         self#pattern pc_lhs (self#option self#expression ~first:"@;when@;") pc_guard self#under_pipe#expression pc_rhs in
     self#list aux f l ~sep:""
   method label_x_expression_param f (l,e) =
-    match l with
-    | ""  -> self#expression2 f e ; (* level 2*)
-    | lbl ->
-        let simple_name = match e.pexp_desc with
-        | Pexp_ident {txt=Lident l;_} -> Some l
-        | _ -> None in
-        if  lbl.[0] = '?' then
-          let str = String.sub lbl 1 (String.length lbl-1) in
+    let simple_name = match e.pexp_desc with
+    | Pexp_ident {txt=Lident l;_} -> Some l
+    | _ -> None
+    in match l with
+    | Nolabel  -> self#expression2 f e ; (* level 2*)
+    | Optional str ->
           if Some str = simple_name then
-            pp f "%s" lbl
+            pp f "?%s" str
           else
-            pp f "%s:%a" lbl self#simple_expr e
-        else
+            pp f "?%s:%a" str self#simple_expr e
+    | Labelled lbl ->
           if Some lbl = simple_name then
             pp f "~%s" lbl
           else
diff --git a/parsing/pprintast.mli b/parsing/pprintast.mli
index 42a340915..a5b468cdc 100644
--- a/parsing/pprintast.mli
+++ b/parsing/pprintast.mli
@@ -53,10 +53,10 @@ class printer :
       Format.formatter -> Parsetree.extension_constructor -> unit
     method label_exp :
       Format.formatter ->
-      Asttypes.label * Parsetree.expression option * Parsetree.pattern ->
+      Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern ->
       unit
     method label_x_expression_param :
-      Format.formatter -> Asttypes.label * Parsetree.expression -> unit
+      Format.formatter -> Asttypes.arg_label * Parsetree.expression -> unit
     method list :
       ?sep:space_formatter ->
       ?first:space_formatter ->
@@ -113,7 +113,7 @@ class printer :
     method type_params :
       Format.formatter -> (Parsetree.core_type * Asttypes.variance) list -> unit
     method type_with_label :
-      Format.formatter -> Asttypes.label * Parsetree.core_type -> unit
+      Format.formatter -> Asttypes.arg_label * Parsetree.core_type -> unit
     method tyvar : Format.formatter -> string -> unit
     method under_pipe : 'b
     method under_semi : 'b
diff --git a/parsing/printast.ml b/parsing/printast.ml
index 2bf9d8f3e..490e319f5 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -130,6 +130,11 @@ let string i ppf s = line i ppf "\"%s\"\n" s;;
 let string_loc i ppf s = line i ppf "%a\n" fmt_string_loc s;;
 let bool i ppf x = line i ppf "%s\n" (string_of_bool x);;
 let label i ppf x = line i ppf "label=\"%s\"\n" x;;
+let arg_label i ppf = function
+  | Nolabel -> line i ppf "Nolabel\n"
+  | Optional s -> line i ppf "Optional \"%s\"\n" s
+  | Labelled s -> line i ppf "Labelled \"%s\"\n" s
+;;
 
 let rec core_type i ppf x =
   line i ppf "core_type %a\n" fmt_location x.ptyp_loc;
@@ -140,7 +145,7 @@ let rec core_type i ppf x =
   | Ptyp_var (s) -> line i ppf "Ptyp_var %s\n" s;
   | Ptyp_arrow (l, ct1, ct2) ->
       line i ppf "Ptyp_arrow\n";
-      string i ppf l;
+      arg_label i ppf l;
       core_type i ppf ct1;
       core_type i ppf ct2;
   | Ptyp_tuple l ->
@@ -250,7 +255,8 @@ and expression i ppf x =
       line i ppf "Pexp_function\n";
       list i case ppf l;
   | Pexp_fun (l, eo, p, e) ->
-      line i ppf "Pexp_fun \"%s\"\n" l;
+      line i ppf "Pexp_fun\n";
+      arg_label i ppf l;
       option i expression ppf eo;
       pattern i ppf p;
       expression i ppf e;
@@ -457,7 +463,8 @@ and class_type i ppf x =
       line i ppf "Pcty_signature\n";
       class_signature i ppf cs;
   | Pcty_arrow (l, co, cl) ->
-      line i ppf "Pcty_arrow \"%s\"\n" l;
+      line i ppf "Pcty_arrow\n";
+      arg_label i ppf l;
       core_type i ppf co;
       class_type i ppf cl;
   | Pcty_extension (s, arg) ->
@@ -531,7 +538,7 @@ and class_expr i ppf x =
       class_structure i ppf cs;
   | Pcl_fun (l, eo, p, e) ->
       line i ppf "Pcl_fun\n";
-      label i ppf l;
+      arg_label i ppf l;
       option i expression ppf eo;
       pattern i ppf p;
       class_expr i ppf e;
@@ -852,7 +859,8 @@ and longident_x_expression i ppf (li, e) =
   expression (i+1) ppf e;
 
 and label_x_expression i ppf (l,e) =
-  line i ppf "<label> \"%s\"\n" l;
+  line i ppf "<arg>\n";
+  arg_label i ppf l;
   expression (i+1) ppf e;
 
 and label_x_bool_x_core_type_list i ppf x =
diff --git a/tools/untypeast.ml b/tools/untypeast.ml
index 58242fc23..93e0c84fb 100644
--- a/tools/untypeast.ml
+++ b/tools/untypeast.ml
@@ -270,7 +270,7 @@ and untype_expression exp =
           untype_expression exp)
     | Texp_function (label, [{c_lhs=p; c_guard=None; c_rhs=e}], _) ->
         Pexp_fun (label, None, untype_pattern p, untype_expression e)
-    | Texp_function ("", cases, _) ->
+    | Texp_function (Nolabel, cases, _) ->
         Pexp_function (untype_cases cases)
     | Texp_function _ ->
         assert false
@@ -623,14 +623,16 @@ and untype_class_field cf =
         Pcf_method (lab, priv, Cfk_virtual (untype_core_type cty))
     | Tcf_method (lab, priv, Tcfk_concrete (o, exp)) ->
         let remove_fun_self = function
-          | { exp_desc = Texp_function("", [case], _) } when is_self_pat case.c_lhs && case.c_guard = None -> case.c_rhs
+          | { exp_desc = Texp_function(Nolabel, [case], _) }
+            when is_self_pat case.c_lhs && case.c_guard = None -> case.c_rhs
           | e -> e
         in
         let exp = remove_fun_self exp in
         Pcf_method (lab, priv, Cfk_concrete (o, untype_expression exp))
     | Tcf_initializer exp -> 
         let remove_fun_self = function
-          | { exp_desc = Texp_function("", [case], _) } when is_self_pat case.c_lhs && case.c_guard = None -> case.c_rhs
+          | { exp_desc = Texp_function(Nolabel, [case], _) }
+            when is_self_pat case.c_lhs && case.c_guard = None -> case.c_rhs
           | e -> e
         in
         let exp = remove_fun_self exp in
diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml
index 1fd90094a..a9014b422 100644
--- a/toplevel/topdirs.ml
+++ b/toplevel/topdirs.ml
@@ -236,7 +236,7 @@ let match_generic_printer_type ppf desc path args printer_type =
     List.map (fun ty_var -> Ctype.newconstr printer_type [ty_var]) args in
   let ty_expected =
     List.fold_right
-      (fun ty_arg ty -> Ctype.newty (Tarrow ("", ty_arg, ty, Cunknown)))
+      (fun ty_arg ty -> Ctype.newty (Tarrow (Asttypes.Nolabel, ty_arg, ty, Cunknown)))
       ty_args (Ctype.newconstr printer_type [ty_target]) in
   Ctype.unify !toplevel_env
     ty_expected
diff --git a/toplevel/trace.ml b/toplevel/trace.ml
index 669044836..8c5fabecc 100644
--- a/toplevel/trace.ml
+++ b/toplevel/trace.ml
@@ -52,7 +52,8 @@ let set_code_pointer cls ptr = Obj.set_field cls 0 ptr
 let invoke_traced_function codeptr env arg =
   Meta.invoke_traced_function codeptr env arg
 
-let print_label ppf l = if l <> "" then fprintf ppf "%s:" l
+let print_label ppf l =
+  if l <> Asttypes.Nolabel then fprintf ppf "%s:" (Printtyp.string_of_label l)
 
 (* If a function returns a functional value, wrap it into a trace code *)
 
diff --git a/typing/btype.ml b/typing/btype.ml
index f23b7387b..7627913c9 100644
--- a/typing/btype.ml
+++ b/typing/btype.ml
@@ -13,6 +13,7 @@
 (* Basic operations on core types *)
 
 open Misc
+open Asttypes
 open Types
 
 (**** Sets, maps and hashtables of types ****)
@@ -561,15 +562,17 @@ let check_memorized_abbrevs () =
                   (*  Utilities for labels          *)
                   (**********************************)
 
-let is_optional l =
-  String.length l > 0 && l.[0] = '?'
+let is_optional = function Optional _ -> true | _ -> false
 
-let label_name l =
-  if is_optional l then String.sub l 1 (String.length l - 1)
-                   else l
+let label_name = function
+    Nolabel -> ""
+  | Labelled s
+  | Optional s -> s
 
-let prefixed_label_name l =
-  if is_optional l then l else "~" ^ l
+let prefixed_label_name = function
+    Nolabel -> ""
+  | Labelled s -> "~" ^ s
+  | Optional s -> "?" ^ s
 
 let rec extract_label_aux hd l = function
     [] -> raise Not_found
diff --git a/typing/btype.mli b/typing/btype.mli
index ec63e9ae6..4e1b1413c 100644
--- a/typing/btype.mli
+++ b/typing/btype.mli
@@ -162,15 +162,15 @@ val forget_abbrev:
 
 (**** Utilities for labels ****)
 
-val is_optional : label -> bool
-val label_name : label -> label
+val is_optional : arg_label -> bool
+val label_name : arg_label -> label
 
 (* Returns the label name with first character '?' or '~' as appropriate. *)
-val prefixed_label_name : label -> label
+val prefixed_label_name : arg_label -> label
 
 val extract_label :
-    label -> (label * 'a) list ->
-    label * 'a * (label * 'a) list * (label * 'a) list
+    label -> (arg_label * 'a) list ->
+    arg_label * 'a * (arg_label * 'a) list * (arg_label * 'a) list
     (* actual label, value, before list, after list *)
 
 (**** Utilities for backtracking ****)
diff --git a/typing/ctype.ml b/typing/ctype.ml
index 6260a85af..10c9b8d42 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -2848,7 +2848,7 @@ let filter_arrow env t l =
       link_type t t';
       (t1, t2)
   | Tarrow(l', t1, t2, _)
-    when l = l' || !Clflags.classic && l = "" && not (is_optional l') ->
+    when l = l' || !Clflags.classic && l = Nolabel && not (is_optional l') ->
       (t1, t2)
   | _ ->
       raise (Unify [])
@@ -3656,7 +3656,7 @@ let match_class_declarations env patt_params patt_type subj_params subj_type =
         (* Use moregeneral for class parameters, need to recheck everything to
            keeps relationships (PR#4824) *)
         let clty_params =
-          List.fold_right (fun ty cty -> Cty_arrow ("*",ty,cty)) in
+          List.fold_right (fun ty cty -> Cty_arrow (Labelled "*",ty,cty)) in
         match_class_types ~trace:false env
           (clty_params patt_params patt_type)
           (clty_params subj_params subj_type)
diff --git a/typing/ctype.mli b/typing/ctype.mli
index 37daf3a42..b1e4b4a06 100644
--- a/typing/ctype.mli
+++ b/typing/ctype.mli
@@ -161,7 +161,7 @@ val unify_gadt: newtype_level:int -> Env.t ref -> type_expr -> type_expr -> unit
 val unify_var: Env.t -> type_expr -> type_expr -> unit
         (* Same as [unify], but allow free univars when first type
            is a variable. *)
-val filter_arrow: Env.t -> type_expr -> label -> type_expr * type_expr
+val filter_arrow: Env.t -> type_expr -> arg_label -> type_expr * type_expr
         (* A special case of unification (with l:'a -> 'b). *)
 val filter_method: Env.t -> string -> private_flag -> type_expr -> type_expr
         (* A special case of unification (with {m : 'a; 'b}). *)
diff --git a/typing/mtype.ml b/typing/mtype.ml
index ec5fa6922..4768edeb5 100644
--- a/typing/mtype.ml
+++ b/typing/mtype.ml
@@ -44,9 +44,8 @@ and strengthen_sig env sg p pos =
   match sg with
     [] -> []
   | (Sig_value(id, desc) as sigelt) :: rem ->
-      let pos =
-        match desc with {val_kind = Val_prim _} -> pos | _ -> pos+1 in
-      sigelt :: strengthen_sig env rem p pos
+      let nextpos = match desc.val_kind with Val_prim _ -> pos | _ -> pos+1 in
+      sigelt :: strengthen_sig env rem p nextpos
   | Sig_type(id, decl, rs) :: rem ->
       let newdecl =
         match decl.type_manifest, decl.type_private, decl.type_kind with
diff --git a/typing/printtyp.ml b/typing/printtyp.ml
index 5acbba910..cb07731ee 100644
--- a/typing/printtyp.ml
+++ b/typing/printtyp.ml
@@ -122,6 +122,11 @@ let print_name ppf = function
     None -> fprintf ppf "None"
   | Some name -> fprintf ppf "\"%s\"" name
 
+let string_of_label = function
+    Nolabel -> ""
+  | Labelled s -> s
+  | Optional s -> "?"^s
+
 let visited = ref []
 let rec raw_type ppf ty =
   let ty = safe_repr [] ty in
@@ -134,8 +139,8 @@ and raw_type_list tl = raw_list raw_type tl
 and raw_type_desc ppf = function
     Tvar name -> fprintf ppf "Tvar %a" print_name name
   | Tarrow(l,t1,t2,c) ->
-      fprintf ppf "@[<hov1>Tarrow(%s,@,%a,@,%a,@,%s)@]"
-        l raw_type t1 raw_type t2
+      fprintf ppf "@[<hov1>Tarrow(\"%s\",@,%a,@,%a,@,%s)@]"
+        (string_of_label l) raw_type t1 raw_type t2
         (safe_commu_repr [] c)
   | Ttuple tl ->
       fprintf ppf "@[<1>Ttuple@,%a@]" raw_type_list tl
@@ -525,7 +530,7 @@ let reset_and_mark_loops_list tyl =
 (* Disabled in classic mode when printing an unification error *)
 let print_labels = ref true
 let print_label ppf l =
-  if !print_labels && l <> "" || is_optional l then fprintf ppf "%s:" l
+  if !print_labels && l <> Nolabel || is_optional l then fprintf ppf "%s:" (string_of_label l)
 
 let rec tree_of_typexp sch ty =
   let ty = repr ty in
@@ -541,7 +546,7 @@ let rec tree_of_typexp sch ty =
     | Tarrow(l, ty1, ty2, _) ->
         let pr_arrow l ty1 ty2 =
           let lab =
-            if !print_labels && l <> "" || is_optional l then l else ""
+            if !print_labels || is_optional l then string_of_label l else ""
           in
           let t1 =
             if is_optional l then
@@ -1040,7 +1045,7 @@ let rec tree_of_class_type sch params =
       in
       Octy_signature (self_ty, List.rev csil)
   | Cty_arrow (l, ty, cty) ->
-      let lab = if !print_labels && l <> "" || is_optional l then l else "" in
+      let lab = if !print_labels || is_optional l then string_of_label l else "" in
       let ty =
        if is_optional l then
          match (repr ty).desc with
diff --git a/typing/printtyp.mli b/typing/printtyp.mli
index c63da986d..9bbc7011a 100644
--- a/typing/printtyp.mli
+++ b/typing/printtyp.mli
@@ -22,6 +22,7 @@ val tree_of_path: Path.t -> out_ident
 val path: formatter -> Path.t -> unit
 val string_of_path: Path.t -> string
 val raw_type_expr: formatter -> type_expr -> unit
+val string_of_label: Asttypes.arg_label -> string
 
 val wrap_printing_env: Env.t -> (unit -> 'a) -> 'a
     (* Call the function using the environment for type path shortening *)
diff --git a/typing/printtyped.ml b/typing/printtyped.ml
index 67c6ff040..3965b2284 100644
--- a/typing/printtyped.ml
+++ b/typing/printtyped.ml
@@ -135,6 +135,11 @@ let string i ppf s = line i ppf "\"%s\"\n" s;;
 let string_loc i ppf s = line i ppf "\"%s\"\n" s.txt;;
 let bool i ppf x = line i ppf "%s\n" (string_of_bool x);;
 let label i ppf x = line i ppf "label=\"%s\"\n" x;;
+let arg_label i ppf = function
+  | Nolabel -> line i ppf "Nolabel\n"
+  | Optional s -> line i ppf "Optional \"%s\"\n" s
+  | Labelled s -> line i ppf "Labelled \"%s\"\n" s
+;;
 
 let attributes i ppf l =
   let i = i + 1 in
@@ -154,7 +159,7 @@ let rec core_type i ppf x =
   | Ttyp_var (s) -> line i ppf "Ttyp_var %s\n" s;
   | Ttyp_arrow (l, ct1, ct2) ->
       line i ppf "Ttyp_arrow\n";
-      string i ppf l;
+      arg_label i ppf l;
       core_type i ppf ct1;
       core_type i ppf ct2;
   | Ttyp_tuple l ->
@@ -282,8 +287,8 @@ and expression i ppf x =
       list i value_binding ppf l;
       expression i ppf e;
   | Texp_function (p, l, _partial) ->
-      line i ppf "Texp_function \"%s\"\n" p;
-(*      option i expression ppf eo; *)
+      line i ppf "Texp_function\n";
+      arg_label i ppf p;
       list i case ppf l;
   | Texp_apply (e, l) ->
       line i ppf "Texp_apply\n";
@@ -449,7 +454,8 @@ and class_type i ppf x =
       line i ppf "Tcty_signature\n";
       class_signature i ppf cs;
   | Tcty_arrow (l, co, cl) ->
-      line i ppf "Tcty_arrow \"%s\"\n" l;
+      line i ppf "Tcty_arrow\n";
+      arg_label i ppf l;
       core_type i ppf co;
       class_type i ppf cl;
 
@@ -515,7 +521,7 @@ and class_expr i ppf x =
       class_structure i ppf cs;
   | Tcl_fun (l, p, _, ce, _) ->
       line i ppf "Tcl_fun\n";
-      label i ppf l;
+      arg_label i ppf l;
       pattern i ppf p;
       class_expr i ppf ce
   | Tcl_apply (ce, l) ->
@@ -821,7 +827,8 @@ and longident_x_expression i ppf (li, _, e) =
   expression (i+1) ppf e;
 
 and label_x_expression i ppf (l, e, _) =
-  line i ppf "<label> \"%s\"\n" l;
+  line i ppf "<arg>\n";
+  arg_label (i+1) ppf l;
   (match e with None -> () | Some e -> expression (i+1) ppf e)
 
 and ident_x_loc_x_expression_def i ppf (l,_, e) =
diff --git a/typing/typeclass.ml b/typing/typeclass.ml
index eb7746214..32babd8fb 100644
--- a/typing/typeclass.ml
+++ b/typing/typeclass.ml
@@ -23,7 +23,7 @@ type error =
   | Field_type_mismatch of string * string * (type_expr * type_expr) list
   | Structure_expected of class_type
   | Cannot_apply of class_type
-  | Apply_wrong_label of label
+  | Apply_wrong_label of arg_label
   | Pattern_type_clash of type_expr
   | Repeated_parameter
   | Unbound_class_2 of Longident.t
@@ -352,7 +352,7 @@ let type_constraint val_env sty sty' loc =
 let make_method loc cl_num expr =
   let open Ast_helper in
   let mkid s = mkloc s loc in
-  Exp.fun_ ~loc:expr.pexp_loc "" None
+  Exp.fun_ ~loc:expr.pexp_loc Nolabel None
     (Pat.alias ~loc (Pat.var ~loc (mkid "self-*")) (mkid ("self-" ^ cl_num)))
     expr
 
@@ -673,7 +673,7 @@ let rec class_field self_loc cl_num self_type meths vars
       let field =
         lazy begin
           let meth_type =
-            Btype.newgenty (Tarrow("", self_type, ty, Cok)) in
+            Btype.newgenty (Tarrow(Nolabel, self_type, ty, Cok)) in
           Ctype.raise_nongen_level ();
           vars := vars_local;
           let texp = type_expect met_env meth_expr meth_type in
@@ -698,7 +698,7 @@ let rec class_field self_loc cl_num self_type meths vars
           Ctype.raise_nongen_level ();
           let meth_type =
             Ctype.newty
-              (Tarrow ("", self_type,
+              (Tarrow (Nolabel, self_type,
                        Ctype.instance_def Predef.type_unit, Cok)) in
           vars := vars_local;
           let texp = type_expect met_env expr meth_type in
@@ -988,8 +988,8 @@ and class_expr cl_num val_env met_env scl =
         !Clflags.classic ||
         let labels = nonopt_labels [] cl.cl_type in
         List.length labels = List.length sargs &&
-        List.for_all (fun (l,_) -> l = "") sargs &&
-        List.exists (fun l -> l <> "") labels &&
+        List.for_all (fun (l,_) -> l = Nolabel) sargs &&
+        List.exists (fun l -> l <> Nolabel) labels &&
         begin
           Location.prerr_warning cl.cl_loc Warnings.Labels_omitted;
           true
@@ -1008,7 +1008,7 @@ and class_expr cl_num val_env met_env scl =
                   (l', sarg0)::_, _ ->
                     raise(Error(sarg0.pexp_loc, val_env, Apply_wrong_label l'))
                 | _, (l', sarg0)::more_sargs ->
-                    if l <> l' && l' <> "" then
+                    if l <> l' && l' <> Nolabel then
                       raise(Error(sarg0.pexp_loc, val_env,
                                   Apply_wrong_label l'))
                     else ([], more_sargs,
@@ -1028,7 +1028,7 @@ and class_expr cl_num val_env met_env scl =
                 in
                 if optional = Required && Btype.is_optional l' then
                   Location.prerr_warning sarg0.pexp_loc
-                    (Warnings.Nonoptional_label l);
+                    (Warnings.Nonoptional_label (Printtyp.string_of_label l));
                 sargs, more_sargs,
                 if optional = Required || Btype.is_optional l' then
                   Some (type_argument val_env sarg0 ty ty0)
@@ -1040,7 +1040,7 @@ and class_expr cl_num val_env met_env scl =
               with Not_found ->
                 sargs, more_sargs,
                 if Btype.is_optional l &&
-                  (List.mem_assoc "" sargs || List.mem_assoc "" more_sargs)
+                  (List.mem_assoc Nolabel sargs || List.mem_assoc Nolabel more_sargs)
                 then
                   Some (option_none ty0 Location.none)
                 else None
@@ -1704,8 +1704,8 @@ let report_error env ppf = function
         "This class expression is not a class function, it cannot be applied"
   | Apply_wrong_label l ->
       let mark_label = function
-        | "" -> "out label"
-        |  l -> sprintf " label ~%s" l in
+        | Nolabel -> "out label"
+        |  l -> sprintf " label %s" (Btype.prefixed_label_name l) in
       fprintf ppf "This argument cannot be applied with%s" (mark_label l)
   | Pattern_type_clash ty ->
       (* XXX Trace *)
diff --git a/typing/typeclass.mli b/typing/typeclass.mli
index 8e8675fe7..d213221a8 100644
--- a/typing/typeclass.mli
+++ b/typing/typeclass.mli
@@ -81,7 +81,7 @@ type error =
   | Field_type_mismatch of string * string * (type_expr * type_expr) list
   | Structure_expected of class_type
   | Cannot_apply of class_type
-  | Apply_wrong_label of label
+  | Apply_wrong_label of arg_label
   | Pattern_type_clash of type_expr
   | Repeated_parameter
   | Unbound_class_2 of Longident.t
diff --git a/typing/typecore.ml b/typing/typecore.ml
index bcd0538e9..f0027f297 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -30,7 +30,7 @@ type error =
   | Orpat_vars of Ident.t * Ident.t list
   | Expr_type_clash of (type_expr * type_expr) list
   | Apply_non_function of type_expr
-  | Apply_wrong_label of label * type_expr
+  | Apply_wrong_label of arg_label * type_expr
   | Label_multiply_defined of string
   | Label_missing of Ident.t list
   | Label_not_mutable of Longident.t
@@ -51,7 +51,7 @@ type error =
   | Coercion_failure of
       type_expr * type_expr * (type_expr * type_expr) list * bool
   | Too_many_arguments of bool * type_expr
-  | Abstract_wrong_label of label * type_expr
+  | Abstract_wrong_label of arg_label * type_expr
   | Scoping_let_module of string * type_expr
   | Masked_instance_variable of Longident.t
   | Not_a_variant_type of Longident.t
@@ -1528,12 +1528,11 @@ let rec approx_type env sty =
 let rec type_approx env sexp =
   match sexp.pexp_desc with
     Pexp_let (_, _, e) -> type_approx env e
-  | Pexp_fun (p, _, _, e) when is_optional p ->
-       newty (Tarrow(p, type_option (newvar ()), type_approx env e, Cok))
-  | Pexp_fun (p,_,_, e) ->
-       newty (Tarrow(p, newvar (), type_approx env e, Cok))
+  | Pexp_fun (p, _, _, e) ->
+      let ty = if is_optional p then type_option (newvar ()) else newvar () in
+      newty (Tarrow(p, ty, type_approx env e, Cok))
   | Pexp_function ({pc_rhs=e}::_) ->
-       newty (Tarrow("", newvar (), type_approx env e, Cok))
+      newty (Tarrow(Nolabel, newvar (), type_approx env e, Cok))
   | Pexp_match (_, {pc_rhs=e}::_) -> type_approx env e
   | Pexp_try (e, _) -> type_approx env e
   | Pexp_tuple l -> newty (Ttuple(List.map (type_approx env) l))
@@ -1919,7 +1918,7 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
         l [{pc_lhs=spat; pc_guard=None; pc_rhs=sexp}]
   | Pexp_function caselist ->
       type_function ?in_function
-        loc sexp.pexp_attributes env ty_expected "" caselist
+        loc sexp.pexp_attributes env ty_expected Nolabel caselist
   | Pexp_apply(sfunct, sargs) ->
       if sargs = [] then
         Syntaxerr.ill_formed_ast loc "Function application with no argument.";
@@ -2393,7 +2392,7 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
                     filter_self_method env met Private meths privty
                   in
                   let method_type = newvar () in
-                  let (obj_ty, res_ty) = filter_arrow env method_type "" in
+                  let (obj_ty, res_ty) = filter_arrow env method_type Nolabel in
                   unify env obj_ty desc.val_type;
                   unify env res_ty (instance env typ);
                   let exp =
@@ -2407,13 +2406,13 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
                                 exp_type = method_type;
                                 exp_attributes = []; (* check *)
                                 exp_env = env},
-                          ["",
+                          [ Nolabel,
                             Some {exp_desc = Texp_ident(path, lid, desc);
                                   exp_loc = obj.exp_loc; exp_extra = [];
                                   exp_type = desc.val_type;
                                   exp_attributes = []; (* check *)
                                   exp_env = env},
-                               Required])
+                            Required ])
                   in
                   (Tmeth_name met, Some (re {exp_desc = exp;
                                              exp_loc = loc; exp_extra = [];
@@ -3106,7 +3105,7 @@ and type_argument ?recarg env sarg ty_expected' ty_expected =
   (* ty_expected' may be generic *)
   let no_labels ty =
     let ls, tvar = list_labels env ty in
-    not tvar && List.for_all ((=) "") ls
+    not tvar && List.for_all ((=) Nolabel) ls
   in
   let rec is_inferred sexp =
     match sexp.pexp_desc with
@@ -3117,7 +3116,7 @@ and type_argument ?recarg env sarg ty_expected' ty_expected =
     | _ -> false
   in
   match expand_head env ty_expected' with
-    {desc = Tarrow("",ty_arg,ty_res,_); level = lv} when is_inferred sarg ->
+    {desc = Tarrow(Nolabel,ty_arg,ty_res,_); level = lv} when is_inferred sarg ->
       (* apply optional arguments when expected type is "" *)
       (* we must be very careful about not breaking the semantics *)
       if !Clflags.principal then begin_def ();
@@ -3131,7 +3130,7 @@ and type_argument ?recarg env sarg ty_expected' ty_expected =
         | Tarrow (l,ty_arg,ty_fun,_) when is_optional l ->
             let ty = option_none (instance env ty_arg) sarg.pexp_loc in
             make_args ((l, Some ty, Optional) :: args) ty_fun
-        | Tarrow (l,_,ty_res',_) when l = "" || !Clflags.classic ->
+        | Tarrow (l,_,ty_res',_) when l = Nolabel || !Clflags.classic ->
             List.rev args, ty_fun, no_labels ty_res'
         | Tvar _ ->  List.rev args, ty_fun, false
         |  _ -> [], texp.exp_type, false
@@ -3167,13 +3166,14 @@ and type_argument ?recarg env sarg ty_expected' ty_expected =
           {texp with exp_type = ty_res; exp_desc =
            Texp_apply
              (texp,
-              args @ ["", Some eta_var, Required])}
+              args @ [Nolabel, Some eta_var, Required])}
         in
         { texp with exp_type = ty_fun; exp_desc =
-          Texp_function("", [case eta_pat e], Total) }
+          Texp_function(Nolabel, [case eta_pat e], Total) }
       in
       Location.prerr_warning texp.exp_loc
-        (Warnings.Eliminated_optional_arguments (List.map (fun (l, _, _) -> l) args));
+        (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");
       if is_nonexpansive texp then func texp else
@@ -3205,7 +3205,7 @@ and type_application env funct sargs =
   let ignored = ref [] in
   let rec type_unknown_args
       (args :
-      (Asttypes.label * (unit -> Typedtree.expression) option *
+      (Asttypes.arg_label * (unit -> Typedtree.expression) option *
          Typedtree.optional) list)
     omitted ty_fun = function
       [] ->
@@ -3231,7 +3231,7 @@ and type_application env funct sargs =
               unify env ty_fun (newty (Tarrow(l1,t1,t2,Clink(ref Cunknown))));
               (t1, t2)
           | Tarrow (l,t1,t2,_) when l = l1
-            || !Clflags.classic && l1 = "" && not (is_optional l) ->
+            || !Clflags.classic && l1 = Nolabel && not (is_optional l) ->
               (t1, t2)
           | td ->
               let ty_fun =
@@ -3264,8 +3264,8 @@ and type_application env funct sargs =
       not tvar &&
       let labels = List.filter (fun l -> not (is_optional l)) ls in
       List.length labels = List.length sargs &&
-      List.for_all (fun (l,_) -> l = "") sargs &&
-      List.exists (fun l -> l <> "") labels &&
+      List.for_all (fun (l,_) -> l = Nolabel) sargs &&
+      List.exists (fun l -> l <> Nolabel) labels &&
       (Location.prerr_warning funct.exp_loc Warnings.Labels_omitted;
        true)
     end
@@ -3293,7 +3293,7 @@ and type_application env funct sargs =
                 raise(Error(sarg0.pexp_loc, env,
                             Apply_wrong_label(l', ty_old)))
             | _, (l', sarg0) :: more_sargs ->
-                if l <> l' && l' <> "" then
+                if l <> l' && l' <> Nolabel then
                   raise(Error(sarg0.pexp_loc, env,
                               Apply_wrong_label(l', ty_fun')))
                 else
@@ -3319,7 +3319,7 @@ and type_application env funct sargs =
             in
             if optional = Required && is_optional l' then
               Location.prerr_warning sarg0.pexp_loc
-                (Warnings.Nonoptional_label l);
+                (Warnings.Nonoptional_label (Printtyp.string_of_label l));
             sargs, more_sargs,
             if optional = Required || is_optional l' then
               Some (fun () -> type_argument env sarg0 ty ty0)
@@ -3333,7 +3333,7 @@ and type_application env funct sargs =
           with Not_found ->
             sargs, more_sargs,
             if optional = Optional &&
-              (List.mem_assoc "" sargs || List.mem_assoc "" more_sargs)
+              (List.mem_assoc Nolabel sargs || List.mem_assoc Nolabel more_sargs)
             then begin
               may_warn funct.exp_loc
                 (Warnings.Without_principality "eliminated optional argument");
@@ -3362,8 +3362,8 @@ and type_application env funct sargs =
   match funct.exp_desc, sargs with
     (* Special case for ignore: avoid discarding warning *)
     Texp_ident (_, _, {val_kind=Val_prim{Primitive.prim_name="%ignore"}}),
-    ["", sarg] ->
-      let ty_arg, ty_res = filter_arrow env (instance env funct.exp_type) "" in
+    [Nolabel, sarg] ->
+      let ty_arg, ty_res = filter_arrow env (instance env funct.exp_type) Nolabel in
       let exp = type_expect env sarg ty_arg in
       begin match (expand_head env exp.exp_type).desc with
       | Tarrow _ ->
@@ -3372,7 +3372,7 @@ and type_application env funct sargs =
           add_delayed_check (fun () -> check_application_result env false exp)
       | _ -> ()
       end;
-      (["", Some exp, Required], ty_res)
+      ([Nolabel, Some exp, Required], ty_res)
   | _ ->
       let ty = funct.exp_type in
       if ignore_labels then
@@ -3897,7 +3897,7 @@ let report_error env ppf = function
       end
   | Apply_wrong_label (l, ty) ->
       let print_label ppf = function
-        | "" -> fprintf ppf "without label"
+        | Nolabel -> fprintf ppf "without label"
         | l ->
             fprintf ppf "with label %s" (prefixed_label_name l)
       in
@@ -3999,9 +3999,8 @@ let report_error env ppf = function
       end
   | Abstract_wrong_label (l, ty) ->
       let label_mark = function
-        | "" -> "but its first argument is not labelled"
-        |  l -> sprintf "but its first argument is labelled %s"
-          (prefixed_label_name l) in
+        | Nolabel -> "but its first argument is not labelled"
+        | l -> sprintf "but its first argument is labelled %s" (prefixed_label_name l) in
       reset_and_mark_loops ty;
       fprintf ppf "@[<v>@[<2>This function should have type@ %a@]@,%s@]"
       type_expr ty (label_mark l)
diff --git a/typing/typecore.mli b/typing/typecore.mli
index 34886b9ed..f792db11f 100644
--- a/typing/typecore.mli
+++ b/typing/typecore.mli
@@ -31,7 +31,7 @@ val type_let:
 val type_expression:
         Env.t -> Parsetree.expression -> Typedtree.expression
 val type_class_arg_pattern:
-        string -> Env.t -> Env.t -> label -> Parsetree.pattern ->
+        string -> Env.t -> Env.t -> arg_label -> Parsetree.pattern ->
         Typedtree.pattern * (Ident.t * string loc * Ident.t * type_expr) list *
         Env.t * Env.t
 val type_self_pattern:
@@ -72,7 +72,7 @@ type error =
   | Orpat_vars of Ident.t * Ident.t list
   | Expr_type_clash of (type_expr * type_expr) list
   | Apply_non_function of type_expr
-  | Apply_wrong_label of label * type_expr
+  | Apply_wrong_label of arg_label * type_expr
   | Label_multiply_defined of string
   | Label_missing of Ident.t list
   | Label_not_mutable of Longident.t
@@ -93,7 +93,7 @@ type error =
   | Coercion_failure of
       type_expr * type_expr * (type_expr * type_expr) list * bool
   | Too_many_arguments of bool * type_expr
-  | Abstract_wrong_label of label * type_expr
+  | Abstract_wrong_label of arg_label * type_expr
   | Scoping_let_module of string * type_expr
   | Masked_instance_variable of Longident.t
   | Not_a_variant_type of Longident.t
diff --git a/typing/typedtree.ml b/typing/typedtree.ml
index 49531687d..9483449c0 100644
--- a/typing/typedtree.ml
+++ b/typing/typedtree.ml
@@ -74,8 +74,8 @@ and expression_desc =
     Texp_ident of Path.t * Longident.t loc * Types.value_description
   | Texp_constant of constant
   | Texp_let of rec_flag * value_binding list * expression
-  | Texp_function of label * case list * partial
-  | Texp_apply of expression * (label * expression option * optional) list
+  | Texp_function of arg_label * case list * partial
+  | Texp_apply of expression * (arg_label * expression option * optional) list
   | Texp_match of expression * case list * case list * partial
   | Texp_try of expression * case list
   | Texp_tuple of expression list
@@ -132,9 +132,9 @@ and class_expr_desc =
     Tcl_ident of Path.t * Longident.t loc * core_type list
   | Tcl_structure of class_structure
   | Tcl_fun of
-      label * pattern * (Ident.t * string loc * expression) list * class_expr *
+      arg_label * pattern * (Ident.t * string loc * expression) list * class_expr *
         partial
-  | Tcl_apply of class_expr * (label * expression option * optional) list
+  | Tcl_apply of class_expr * (arg_label * expression option * optional) list
   | Tcl_let of rec_flag * value_binding list *
                   (Ident.t * string loc * expression) list * class_expr
   | Tcl_constraint of
@@ -353,7 +353,7 @@ and core_type =
 and core_type_desc =
     Ttyp_any
   | Ttyp_var of string
-  | Ttyp_arrow of label * core_type * core_type
+  | Ttyp_arrow of arg_label * core_type * core_type
   | Ttyp_tuple of core_type list
   | Ttyp_constr of Path.t * Longident.t loc * core_type list
   | Ttyp_object of (string * attributes * core_type) list * closed_flag
@@ -463,7 +463,7 @@ and class_type =
 and class_type_desc =
     Tcty_constr of Path.t * Longident.t loc * core_type list
   | Tcty_signature of class_signature
-  | Tcty_arrow of label * core_type * class_type
+  | Tcty_arrow of arg_label * core_type * class_type
 
 and class_signature = {
     csig_self : core_type;
diff --git a/typing/typedtree.mli b/typing/typedtree.mli
index a1de51781..4f0e32ce9 100644
--- a/typing/typedtree.mli
+++ b/typing/typedtree.mli
@@ -73,8 +73,8 @@ and expression_desc =
     Texp_ident of Path.t * Longident.t loc * Types.value_description
   | Texp_constant of constant
   | Texp_let of rec_flag * value_binding list * expression
-  | Texp_function of label * case list * partial
-  | Texp_apply of expression * (label * expression option * optional) list
+  | Texp_function of arg_label * case list * partial
+  | Texp_apply of expression * (arg_label * expression option * optional) list
   | Texp_match of expression * case list * case list * partial
   | Texp_try of expression * case list
   | Texp_tuple of expression list
@@ -131,9 +131,9 @@ and class_expr_desc =
     Tcl_ident of Path.t * Longident.t loc * core_type list
   | Tcl_structure of class_structure
   | Tcl_fun of
-      label * pattern * (Ident.t * string loc * expression) list * class_expr *
+      arg_label * pattern * (Ident.t * string loc * expression) list * class_expr *
         partial
-  | Tcl_apply of class_expr * (label * expression option * optional) list
+  | Tcl_apply of class_expr * (arg_label * expression option * optional) list
   | Tcl_let of rec_flag * value_binding list *
                   (Ident.t * string loc * expression) list * class_expr
   | Tcl_constraint of
@@ -351,7 +351,7 @@ and core_type =
 and core_type_desc =
     Ttyp_any
   | Ttyp_var of string
-  | Ttyp_arrow of label * core_type * core_type
+  | Ttyp_arrow of arg_label * core_type * core_type
   | Ttyp_tuple of core_type list
   | Ttyp_constr of Path.t * Longident.t loc * core_type list
   | Ttyp_object of (string * attributes * core_type) list * closed_flag
@@ -462,7 +462,7 @@ and class_type =
 and class_type_desc =
     Tcty_constr of Path.t * Longident.t loc * core_type list
   | Tcty_signature of class_signature
-  | Tcty_arrow of label * core_type * class_type
+  | Tcty_arrow of arg_label * core_type * class_type
 
 and class_signature = {
     csig_self : core_type;
diff --git a/typing/types.ml b/typing/types.ml
index 1aff7356f..66ef2b795 100644
--- a/typing/types.ml
+++ b/typing/types.ml
@@ -23,7 +23,7 @@ type type_expr =
 
 and type_desc =
     Tvar of string option
-  | Tarrow of label * type_expr * type_expr * commutable
+  | Tarrow of arg_label * type_expr * type_expr * commutable
   | Ttuple of type_expr list
   | Tconstr of Path.t * type_expr list * abbrev_memo ref
   | Tobject of type_expr * (Path.t * type_expr list) option ref
@@ -202,7 +202,7 @@ module Concr = Set.Make(OrderedString)
 type class_type =
     Cty_constr of Path.t * type_expr list * class_type
   | Cty_signature of class_signature
-  | Cty_arrow of label * type_expr * class_type
+  | Cty_arrow of arg_label * type_expr * class_type
 
 and class_signature =
   { csig_self: type_expr;
diff --git a/typing/types.mli b/typing/types.mli
index 0438f897b..38b990274 100644
--- a/typing/types.mli
+++ b/typing/types.mli
@@ -23,7 +23,7 @@ type type_expr =
 
 and type_desc =
     Tvar of string option
-  | Tarrow of label * type_expr * type_expr * commutable
+  | Tarrow of arg_label * type_expr * type_expr * commutable
   | Ttuple of type_expr list
   | Tconstr of Path.t * type_expr list * abbrev_memo ref
   | Tobject of type_expr * (Path.t * type_expr list) option ref
@@ -192,7 +192,7 @@ module Concr : Set.S with type elt = string
 type class_type =
     Cty_constr of Path.t * type_expr list * class_type
   | Cty_signature of class_signature
-  | Cty_arrow of label * type_expr * class_type
+  | Cty_arrow of arg_label * type_expr * class_type
 
 and class_signature =
   { csig_self: type_expr;