Evaluate @int, @as, unit and @ignore arguments of externals in their place

changes/external-int-argument-retention.fix.md

@@ -0,0 +1 @@
+- Fix an `@int` or `@as` argument of an external keeping what it reads alive for as long as a closure created next to it.

changes/external-unit-argument-effects-in-place.fix.md

@@ -0,0 +1,3 @@
+- Evaluate a `unit` or `@ignore` argument of an external in source order, as in `setX(t, f(), g())`.
+- Call an external whose arguments are all `@ignore` without them, like other externals.
+- Keep the effects of the `@ignore` arguments of a `@module` external that is the module itself.

compiler/core/js_exp_make.ml

@@ -406,8 +406,6 @@ let rec seq ?comment (e0 : t) (e1 : t) : t =
   | (Number _ | Var _ | Undefined _), _ -> e1
   | _ -> {expression_desc = Seq (e0, e1); comment; source_loc = None}
 
-let fuse_to_seq x xs = if xs = [] then x else Ext_list.fold_left xs x seq
-
 let zero_int_literal : t =
   {
     expression_desc = Number (Int {i = 0l; c = None});
@@ -1767,30 +1765,6 @@ let bigint_mod ~checked (e0 : t) (e1 : t) =
   if checked then runtime_call Primitive_modules.bigint "mod_" [e0; e1]
   else bigint_op Mod e0 e1
 
-(* TODO -- alpha conversion
-    remember to add parens..
-*)
-let of_block block : t =
-  let return_unit = false in
-  (* This case is not hit that much*)
-  call ~info:Js_call_info.ml_full_call
-    {
-      comment = None;
-      source_loc = None;
-      expression_desc =
-        Fun
-          {
-            is_method = false;
-            params = [];
-            body = block;
-            env = Js_fun_env.make 0;
-            return_unit;
-            async = false;
-            directive = None;
-          };
-    }
-    []
-
 let is_null (x : t) = triple_equal x nil
 
 let is_null_undefined_constant (x : t) =

compiler/core/js_exp_make.mli

@@ -269,8 +269,6 @@ val make_block :
 
 val seq : ?comment:string -> t -> t -> t
 
-val fuse_to_seq : t -> t list -> t
-
 val object_entries : ?dup:J.expression -> J.property_map -> J.object_entry list
 
 val obj : ?dup:J.expression -> J.property_map -> t
@@ -307,9 +305,6 @@ val in_ : t -> t -> t
 
 val dummy_obj : Lambda.tag_info -> t
 
-val of_block : J.statement list -> t
-(** convert a block to expresion by using IIFE *)
-
 val raw_js_code : Js_raw_info.code_info -> string -> t
 
 val nil : t

compiler/core/js_of_lam_variant.ml

@@ -27,34 +27,55 @@ module S = Js_stmt_make
 
 type arg_expression = Splice0 | Splice1 of E.t | Splice2 of E.t * E.t
 
-(* [eval] and [eval_as_int] read an argument other than a literal once,
-   inside the function that dispatches on it. That is the same as reading it
-   in place when the read has no effect and cannot await. *)
-let eval_in_place (arg : J.expression) =
-  Js_analyzer.no_side_effect_expression arg
-
 (* [eval_as_event] reads an argument other than a literal twice, for the tag
-   (inside the function that dispatches on it, with [@as]) and for the
-   payload. That is the same as reading it once, in place, for constants,
-   variables, and fields, array elements and conditionals of them. A JS global
-   ([@val]) or a JS property read, as from a [@get] external, may run a getter
-   each time, so it does not count. *)
+   and for the payload. That is the same as reading it once, in place, when
+   [Js_analyzer.is_okay_to_duplicate ~property_reads:false] holds for it: for
+   constants, variables and fields of records. A JS global ([@val]) counts as
+   a variable, like a value of a JS module ([@module]), though either may be
+   a getter. A JS property read does not count: a [@get] external is there to
+   run a getter, and a [@val] or [@module] value with [@scope], or a [@val]
+   with a dotted name such as ["window.ev"], is a property read as well,
+   which cannot be told from it. Array elements and conditionals of such
+   arguments, and their fields, count too, though [is_okay_to_duplicate]
+   leaves them out: here the alternative is a temporary, a statement that
+   also binds the arguments to its left that have side effects. *)
 let eval_as_event_in_place (arg : J.expression) =
   let rec duplicable (e : J.expression) =
     match e.expression_desc with
-    | Undefined _ | Bool _ | Number _ | Str _ | Template_literal _
-    | Var (Qualified _) ->
-      true
-    | Var (Id id) -> not (Ext_ident.is_js id)
     | Static_index (e, _, Some _) -> duplicable e
     | Array_index (a, b) -> duplicable a && duplicable b
     | Cond (a, b, c) -> duplicable a && duplicable b && duplicable c
-    | _ -> false
+    | _ -> Js_analyzer.is_okay_to_duplicate ~property_reads:false e
   in
   match arg.expression_desc with
   | Caml_block ([{expression_desc = Str _}; _], _, Blk_poly_var) -> true
   | _ -> duplicable arg
 
