implement syntax for arity zero vs arity one in uncurried application (#139)

* implement syntax for arity zero vs arity one in uncurried application

Since there is no syntax space for arity zero vs arity one,
we parse
  `fn(. ())` into
  `fn(. {let __res_unit = (); __res_unit})`
  when the parsetree is intended for type checking

`fn(.)` is treated as zero arity application

* add CHANGELOG entry

Author: IwanKaramazow

CHANGELOG.md

@@ -1,5 +1,6 @@
 ## Unreleased
 
+* Implement syntax for arity zero vs arity one in uncurried application in [#139](https://github.com/rescript-lang/syntax/pull/139)
 * Fix parsing of first class module exprs as part of binary/ternary expr in [#256](https://github.com/rescript-lang/syntax/pull/256)
 
 ## ReScript 9.0.0

src/res_ast_conversion.ml

@@ -318,6 +318,11 @@ let stringLiteralMapper stringData =
     )
   }
 
+let hasUncurriedAttribute attrs = List.exists (fun attr -> match attr with
+  | ({Asttypes.txt = "bs"}, Parsetree.PStr []) -> true
+  | _ -> false
+) attrs
+
 let normalize =
   let open Ast_mapper in
   { default_mapper with
@@ -394,6 +399,21 @@ let normalize =
           pexp_attributes = mapper.attributes mapper expr.pexp_attributes;
           pexp_desc = Pexp_constant s
         }
+      | Pexp_apply (
+          callExpr,
+          [
+            Nolabel,
+            ({pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, None); pexp_attributes = []} as unitExpr)
+          ]
+        ) when hasUncurriedAttribute expr.pexp_attributes
+        ->
+        {expr with
+          pexp_attributes = mapper.attributes mapper expr.pexp_attributes;
+          pexp_desc = Pexp_apply (
+            callExpr,
+            [Nolabel, {unitExpr with pexp_loc = {unitExpr.pexp_loc with loc_ghost = true}}]
+          )
+        }
       | Pexp_function cases ->
         let loc = match (cases, List.rev cases) with
         | (first::_), (last::_) ->

src/res_core.ml

@@ -3385,14 +3385,13 @@ and parseArgument p =
     match p.Parser.token with
     | Dot ->
       let uncurried = true in
-      let startPos = p.Parser.startPos in
       Parser.next(p);
       begin match p.token with
         (* apply(.) *)
         | Rparen ->
-          let loc = mkLoc startPos p.prevEndPos in
-          let unitExpr = Ast_helper.Exp.construct ~loc
-            (Location.mkloc (Longident.Lident "()") loc) None
+          let unitExpr = Ast_helper.Exp.construct
+            (Location.mknoloc (Longident.Lident "()"))
+            None
           in
           Some (uncurried, Asttypes.Nolabel, unitExpr)
         | _ ->
@@ -3486,6 +3485,37 @@ and parseCallExpr p funExpr =
       Ast_helper.Exp.construct
         ~loc (Location.mkloc (Longident.Lident "()") loc) None
     ]
+  | [
+      true,
+      Asttypes.Nolabel,
+      ({
+        pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, None);
+        pexp_loc = loc;
+        pexp_attributes = []
+      } as expr)
+    ] when (not loc.loc_ghost) && p.mode = ParseForTypeChecker ->
+      (*  Since there is no syntax space for arity zero vs arity one,
+       *  we expand
+       *    `fn(. ())` into
+       *    `fn(. {let __res_unit = (); __res_unit})`
+       *  when the parsetree is intended for type checking
+       *
+       *  Note:
+       *    `fn(.)` is treated as zero arity application.
+       *  The invisible unit expression here has loc_ghost === true
+       *
+       *  Related: https://github.com/rescript-lang/syntax/issues/138
+       *)
+   [
+     true,
+     Asttypes.Nolabel,
+     Ast_helper.Exp.let_
+      Asttypes.Nonrecursive
+      [Ast_helper.Vb.mk
+        (Ast_helper.Pat.var (Location.mknoloc "__res_unit"))
+        expr]
+      (Ast_helper.Exp.ident (Location.mknoloc (Longident.Lident "__res_unit")))
+   ]
   | args -> args
   in
   let loc = {funExpr.pexp_loc with loc_end = p.prevEndPos} in

src/res_printer.ml

@@ -4248,8 +4248,15 @@ and printArgumentsWithCallbackInLastPosition ~uncurried args cmtTbl =
 
 and printArguments ~uncurried (args : (Asttypes.arg_label * Parsetree.expression) list) cmtTbl =
   match args with
-  | [Nolabel, {pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _)}] ->
-    if uncurried then Doc.text "(.)" else Doc.text "()"
+  | [Nolabel, {pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _); pexp_loc = loc}] ->
+    (* See "parseCallExpr", ghost unit expression is used the implement
+     * arity zero vs arity one syntax.
+     * Related: https://github.com/rescript-lang/syntax/issues/138 *)
+    begin match uncurried, loc.loc_ghost with
+    | true, true -> Doc.text "(.)" (* arity zero *)
+    | true, false -> Doc.text "(. ())" (* arity one *)
+    | _ -> Doc.text "()"
+    end
   | [(Nolabel, arg)] when ParsetreeViewer.isHuggableExpression arg ->
     let argDoc =
       let doc = printExpressionWithComments arg cmtTbl in

tests/parsing/grammar/expressions/argument.res

@@ -7,3 +7,7 @@ callback(. firstNode, ~y)
 document.createElementWithOptions(. "div", elementProps(~onClick=_ =>
     Js.log("hello world")
   ))
+
+
+resolve(.)
+resolve(. ())

tests/parsing/grammar/expressions/expected/argument.res.txt

@@ -1,4 +1,5 @@
-let foo ~a:((a)[@ns.namedArgLoc ])  = ((a ())[@bs ]) +. 1.
+let foo ~a:((a)[@ns.namedArgLoc ])  =
+  ((a (let __res_unit = () in __res_unit))[@bs ]) +. 1.
 let a = ((fun () -> 2)[@bs ])
 let bar = foo ~a:((a)[@ns.namedArgLoc ])
 let comparisonResult =
@@ -7,4 +8,6 @@ let comparisonResult =
 ;;((callback firstNode ~y:((y)[@ns.namedArgLoc ]))[@bs ])
 ;;((document.createElementWithOptions "div"
       (elementProps ~onClick:((fun _ -> Js.log "hello world")
-         [@ns.namedArgLoc ])))[@bs ])
+         [@ns.namedArgLoc ])))[@bs ])
+;;((resolve ())[@bs ])
+;;((resolve (let __res_unit = () in __res_unit))[@bs ])

tests/printer/expr/apply.res

@@ -70,3 +70,6 @@ f(. {
   exception Exit
   raise(Exit)
 })
+
+resolve(.)
+resolve(. ())

tests/printer/expr/expected/apply.res.txt

@@ -90,3 +90,6 @@ f(. {
   exception Exit
   raise(Exit)
 })
+
+resolve(.)
+resolve(. ())