Cleanup uncurried (#6080)

* Clean up uncurried: uncurried.swap and config

Rename `@@uncurried` to `@@uncurried.swap` so relegating it to tests only.
Also simplify the setting in bsconfig, which now takes just a boolean.

* Remove @toUncurried, which is not essential.

* Update CHANGELOG.md

* Rename `@@uncurried.always` to simply `@@uncurried`.

* Move all the uncurried config to module Config.

The Config module is used by the compiler, so the `uncurried` setting needs to be reset on each file as tests compile several files on a single command line (actual project builds don't).

* Update CHANGELOG.md

* Clean up isSwap

Author: cristianoc

CHANGELOG.md

@@ -14,8 +14,8 @@
 
 #### :rocket: New Feature
 
-- Introduce experimental uncurried by default mode. Can be turned on mid-file by adding standalone annotation `@@uncurried`. For experimentation only. https://github.com/rescript-lang/rescript-compiler/pull/5796
-- Adding `@@toUncurried` to the file and reformat will convert to uncurried syntax https://github.com/rescript-lang/rescript-compiler/pull/5800
+- Introduce experimental uncurried by default mode. Can be turned on mid-file by adding standalone annotation `@@uncurried.swap`. For experimentation only. https://github.com/rescript-lang/rescript-compiler/pull/5796
+- ~Adding `@@toUncurried` to the file and reformat will convert to uncurried syntax https://github.com/rescript-lang/rescript-compiler/pull/5800~
 - Add support for unary uncurried pipe in uncurried mode https://github.com/rescript-lang/rescript-compiler/pull/5804
 - Add support for partial application of uncurried functions: with uncurried application one can provide a
 subset of the arguments, and return a curried type with the remaining ones https://github.com/rescript-lang/rescript-compiler/pull/5805
@@ -24,10 +24,10 @@ subset of the arguments, and return a curried type with the remaining ones https
 - Add support for default arguments in uncurried functions https://github.com/rescript-lang/rescript-compiler/pull/5835
 - Inline uncurried application when it is safe https://github.com/rescript-lang/rescript-compiler/pull/5847
 - Support optional named arguments without a final unit in uncurried functions https://github.com/rescript-lang/rescript-compiler/pull/5907
-- Add support for uncurried-always: a mode where everything is considered uncurried, whether with or without the `.`. This can be turned on with `@@uncurriedAlways` locally in a file. Added a project config `"uncurried"`, which propagates to dependencies, and takes the values: `"legacy"` which changes nothing, or `"default"` for uncurried by default, or `"always"` for uncurried-always.
+- Add support for uncurried mode: a mode where everything is considered uncurried, whether with or without the `.`. This can be turned on with `@@uncurried` locally in a file. For project-level configuration in `bsconfig.json`, there's a boolean config `"uncurried"`, which propagates to dependencies, to turn on uncurried mode.
 Since there's no syntax for partial application in this new mode, introduce `@res.partial foo(x)` to express partial application. This is temporary and will later have some surface syntax.
 Use best effort to determine the config when formatting a file.
-https://github.com/rescript-lang/rescript-compiler/pull/5968
+https://github.com/rescript-lang/rescript-compiler/pull/5968 https://github.com/rescript-lang/rescript-compiler/pull/6080
 
 #### :boom: Breaking Change
 

docs/docson/build-schema.json

@@ -359,10 +359,6 @@
       "additionalProperties": false,
       "required": ["version"]
     },
-    "uncurried-specs": {
-      "type": "string",
-      "enum": ["legacy", "default", "always"]
-    },
     "bsc-flags": {
       "oneOf": [
         {
@@ -445,7 +441,7 @@
       "description": "Configuration for the JSX transformation."
     },
     "uncurried": {
-      "$ref": "#/definitions/uncurried-specs",
+      "type": "boolean",
       "description": "Configuration for the uncurried mode."
     },
     "reason": {

jscomp/bsb/bsb_config_parse.ml

@@ -95,14 +95,13 @@ let extract_gentype_config (map : json_map) : Bsb_config_types.gentype_config =
   | Some config ->
       Bsb_exception.config_error config "gentypeconfig expect an object"
 
-let extract_uncurried (map : json_map) : Res_uncurried.config =
+let extract_uncurried (map : json_map) : bool =
   match map.?(Bsb_build_schemas.uncurried) with
-  | None -> Legacy
-  | Some (Str { str = "legacy" }) -> Legacy
-  | Some (Str { str = "default" }) -> Default
-  | Some (Str { str = "always" }) -> Always
+  | None -> false
+  | Some (True _) -> true
+  | Some (False _) -> false
   | Some config ->
-      Bsb_exception.config_error config "uncurried expects one of: \"legacy\", \"default\", \"always\"."
+      Bsb_exception.config_error config "uncurried expects one of: true, false."
 
 let extract_string (map : json_map) (field : string) cb =
   match map.?(field) with

jscomp/bsb/bsb_config_parse.mli

@@ -22,7 +22,7 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-val deps_from_bsconfig : unit -> Bsb_package_specs.t * Bsb_jsx.t * Res_uncurried.config *  Set_string.t
+val deps_from_bsconfig : unit -> Bsb_package_specs.t * Bsb_jsx.t * bool *  Set_string.t
 
 val interpret_json :
   package_kind:Bsb_package_kind.t -> per_proj_dir:string -> Bsb_config_types.t

jscomp/bsb/bsb_config_types.ml

@@ -64,5 +64,5 @@ type t = {
   cut_generators : bool;
   (* note when used as a dev mode, we will always ignore it *)
   gentype_config : gentype_config;
-  uncurried: Res_uncurried.config;
+  uncurried: bool;
 }

jscomp/bsb/bsb_ninja_rule.ml

@@ -91,7 +91,7 @@ let make_custom_rules ~(gentype_config : Bsb_config_types.gentype_config)
     ~(has_postbuild : string option) ~(pp_file : string option)
     ~(has_builtin : bool)
     ~(reason_react_jsx : Bsb_config_types.reason_react_jsx option)
-    ~(jsx : Bsb_jsx.t) ~(uncurried: Res_uncurried.config)  ~(digest : string) ~(package_specs : Bsb_package_specs.t)
+    ~(jsx : Bsb_jsx.t) ~(uncurried: bool)  ~(digest : string) ~(package_specs : Bsb_package_specs.t)
     ~(namespace : string option) ~package_name ~warnings
     ~(ppx_files : Bsb_config_types.ppx list) ~bsc_flags ~(dpkg_incls : string)
     ~(lib_incls : string) ~(dev_incls : string) ~bs_dependencies
@@ -102,10 +102,8 @@ let make_custom_rules ~(gentype_config : Bsb_config_types.gentype_config)
       since the default is already good -- it does not*)
   let buf = Ext_buffer.create 100 in
   let ns_flag = match namespace with None -> "" | Some n -> " -bs-ns " ^ n in
-  let add_uncurried_flag = function
-    | Res_uncurried.Legacy -> ()
-    | Default -> Ext_buffer.add_string buf " -uncurried default"
-    | Always -> Ext_buffer.add_string buf " -uncurried always" in
+  let add_uncurried_flag b =
+    if b then Ext_buffer.add_string buf " -uncurried" in
   let mk_ml_cmj_cmd ~(read_cmi : [ `yes | `is_cmi | `no ]) ~is_dev ~postbuild :
       string =
     Ext_buffer.clear buf;

jscomp/bsb/bsb_ninja_rule.mli

@@ -72,7 +72,7 @@ val make_custom_rules :
   has_builtin:bool ->
   reason_react_jsx:Bsb_config_types.reason_react_jsx option ->
   jsx:Bsb_jsx.t ->
-  uncurried:Res_uncurried.config ->
+  uncurried:bool ->
   digest:string ->
   package_specs:Bsb_package_specs.t ->
   namespace:string option ->

jscomp/bsb/bsb_package_kind.ml

@@ -22,7 +22,7 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-type dep_payload = { package_specs : Bsb_package_specs.t; jsx : Bsb_jsx.t; uncurried : Res_uncurried.config }
+type dep_payload = { package_specs : Bsb_package_specs.t; jsx : Bsb_jsx.t; uncurried : bool }
 
 type t =
   | Toplevel

jscomp/bsc/rescript_compiler_main.ml

@@ -51,11 +51,12 @@ let process_file sourcefile ?(kind ) ppf =
      The {!Location.input_name} relies on that we write the binary ast 
      properly
   *)
+  let uncurried = !Config.uncurried in
   let kind =
     match kind with 
     | None -> Ext_file_extensions.classify_input (Ext_filename.get_extension_maybe sourcefile)  
     | Some kind -> kind in 
-  match kind with 
+  let res = match kind with 
   | Ml ->
     let sourcefile = set_abs_input_name  sourcefile in     
     setup_compiler_printer `ml;
@@ -103,6 +104,9 @@ let process_file sourcefile ?(kind ) ppf =
     Format.pp_print_newline Format.std_formatter ()      
   | Unknown -> 
     Bsc_args.bad_arg ("don't know what to do with " ^ sourcefile)
+  in
+  Config.uncurried := uncurried;
+  res
 let usage = "Usage: bsc <options> <files>\nOptions are:"
 
 let ppf = Format.err_formatter
@@ -406,13 +410,7 @@ let buckle_script_flags : (string * Bsc_args.spec * string) array =
 
     "-nopervasives", set Clflags.nopervasives, 
     "*internal*";
-    "-uncurried", string_call (fun i ->
-      match i with
-      | "default" -> Res_uncurried.init := Default
-      | "always" -> Res_uncurried.init := Always; Config.use_automatic_curried_application := true
-      | "legacy" -> Res_uncurried.init := Legacy
-      | _ -> Bsc_args.bad_arg (" Not supported -uncurried option : " ^ i)
-  ),
+    "-uncurried", unit_call (fun () -> Config.uncurried := Uncurried),
     "*internal* Set jsx module";
     "-v", unit_call print_version_string,
     "Print compiler version and location of standard library and exit";  

jscomp/build_tests/uncurried-always/bsconfig.json

@@ -5,5 +5,5 @@
     "dir" : "src",
     "subdirs" : true
   },
-  "uncurried": "always"
+  "uncurried": true
 }

jscomp/core/res_compmisc.ml

@@ -46,7 +46,7 @@ let initial_env () =
   let initial = Env.initial_safe_string in
   let env =
     if !Clflags.nopervasives then initial
-    else open_implicit_module (if !Config.use_automatic_curried_application then "PervasivesU" else "Pervasives") initial
+    else open_implicit_module (if !Config.uncurried = Uncurried then "PervasivesU" else "Pervasives") initial
   in
   List.fold_left
     (fun env m -> open_implicit_module m env)

jscomp/ext/config.ml

@@ -13,7 +13,8 @@ let bs_only = ref true
 
 let unsafe_empty_array = ref false
 
-let use_automatic_curried_application = ref false
+type uncurried = Legacy | Uncurried | Swap
+let uncurried = ref Legacy
 
 and cmi_magic_number = "Caml1999I022"
 

jscomp/ext/config.mli

@@ -47,4 +47,5 @@ val cmt_magic_number : string
 
 val print_config : out_channel -> unit
 
-val use_automatic_curried_application : bool ref
+type uncurried = Legacy | Uncurried | Swap
+val uncurried : uncurried ref

jscomp/frontend/ast_config.ml

@@ -44,7 +44,7 @@ let process_directives str =
   | Pstr_attribute ({ txt = "directive" },
       PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_constant (Pconst_string (d, _)) }, _) } ]) ->
       Js_config.directives := !Js_config.directives @ [d]
