fix: handle case of missing .cmj when trying to inline external field

Changes.md

@@ -21,6 +21,11 @@ Unreleased
   going to be reassigned
   ([#1019](https://github.com/melange-re/melange/pull/1019),
   [#1059](https://github.com/melange-re/melange/pull/1059)).
+- runtime: add minimal bindings for JS iterators
+  ([#1060](https://github.com/melange-re/melange/pull/1060))
+- core: handle missing `.cmj` when compiling dune virtual libraries
+  ([#1067](https://github.com/melange-re/melange/pull/1067), fixes
+  [#658](https://github.com/melange-re/melange/issues/658))
 
 3.0.0 2024-01-28
 ---------------

jscomp/core/lam_arity_analysis.ml

@@ -48,9 +48,9 @@ let rec get_arity (meta : Lam_stats.t) (lam : Lam.t) : Lam_arity.t =
         args = [ Lglobal_module id ];
         _;
       } -> (
-      match (Lam_compile_env.query_external_id_info id name).arity with
-      | Single x -> x
-      | Submodule _ -> Lam_arity.na)
+      match Lam_compile_env.query_external_id_info id name with
+      | Some { arity = Single x; _ } -> x
+      | Some { arity = Submodule _; _ } | None -> Lam_arity.na)
   | Lprim
       {
         primitive = Pfield (m, _);
@@ -65,9 +65,10 @@ let rec get_arity (meta : Lam_stats.t) (lam : Lam.t) : Lam_arity.t =
           ];
         _;
       } -> (
-      match (Lam_compile_env.query_external_id_info id name).arity with
-      | Submodule subs -> subs.(m) (* TODO: shall we store it as array?*)
-      | Single _ -> Lam_arity.na)
+      match Lam_compile_env.query_external_id_info id name with
+      | Some { arity = Submodule subs; _ } ->
+          subs.(m) (* TODO: shall we store it as array?*)
+      | Some { arity = Single _; _ } | None -> Lam_arity.na)
   (* TODO: all information except Pccall is complete, we could
      get more arity information
   *)

jscomp/core/lam_compile.ml

@@ -187,12 +187,13 @@ type initialization = J.block
    -: we should not do functor application inlining in a
       non-toplevel, it will explode code very quickly
 *)
-let rec compile_external_field (* Like [List.empty]*)
+let rec compile_external_field (* Like [List.empty] *)
     (lamba_cxt : Lam_compile_context.t) (id : Ident.t) name : Js_output.t =
   match Lam_compile_env.query_external_id_info id name with
-  | { persistent_closed_lambda = Some lam; _ } when Lam_util.not_function lam ->
+  | Some { persistent_closed_lambda = Some lam; _ }
+    when Lam_util.not_function lam ->
       compile_lambda lamba_cxt lam
-  | _ ->
+  | Some _ | None ->
       Js_output.output_of_expression lamba_cxt.continuation
         ~no_effects:no_effects_const (E.ml_var_dot id name)
 
@@ -229,16 +230,22 @@ and compile_external_field_apply (appinfo : Lam.apply) (module_id : Ident.t)
     Lam_compile_env.query_external_id_info module_id field_name
   in
   let ap_args = appinfo.ap_args in
-  match ident_info.persistent_closed_lambda with
-  | Some (Lfunction { params; body; _ }) when List.same_length params ap_args ->
+  match ident_info with
+  | Some { persistent_closed_lambda = Some (Lfunction { params; body; _ }); _ }
+    when List.same_length params ap_args ->
       (* TODO: serialize it when exporting to save compile time *)
       let _, param_map =
         Lam_closure.is_closed_with_map Ident.Set.empty params body
       in
       compile_lambda lambda_cxt
         (Lam_beta_reduce.propogate_beta_reduce_with_map lambda_cxt.meta
            param_map params body ap_args)
-  | _ ->
+  | Some _ | None ->
+      let arity =
+        ident_info
+        |> Option.map (fun (t : Js_cmj_format.keyed_cmj_value) -> t.arity)
+        |> Option.value ~default:Js_cmj_format.single_na
+      in
       let args_code, args =
         let dummy = ([], []) in
         if ap_args = [] then dummy
@@ -253,13 +260,13 @@ and compile_external_field_apply (appinfo : Lam.apply) (module_id : Ident.t)
             ap_args ~init:dummy
       in
 
-      let fn = E.ml_var_dot module_id ident_info.name in
+      let fn = E.ml_var_dot module_id field_name in
       let expression =
         match appinfo.ap_info.ap_status with
         | (App_infer_full | App_uncurry) as ap_status ->
             E.call ~info:(call_info_of_ap_status ap_status) fn args
         | App_na -> (
-            match ident_info.arity with
+            match arity with
             | Submodule _ | Single Arity_na ->
                 E.call ~info:Js_call_info.dummy fn args
             | Single x ->

jscomp/core/lam_compile_env.ml

@@ -82,7 +82,8 @@ let add_js_module (hint_name : Melange_ffi.External_ffi_types.module_bind_name)
       id
   | Some old_key -> old_key.id
 
-let query_external_id_info (module_id : Ident.t) (name : string) : ident_info =
+let query_external_id_info_exn (module_id : Ident.t) (name : string) :
+    ident_info =
   let oid = Lam_module_ident.of_ml module_id in
   let cmj_table =
     match Lam_module_ident.Hash.find_opt cached_tbl oid with
@@ -95,6 +96,10 @@ let query_external_id_info (module_id : Ident.t) (name : string) : ident_info =
   in
   Js_cmj_format.query_by_name cmj_table name
 
+let query_external_id_info module_id name =
+  try Some (query_external_id_info_exn module_id name)
+  with Mel_exception.Error (Cmj_not_found _) -> None
+
 let get_dependency_info_from_cmj (id : Lam_module_ident.t) :
     Js_packages_info.t * Js_packages_info.file_case =
   let cmj_load_info =

jscomp/core/lam_compile_env.mli

@@ -59,11 +59,20 @@ val add_js_module :
    pay attention to for those modules are actually used or not
 *)
 
-val query_external_id_info : Ident.t -> string -> Js_cmj_format.keyed_cmj_value
-(**
-  [query_external_id_info id pos env found]
-  will raise if not found
-*)
+val query_external_id_info :
+  Ident.t -> string -> Js_cmj_format.keyed_cmj_value option
+(** [query_external_id_info module_id name]
+
+  Note: This function checks whether there's inlining information available for
+  the lambda being compiled.
+
+  The fallback case (deopt) happens in 2 scenarios:
+
+    1. there's no inlining information available in the `.cmj` file
+    2. there's no `.cmj` file available. This can happen if we're compiling a
+    dune virtual library where one of the modules uses a binding from any of
+    its virtual modules. Because we're programming against the interface file
+    at this point, we must emit the deoptimized expression too. *)
 
 val is_pure_module : Lam_module_ident.t -> bool
 

jscomp/core/lam_pass_remove_alias.ml

@@ -133,7 +133,11 @@ let simplify_alias (meta : Lam_stats.t) (lam : Lam.t) : Lam.t =
           ap_info;
         } -> (
         match Lam_compile_env.query_external_id_info ident fld_name with
-        | { persistent_closed_lambda = Some (Lfunction { params; body; _ }); _ }
+        | Some
+            {
+              persistent_closed_lambda = Some (Lfunction { params; body; _ });
+              _;
+            }
         (* be more cautious when do cross module inlining *)
           when List.same_length params args
                && List.for_all
@@ -146,7 +150,8 @@ let simplify_alias (meta : Lam_stats.t) (lam : Lam.t) : Lam.t =
                       | _ -> true)
                     args ->
             simpl (Lam_beta_reduce.propogate_beta_reduce meta params body args)
-        | _ -> Lam.apply (simpl l1) (List.map ~f:simpl args) ap_info)
+        | Some _ | None -> Lam.apply (simpl l1) (List.map ~f:simpl args) ap_info
+        )
     (* Function inlining interact with other optimizations...
 
         - parameter attributes

jscomp/core/mel_exception.mli

@@ -33,7 +33,7 @@ TODO: In the futrue, we should refine dependency [bsb]
 should not rely on such exception, it should have its own exception handling
 *)
 
