Add @res.hoistedFunction support for flat JS export

Signed-off-by: Christoph Knittel <ck@cca.io>

Author: cknitt

CHANGELOG.md

@@ -23,6 +23,7 @@
 
 #### :rocket: New Feature
 
+- Add `@res.hoistedFunction` for emitting nested module functions as flat JavaScript exports. https://github.com/rescript-lang/rescript/pull/8402
 - Add source map support with linked, inline, and hidden modes. https://github.com/rescript-lang/rescript/pull/8393
 - Add `List.includes`, deprecate `List.has` in favor of `List.some`, and clarify the equality semantics of `List.includes` and `Array.includes`. https://github.com/rescript-lang/rescript/pull/8530
 

compiler/core/js_cmj_format.ml

@@ -45,14 +45,21 @@ type keyed_cmj_value = {
 
 type keyed_cmj_values = keyed_cmj_value array
 
+type hoisted_value = {
+  path: string list;  (** Exact source-level module path segments. *)
+  name: string;  (** Flat compiler identifier used for the public JS export. *)
+}
+
 type t = {
   values: keyed_cmj_values;
+  hoisted_values: hoisted_value array;
   pure: bool;
   package_spec: Js_packages_info.t;
   case: Ext_js_file_kind.case;
 }
 
-let make ~(values : cmj_value Map_string.t) ~effect_ ~package_spec ~case : t =
+let make ~(values : cmj_value Map_string.t) ~hoisted_values ~effect_
+    ~package_spec ~case : t =
   {
     values =
       Map_string.to_sorted_array_with_f values (fun k v ->
@@ -61,6 +68,7 @@ let make ~(values : cmj_value Map_string.t) ~effect_ ~package_spec ~case : t =
             arity = v.arity;
             persistent_closed_lambda = v.persistent_closed_lambda;
           });
+    hoisted_values = Array.of_list hoisted_values;
     pure = effect_ = None;
     package_spec;
     case;
@@ -97,7 +105,8 @@ let to_file name ~check_exists (v : t) =
     output_string oc s;
     close_out oc)
 
-let key_comp (a : string) b = Map_string.compare_key a b.name
+let key_comp (a : string) (b : keyed_cmj_value) =
+  Map_string.compare_key a b.name
 
 let not_found key =
   {name = key; arity = single_na; persistent_closed_lambda = None}
@@ -151,6 +160,13 @@ let query_by_name (cmj_table : t) name : keyed_cmj_value =
   let values = cmj_table.values in
   binary_search values name
 
+let find_hoisted_value (cmj_table : t) path =
+  Array.find_map
+    (fun value ->
+      if List.equal Ext_string.equal value.path path then Some value.name
+      else None)
+    cmj_table.hoisted_values
+
 type path = string
 
 type cmj_load_info = {

compiler/core/js_cmj_format.mli

@@ -60,22 +60,31 @@ type keyed_cmj_value = {
   persistent_closed_lambda: Lam.t option;
 }
 
+type hoisted_value = {
+  path: string list;  (** Exact source-level module path segments. *)
+  name: string;  (** Flat compiler identifier used for the public JS export. *)
+}
+
 type t = {
   values: keyed_cmj_value array;
+  hoisted_values: hoisted_value array;
   pure: bool;
   package_spec: Js_packages_info.t;
   case: Ext_js_file_kind.case;
 }
 
 val make :
   values:cmj_value Map_string.t ->
+  hoisted_values:hoisted_value list ->
   effect_:effect_ ->
   package_spec:Js_packages_info.t ->
   case:Ext_js_file_kind.case ->
   t
 
 val query_by_name : t -> string -> keyed_cmj_value
 
+val find_hoisted_value : t -> string list -> string option
+
 val single_na : arity
 
 val from_file : string -> t

compiler/core/lam_compile.ml

@@ -290,6 +290,39 @@ type initialization = J.block
 *)
 
 let compile output_prefix =