-  | Pstr_attribute ({txt = "uncurriedAlways"}, _) -> Config.use_automatic_curried_application := true
+  | Pstr_attribute ({txt = "uncurried"}, _) -> Config.uncurried := Uncurried
   | _ -> ())
 
 let rec iter_on_bs_config_str (x : Parsetree.structure) =

jscomp/ml/ctype.ml

@@ -2341,7 +2341,7 @@ let rec unify (env:Env.t ref) t1 t2 =
         with Cannot_expand ->
           unify2 env t1 t2
         end
-    | (Tconstr (Pident {name="function$"}, [tFun; _], _), Tarrow _) when !Config.use_automatic_curried_application ->
+    | (Tconstr (Pident {name="function$"}, [tFun; _], _), Tarrow _) when !Config.uncurried = Uncurried ->
         (* subtype: an uncurried function is cast to a curried one *)
         unify2 env tFun t2
     | _ ->

jscomp/ml/typecore.ml

@@ -2980,7 +2980,7 @@ and type_argument ?recarg env sarg ty_expected' ty_expected =
       texp
 and is_automatic_curried_application env funct =
   (* When a curried function is used with uncurried application, treat it as a curried application *)
-  !Config.use_automatic_curried_application &&
+  !Config.uncurried = Uncurried &&
   match (expand_head env funct.exp_type).desc with
   | Tarrow _ -> true
   | _ -> false

