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.

changes/optional-external-argument-none.fix.md

@@ -0,0 +1 @@
+- Fix a `TypeError` when an optional external argument such as `~x=?dict->Dict.get(k)`, or an optional JSX key, is `None`.

changes/optional-external-argument-once.fix.md

@@ -0,0 +1,2 @@
+- Evaluate an optional `@obj` argument such as `~x=?f()` in source order.
+- Read an optional external argument that is a JS property, such as a `@get` getter, only once.

compiler/core/js_analyzer.ml

@@ -365,8 +365,13 @@ let rev_toplevel_flatten block =
     is_constant a && is_constant b
    | _ -> false *)
 
-let rec is_okay_to_duplicate (e : J.expression) =
+let rec is_okay_to_duplicate ?(property_reads = true) (e : J.expression) =
   match e.expression_desc with
+  | Var (Id id)
+    when (not property_reads) && Ext_ident.is_js id
+         && String.contains id.name '.' ->
+    false
   | Var _ | Bool _ | Str _ | Template_literal _ | Number _ -> true
-  | Static_index (e, _s, _off) -> is_okay_to_duplicate e
+  | Static_index (e, _s, off) ->
+    (property_reads || off <> None) && is_okay_to_duplicate ~property_reads e
   | _ -> false

compiler/core/js_analyzer.mli

@@ -70,8 +70,9 @@ val rev_toplevel_flatten : J.block -> J.block
 
 (* val is_constant : J.expression -> bool *)
 
-(** Simple expression, 
-    no computation involved so that  it is okay to be duplicated
-*)
-
-val is_okay_to_duplicate : J.expression -> bool
+val is_okay_to_duplicate : ?property_reads:bool -> J.expression -> bool
+(** Simple expression, no computation involved so that it is okay to be
+    duplicated. With [~property_reads:false], reading it twice also gives the
+    same value twice: it reads no JS property, which may run a getter each
+    time, as one from a [@get] external or a [@val] name with a dot does.
+    Fields of records count. *)

compiler/core/js_ast_util.ml

@@ -26,8 +26,9 @@
 
 module S = Js_stmt_make
 
-let named_expression (e : J.expression) : (J.statement * Ident.t) option =
-  if Js_analyzer.is_okay_to_duplicate e then None
+let named_expression ?property_reads (e : J.expression) :
+    (J.statement * Ident.t) option =
+  if Js_analyzer.is_okay_to_duplicate ?property_reads e then None
   else
     let obj = Ext_ident.create_tmp () in
     let obj_code = S.define_variable ~kind:Strict obj e in

compiler/core/js_ast_util.mli

@@ -22,4 +22,7 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-val named_expression : J.expression -> (J.statement * Ident.t) option
+val named_expression :
+  ?property_reads:bool -> J.expression -> (J.statement * Ident.t) option
+(** A temporary bound to the expression, unless
+    {!Js_analyzer.is_okay_to_duplicate} holds for it *)

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_option.ml

@@ -74,10 +74,12 @@ let get_default_undefined_from_optional (arg : J.expression) : J.expression =
     match desc with
     | Optional_block (x, _) -> x (* invariant: option encoding *)
     | _ ->
-      if Js_analyzer.is_okay_to_duplicate arg then
+      if Js_analyzer.is_okay_to_duplicate ~property_reads:false arg then
         (* FIXME: no need do such inlining*)
         E.econd (is_not_none arg) (val_from_option arg) E.undefined
-      else E.runtime_call Primitive_modules.option "valFromOption" [arg]
+      else
+        (* [valFromOption] returns [undefined] for [None] as well *)
+        E.runtime_call Primitive_modules.option "valFromOption" [arg]
 
 let option_unwrap (arg : J.expression) : J.expression =
   let desc = arg.expression_desc in

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

@@ -282,7 +282,8 @@ let rec delay_safe ~assignable (e : J.expression) =
    Building an array, block or object literal is pure, so a literal stays in
    place and its elements are evaluated now instead. That also keeps the
    literal visible to translations that look into their arguments, such as
-   the rows of a dict literal or a [@variadic] array. *)
+   the rows of a dict literal or a [@variadic] array. So does an
+   [Optional_block], which keeps an optional argument known to be present. *)
 let rec evaluate_now ~assignable (e : J.expression) : J.block * J.expression =
   match e.expression_desc with
   | _ when delay_safe ~assignable e -> ([], e)
@@ -291,6 +292,9 @@ let rec evaluate_now ~assignable (e : J.expression) : J.block * J.expression =
     if Js_analyzer.no_side_effect_expression a then (rest, b)
     else
       ({J.statement_desc = Exp a; comment = None; source_loc = None} :: rest, b)
+  | Optional_block (a, identity) ->
+    let held, a = evaluate_now ~assignable a in
+    (held, {e with expression_desc = Optional_block (a, identity)})
   | Array xs ->
     let held, xs = evaluate_all_now ~assignable xs in
     (held, {e with expression_desc = Array xs})
@@ -327,12 +331,29 @@ and evaluate_all_now ~assignable (xs : J.expression list) :
   let blocks, xs = Ext_list.split_map xs (evaluate_now ~assignable) in
   (List.concat blocks, xs)
 
+(* Whether evaluating [e] runs no code: it has no side effects and reads no JS
+   property, which may run a getter. A record field counts. *)
+let runs_no_code (e : J.expression) =
+  Js_analyzer.is_okay_to_duplicate ~property_reads:false e
+
+(* Whether [block] only defines variables as values that run no code, as a
+   temporary bound to a record field does *)
+let defines_pure_values (block : J.block) =
+  Ext_list.for_all block (fun (s : J.statement) ->
+      match s.statement_desc with
+      | Variable {value = None} -> true
+      | Variable {value = Some e} -> runs_no_code e
+      | _ -> false)
+
 (* Assembles compiled arguments for a call or a literal that evaluates them
    left to right. Each argument comes with the statements that have to run
    before its value is read. Putting all statements first and then the
    values would move the statements of an argument in front of the values of
    the arguments to its left, so when an argument has statements, every
-   argument to its left is evaluated before them with [evaluate_now].
+   argument to its left is evaluated before them with [evaluate_now]. An
+   argument that runs no code stays in place when the statements after it
+   only define values that run none either, since then neither can change
+   the other.
 
    With [~method_callee:true], the first argument is a JS method read
    [obj.m] being called: the object is held and the property read stays in
@@ -351,7 +372,8 @@ let sequence_arguments ?(method_callee = false) ~assignable
       Ext_list.fold_right args (last, [], [])
         (fun (block, value) (i, code, values) ->
           let held, value =
-            if code = [] then ([], value)
+            if code = [] || (runs_no_code value && defines_pure_values code)
+            then ([], value)
             else
               match value.expression_desc with
               | Static_index (obj, name, pos) when method_callee && i = 0 ->
@@ -1908,7 +1930,10 @@ let compile output_prefix =
     | {primitive = Pjs_object_create labels; args} ->
       let args_code, args_expr =
         compile_arguments
-          ~hold:(Lam_compile_external_obj.hold_obj_args labels)
+          ~hold:
+            (Lam_compile_external_obj.hold_obj_args
+               ~delay_safe:(delay_safe ~assignable:lambda_cxt.meta.assignable)
+               labels)
           lambda_cxt args
       in
       let block, exp =
@@ -1917,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)