Add opt-in cross-module inlining for Option helpers

changes/cross-module-inline-option.feature.md

@@ -0,0 +1 @@
+- Allow selected functions to opt into cross-module inlining with `@inline(crossModule)` and inline common `Option` helpers in application code.

compiler/core/js_cmj_format.ml

@@ -118,6 +118,7 @@ let get_result mid_val =
          (Const_js_null | Const_js_undefined _ | Const_js_true | Const_js_false))
   | None ->
     mid_val
+  | Some (Lfunction f) when f.attr.inline = Cross_module_inline -> mid_val
   | Some _ ->
     if !((Js_config.current ()).cross_module_inline) then mid_val
     else {mid_val with persistent_closed_lambda = None}

compiler/core/js_cmj_format.mli

@@ -81,9 +81,8 @@ val single_na : arity
 
 val from_file : string -> t
 
-(*
-   Note writing the file if its content is not changed
-*)
+(* Write the .cmj. Unchanged files are not rewritten when [check_exists] is
+   true, so Rewatch can use changes to this file to invalidate callers. *)
 val to_file : string -> check_exists:bool -> t -> unit
 
 type path = string

compiler/core/lam_analysis.ml

@@ -278,7 +278,7 @@ let lfunction_can_be_inlined (lfunction : Lambda.lfunction) =
 (** Hints to inlining *)
 let ok_to_inline_fun_when_app (m : Lambda.lfunction) (args : Lambda.t list) =
   match m.attr.inline with
-  | Always_inline -> true
+  | Always_inline | Cross_module_inline -> true
   | Never_inline -> false
   | Default_inline -> (
     match m with

compiler/core/lam_closure.ml

@@ -117,7 +117,11 @@ let free_variables (export_idents : Set_ident.t) (params : stats Map_ident.t)
       iter sink_pos e1;
       local_add_list vars;
       iter sink_pos e2
-    | Ltrywith (e1, _, e2) | Ltryfinally (e1, e2) ->
+    | Ltrywith (e1, exn, e2) ->
+      iter top e1;
+      local_add exn;
+      iter sink_pos e2
+    | Ltryfinally (e1, e2) ->
       iter top e1;
       iter sink_pos e2
     | Lifthenelse (e1, e2, e3) ->

compiler/core/lam_stats_export.ml

@@ -58,6 +58,19 @@ let values_of_export (meta : Lam_stats.t) (export_map : Lambda.t Map_ident.t) :
                | Const_js_false ))
         | None ->
           optlam
+        | Some
+            (Lfunction
+               ({attr = {inline = Cross_module_inline}; loc} as lfunction) as
+             lambda) ->
+          if not (Lam_analysis.lfunction_can_be_inlined lfunction) then
+            Location.raise_errorf ~loc
+              "@inline(crossModule) cannot be used on an async or directed \
+               function"
+          else if not (Lam_closure.is_closed lambda) then
+            Location.raise_errorf ~loc
+              "@inline(crossModule) requires a function without captured local \
+               values"
+          else optlam
         | Some lambda ->
           if not !((Js_config.current ()).cross_module_inline) then None
           else if

compiler/ml/lambda.ml

@@ -331,6 +331,7 @@ type inline_attribute =
   | Always_inline (* [@inline] or [@inline always] *)
   | Never_inline (* [@inline never] *)
   | Default_inline (* no [@inline] attribute *)
+  | Cross_module_inline (* [@inline(crossModule)] *)
 
 type let_kind = Strict | Alias | StrictOpt | Variable
 

compiler/ml/lambda.mli

@@ -334,6 +334,7 @@ type inline_attribute =
   | Always_inline (* [@inline] or [@inline always] *)
   | Never_inline (* [@inline never] *)
   | Default_inline (* no [@inline] attribute *)
