Pun labelled arguments with type constraint in function applications (#…

…10434) Accept labelled argument punning with type constraint in pexp_apply For example, function application of the form "foo ~(x:int)" instead of the explicit "foo ~x:(x:int)".
ocaml · Jun 23, 2021 · ec880ee · ec880ee
1 parent b3d44c3
commit ec880ee
Show file tree

Hide file tree

Showing 6 changed files with 2,976 additions and 2,840 deletions.
diff --git a/Changes b/Changes
@@ -29,6 +29,9 @@ Working version
   64-bit floats in Cmm.memory_chunk.
   (Greta Yorsh, review by Xavier Leroy)
 
+- #10434: Pun labelled arguments with type constraint in function applications.
+  (Greta Yorsh, review by Nicolas Chataing and Nicolás Ojeda Bär)
+
 ### Build system:
 
 ### Bug fixes:

diff --git a/boot/menhir/parser.ml b/boot/menhir/parser.ml
diff --git a/parsing/parser.mly b/parsing/parser.mly
@@ -2467,6 +2467,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) }

diff --git a/testsuite/tests/parsetree/locations_test.compilers.reference b/testsuite/tests/parsetree/locations_test.compilers.reference
@@ -1308,4 +1308,64 @@ Ptop_def
   ]
 
 - : < f : int > = <obj>
+Ptop_def
+  [
+    structure_item (//toplevel//[3,66+0]..[5,98+12])
+      Pstr_value Nonrec
+      [
+        <def>
+          pattern (//toplevel//[3,66+4]..[3,66+5])
+            Ppat_var "g" (//toplevel//[3,66+4]..[3,66+5])
+          expression (//toplevel//[3,66+6]..[5,98+12]) ghost
+            Pexp_fun
+            Nolabel
+            None
+            pattern (//toplevel//[3,66+6]..[3,66+7])
+              Ppat_var "y" (//toplevel//[3,66+6]..[3,66+7])
+            expression (//toplevel//[4,76+2]..[5,98+12])
+              Pexp_let Nonrec
+              [
+                <def>
+                  pattern (//toplevel//[4,76+6]..[4,76+7])
+                    Ppat_var "f" (//toplevel//[4,76+6]..[4,76+7])
+                  expression (//toplevel//[4,76+8]..[4,76+18]) ghost
+                    Pexp_fun
+                    Labelled "y"
+                    None
+                    pattern (//toplevel//[4,76+9]..[4,76+10])
+                      Ppat_var "y" (//toplevel//[4,76+9]..[4,76+10])
+                    expression (//toplevel//[4,76+13]..[4,76+18])
+                      Pexp_apply
+                      expression (//toplevel//[4,76+15]..[4,76+16])
+                        Pexp_ident "+" (//toplevel//[4,76+15]..[4,76+16])
+                      [
+                        <arg>
+                        Nolabel
+                          expression (//toplevel//[4,76+13]..[4,76+14])
+                            Pexp_ident "y" (//toplevel//[4,76+13]..[4,76+14])
+                        <arg>
+                        Nolabel
+                          expression (//toplevel//[4,76+17]..[4,76+18])
+                            Pexp_constant PConst_int (1,None)
+                      ]
+              ]
+              expression (//toplevel//[5,98+2]..[5,98+12])
+                Pexp_apply
+                expression (//toplevel//[5,98+2]..[5,98+3])
+                  Pexp_ident "f" (//toplevel//[5,98+2]..[5,98+3])
+                [
+                  <arg>
+                  Labelled "y"
+                    expression (//toplevel//[5,98+5]..[5,98+12]) ghost
+                      Pexp_constraint
+                      expression (//toplevel//[5,98+6]..[5,98+7])
+                        Pexp_ident "y" (//toplevel//[5,98+6]..[5,98+7])
+                      core_type (//toplevel//[5,98+8]..[5,98+11])
+                        Ptyp_constr "int" (//toplevel//[5,98+8]..[5,98+11])
+                        []
+                ]
+      ]
+  ]
+
+val g : int -> int = <fun>
 
diff --git a/testsuite/tests/parsetree/locations_test.ml b/testsuite/tests/parsetree/locations_test.ml
@@ -122,3 +122,9 @@ f object method f = 1 end
   object method f = 1 end # f
   object end
 ;;
+
+(* Punning of labelled function argument with type constraint *)
+let g y =
+  let f ~y = y + 1 in
+  f ~(y:int)
+;;
diff --git a/testsuite/tests/parsetree/source.ml b/testsuite/tests/parsetree/source.ml
@@ -7436,4 +7436,8 @@ let f x y z = x in
 f object method f = 1 end
   object method f = 1 end # f
   object end
-;;
+
+(* Punning of labelled function argument with type constraint *)
+let g y =
+  let f ~y = y + 1 in
+  f ~(y:int)