Merge branch 'master' into compiler-error-variant-tag-constructor-field

Author: mediremi

.github/workflows/ci.yml

@@ -674,6 +674,8 @@ jobs:
         shell: bash
 
   publish:
+    permissions:
+      id-token: write
     needs:
       - test-installation-npm
       - test-installation-pnpm
@@ -701,11 +703,9 @@ jobs:
         shell: bash
 
       - name: Publish packages on npm with tag "ci"
-        env:
-          YARN_NPM_AUTH_TOKEN: ${{ secrets.NPM_ACCESS_TOKEN }}
         run: |
           yarn workspaces foreach -W --no-private \
-            npm publish --tolerate-republish --tag ci
+            npm publish --provenance --tolerate-republish --tag ci
 
       - name: Update Website Playground
         run: curl -X POST "${{ secrets.CLOUDFLARE_PAGES_DEPLOYMENT_HOOK }}"

CHANGELOG.md

@@ -14,20 +14,30 @@
 
 #### :boom: Breaking Change
 
+- Fix return type of `String.charCodeAt`. https://github.com/rescript-lang/rescript/pull/7864
+
 #### :eyeglasses: Spec Compliance
 
 #### :rocket: New Feature
 
 #### :bug: Bug fix
 
 - Fix code generation for emojis in polyvars and labels. https://github.com/rescript-lang/rescript/pull/7853
+- Add `reset` to `experimental_features` to correctly reset playground. https://github.com/rescript-lang/rescript/pull/7868
+- Fix crash with `@get` on external of type `unit => 'a`. https://github.com/rescript-lang/rescript/pull/7866
+- Fix record type spreads in inline records. https://github.com/rescript-lang/rescript/pull/7859
 
 #### :memo: Documentation
 
 #### :nail_care: Polish
 
+- Reactivate optimization for length of array literals. https://github.com/rescript-lang/rescript/pull/7872
+
 #### :house: Internal
 
+- Playground: Add config options for experimental features and jsx preserve mode. https://github.com/rescript-lang/rescript/pull/7865
+- Clean up tests. https://github.com/rescript-lang/rescript/pull/7861 https://github.com/rescript-lang/rescript/pull/7871
+
 # 12.0.0-beta.10
 
 #### :rocket: New Feature

CONTRIBUTING.md

@@ -227,14 +227,23 @@ Below we will discuss on how to write, build and run these test files.
 - Inside the file, add a mocha test suite. The mocha bindings are defined in `tests/tests/src/mt.res`. To get you started, here is a simple scaffold for a test suite with multiple test cases:
 
   ```rescript
-  let suites: Mt.pair_suites = list{
-    ("hey", _ => Eq(true, 3 > 2)),
-    ("hi", _ => Neq(2, 3)),
-    ("hello", _ => Approx(3.0, 3.0)),
-    ("throw", _ => ThrowAny(_ => raise(SomeException))),
-  }
-
-  Mt.from_pair_suites(__MODULE__, suites)
+  open Mocha
+  open Test_utils
+
+  describe(__MODULE__, () => {
+    test("hey", () => {
+      ok(__LOC__, 3 > 2)
+    })
+
+    test("hi", () => {
+      eq(__LOC__, 2, 2)
+      eq(__LOC__, 3, 3)
+    })
+
+    test("throw", () => {
+      throws(__LOC__, () => throw(SomeException))
+    })
+  })
   ```
 
 - Build the test files and run the tests: `node scripts/test.js -mocha`.

biome.json

@@ -65,6 +65,7 @@
       "rewatch/**",
       "lib/es6/**",
       "lib/js/**",
+      "lib/bs/**",
       "ninja/**",
       "playground/**",
       "*.bs.js",

compiler/core/lam_compile_external_call.ml

@@ -421,7 +421,11 @@ let translate_ffi ?(transformed_jsx = false) (cxt : Lam_compile_context.t)
     | [obj] ->
       let obj = translate_scoped_access scopes obj in
       E.dot obj name
