Add support for uncurried-always

cristianoc · cristianoc · commit 07e7372b287f · 2023-02-01T11:14:21.000+01:00
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.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -25,6 +25,7 @@ subset of the arguments, and return a curried type with the remaining ones https
 - Inline uncurried application when it is safe https://github.com/rescript-lang/rescript-compiler/pull/5847
 - Add support for toplevel `await` https://github.com/rescript-lang/rescript-compiler/pull/5940
 - 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. https://github.com/rescript-lang/rescript-compiler/pull/5968
 
 #### :boom: Breaking Change
 
diff --git a/docs/docson/build-schema.json b/docs/docson/build-schema.json
@@ -359,6 +359,10 @@
       "additionalProperties": false,
       "required": ["version"]
     },
+    "uncurried-specs": {
+      "type": "string",
+      "enum": ["legacy", "default", "always"]
+    },
     "bsc-flags": {
       "oneOf": [
         {
@@ -440,6 +444,10 @@
       "$ref": "#/definitions/jsx-specs",
       "description": "Configuration for the JSX transformation."
     },
+    "uncurried": {
+      "$ref": "#/definitions/uncurried-specs",
+      "description": "Configuration for the uncurried mode."
+    },
     "reason": {
       "$ref": "#/definitions/reason-specs",
       "description": "ReScript comes with [Reason](http://reasonml.github.io/) by default. Specific configurations here."
diff --git a/jscomp/bsb/bsb_build_schemas.ml b/jscomp/bsb/bsb_build_schemas.ml
@@ -79,3 +79,5 @@ let gentypeconfig = "gentypeconfig"
 let language = "language"
 let path = "path"
 let ignored_dirs = "ignored-dirs"
+
+let uncurried = "uncurried"
diff --git a/jscomp/bsb/bsb_clean.ml b/jscomp/bsb/bsb_clean.ml
@@ -51,7 +51,7 @@ let clean_bs_garbage proj_dir =
     Bsb_log.warn "@{<warning>Failed@} to clean due to %s" (Printexc.to_string e)
 
 let clean_bs_deps proj_dir =
-  let _, _, pinned_dependencies = Bsb_config_parse.deps_from_bsconfig () in
+  let _, _, _, pinned_dependencies = Bsb_config_parse.deps_from_bsconfig () in
   let queue = Bsb_build_util.walk_all_deps proj_dir ~pinned_dependencies in
   Queue.iter
     (fun (pkg_cxt : Bsb_build_util.package_context) ->
diff --git a/jscomp/bsb/bsb_config_parse.ml b/jscomp/bsb/bsb_config_parse.ml
@@ -95,6 +95,15 @@ 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 =
+  match map.?(Bsb_build_schemas.uncurried) with
+  | None -> Legacy
+  | Some (Str { str = "legacy" }) -> Legacy
+  | Some (Str { str = "default" }) -> Default
+  | Some (Str { str = "always" }) -> Always
+  | Some config ->
+      Bsb_exception.config_error config "uncurried expects one of: \"legacy\", \"default\", \"always\"."
+
 let extract_string (map : json_map) (field : string) cb =
   match map.?(field) with
   | None -> None
@@ -337,6 +346,10 @@ let interpret_json ~(package_kind : Bsb_package_kind.t) ~(per_proj_dir : string)
             jsx;
             generators = extract_generators map;
             cut_generators;
+            uncurried =
+            (match package_kind with
+            | Toplevel -> extract_uncurried map
+            | Pinned_dependency x | Dependency x -> x.uncurried);
           }
       | None ->
           Bsb_exception.invalid_spec "no sources specified in bsconfig.json")
@@ -348,5 +361,6 @@ let deps_from_bsconfig () =
   | Obj { map } ->
       ( Bsb_package_specs.from_map ~cwd:Bsb_global_paths.cwd map,
         Bsb_jsx.from_map map,
+        extract_uncurried map,
         Bsb_build_util.extract_pinned_dependencies map )
   | _ -> assert false
diff --git a/jscomp/bsb/bsb_config_parse.mli b/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 * Set_string.t
+val deps_from_bsconfig : unit -> Bsb_package_specs.t * Bsb_jsx.t * Res_uncurried.config *  Set_string.t
 
 val interpret_json :
   package_kind:Bsb_package_kind.t -> per_proj_dir:string -> Bsb_config_types.t
diff --git a/jscomp/bsb/bsb_config_types.ml b/jscomp/bsb/bsb_config_types.ml
@@ -64,4 +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;
 }
diff --git a/jscomp/bsb/bsb_ninja_gen.ml b/jscomp/bsb/bsb_ninja_gen.ml
@@ -159,6 +159,7 @@ let output_ninja_and_namespace_map ~per_proj_dir ~package_kind
        built_in_dependency;
        reason_react_jsx;
        jsx;
+       uncurried;
        generators;
        namespace;
        warning;
@@ -205,7 +206,7 @@ let output_ninja_and_namespace_map ~per_proj_dir ~package_kind
   let rules : Bsb_ninja_rule.builtin =
     Bsb_ninja_rule.make_custom_rules ~gentype_config
       ~has_postbuild:js_post_build_cmd ~pp_file ~has_builtin:built_in_dependency
-      ~reason_react_jsx ~jsx ~package_specs ~namespace ~digest ~package_name
+      ~reason_react_jsx ~jsx ~uncurried ~package_specs ~namespace ~digest ~package_name
       ~warnings ~ppx_files ~bsc_flags ~dpkg_incls (* dev dependencies *)
       ~lib_incls (* its own libs *)
       ~dev_incls (* its own devs *)
diff --git a/jscomp/bsb/bsb_ninja_rule.ml b/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) ~(digest : string) ~(package_specs : Bsb_package_specs.t)
+    ~(jsx : Bsb_jsx.t) ~(uncurried: Res_uncurried.config)  ~(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
@@ -171,6 +171,10 @@ let make_custom_rules ~(gentype_config : Bsb_config_types.gentype_config)
     | None -> ()
     | Some Classic -> Ext_buffer.add_string buf " -bs-jsx-mode classic"
     | Some Automatic -> Ext_buffer.add_string buf " -bs-jsx-mode automatic");
