Handle punned labelled arguments with type constraint in function app…

…lications (ocaml#10434) (#1756)

Update the parser with ocaml/ocaml#10434

Accept labelled argument punning with type constraint in pexp_apply

For example, function application of the form ~(x:int) instead of the explicit ~x:(x:int).

CHANGES.md

@@ -22,6 +22,9 @@
 
   + Handle merlin typed holes (#1698, @gpetiot)
 
+  + Handle punned labelled arguments with type constraint in function applications.
+    For example, function application of the form `foo ~(x:int)` instead of the explicit `foo ~x:(x:int)`. (ocaml#10434) (#1756, @gpetiot)
+
 ### 0.19.0 (2021-07-16)
 
 #### Bug fixes

lib/Fmt_ast.ml

@@ -1350,6 +1350,16 @@ and fmt_label_arg ?(box = true) ?epi ?parens ?eol c
   | (Labelled l | Optional l), Pexp_ident {txt= Lident i; loc}
     when String.equal l i && List.is_empty arg.pexp_attributes ->
       Cmts.fmt c loc @@ Cmts.fmt c ?eol arg.pexp_loc @@ fmt_label lbl ""
+  | ( (Labelled l | Optional l)
+    , Pexp_constraint ({pexp_desc= Pexp_ident {txt= Lident i; _}; _}, _) )
+    when String.equal l i && List.is_empty arg.pexp_attributes ->
+      let lbl =
+        match lbl with
+        | Labelled _ -> str "~"
+        | Optional _ -> str "?"
+        | Nolabel -> noop
+      in
+      lbl $ fmt_expression c ~box ?epi ?parens xarg
   | _ -> fmt_label lbl ":@," $ fmt_expression c ~box ?epi ?parens xarg
 
 and expression_width c xe =

test/passing/tests/apply.ml

@@ -83,3 +83,7 @@ let _ =
     (loooooooooooong looooooooooooooong loooooooooooooong
        [loooooooooong; loooooooooooong; loooooooooooooooooooooong]
     )
+
+let _ =
+  let f ~y = y + 1 in
+  f ~(y : int)

vendor/ocaml-4.13/parser.mly

@@ -2474,6 +2474,9 @@ labeled_simple_expr:
   | TILDE label = LIDENT
       { let loc = $loc(label) in
         (Labelled label, mkexpvar ~loc label) }
+  | TILDE LPAREN label = LIDENT ty = type_constraint RPAREN
+      { (Labelled label, mkexp_constraint ~loc:($startpos($2), $endpos)
+                           (mkexpvar ~loc:$loc(label) label) ty) }
   | QUESTION label = LIDENT
       { let loc = $loc(label) in
         (Optional label, mkexpvar ~loc label) }

vendor/parse-wyc/lib/parser.mly

@@ -2464,6 +2464,9 @@ labeled_simple_expr:
   | TILDE label = LIDENT
       { let loc = $loc(label) in
         (Labelled label, mkexpvar ~loc label) }
+  | TILDE LPAREN label = LIDENT ty = type_constraint RPAREN
+      { (Labelled label, mkexp_constraint ~loc:($startpos($2), $endpos)
+                           (mkexpvar ~loc:$loc(label) label) ty) }
   | QUESTION label = LIDENT
       { let loc = $loc(label) in
         (Optional label, mkexpvar ~loc label) }