-    | _ -> assert false
+    | _ ->
+      (* This should have been caught in the frontend validation. *)
+      invalid_arg
+        "Internal compiler error: @get external called with wrong number of \
+         arguments. Expected exactly one object argument."
     (* Note these assertion happens in call site *))
   | Js_set {js_set_name = name; js_set_scopes = scopes} -> (
     (* assert (js_splice = false) ;  *)

compiler/frontend/ast_external_process.ml

@@ -899,7 +899,12 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
    tagged_template = _;
   } ->
     if arg_type_specs_length = 1 then
-      Js_get {js_get_name = name; js_get_scopes = scopes}
+      (* Check if the first argument is unit, which is invalid for @get *)
+      match arg_type_specs with
+      | [{arg_type = Extern_unit}] ->
+        Location.raise_errorf ~loc
+          "Ill defined attribute %@get (unit argument is not allowed)"
+      | _ -> Js_get {js_get_name = name; js_get_scopes = scopes}
     else
       Location.raise_errorf ~loc
         "Ill defined attribute %@get (only one argument)"

compiler/jsoo/jsoo_playground_main.ml

@@ -49,8 +49,10 @@
  `config.uncurried` to the BundleConfig.
  * v4: Added `config.open_modules` to the BundleConfig to enable implicitly opened
  * modules in the playground.
+ * v5: Removed .ml support.
+ * v6: Added `config.experimental_features` and `config.jsx_preserve_mode` to the BundleConfig.
  * *)
-let api_version = "5"
+let api_version = "6"
 
 module Js = Js_of_ocaml.Js
 
@@ -73,6 +75,8 @@ module BundleConfig = struct
     mutable filename: string option;
     mutable warn_flags: string;
     mutable open_modules: string list;
+    mutable experimental_features: string list;
+    mutable jsx_preserve_mode: bool;
   }
 
   let make () =
@@ -81,6 +85,8 @@ module BundleConfig = struct
       filename = None;
       warn_flags = Bsc_warnings.defaults_w;
       open_modules = [];
+      experimental_features = [];
+      jsx_preserve_mode = false;
     }
 
   let default_filename (lang : Lang.t) = "playground." ^ Lang.to_string lang
@@ -372,6 +378,7 @@ module Compile = struct
   (* Responsible for resetting all compiler state as if it were a new instance *)
   let reset_compiler () =
     warning_infos := [||];
+    Experimental_features.reset ();
     flush_warning_buffer () |> ignore;
     Warnings.reset_fatal ();
     Env.reset_cache_toplevel ()
@@ -467,7 +474,15 @@ module Compile = struct
     Js.array (!acc |> Array.of_list)
 
   let implementation ~(config : BundleConfig.t) ~lang str =
-    let {BundleConfig.module_system; warn_flags; open_modules} = config in
+    let {
+      BundleConfig.module_system;
+      warn_flags;
+      open_modules;
+      experimental_features;
+      jsx_preserve_mode;
+    } =
+      config
+    in
     try
       reset_compiler ();
       Warnings.parse_options false warn_flags;
@@ -485,6 +500,9 @@ module Compile = struct
       (* let finalenv = ref Env.empty in *)
       let types_signature = ref [] in
       Js_config.jsx_version := Some Js_config.Jsx_v4;
+      Js_config.jsx_preserve := jsx_preserve_mode;
+      experimental_features
+      |> List.iter Experimental_features.enable_from_string;
       (* default *)
       let ast = impl str in
       let ast = Ppx_entry.rewrite_implementation ast in
@@ -606,6 +624,14 @@ module Export = struct
       config.open_modules <- value;
       true
     in
+    let set_experimental_features value =
+      config.experimental_features <- value;
+      true
+    in
+    let set_jsx_preserve_mode value =
+      config.jsx_preserve_mode <- value;
+      true
+    in
     let convert_syntax ~(from_lang : string) ~(to_lang : string) (src : string)
         =
       let open Lang in
@@ -653,6 +679,17 @@ module Export = struct
                      (set_open_modules
                         (value |> Js.to_array |> Array.map Js.to_string
                        |> Array.to_list))) );