+(* [(x => { switch (x) { case s: return r; ... } })(arg)]: the result [r] for
+   the case [s] that [arg] matches. [arg] is an argument of the call, so it is
+   evaluated once and in its place, and an [await] in it belongs to the code
+   around it. The function captures no variable of that code, so it keeps
+   none of them alive for the closures that code creates. *)
+let dispatch (arg : J.expression) (cases : (string * 'a) list)
+    (result : 'a -> J.expression) : J.expression =
+  let x = Ident.create "x" in
+  E.call ~info:Js_call_info.ml_full_call
+    (E.ocaml_fun ~return_unit:false ~async:false ~one_unit_arg:false [x]
+       [
+         S.string_switch (E.var x)
+           (Ext_list.map cases (fun (s, r) ->
+                ( Variant_runtime.Literal (String s),
+                  J.
+                    {
+                      switch_body = [S.return_stmt (result r)];
+                      should_break = false;
+                      (* FIXME: if true, still print break*)
+                      comment = None;
+                      source_loc = None;
+                    } )));
+       ])
+    [arg]
+
 (* we need destruct [undefined] when input is optional *)
 let eval (arg : J.expression) (dispatches : (string * string) list) : E.t =
   if arg == E.undefined then E.undefined
@@ -63,21 +84,7 @@ let eval (arg : J.expression) (dispatches : (string * string) list) : E.t =
     | Str txt ->
       let s = Ext_list.assoc_by_string dispatches txt None in
       E.str s
-    | _ ->
-      E.of_block
-        [
-          S.string_switch arg
-            (Ext_list.map dispatches (fun (s, r) ->
-                 ( Variant_runtime.Literal (String s),
-                   J.
-                     {
-                       switch_body = [S.return_stmt (E.str r)];
-                       should_break = false;
-                       (* FIXME: if true, still print break*)
-                       comment = None;
-                       source_loc = None;
-                     } )));
-        ]
+    | _ -> dispatch arg dispatches E.str
 
 (* invariant: optional is not allowed in this case *)
 (* arg is a polyvar *)
@@ -99,21 +106,7 @@ let eval_as_event (arg : J.expression)
     Splice2
       ( (match dispatches with
         | Some dispatches ->
-          E.of_block
-            [
-              S.string_switch
-                (E.poly_var_tag_access arg)
-                (Ext_list.map dispatches (fun (s, r) ->
-                     ( Variant_runtime.Literal (String s),
-                       J.
-                         {
-                           switch_body = [S.return_stmt (E.str r)];
-                           should_break = false;
-                           (* FIXME: if true, still print break*)
-                           comment = None;
-                           source_loc = None;
-                         } )));
-            ]
+          dispatch (E.poly_var_tag_access arg) dispatches E.str
         | None -> E.poly_var_tag_access arg),
         E.poly_var_value_access arg )
 
@@ -124,21 +117,7 @@ let eval_as_int (arg : J.expression) (dispatches : (string * int) list) : E.t =
     match arg.expression_desc with
     | Str txt ->
       E.int (Int32.of_int (Ext_list.assoc_by_string dispatches txt None))
-    | _ ->
-      E.of_block
-        [
-          S.string_switch arg
-            (Ext_list.map dispatches (fun (s, r) ->
-                 ( Variant_runtime.Literal (String s),
-                   J.
-                     {
-                       switch_body = [S.return_stmt (E.int (Int32.of_int r))];
-                       should_break = false;
-                       (* FIXME: if true, still print break*)
-                       comment = None;
-                       source_loc = None;
-                     } )));
-        ]
+    | _ -> dispatch arg dispatches (fun r -> E.int (Int32.of_int r))
 
 let eval_as_unwrap (arg : J.expression) : E.t =
   match arg.expression_desc with

compiler/core/js_of_lam_variant.mli

@@ -29,19 +29,19 @@ type arg_expression =
   | Splice1 of J.expression
   | Splice2 of J.expression * J.expression
 
-val eval_in_place : J.expression -> bool
-(** Whether [eval] and [eval_as_int] can be given the argument as it is,
-    rather than a variable bound to it: they may read it inside a function *)
-
 val eval_as_event_in_place : J.expression -> bool
 (** Whether [eval_as_event] can be given the argument as it is, rather than a
     variable bound to it: it may read it twice *)
 
 val eval : J.expression -> (string * string) list -> J.expression
+(** The string that a [@string] argument stands for. The argument is
+    evaluated once, in its place: a function that switches on it is called
+    with it. *)
 
 val eval_as_event :
   J.expression -> (string * string) list option -> arg_expression
 
 val eval_as_int : J.expression -> (string * int) list -> J.expression
+(** The integer that an [@int] argument stands for, evaluated like [eval] *)
 
 val eval_as_unwrap : J.expression -> J.expression

compiler/core/lam_compile.ml

@@ -1942,9 +1942,9 @@ let compile output_prefix =
       Js_output.output_of_block_and_expression lambda_cxt.continuation
         (Ext_list.append args_code block)
         exp
-    | {primitive = Pjs_call {arg_types} as primitive; args; loc} ->
+    | {primitive = Pjs_call {arg_types; ffi} as primitive; args; loc} ->
       compile_primitive_default
-        ~hold:(Lam_compile_external_call.hold_args arg_types)
+        ~hold:(Lam_compile_external_call.hold_args ffi arg_types)
         primitive args loc
     | {primitive; args; loc} -> compile_primitive_default primitive args loc
   and collect_dup_overrides (copy_id : Ident.t) (lam : Lambda.t)