[PoC]: Add platform-specific module support

CHANGELOG.md

@@ -28,6 +28,7 @@
 
 #### :rocket: New Feature
 
+- Add opt-in platform modules such as `Button.android.res` and `Button.ios.res`, with platform-specific JavaScript outputs sharing one `Button.resi` interface. https://github.com/rescript-lang/rescript/pull/8637
 - Support UTF-16 surrogate-pair escapes such as `"\uD83D\uDE00"` in ordinary string literals. https://github.com/rescript-lang/rescript/pull/8606
 - Support dynamic imports of external bindings annotated with `@scope`; the generated import follows the complete property path. These imports were previously rejected. https://github.com/rescript-lang/rescript/pull/8582
 - Add `@res.hoistedFunction` for emitting nested module functions as flat JavaScript exports. https://github.com/rescript-lang/rescript/pull/8402
@@ -38,6 +39,9 @@
 
 - Fix `reanalyze` reporting labels and variant cases of a re-exported type (`type y = x = {...}`) as dead in the editor. The re-export linking existed only in the batch pipeline, while the editor runs the reactive one; both are now the same pipeline. The `reanalyze -reactive` flag is gone with it, since analysis is always reactive. https://github.com/rescript-lang/rescript/issues/8647
 - Fix `reanalyze` reporting record labels reached through a record coercion as dead. The typed tree now keeps the source type of a coercion, so reading a label on the target counts as reading the source label of the same name. https://github.com/rescript-lang/rescript/issues/8643
+- Fix GenType path resolution hanging on Windows when project paths use different short and canonical forms. https://github.com/rescript-lang/rescript/pull/8639
+- Allow `rescript clean` to remove generated files when the source module graph is invalid. https://github.com/rescript-lang/rescript/pull/8640
+- Keep watch mode running after full rebuild initialization fails so it can recover after a later valid change. https://github.com/rescript-lang/rescript/pull/8641
 - Fix constant folding of pattern matches on unboxed variants whose payload overlaps a literal constructor, so inlined calls agree with runtime matching. Reject multi-argument unboxed constructors instead of crashing. https://github.com/rescript-lang/rescript/pull/8631
 - Fix escaped backticks and interpolation openers in backquoted `%raw`, `%ffi`, and `%re` payloads leaking into emitted JavaScript. https://github.com/rescript-lang/rescript/pull/8630
 - Fix the side-effect analysis treating bigint exponentiation and bounds-checked array and string reads as pure, which let dead-code elimination drop an unused one that throws: `let _ = 2n ** -1n` no longer raised. https://github.com/rescript-lang/rescript/pull/8617

analysis/src/find_files.ml

@@ -116,6 +116,27 @@ let get_namespace config =
     in
     from_name |> Option.map name_space_to_name
 
+let get_platforms config =
+  match
+    config |> Yojson_helpers.get "platforms" |> bind Yojson_helpers.to_list_opt
+  with
+  | None -> []
+  | Some platforms -> platforms |> List.filter_map Yojson_helpers.string_opt
+
+let get_platform_implementation platforms file =
+  if not (Filename.check_suffix file ".res") then None
+  else
+    let stem = Filename.basename file |> Filename.chop_extension in
+    platforms
+    |> List.find_map (fun platform ->
+        let suffix = "." ^ platform in
+        if Filename.check_suffix stem suffix then
+          Some
+            ( platform,
+              String.sub stem 0 (String.length stem - String.length suffix)
+              |> String.capitalize_ascii )
+        else None)
+
 module String_set = Set.Make (String)
 
 let get_public config =
@@ -180,7 +201,8 @@ let find_package_root ~base ~sourcedirs_package_roots name =
   | _ -> Module_resolution.resolve_node_module_path ~start_path:base name
 
 (* returns a list of (absolute path to cmt(i), relative path from base to source file) *)
-let find_project_files ~public ~namespace ~path ~source_directories ~lib_bs =
+let find_project_files ~public ~namespace ~platforms ~path ~source_directories
+    ~lib_bs =
   let dirs =
     source_directories |> List.map (Filename.concat path) |> String_set.of_list
   in