+          ( "setExperimentalFeatures",
+            inject
+            @@ Js.wrap_meth_callback (fun _ value ->
+                   Js.bool
+                     (set_experimental_features
+                        (value |> Js.to_array |> Array.map Js.to_string
+                       |> Array.to_list))) );
+          ( "setJsxPreserveMode",
+            inject
+            @@ Js.wrap_meth_callback (fun _ value ->
+                   Js.bool (set_jsx_preserve_mode (Js.to_bool value))) );
           ( "getConfig",
             inject
             @@ Js.wrap_meth_callback (fun _ ->
@@ -665,6 +702,12 @@ module Export = struct
                              |> BundleConfig.string_of_module_system
                              |> Js.string) );
                          ("warn_flags", inject @@ Js.string config.warn_flags);
+                         ( "jsx_preserve_mode",
+                           inject @@ (config.jsx_preserve_mode |> Js.bool) );
+                         ( "experimental_features",
+                           inject
+                           @@ (config.experimental_features |> Array.of_list
+                             |> Js.array) );
                          ( "open_modules",
                            inject
                            @@ (config.open_modules |> Array.of_list |> Js.array)

compiler/ml/experimental_features.ml

@@ -20,4 +20,6 @@ let enable_from_string (s : string) =
   | Some f -> enabled_features := FeatureSet.add f !enabled_features
   | None -> ()
 
+let reset () = enabled_features := FeatureSet.empty
+
 let is_enabled (f : feature) = FeatureSet.mem f !enabled_features

compiler/ml/experimental_features.mli

@@ -3,3 +3,4 @@ type feature = LetUnwrap
 val enable_from_string : string -> unit
 val is_enabled : feature -> bool
 val to_string : feature -> string
+val reset : unit -> unit

compiler/ml/record_type_spread.ml

@@ -89,3 +89,52 @@ let extract_type_vars (type_params : Types.type_expr list)
            | Tvar (Some tname) -> Some (tname, applied_tvar)
            | _ -> None)
   else []
+
+let expand_labels_with_type_spreads (env : Env.t)
+    (lbls : Typedtree.label_declaration list)
+    (lbls' : Types.label_declaration list) =
+  match has_type_spread lbls with
+  | false -> Some (lbls, lbls')
+  | true ->
+    let rec extract (t : Types.type_expr) =
+      match t.desc with
+      | Tpoly (t, []) -> extract t
+      | _ -> Ctype.repr t
+    in
+    let mk_lbl (l : Types.label_declaration) (ld_type : Typedtree.core_type)
+        (type_vars : (string * Types.type_expr) list) :
+        Typedtree.label_declaration =
+      {
+        ld_id = l.ld_id;
+        ld_name = {txt = Ident.name l.ld_id; loc = l.ld_loc};
+        ld_mutable = l.ld_mutable;
+        ld_optional = l.ld_optional;
+        ld_type =
+          {ld_type with ctyp_type = substitute_type_vars type_vars l.ld_type};
+        ld_loc = l.ld_loc;
+        ld_attributes = l.ld_attributes;
+      }
+    in
+    let rec process_lbls acc (lbls : Typedtree.label_declaration list)
+        (lbls' : Types.label_declaration list) =
+      match (lbls, lbls') with
+      | {ld_name = {txt = "..."}; ld_type} :: rest, _ :: rest' -> (
+        match
+          Ctype.extract_concrete_typedecl env (extract ld_type.ctyp_type)
+        with
+        | _p0, _p, {type_kind = Type_record (fields, _repr); type_params} ->
+          let type_vars = extract_type_vars type_params ld_type.ctyp_type in
+          process_lbls
+            ( fst acc @ Ext_list.map fields (fun l -> mk_lbl l ld_type type_vars),
+              snd acc
+              @ Ext_list.map fields (fun l ->
+                    {l with ld_type = substitute_type_vars type_vars l.ld_type})
+            )
+            rest rest'
+        | _ -> None
+        | exception _ -> None)
+      | lbl :: rest, lbl' :: rest' ->
+        process_lbls (fst acc @ [lbl], snd acc @ [lbl']) rest rest'
+      | _ -> Some acc
+    in
+    process_lbls ([], []) lbls lbls'