jscomp/stdlib-406/pervasivesU.res

@@ -13,7 +13,7 @@
 /*  */
 /* ************************************************************************ */
 
-@@uncurriedAlways
+@@uncurried
 
 /* Internal */
 external __unsafe_cast: 'a => 'b = "%identity"

jscomp/stdlib-406/pervasivesU.resi

@@ -13,7 +13,7 @@
 /*  */
 /* ************************************************************************ */
 
-@@uncurriedAlways
+@@uncurried
 
 " The initially opened module.
 

jscomp/test/UncurriedAlways.res

@@ -1,4 +1,4 @@
-@@uncurriedAlways
+@@uncurried
 
 let foo = (x, y) => x + y
 

jscomp/test/UncurriedExternals.res

@@ -39,7 +39,7 @@ module StandardNotation = {
   let (get, set) = useState(() => 3)
 }
 
-@@uncurried
+@@uncurried.swap
 
 external raise: exn => 'a = "%raise"
 let dd = (. ()) => raise(Not_found)

jscomp/test/UncurriedPervasives.res

@@ -1,2 +1,2 @@
-@@uncurriedAlways
+@@uncurried
 let n : _ => unit = ignore // Check that we're pulling in uncurried pervasives

jscomp/test/async_await.res

@@ -1,4 +1,4 @@
-@@uncurried
+@@uncurried.swap
 
 let next = n => n + 1
 let useNext = async () => next(3)