@@ -205,47 +227,85 @@ let find_project_files ~public ~namespace ~path ~source_directories ~lib_bs =
 
   let normals =
     files |> String_set.elements
-    |> Utils.filter_map (fun file ->
+    |> List.concat_map (fun file ->
         if is_implementation file then (
-          let module_name = get_name file in
+          let platform_implementation =
+            get_platform_implementation platforms file
+          in
+          let physical_module_name = get_name file in
+          let module_name =
+            match platform_implementation with
+            | Some (_, logical_module_name) -> logical_module_name
+            | None -> physical_module_name
+          in
+          let is_primary_platform =
+            match (platforms, platform_implementation) with
+            | primary :: _, Some (platform, _) -> primary = platform
+            | _ -> true
+          in
           let resi = Hashtbl.find_opt interfaces module_name in
-          Hashtbl.remove interfaces module_name;
+          if is_primary_platform then Hashtbl.remove interfaces module_name;
           let base = compiled_base_name ~namespace (Files.relpath path file) in
-          match resi with
-          | Some resi ->
-            let cmti = (lib_bs /+ base) ^ ".cmti" in
+          match (platform_implementation, is_primary_platform, resi) with
+          | Some _, false, _ ->
+            let cmt = (lib_bs /+ base) ^ ".cmt" in
+            if Files.exists cmt then
+              [
+                ( physical_module_name,
+                  module_name,
+                  Shared_types.Impl {cmt; res = file} );
+              ]
+            else (
+              Log.log ("Bad platform source file (no cmt) " ^ (lib_bs /+ base));
+              [])
+          | _, _, Some resi ->
+            let interface_base =
+              compiled_base_name ~namespace (Files.relpath path resi)
+            in
+            let cmti = (lib_bs /+ interface_base) ^ ".cmti" in
             let cmt = (lib_bs /+ base) ^ ".cmt" in
             if Files.exists cmti then
               if Files.exists cmt then
                 (* Log.log("Intf and impl " ++ cmti ++ " " ++ cmt) *)
-                Some
+                let logical_entry =
                   ( module_name,
+                    module_name,
                     Shared_types.IntfAndImpl {cmti; resi; cmt; res = file} )
-              else None
+                in
+                match platform_implementation with
+                | Some _ ->
+                  [
+                    logical_entry;
+                    ( physical_module_name,
+                      module_name,
+                      Shared_types.Impl {cmt; res = file} );
+                  ]
+                | None -> [logical_entry]
+              else []
             else (
               (* Log.log("Just intf " ++ cmti) *)
               Log.log ("Bad source file (no cmt/cmti/cmi) " ^ (lib_bs /+ base));
-              None)
-          | None ->
+              [])
+          | _, _, None ->
             let cmt = (lib_bs /+ base) ^ ".cmt" in
-            if Files.exists cmt then Some (module_name, Impl {cmt; res = file})
+            if Files.exists cmt then
+              [(module_name, module_name, Shared_types.Impl {cmt; res = file})]
             else (
               Log.log ("Bad source file (no cmt/cmi) " ^ (lib_bs /+ base));
-              None))
-        else None)
+              []))
+        else [])
   in
   let result =
     normals
-    |> List.filter_map (fun (name, paths) ->
-        let original_name = name in
+    |> List.filter_map (fun (name, public_name, paths) ->
         let name =
           match namespace with
           | None -> name
           | Some namespace -> name ^ "-" ^ namespace
         in
         match public with
         | Some public ->
-          if public |> String_set.mem original_name then Some (name, paths)
+          if public |> String_set.mem public_name then Some (name, paths)
           else None
         | None -> Some (name, paths))
   in
@@ -316,7 +376,8 @@ let find_dependency_files base config =
                     in
                     let project_files =
                       find_project_files ~public:(get_public inner) ~namespace
-                        ~path ~source_directories ~lib_bs
+                        ~platforms:(get_platforms inner) ~path
+                        ~source_directories ~lib_bs
                     in
                     Some (compiled_directories, project_files))
                 | None -> None