+    (match uncurried with
+    | Legacy -> ()
+    | Default -> Ext_buffer.add_string buf " -uncurried default"
+    | Always -> Ext_buffer.add_string buf " -uncurried always");
 
     Ext_buffer.add_char_string buf ' ' bsc_flags;
     Ext_buffer.add_string buf " -absname -bs-ast -o $out $i";
diff --git a/jscomp/bsb/bsb_ninja_rule.mli b/jscomp/bsb/bsb_ninja_rule.mli
@@ -72,6 +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 ->
   digest:string ->
   package_specs:Bsb_package_specs.t ->
   namespace:string option ->
diff --git a/jscomp/bsb/bsb_package_kind.ml b/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 }
+type dep_payload = { package_specs : Bsb_package_specs.t; jsx : Bsb_jsx.t; uncurried : Res_uncurried.config }
 
 type t =
   | Toplevel
diff --git a/jscomp/bsb/bsb_world.ml b/jscomp/bsb/bsb_world.ml
@@ -27,7 +27,7 @@ let vendor_ninja = Bsb_global_paths.vendor_ninja
 
 let make_world_deps cwd (config : Bsb_config_types.t option)
     (ninja_args : string array) =
-  let package_specs, jsx, pinned_dependencies =
+  let package_specs, jsx, uncurried, pinned_dependencies =
     match config with
     | None ->
         (* When this running bsb does not read bsconfig.json,
@@ -36,7 +36,7 @@ let make_world_deps cwd (config : Bsb_config_types.t option)
         *)
         Bsb_config_parse.deps_from_bsconfig ()
     | Some config ->
-        (config.package_specs, config.jsx, config.pinned_dependencies)
+        (config.package_specs, config.jsx, config.uncurried, config.pinned_dependencies)
   in
   let args =
     if Ext_array.is_empty ninja_args then [| vendor_ninja |]
@@ -67,8 +67,8 @@ let make_world_deps cwd (config : Bsb_config_types.t option)
              let _config : _ option =
                Bsb_ninja_regen.regenerate_ninja
                  ~package_kind:
-                   (if is_pinned then Pinned_dependency { package_specs; jsx }
-                   else Dependency { package_specs; jsx })
+                   (if is_pinned then Pinned_dependency { package_specs; jsx; uncurried }
+                   else Dependency { package_specs; jsx; uncurried })
                  ~per_proj_dir:proj_dir ~forced:false
              in
              let command =
diff --git a/jscomp/bsc/rescript_compiler_main.ml b/jscomp/bsc/rescript_compiler_main.ml
@@ -24,7 +24,7 @@ let setup_compiler_printer (syntax_kind : [ syntax_kind | `default])=
   (match syntax_kind with 
    | `default -> ()  
    | #syntax_kind as k -> Config.syntax_kind := k);   
-  let syntax_kind = !Config.syntax_kind in 
+  let syntax_kind = !Config.syntax_kind in
   if syntax_kind = `rescript then begin 
     Lazy.force Super_main.setup;  
     Lazy.force Res_outcome_printer.setup  
@@ -245,20 +245,17 @@ let buckle_script_flags : (string * Bsc_args.spec * string) array =
 
     "-bs-jsx", string_call (fun i -> 
       (if i <> "3" && i <> "4" then Bsc_args.bad_arg (" Not supported jsx version : " ^  i));
-      let open Js_config in
-      jsx_version := jsx_version_of_int @@ int_of_string i),
+      Js_config.jsx_version := Js_config.jsx_version_of_int @@ int_of_string i),
     "*internal* Set jsx version";
 
     "-bs-jsx-module", string_call (fun i ->
       (if i <> "react" then Bsc_args.bad_arg (" Not supported jsx-module : " ^ i));
-      let open Js_config in
-      Js_config.jsx_module := jsx_module_of_string i),
+      Js_config.jsx_module := Js_config.jsx_module_of_string i),
     "*internal* Set jsx module";
 
     "-bs-jsx-mode", string_call (fun i ->
       (if i <> "classic" && i <> "automatic" then Bsc_args.bad_arg (" Not supported jsx-mode : " ^ i));
-      let open Js_config in
-      Js_config.jsx_mode := jsx_mode_of_string i),
+      Js_config.jsx_mode := Js_config.jsx_mode_of_string i),
     "*internal* Set jsx mode";
 
     "-bs-package-output", string_call Js_packages_state.update_npm_package_path, 
@@ -406,8 +403,14 @@ let buckle_script_flags : (string * Bsc_args.spec * string) array =
 
     "-nopervasives", set Clflags.nopervasives, 
     "*internal*";
-    "-bs-uncurry", set Config.default_uncurry,
-    "*internal" ;
+    "-uncurried", string_call (fun i ->
+      match i with
+      | "default" -> Res_uncurried.init := Default
+      | "always" -> Res_uncurried.init := Always
+      | "legacy" -> Res_uncurried.init := Legacy
+      | _ -> Bsc_args.bad_arg (" Not supported -uncurried option : " ^ i)
+  ),
+    "*internal* Set jsx module";
     "-v", unit_call print_version_string,
     "Print compiler version and location of standard library and exit";  
 
diff --git a/jscomp/build_tests/uncurried/.gitignore b/jscomp/build_tests/uncurried/.gitignore
@@ -0,0 +1,26 @@
+*.exe
+*.obj
+*.out
+*.compile
+*.native
+*.byte
+*.cmo
+*.annot
+*.cmi
+*.cmx
+*.cmt
+*.cmti
+*.cma
+*.a
+*.cmxa
+*.obj
+*~
+*.annot
+*.cmj
+*.bak
+lib/bs
+*.mlast
+*.mliast
+.vscode
+.merlin
+.bsb.lock
diff --git a/jscomp/build_tests/uncurried/bsconfig.json b/jscomp/build_tests/uncurried/bsconfig.json
@@ -0,0 +1,9 @@
+{
+  "name": "uncurried",
+  "version": "0.1.0",
+  "sources": {
+    "dir" : "src",
+    "subdirs" : true
+  },
+  "uncurried": "always"
+}
diff --git a/jscomp/build_tests/uncurried/input.js b/jscomp/build_tests/uncurried/input.js
@@ -0,0 +1,9 @@
+//@ts-check
+const cp = require("child_process");
+const assert = require("assert");
+const fs = require('fs')
+const path = require('path')
+var rescript_exe = require("../../../scripts/bin_path").rescript_exe
+
+cp.execSync(`${rescript_exe} clean -with-deps`, { cwd: __dirname, });
+cp.execSync(`${rescript_exe}`, { cwd: __dirname, });
diff --git a/jscomp/build_tests/uncurried/package-lock.json b/jscomp/build_tests/uncurried/package-lock.json
diff --git a/jscomp/build_tests/uncurried/package.json b/jscomp/build_tests/uncurried/package.json
@@ -0,0 +1,17 @@
+{
+  "name": "uncurried",
+  "version": "0.1.0",
+  "scripts": {
+    "clean": "rescript clean",
+    "build": "rescript build",
+    "watch": "rescript build -w"
+  },
+  "keywords": [
+    "ReScript"
+  ],
+  "author": "",
+  "license": "MIT",
+  "devDependencies": {
+    "rescript": "^10.0.0"
+  }
+}
diff --git a/jscomp/build_tests/uncurried/src/Tst.res b/jscomp/build_tests/uncurried/src/Tst.res
@@ -0,0 +1,11 @@
+let foo = (x, y) => x + y
+
+let z = foo(. 3, 4)
+
+let bar = (. x, y) => x + y
+
+let b = bar(3, 4)
+
+let w = 3->foo(4)
+
+let a = 3->foo(. 4)
diff --git a/jscomp/ext/config.ml b/jscomp/ext/config.ml
@@ -29,8 +29,6 @@ let interface_suffix = ref ".mli"
    separately because it can differ when we're in the middle of a
    bootstrapping phase. *)
 
-let default_uncurry = ref false
-
 let print_config oc =
   let p name valu = Printf.fprintf oc "%s: %s\n" name valu in
   p "version" version;
diff --git a/jscomp/ext/config.mli b/jscomp/ext/config.mli
@@ -45,6 +45,4 @@ val ast_impl_magic_number : string
 val cmt_magic_number : string
 (* Magic number for compiled interface files *)
 
-val default_uncurry : bool ref
-
 val print_config : out_channel -> unit
diff --git a/res_syntax/src/res_core.ml b/res_syntax/src/res_core.ml
@@ -6410,6 +6410,9 @@ and parseStandaloneAttribute p =
     | "uncurried" ->
       p.uncurried_config <- Res_uncurried.Default;
       attrId
+    | "uncurriedAlways" ->
+      p.uncurried_config <- Res_uncurried.Always;
+      attrId
     | "toUncurried" -> {attrId with txt = "uncurried"}
     | _ -> attrId
   in
diff --git a/res_syntax/src/res_parser.ml b/res_syntax/src/res_parser.ml
@@ -122,7 +122,7 @@ let make ?(mode = ParseForTypeChecker) src filename =
       diagnostics = [];
       comments = [];
       regions = [ref Report];
-      uncurried_config = Res_uncurried.init;
+      uncurried_config = !Res_uncurried.init;
     }
   in
   parserState.scanner.err <-
diff --git a/res_syntax/src/res_printer.ml b/res_syntax/src/res_printer.ml
diff --git a/res_syntax/src/res_uncurried.ml b/res_syntax/src/res_uncurried.ml
diff --git a/res_syntax/tests/parsing/grammar/expressions/UncurriedAlways.res b/res_syntax/tests/parsing/grammar/expressions/UncurriedAlways.res
diff --git a/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedAlways.res.txt b/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedAlways.res.txt

Original file line number	Diff line number	Diff line change
`@@ -64,4 +64,5 @@ type t = {`
`64`	`64`	`cut_generators : bool;`
`65`	`65`	`(* note when used as a dev mode, we will always ignore it *)`
`66`	`66`	`gentype_config : gentype_config;`
	`67`	`+ uncurried: Res_uncurried.config;`
`67`	`68`	`}`