-(* exception Error of error *)
+exception Error of error
 
 (* val report_error : Format.formatter -> error -> unit *)
 

test/blackbox-tests/virtual-lib-compilation.t

@@ -0,0 +1,61 @@
+
+  $ . ./setup.sh
+  $ cat > dune-project <<EOF
+  > (lang dune 3.9)
+  > (using melange 0.1)
+  > EOF
+  $ cat > dune <<EOF
+  > (melange.emit
+  >  (target output)
+  >  (alias mel)
+  >  (modules x)
+  >  (emit_stdlib false)
+  >  (libraries vlib impl_melange))
+  > EOF
+
+  $ mkdir impl_melange vlib
+  $ cat > vlib/dune <<EOF
+  > (library
+  >  (name vlib)
+  >  (wrapped false)
+  >  (modes melange)
+  >  (virtual_modules virt))
+  > EOF
+
+  $ cat > vlib/virt.mli <<EOF
+  > val t : string
+  > EOF
+  $ cat > vlib/vlib.ml <<EOF
+  > let hello = "Hello from " ^ Virt.t
+  > EOF
+
+  $ cat > impl_melange/dune <<EOF
+  > (library
+  >  (name impl_melange)
+  >  (modes melange)
+  >  (implements vlib))
+  > EOF
+
+  $ cat > impl_melange/virt.ml << EOF
+  > let t = "melange"
+  > EOF
+
+  $ cat > x.ml <<EOF
+  > let () = print_endline Vlib.hello
+  > EOF
+
+  $ dune build @mel --display=short
+      ocamldep vlib/.vlib.objs/virt.intf.d
+      ocamldep impl_melange/.impl_melange.objs/virt.impl.d
+      ocamldep vlib/.vlib.objs/vlib.impl.d
+          melc vlib/.vlib.objs/melange/virt.{cmi,cmti}
+          melc vlib/.vlib.objs/melange/vlib.{cmi,cmj,cmt}
+          melc impl_melange/.impl_melange.objs/melange/virt.{cmj,cmt}
+          melc output/vlib/vlib.js
+          melc .output.mobjs/melange/melange__X.{cmi,cmj,cmt}
+          melc output/impl_melange/virt.js
+          melc output/x.js
+
+  $ output=_build/default/output/x.js
+  $ node "$output"
+  Hello from melange