+  | Cross_module_inline (* [@inline(crossModule)] *)
 
 type let_kind = Strict | Alias | StrictOpt | Variable
 (* Meaning of kinds for let x = e in e':

compiler/ml/printlambda.ml

@@ -242,6 +242,7 @@ let function_attribute ppf {inline; is_a_functor; return_unit} =
   match inline with
   | Default_inline -> ()
   | Always_inline -> fprintf ppf "always_inline@ "
+  | Cross_module_inline -> fprintf ppf "cross_module_inline@ "
   | Never_inline -> fprintf ppf "never_inline@ "
 
 let rec lam ppf = function

compiler/ml/translattribute.ml

@@ -34,18 +34,20 @@ let parse_inline_attribute (attr : t option) : Lambda.inline_attribute =
   | Some ({txt; loc}, payload) -> (
     let open Parsetree in
     (* the 'inline' attribute can be used as
-       [@inline], [@inline never] or [@inline always].
+       [@inline], [@inline never], [@inline always] or
+       [@inline(crossModule)].
        [@inline] is equivalent to [@inline always] *)
     let warning txt =
       Warnings.Attribute_payload
-        (txt, "It must be either empty, 'always' or 'never'")
+        (txt, "It must be empty, 'always', 'never' or 'crossModule'")
     in
     match payload with
     | PStr [] -> Always_inline
     | PStr [{pstr_desc = Pstr_eval (expression, [])}] -> (
       match (Ast_payload.unwrap_braces expression).pexp_desc with
       | Pexp_ident {txt = Longident.Lident "never"} -> Never_inline
       | Pexp_ident {txt = Longident.Lident "always"} -> Always_inline
+      | Pexp_ident {txt = Longident.Lident "crossModule"} -> Cross_module_inline
       | _ ->
         Location.prerr_warning loc (warning txt);
         Default_inline)
@@ -62,14 +64,11 @@ let add_inline_attribute (expr : Lambda.t) loc attributes =
   | Lfunction ({attr} as funct), inline ->
     (match attr.inline with
     | Default_inline -> ()
-    | Always_inline | Never_inline ->
+    | Always_inline | Cross_module_inline | Never_inline ->
       Location.prerr_warning loc (Warnings.Duplicated_attribute "inline"));
     let attr = {attr with inline} in
     Lambda.function_ ~loc:funct.loc ~attr ~params:funct.params ~body:funct.body
-  | expr, Always_inline ->
-    Location.prerr_warning loc (Warnings.Misplaced_attribute "inline");
-    expr
-  | expr, Never_inline ->
+  | expr, (Always_inline | Cross_module_inline | Never_inline) ->
     Location.prerr_warning loc (Warnings.Misplaced_attribute "inline");
     expr
 

packages/@rescript/runtime/Stdlib_Option.res

@@ -5,12 +5,14 @@
  */
 type t<'a> = option<'a> = None | Some('a)
 
+@inline(crossModule)
 let filter = (opt, p) =>
   switch opt {
   | Some(x) as option if p(x) => option
   | _ => None
   }
 
+@inline(crossModule)
 let forEach = (opt, f) =>
   switch opt {
   | Some(x) => f(x)
@@ -31,42 +33,49 @@ let getOrThrow = (x, ~message=?) =>
 
 external getUnsafe: option<'a> => 'a = "%identity"
 
+@inline(crossModule)
 let mapOr = (opt, default, f) =>
   switch opt {
   | Some(x) => f(x)
   | None => default
   }
 
+@inline(crossModule)
 let map = (opt, f) =>
   switch opt {
   | Some(x) => Some(f(x))
   | None => None
   }
 
+@inline(crossModule)
 let flatMap = (opt, f) =>
   switch opt {
   | Some(x) => f(x)
   | None => None
   }
 
+@inline(crossModule)
 let getOr = (opt, default) =>
   switch opt {
   | Some(x) => x
   | None => default
   }
 
+@inline(crossModule)
 let orElse = (opt, other) =>
   switch opt {
   | Some(_) as some => some
   | None => other
   }
 
+@inline(crossModule)
 let isSome = x =>
   switch x {
   | Some(_) => true
   | None => false
   }
 
+@inline(crossModule)
 let isNone = x => x == None
 
 let equal = (a, b, eq) =>

rewatch-ocaml/build_state.ml

@@ -111,8 +111,7 @@ let record_published_cmi ?dirty_propagation state ~compile_assets module_ ~path
     mark_dependents_compile_dirty ?visited:dirty_propagation state module_);
   Compile_assets.refresh_cmi compile_assets ~key:module_.key ~path;
   module_.last_compiled_cmi <-
-    Compile_assets.cmi compile_assets module_.key
-    |> Option.map (fun entry -> entry.Compile_assets.modified)
+    Compile_assets.published compile_assets module_.key
 
 let record_successful_compile ~compile_assets module_ ~cmt_path =
   Compile_assets.refresh_cmt compile_assets ~key:module_.key ~path:cmt_path;

rewatch-ocaml/build_state.mli

@@ -15,6 +15,7 @@ type module_ = {
   mutable dependents: String_set.t;
   mutable compile_dirty: bool;
   mutable last_compiled_cmi: float option;
+      (** See {!Compile_assets.published}. *)
   mutable last_compiled_cmt: float option;
 }
 

rewatch-ocaml/compile_assets.ml

@@ -8,6 +8,7 @@ type t = {
   ast_by_source: (string, entry) Hashtbl.t;
   cmi_by_module: (string, entry) Hashtbl.t;
   cmt_by_module: (string, entry) Hashtbl.t;
+  cmj_by_module: (string, entry) Hashtbl.t;
 }
 
 let ast_header path =
@@ -21,7 +22,7 @@ let is_managed_basename basename =
   List.exists (Filename.check_suffix basename) cleanup_extensions
 
 let state_extension = function
-  | ".ast" | ".iast" | ".cmi" | ".cmt" -> true
+  | ".ast" | ".iast" | ".cmi" | ".cmj" | ".cmt" -> true
   | _ -> false
 
 let read_directory directory =
@@ -58,6 +59,7 @@ let add_module_artifact state (entry, name) =
   match Filename.extension name with
   | ".cmi" -> Hashtbl.replace state.cmi_by_module (module_key name) entry
   | ".cmt" -> Hashtbl.replace state.cmt_by_module (module_key name) entry
+  | ".cmj" -> Hashtbl.replace state.cmj_by_module (module_key name) entry
   | _ -> ()
 
 let create directories =
@@ -69,6 +71,7 @@ let create directories =
       ast_by_source = Hashtbl.create 64;
       cmi_by_module = Hashtbl.create 64;
       cmt_by_module = Hashtbl.create 64;
+      cmj_by_module = Hashtbl.create 64;
     }
   in
   directories
@@ -118,14 +121,22 @@ let ast state source = Hashtbl.find_opt state.ast_by_source (source_key source)
 let cmi state key = Hashtbl.find_opt state.cmi_by_module key
 let cmt state key = Hashtbl.find_opt state.cmt_by_module key
 
+let published state key =
+  match (cmi state key, Hashtbl.find_opt state.cmj_by_module key) with
+  | None, _ -> None
+  | Some cmi, None -> Some cmi.modified
+  | Some cmi, Some cmj -> Some (Float.max cmi.modified cmj.modified)
+
 let replace_from_path table key path =
   try
     Hashtbl.replace table key {path; modified = (Unix.stat path).Unix.st_mtime}
   with Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) ->
     Hashtbl.remove table key
 
 let refresh_cmi state ~key ~path =
-  replace_from_path state.cmi_by_module key path
+  replace_from_path state.cmi_by_module key path;
+  replace_from_path state.cmj_by_module key
+    (Filename.remove_extension path ^ ".cmj")
 
 let refresh_cmt state ~key ~path =
   replace_from_path state.cmt_by_module key path

rewatch-ocaml/compile_assets.mli

@@ -14,6 +14,14 @@ val ast_dependencies : t -> string -> string list
 val ast : t -> string -> entry option
 val cmi : t -> string -> entry option
 val cmt : t -> string -> entry option
+
+val published : t -> string -> float option
+(** When the module's CMI, or its CMJ if newer, was last written; [None] without
+    a CMI. A CMJ can change without its CMI, for example when an exported inline
+    body changes, and dependents compiled before it are stale too. *)
+
 val refresh_cmi : t -> key:string -> path:string -> unit
+(** Also refreshes the CMJ next to [path]. *)
+
 val refresh_cmt : t -> key:string -> path:string -> unit
 val refresh_ast : t -> source:string -> path:string -> unit

rewatch-ocaml/compiler_process.ml

@@ -124,7 +124,11 @@ let parse_request ~build_dir ~(config : Config.t) path =
 let ast_dependencies ~build_dir ast =
   (Ast_header.read (Filename.concat build_dir ast)).dependencies
 
-type compiler_artifact = Cmi | Required of string | Optional of string
+type compiler_artifact = Cmi | Cmj | Required of string | Optional of string
+
+(* The returned change tells whether dependents must recompile. Besides the
+   .cmi, this includes the .cmj: exported inline bodies can change without
+   changing the module's type. *)
 
 let publish_compiler_artifacts ~artifact_dir ~ocaml_dir ~basename artifacts =
   let cmi_change = ref Compiler_scheduler.Cmi_change_unknown in
@@ -134,6 +138,7 @@ let publish_compiler_artifacts ~artifact_dir ~ocaml_dir ~basename artifacts =
         let extension =
           match artifact with
           | Cmi -> "cmi"
+          | Cmj -> "cmj"
           | Required name | Optional name -> name
         in
         let source =
@@ -148,6 +153,14 @@ let publish_compiler_artifacts ~artifact_dir ~ocaml_dir ~basename artifacts =
             if File_util.copy_file_if_different source destination then
               Compiler_scheduler.Cmi_changed
             else Compiler_scheduler.Cmi_unchanged
+        | Cmj -> (
+          match
+            (File_util.copy_file_if_different source destination, !cmi_change)
+          with
+          | true, _ -> cmi_change := Compiler_scheduler.Cmi_changed
+          | false, Compiler_scheduler.Cmi_change_unknown ->
+            cmi_change := Compiler_scheduler.Cmi_unchanged
+          | false, (Compiler_scheduler.Cmi_changed | Cmi_unchanged) -> ())
         | Required _ -> File_util.copy_existing_file source destination
         | Optional _ -> File_util.copy_optional_existing_file source destination)
       artifacts;
@@ -278,13 +291,11 @@ let publish ~build_dir ~ocaml_dir ~is_local ~(config : Config.t) ~has_interface
        | Source.Implementation when has_interface ->
          (* The implementation is compiled with -bs-read-cmi, so its .cmi is
            the one already published after compiling the interface. *)
-         ignore
-           (publish_compiler_artifacts ~artifact_dir ~ocaml_dir ~basename
-              [Required "cmj"; Optional "cmt"]);
-         Compiler_scheduler.Cmi_unchanged
+         publish_compiler_artifacts ~artifact_dir ~ocaml_dir ~basename
+           [Cmj; Optional "cmt"]
        | Source.Implementation ->
          publish_compiler_artifacts ~artifact_dir ~ocaml_dir ~basename
-           [Cmi; Required "cmj"; Optional "cmt"]);
+           [Cmi; Cmj; Optional "cmt"]);
     let source = Filename.concat config.root path in
     let build_source = Filename.concat build_dir path in
     File_util.ensure_dir (Filename.dirname build_source);