jscomp/test/uncurried_cast.res

@@ -23,7 +23,7 @@ module StandardNotation = {
   let anInt = still2Args(~z=3)(. 5)
 }
 
-@@uncurried
+@@uncurried.swap
 
 open Uncurried
 

jscomp/test/uncurried_default.args.res

@@ -14,7 +14,7 @@ module StandardNotation = {
   let r3 = foo3(. )
 }
 
-@@uncurried
+@@uncurried.swap
 
 open StandardNotation
 

jscomp/test/uncurried_pipe.res

@@ -10,7 +10,7 @@ module StandardNotation = {
   let unary = (. x) => x + 1
 }
 
-@@uncurried
+@@uncurried.swap
 
 open StandardNotation
 

res_syntax/src/res_core.ml

@@ -386,7 +386,7 @@ let buildLongident words =
 let makeInfixOperator (p : Parser.t) token startPos endPos =
   let stringifiedToken =
     if token = Token.MinusGreater then
-      if p.uncurried_config |> Res_uncurried.isDefault then "|.u" else "|."
+      if p.uncurried_config = Legacy then "|." else "|.u"
     else if token = Token.PlusPlus then "^"
     else if token = Token.BangEqual then "<>"
     else if token = Token.BangEqualEqual then "!="
@@ -1558,8 +1558,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context
     | TermParameter {dotted} :: _
       when p.uncurried_config |> Res_uncurried.fromDotted ~dotted && isFun ->
       true