analysis/src/packages.ml

@@ -106,7 +106,9 @@ let new_bs_package ~root_path =
             let project_files_and_paths =
               Find_files.find_project_files
                 ~public:(Find_files.get_public config)
-                ~namespace ~path:root_path ~source_directories ~lib_bs
+                ~namespace
+                ~platforms:(Find_files.get_platforms config)
+                ~path:root_path ~source_directories ~lib_bs
             in
             let paths_for_module =
               make_paths_for_module ~project_files_and_paths

compiler/bsc/rescript_compiler_main.ml

@@ -249,6 +249,9 @@ let command_line_flags : (string * Bsc_args.spec * string) array =
     ( "-bs-read-cmi",
       unit_call (fun _ -> Clflags.assume_no_mli := Mli_exists),
       "*internal* Assume mli always exist " );
+    ( "-bs-platform-interface",
+      set Js_config.platform_interface,
+      "*internal* Emit platform-independent cmj metadata" );
     ( "-ppx",
       string_list_add Clflags.all_ppx,
       "*internal* <command>  Pipe abstract syntax trees through preprocessor \

compiler/common/js_config.ml

@@ -32,6 +32,7 @@ let no_version_header = ref false
 
 let directives = ref []
 let cross_module_inline = ref false
+let platform_interface = ref false
 let debug_ir = ref false
 let check_lam = ref false
 

compiler/common/js_config.mli

@@ -49,6 +49,9 @@ val directives : string list ref
 val cross_module_inline : bool ref
 (** cross module inline option *)
 
+val platform_interface : bool ref
+(** emit conservative [.cmj] metadata for a platform implementation *)
+
 val debug_ir : bool ref
 (** dump intermediate representations and related diagnostics *)
 

compiler/core/js_packages_info.ml

@@ -68,6 +68,13 @@ let iter (x : t) cb = Ext_list.iter x.module_systems cb
 
 let map (x : t) cb = Ext_list.map x.module_systems cb
 
+let with_suffix suffix (x : t) =
+  {
+    x with
+    module_systems =
+      Ext_list.map x.module_systems (fun package -> {package with suffix});
+  }
+
 (* let equal (x : t) ({name; module_systems}) =
     x.name = name &&
     Ext_list.for_all2_no_exn

compiler/core/js_packages_info.mli

@@ -42,6 +42,8 @@ val iter : t -> (package_info -> unit) -> unit
 
 val map : t -> (package_info -> 'a) -> 'a list
 
+val with_suffix : string -> t -> t
+
 val empty : t
 
 val from_name : string -> t

compiler/core/lam_stats_export.ml

@@ -50,49 +50,51 @@ let values_of_export (meta : Lam_stats.t) (export_map : Lambda.t Map_ident.t) :
       in
       let persistent_closed_lambda =
         let optlam = Map_ident.find_opt export_map x in
-        match optlam with
-        | Some
-            (Lconst
-               ( Const_js_null | Const_js_undefined _ | Const_js_true
-               | Const_js_false ))
-        | None ->
-          optlam
-        | Some lambda ->
-          if not !Js_config.cross_module_inline then None
-          else if
-            Lam_analysis.safe_to_inline lambda
-            (* when inlning a non function, we have to be very careful,
+        if !Js_config.platform_interface then None
+        else
+          match optlam with
+          | Some
+              (Lconst
+                 ( Const_js_null | Const_js_undefined _ | Const_js_true
+                 | Const_js_false ))
+          | None ->
+            optlam
+          | Some lambda ->
+            if not !Js_config.cross_module_inline then None
+            else if
+              Lam_analysis.safe_to_inline lambda
+              (* when inlning a non function, we have to be very careful,
                only truly immutable values can be inlined
             *)
-          then
-            match lambda with
-            | Lfunction {attr = {inline = Always_inline}}
-            (* FIXME: is_closed lambda is too restrictive
+            then
+              match lambda with
+              | Lfunction {attr = {inline = Always_inline}}
+              (* FIXME: is_closed lambda is too restrictive
                It precludes ues cases
                - inline forEach but not forEachU
             *)
-            | Lfunction {attr = {is_a_functor = true}} ->
-              if Lam_closure.is_closed lambda (* TODO: seriealize more*) then
-                optlam
-              else None
-            | _ ->
-              let lam_size = Lam_analysis.size lambda in
-              (* TODO:
+              | Lfunction {attr = {is_a_functor = true}} ->
+                if Lam_closure.is_closed lambda (* TODO: seriealize more*) then
+                  optlam
+                else None
+              | _ ->
+                let lam_size = Lam_analysis.size lambda in
+                (* TODO:
                  1. global need re-assocate when do the beta reduction
                  2. [lambda_exports] is not precise
               *)
-              let free_variables =
-                Lam_closure.free_variables Set_ident.empty Map_ident.empty
-                  lambda
-              in
-              if
-                lam_size < Lam_analysis.small_inline_size
-                && Map_ident.is_empty free_variables
-              then (
-                Ext_log.dwarn ~__POS__ "%s recorded for inlining @." x.name;
-                optlam)
-              else None
-          else None
+                let free_variables =
+                  Lam_closure.free_variables Set_ident.empty Map_ident.empty
+                    lambda
+                in
+                if
+                  lam_size < Lam_analysis.small_inline_size
+                  && Map_ident.is_empty free_variables
+                then (
+                  Ext_log.dwarn ~__POS__ "%s recorded for inlining @." x.name;
+                  optlam)
+                else None
+            else None
       in
       match (arity, persistent_closed_lambda) with
       | Single Arity_na, (None | Some (Lconst Const_module_alias)) -> acc
@@ -129,10 +131,17 @@ let get_dependent_module_effect (maybe_pure : string option)
 let export_to_cmj (meta : Lam_stats.t) effect_ export_map hoisted_exports case :
     Js_cmj_format.t =
   let values = values_of_export meta export_map in
-
-  Js_cmj_format.make ~values ~hoisted_exports ~effect_
-    ~package_spec:(Js_packages_state.get_packages_info ())
-    ~case
+  let values, hoisted_exports, effect_, package_spec =
+    if !Js_config.platform_interface then
+      ( Map_string.empty,
+        [],
+        Some "platform implementation",
+        Js_packages_state.get_packages_info ()
+        |> Js_packages_info.with_suffix "" )
+    else
+      (values, hoisted_exports, effect_, Js_packages_state.get_packages_info ())
+  in
+  Js_cmj_format.make ~values ~hoisted_exports ~effect_ ~package_spec ~case
 (* FIXME: make sure [-o] would not change its case
    add test for ns/non-ns
 *)

compiler/gentype/module_resolver.ml

@@ -133,11 +133,10 @@ let resolve_module ~(config : Config.t) ~import_extension ~output_file_relative
   if Sys.file_exists module_name_res_file then candidate
   else
     let rec path_to_list path =
-      let is_root = path |> Filename.basename = path in
-      match is_root with
-      | true -> [path]
-      | false ->
-        (path |> Filename.basename) :: (path |> Filename.dirname |> path_to_list)
+      let parent = Filename.dirname path in
+      (* On Windows, the basename of a drive root omits the drive prefix. *)
+      if Filename.basename path = path || parent = path then [path]
+      else (path |> Filename.basename) :: path_to_list parent
     in
     match module_name |> apply ~resolver ~use_bs_dependencies with
     | None -> candidate

docs/docson/build-schema.json

@@ -493,6 +493,16 @@
     "suffix": {
       "$ref": "#/definitions/suffix-spec"
     },
+    "platforms": {
+      "type": "array",
+      "minItems": 1,
+      "uniqueItems": true,
+      "items": {
+        "type": "string",
+        "pattern": "^[a-z][a-z0-9_]*$"
+      },
+      "description": "Platform suffixes for shared-interface modules such as Button.android.res and Button.ios.res."
+    },
     "reanalyze": {
       "$ref": "#/definitions/reanalyze",
       "description": "Configure reanalyze, a static code analysis tool for ReScript."