rewatch-ocaml/module_graph.ml

@@ -291,8 +291,7 @@ let initialize ~(root_config : Config.t) ~package_plans ~compile_assets
   List.iter
     (fun ((node : module_node), _) ->
       Build_state.add build_state ~key:node.key ~kind:Build_state.Source_module
-        ~last_compiled_cmi:
-          (Compile_assets.cmi compile_assets node.key |> modified)
+        ~last_compiled_cmi:(Compile_assets.published compile_assets node.key)
         ~last_compiled_cmt:
           (Compile_assets.cmt compile_assets node.key |> modified))
     source_graph_nodes;
@@ -301,8 +300,7 @@ let initialize ~(root_config : Config.t) ~package_plans ~compile_assets
       Build_state.add build_state ~key:namespace_map.key
         ~kind:Build_state.Namespace_map
         ~last_compiled_cmi:
-          (Compile_assets.cmi compile_assets namespace_map.compiler_name
-          |> modified)
+          (Compile_assets.published compile_assets namespace_map.compiler_name)
         ~last_compiled_cmt:
           (Compile_assets.cmt compile_assets namespace_map.compiler_name
           |> modified))

rewatch/src/build/clean.rs

@@ -55,7 +55,7 @@ fn remove_compile_asset(package: &packages::Package, source_file: &Path, extensi
         package,
         &package.namespace,
         source_file,
-        extension,
+        &format!(".{extension}"),
     ));
 }