+  (* When compiling a read from another module, a nested source path like
+     Other.A.B.make reaches this point as nested module-field reads:
+
+       Pfield "make" (Pfield "B" (Pfield "A" (Lglobal_module Other)))
+
+     Normal compilation does not look up the full path.  It only queries the
+     first field, "A", and then emits the remaining fields as JS property
+     access: Other.A.B.make.  The "A" lookup may include Submodule arity data,
+     but it does not say whether A.B.make has a separate root-level export.
+
+     Hoisted functions need that extra question. For them, query the separate
+     hoisted-values table with an unambiguous key for source path A.B.make. If
+     present, the table returns the root-level JS export name, for example
+     A$B$make. Normal export metadata still lives in the regular .cmj values
+     table. *)
+  let rec extract_field_path segments primitive args =
+    match (primitive, args) with
+    | ( Lam_primitive.Pfield (_, Fld_module {name}),
+        [Lam.Lprim {primitive; args; _}] ) ->
+      extract_field_path (name :: segments) primitive args
+    | ( Lam_primitive.Pfield (_, Fld_module {name}),
+        [Lam.Lglobal_module (id, dynamic_import)] ) ->
+      Some (id, dynamic_import, name :: segments)
+    | _ -> None
+  in
+  let hoisted_external_field_name primitive args =
+    match extract_field_path [] primitive args with
+    | Some (id, dynamic_import, (_ :: _ :: _ as segments)) ->
+      Ext_option.map
+        (Lam_compile_env.find_hoisted_external_id ~dynamic_import id segments)
+        (fun name -> (id, dynamic_import, name))
+    | Some (_, _, ([] | [_])) | None -> None
+  in
   let rec compile_external_field (* Like [List.empty]*)
       ?(dynamic_import = false) (lamba_cxt : Lam_compile_context.t)
       (id : Ident.t) name : Js_output.t =
@@ -1718,17 +1751,47 @@ let compile output_prefix =
                 fn_code args)))
   and compile_prim (prim_info : Lam.prim_info)
       (lambda_cxt : Lam_compile_context.t) =
+    let compile_primitive_default primitive args loc =
+      let args_block, args_expr =
+        if args = [] then ([], [])
+        else
+          let new_cxt = {lambda_cxt with continuation = NeedValue Not_tail} in
+          Ext_list.split_map args (fun x ->
+              match compile_lambda new_cxt x with
+              | {block; value = Some b} -> (block, b)
+              | {value = None} -> assert false)
+      in
+      let args_code : J.block = List.concat args_block in
+      let exp =
+        (* TODO: all can be done in [compile_primitive] *)
+        Lam_compile_primitive.translate output_prefix loc lambda_cxt primitive
+          args_expr
+      in
+      Js_output.output_of_block_and_expression lambda_cxt.continuation args_code
+        (with_source_loc loc exp)
+    in
     match prim_info with
-    | {
-     primitive = Pfield (_, fld_info);
-     args = [Lglobal_module (id, dynamic_import)];
-     _;
-    } -> (
-      (* should be before Lglobal_global *)
-      match fld_info with
-      | Fld_module {name = field} ->
-        compile_external_field ~dynamic_import lambda_cxt id field
-      | _ -> assert false)
+    | {primitive = Pfield (_, Fld_module _); _} -> (
+      match hoisted_external_field_name prim_info.primitive prim_info.args with
+      | Some (id, dynamic_import, hoisted_name) ->
+        Js_output.output_of_expression lambda_cxt.continuation
+          ~no_effects:no_effects_const
+          (E.ml_var_dot ~dynamic_import id hoisted_name)
+      | None -> (
+        match prim_info with
+        | {
+         primitive = Pfield (_, fld_info);
+         args = [Lglobal_module (id, dynamic_import)];
+         _;
+        } -> (
+          (* should be before Lglobal_global *)
+          match fld_info with
+          | Fld_module {name = field} ->
+            compile_external_field ~dynamic_import lambda_cxt id field
+          | _ -> assert false)
+        | _ ->
+          compile_primitive_default prim_info.primitive prim_info.args
+            prim_info.loc))
     | {primitive = Praise; args = [e]; loc} -> (
       match
         compile_lambda {lambda_cxt with continuation = NeedValue Not_tail} e
@@ -1898,24 +1961,7 @@ let compile output_prefix =
         Location.raise_errorf ~loc
           "Invalid argument: unsupported argument to dynamic import. If you \
            believe this should be supported, please open an issue.")