-    | TermParameter _ :: rest
-      when (not (p.uncurried_config |> Res_uncurried.isDefault)) && isFun ->
+    | TermParameter _ :: rest when p.uncurried_config = Legacy && isFun ->
       rest
       |> List.exists (function
            | TermParameter {dotted} -> dotted
@@ -1594,11 +1593,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context
           let uncurried =
             p.uncurried_config |> Res_uncurried.fromDotted ~dotted
           in
-          if
-            uncurried
-            && (termParamNum = 1
-               || not (p.uncurried_config |> Res_uncurried.isDefault))
-          then
+          if uncurried && (termParamNum = 1 || p.uncurried_config = Legacy) then
             (termParamNum - 1, Ast_uncurried.uncurriedFun ~loc ~arity funExpr, 1)
           else (termParamNum - 1, funExpr, arity + 1)
         | TypeParameter {dotted = _; attrs; locs = newtypes; pos = startPos} ->
@@ -3922,9 +3917,8 @@ and parsePolyTypeExpr p =
         let returnType = parseTypExpr ~alias:false p in
         let loc = mkLoc typ.Parsetree.ptyp_loc.loc_start p.prevEndPos in
         let tFun = Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ returnType in
-        if p.uncurried_config |> Res_uncurried.isDefault then
-          Ast_uncurried.uncurriedType ~loc ~arity:1 tFun
-        else tFun
+        if p.uncurried_config = Legacy then tFun
+        else Ast_uncurried.uncurriedType ~loc ~arity:1 tFun
       | _ -> Ast_helper.Typ.var ~loc:var.loc var.txt)
     | _ -> assert false)
   | _ -> parseTypExpr p
@@ -4252,7 +4246,7 @@ and parseEs6ArrowType ~attrs p =
     let endPos = p.prevEndPos in
     let returnTypeArity =
       match parameters with
-      | _ when p.uncurried_config |> Res_uncurried.isDefault -> 0
+      | _ when p.uncurried_config <> Legacy -> 0
       | _ ->
         if parameters |> List.exists (function {dotted; typ = _} -> dotted)
         then 0
@@ -4266,11 +4260,7 @@ and parseEs6ArrowType ~attrs p =
           let uncurried =
             p.uncurried_config |> Res_uncurried.fromDotted ~dotted
           in
-          if
-            uncurried
-            && (paramNum = 1
-               || not (p.uncurried_config |> Res_uncurried.isDefault))
-          then
+          if uncurried && (paramNum = 1 || p.uncurried_config = Legacy) then
             let loc = mkLoc startPos endPos in
             let tArg = Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t in
             (paramNum - 1, Ast_uncurried.uncurriedType ~loc ~arity tArg, 1)
@@ -4335,9 +4325,8 @@ and parseArrowTypeRest ~es6Arrow ~startPos typ p =
     let returnType = parseTypExpr ~alias:false p in
     let loc = mkLoc startPos p.prevEndPos in
     let arrowTyp = Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ returnType in
-    if p.uncurried_config |> Res_uncurried.isDefault then
-      Ast_uncurried.uncurriedType ~loc ~arity:1 arrowTyp
-    else arrowTyp
+    if p.uncurried_config = Legacy then arrowTyp
+    else Ast_uncurried.uncurriedType ~loc ~arity:1 arrowTyp
   | _ -> typ
 
 and parseTypExprRegion p =
@@ -6409,13 +6398,12 @@ and parseStandaloneAttribute p =
   let attrId = parseAttributeId ~startPos p in
   let attrId =
     match attrId.txt with
-    | "uncurried" ->
-      p.uncurried_config <- Res_uncurried.Default;
+    | "uncurried.swap" ->
+      p.uncurried_config <- Config.Swap;
       attrId
-    | "uncurriedAlways" ->
-      p.uncurried_config <- Res_uncurried.Always;
+    | "uncurried" ->
+      p.uncurried_config <- Config.Uncurried;
       attrId
-    | "toUncurried" -> {attrId with txt = "uncurried"}
     | _ -> attrId
   in
   let payload = parsePayload p in