Evaluate optional @obj arguments in source order and read properties once

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_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/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 =

compiler/core/lam_compile_external_obj.ml

@@ -36,24 +36,72 @@ module S = Js_stmt_make
    But the default to be undefined  seems reasonable
 *)
 
+(* Whether [assemble_obj_args] assigns the optional argument [arg] after the
+   object literal, since its presence is not known *)
+let presence_unknown (arg : J.expression) =
+  Js_of_lam_option.destruct_optional arg ~for_sure_none:false
+    ~for_sure_some:(fun _ -> false)
+    ~not_sure:(fun () -> true)
+
+(* The arguments that [assemble_obj_args] evaluates in the object literal or
+   before it, which are all but the optional ones whose presence is not
+   known *)
+let rec literal_args (labels : External_arg_spec.obj_params)
+    (args : (J.block * J.expression) list) =
+  match (labels, args) with
+  | {obj_arg_label = Obj_label _; obj_arg_type = Arg_cst _} :: labels, args ->
+    literal_args labels args
+  | {obj_arg_label = Obj_optional _} :: labels, (_, arg) :: args
+    when presence_unknown arg ->
+    literal_args labels args
+  | ( {obj_arg_label = Obj_empty | Obj_label _ | Obj_optional _} :: labels,
+      (_, arg) :: args ) ->
+    arg :: literal_args labels args
+  | [], [] -> []
+  | [], _ :: _ | _ :: _, [] -> assert false
+
 (* [Lam_compile_external_call.hold_arg] for the compiled arguments of an
    object-creating external, which pair with the labels as in
-   [assemble_obj_args] *)
-let rec hold_obj_args (labels : External_arg_spec.obj_params)
+   [assemble_obj_args]. That function assigns an optional argument whose
+   presence is not known after the object literal, so it evaluates the
+   argument after the arguments that follow it. Unless that gives the same
+   values and effects, the argument is bound to a temporary after its
+   statements, which keeps it in its place. It does when the argument is
+   [delay_safe], and when each argument that the literal evaluates after it
+   is [delay_safe] or neither of the two has side effects. *)
+let rec hold_obj_args ~(delay_safe : J.expression -> bool)
+    (labels : External_arg_spec.obj_params)
     (args : (J.block * J.expression) list) =
   match (labels, args) with
   | {obj_arg_label = Obj_label _; obj_arg_type = Arg_cst _} :: labels, args ->
-    hold_obj_args labels args
+    hold_obj_args ~delay_safe labels args
   | {obj_arg_label = Obj_empty} :: labels, arg :: args ->
-    arg :: hold_obj_args labels args
+    arg :: hold_obj_args ~delay_safe labels args
   | {obj_arg_label = Obj_label _; obj_arg_type} :: labels, arg :: args ->
     Lam_compile_external_call.hold_arg ~arg_label:Arg_label
       ~arg_type:obj_arg_type arg
-    :: hold_obj_args labels args
+    :: hold_obj_args ~delay_safe labels args
   | {obj_arg_label = Obj_optional _; obj_arg_type} :: labels, arg :: args ->
-    Lam_compile_external_call.hold_arg ~arg_label:Arg_optional
-      ~arg_type:obj_arg_type arg
-    :: hold_obj_args labels args
+    let ((block, value) as held) =
+      Lam_compile_external_call.hold_arg ~arg_label:Arg_optional
+        ~arg_type:obj_arg_type arg
+    in
+    let order_matters (later : J.expression) =
+      not
+        (delay_safe later
+        || Js_analyzer.no_side_effect_expression value
+           && Js_analyzer.no_side_effect_expression later)
+    in
+    (if
+       presence_unknown value
+       && (not (delay_safe value))
+       && List.exists order_matters (literal_args labels args)
+     then
+       let tmp = Ext_ident.create_tmp () in
+       ( Ext_list.append_one block (S.define_variable ~kind:Strict tmp value),
+         E.var tmp )
+     else held)
+    :: hold_obj_args ~delay_safe labels args
   | [], [] -> []
   | [], _ :: _ | _ :: _, [] -> assert false
 
@@ -130,10 +178,10 @@ let assemble_obj_args (labels : External_arg_spec.obj_params)
               obj_arg_label =
                 Obj_optional {name = label; for_sure_no_nested_option};
              } -> (
-               (* Need make sure whether assignment is effectful or not
-                  to avoid code duplication
-               *)
-               match Js_ast_util.named_expression arg with
+               (* [arg] is read for its presence and for its value, so it is
+                  bound to a temporary unless reading it twice gives the
+                  same value twice *)
+               match Js_ast_util.named_expression ~property_reads:false arg with
                | None -> (
                  let acc, new_eff =
                    Lam_compile_external_call.ocaml_to_js_eff

compiler/core/lam_compile_external_obj.mli

@@ -26,11 +26,16 @@
     object literal. *)
 
 val hold_obj_args :
+  delay_safe:(J.expression -> bool) ->
   External_arg_spec.obj_params ->
   (J.block * J.expression) list ->
   (J.block * J.expression) list
 (** {!Lam_compile_external_call.hold_arg} for the compiled arguments of an
-    object-creating external *)
+    object-creating external. An optional argument whose presence is not
+    known is also bound to a temporary when evaluating it after the object
+    literal, as {!assemble_obj_args} does, could change a value or the order
+    of effects. [delay_safe] tells whether evaluating an argument after other
+    code gives the same value and effects. *)
 
 val assemble_obj_args :
   External_arg_spec.obj_params -> J.expression list -> J.block * J.expression

packages/@rescript/runtime/Primitive_option.res

@@ -63,7 +63,7 @@ let fromNull = (type t, x: Primitive_js_extern.null<t>): option<t> =>
 /** Preserves `None`/`undefined` and unwraps one outer option layer.
     Nested `Some` values stay encoded one level deeper. */
 let valFromOption = (x: Obj.t): Obj.t =>
-  if x !== Obj.repr(Primitive_js_extern.null) && isNested(x) {
+  if !Primitive_js_extern.testAny(x) && isNested(x) {
     let {depth}: nested = Obj.magic(x)
     if depth == 0 {
       Obj.magic(None)

packages/@rescript/runtime/lib/es6/Primitive_option.mjs

@@ -46,7 +46,7 @@ function fromNull(x) {
 }
 
 function valFromOption(x) {
-  if (x === null || x.BS_PRIVATE_NESTED_SOME_NONE === undefined) {
+  if ((x == null) || x.BS_PRIVATE_NESTED_SOME_NONE === undefined) {
     return x;
   }
   let depth = x.BS_PRIVATE_NESTED_SOME_NONE;

packages/@rescript/runtime/lib/js/Primitive_option.cjs

@@ -46,7 +46,7 @@ function fromNull(x) {
 }
 
 function valFromOption(x) {
-  if (x === null || x.BS_PRIVATE_NESTED_SOME_NONE === undefined) {
+  if ((x == null) || x.BS_PRIVATE_NESTED_SOME_NONE === undefined) {
     return x;
   }
   let depth = x.BS_PRIVATE_NESTED_SOME_NONE;