-    | {primitive; args; loc} ->
-      let args_block, args_expr =
-        if args = [] then ([], [])
-        else
-          let new_cxt = {lambda_cxt with continuation = NeedValue Not_tail} in
-          Ext_list.split_map args (fun x ->
-              match compile_lambda new_cxt x with
-              | {block; value = Some b} -> (block, b)
-              | {value = None} -> assert false)
-      in
-      let args_code : J.block = List.concat args_block in
-      let exp =
-        (* TODO: all can be done in [compile_primitive] *)
-        Lam_compile_primitive.translate output_prefix loc lambda_cxt primitive
-          args_expr
-      in
-      Js_output.output_of_block_and_expression lambda_cxt.continuation args_code
-        (with_source_loc loc exp)
+    | {primitive; args; loc} -> compile_primitive_default primitive args loc
   and collect_dup_overrides (copy_id : Ident.t) (lam : Lam.t)
       (acc : (Lam_compat.set_field_dbg_info * Lam.t) list) :
       (Lam_compat.set_field_dbg_info * Lam.t) list option =

compiler/core/lam_compile_env.ml

@@ -84,20 +84,26 @@ let add_js_module ?import_attributes
     id
   | Some old_key -> old_key.id
 
+let cmj_table_of_module_id ~dynamic_import (module_id : Ident.t) =
+  let oid = Lam_module_ident.of_ml ~dynamic_import module_id in
+  match Lam_module_ident.Hash.find_opt cached_tbl oid with
+  | None ->
+    let cmj_load_info = !Js_cmj_load.load_unit module_id.name in
+    oid +> Ml cmj_load_info;
+    cmj_load_info.cmj_table
+  | Some (Ml {cmj_table}) -> cmj_table
+  | Some External -> assert false
+
 let query_external_id_info ?(dynamic_import = false) (module_id : Ident.t)
     (name : string) : ident_info =
-  let oid = Lam_module_ident.of_ml ~dynamic_import module_id in
-  let cmj_table =
-    match Lam_module_ident.Hash.find_opt cached_tbl oid with
-    | None ->
-      let cmj_load_info = !Js_cmj_load.load_unit module_id.name in
-      oid +> Ml cmj_load_info;
-      cmj_load_info.cmj_table
-    | Some (Ml {cmj_table}) -> cmj_table
-    | Some External -> assert false
-  in
+  let cmj_table = cmj_table_of_module_id ~dynamic_import module_id in
   Js_cmj_format.query_by_name cmj_table name
 
+let find_hoisted_external_id ?(dynamic_import = false) (module_id : Ident.t)
+    (path : string list) : string option =
+  let cmj_table = cmj_table_of_module_id ~dynamic_import module_id in
+  Js_cmj_format.find_hoisted_value cmj_table path
+
 let get_package_path_from_cmj (id : Lam_module_ident.t) :
     string * Js_packages_info.t * Ext_js_file_kind.case =
   let cmj_load_info =

compiler/core/lam_compile_env.mli

@@ -71,6 +71,9 @@ val query_external_id_info :
    will raise if not found
 *)
 
+val find_hoisted_external_id :
+  ?dynamic_import:bool -> Ident.t -> string list -> string option
+
 val is_pure_module : Lam_module_ident.t -> bool
 
 val get_package_path_from_cmj :