[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

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
 *)

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."

rewatch/CompilerConfigurationSpec.md

@@ -35,10 +35,39 @@ recommended for new projects.
 | entries               | array of Target-Item    |                                                             |     [_]      |
 | bs-external-includes  | array of string         |                                                             |     [_]      |
 | suffix                | Suffix                  |                                                             |     [x]      |
+| platforms             | array of string         | Shared-interface platform modules; see below                |     [x]      |
 | reanalyze             | Reanalyze               | Reanalyze config; ignored by rewatch                        |     [x]      |
 | experimental-features | ExperimentalFeatures    |                                                             |     [x]      |
 | editor                | object                  | VS Code tooling only; ignored by rewatch                    |     [x]      |
 
+### Platform modules
+
+`platforms` enables platform-specific implementations behind one ordinary
+interface. The first entry is the primary implementation used for compiler
+artifacts and editor navigation; generated JavaScript still contains every
+configured variant.
+
+```json
+{"platforms": ["android", "ios"]}
+```
+
+For a module named `Button`, the source layout is:
+
+```text
+Button.resi
+Button.android.res
+Button.ios.res
+```
+
+Every configured implementation is required and checked against `Button.resi`.
+The outputs are `Button.android.js` and `Button.ios.js` (using the configured JS
+suffix), while ordinary consumers emit an extensionless import of `Button` so a
+platform-aware resolver such as Metro can select the implementation. Generic
+fallbacks, `.native.res`, and platform-specific interfaces are not supported.
+
+Platform names must begin with a lowercase ASCII letter and contain only
+lowercase letters, digits, and underscores.
+
 ### Source
 
 | Parameter        | JSON type                | Remark                                                  | Implemented? |

rewatch/README.md

@@ -25,6 +25,7 @@ Focused documentation:
 - [monorepo discovery and build scope](MonorepoSupport.md)
 - [feature-gated source directories](Features.md)
 - [integration-test workspace](testrepo/README.md)
+- [platform module acceptance tests](tests/platforms/README.md)
 
 The ReScript website owns user-facing configuration documentation. The support
 matrix in this directory records what the current Rewatch implementation