Implement and use %option_for_each primitive for Option.each

compiler/core/js_of_lam_option.ml

@@ -106,3 +106,12 @@ let null_to_opt e = E.econd (E.is_null e) none (some e)
 let undef_to_opt e = E.econd (E.is_undef e) none (some e)
 
 let null_undef_to_opt e = E.econd (E.is_null_undefined e) none (some e)
+
+let option_for_each opt f =
+  destruct_optional opt ~for_sure_none:E.unit
+    ~for_sure_some:(fun x ->
+      E.call ~info:(Js_call_info.na_full_call false) f [x])
+    ~not_sure:(fun () ->
+      E.econd (is_not_none opt)
+        (E.call ~info:(Js_call_info.na_full_call false) f [opt])
+        E.unit)

compiler/core/js_of_lam_option.mli

@@ -50,3 +50,5 @@ val null_to_opt : J.expression -> J.expression
 val undef_to_opt : J.expression -> J.expression
 
 val null_undef_to_opt : J.expression -> J.expression
+
+val option_for_each : J.expression -> J.expression -> J.expression

compiler/core/lam_analysis.ml

@@ -92,7 +92,7 @@ let rec no_side_effects (lam : Lam.t) : bool =
       ->
       true
     | Pjs_apply | Pjs_runtime_apply | Pjs_call _ | Pinit_mod | Pupdate_mod
-    | Pjs_unsafe_downgrade _ | Pdebugger | Pjs_fn_method
+    | Pjs_unsafe_downgrade _ | Pdebugger | Pjs_fn_method | Poption_for_each
     (* Await promise *)
     | Pawait
     (* TODO *)

compiler/core/lam_compile_primitive.ml

@@ -167,6 +167,10 @@ let translate output_prefix loc (cxt : Lam_compile_context.t)
   | Pval_from_option ->
     Js_of_lam_option.val_from_option (Ext_list.singleton_exn args)
   | Pval_from_option_not_nest -> Ext_list.singleton_exn args
+  | Poption_for_each -> (
+    match args with
+    | [opt; f] -> Js_of_lam_option.option_for_each opt f
+    | _ -> assert false)
   | Pfield (i, fld_info) ->
     Js_of_lam_block.field fld_info
       (Ext_list.singleton_exn args)

compiler/core/lam_convert.ml

@@ -201,6 +201,7 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
   | Pval_from_option -> prim ~primitive:Pval_from_option ~args loc
   | Pval_from_option_not_nest ->
     prim ~primitive:Pval_from_option_not_nest ~args loc
+  | Poption_for_each -> prim ~primitive:Poption_for_each ~args loc
   | Pjscomp x -> prim ~primitive:(Pjscomp x) ~args loc
   | Pfield (id, info) -> prim ~primitive:(Pfield (id, info)) ~args loc
   | Psetfield (id, info) -> prim ~primitive:(Psetfield (id, info)) ~args loc

compiler/core/lam_primitive.ml

@@ -175,6 +175,7 @@ type t =
   | Pis_not_none (* no info about its type *)
   | Pval_from_option
   | Pval_from_option_not_nest
+  | Poption_for_each
   | Psome
   | Psome_not_nest
   | Phash
@@ -223,12 +224,12 @@ let eq_primitive_approx (lhs : t) (rhs : t) =
   | Pawait
   (* etc *)
   | Pjs_apply | Pjs_runtime_apply | Pval_from_option | Pval_from_option_not_nest
-  | Pnull_to_opt | Pnull_undefined_to_opt | Pis_null | Pis_not_none | Psome
-  | Psome_not_nest | Pis_undefined | Pis_null_undefined | Pimport | Ptypeof
-  | Pfn_arity | Pis_poly_var_block | Pdebugger | Pinit_mod | Pupdate_mod
-  | Pduprecord | Pmakearray | Parraylength | Parrayrefu | Parraysetu
-  | Parrayrefs | Parraysets | Pjs_fn_make_unit | Pjs_fn_method | Phash
-  | Phash_mixstring | Phash_mixint | Phash_finalmix ->
+  | Poption_for_each | Pnull_to_opt | Pnull_undefined_to_opt | Pis_null
+  | Pis_not_none | Psome | Psome_not_nest | Pis_undefined | Pis_null_undefined
+  | Pimport | Ptypeof | Pfn_arity | Pis_poly_var_block | Pdebugger | Pinit_mod
+  | Pupdate_mod | Pduprecord | Pmakearray | Parraylength | Parrayrefu
+  | Parraysetu | Parrayrefs | Parraysets | Pjs_fn_make_unit | Pjs_fn_method
+  | Phash | Phash_mixstring | Phash_mixint | Phash_finalmix ->
     rhs = lhs
   | Pcreate_extension a -> (
     match rhs with

compiler/core/lam_primitive.mli

@@ -166,6 +166,7 @@ type t =
   | Pis_not_none
   | Pval_from_option
   | Pval_from_option_not_nest
+  | Poption_for_each
   | Psome
   | Psome_not_nest
   | Phash

compiler/core/lam_print.ml

@@ -68,6 +68,7 @@ let primitive ppf (prim : Lam_primitive.t) =
   | Psome_not_nest -> fprintf ppf "[some-not-nest]"
   | Pval_from_option -> fprintf ppf "[?unbox]"
   | Pval_from_option_not_nest -> fprintf ppf "[?unbox-not-nest]"
+  | Poption_for_each -> fprintf ppf "[option_for_each]"
   | Pis_undefined -> fprintf ppf "[?undefined]"
   | Pis_null_undefined -> fprintf ppf "[?null?undefined]"
   | Pimport -> fprintf ppf "[import]"

compiler/ml/lambda.ml

@@ -300,6 +300,7 @@ type primitive =
   | Pis_not_none
   | Pval_from_option
   | Pval_from_option_not_nest
+  | Poption_for_each
   | Pis_poly_var_block
   | Pjs_raw_expr
   | Pjs_raw_stmt

compiler/ml/lambda.mli

@@ -269,6 +269,7 @@ type primitive =
   | Pis_not_none
   | Pval_from_option
   | Pval_from_option_not_nest
+  | Poption_for_each
   | Pis_poly_var_block
   | Pjs_raw_expr
   | Pjs_raw_stmt

compiler/ml/printlambda.ml

@@ -257,6 +257,7 @@ let primitive ppf = function
   | Pis_not_none -> fprintf ppf "#is_not_none"
   | Pval_from_option -> fprintf ppf "#val_from_option"
   | Pval_from_option_not_nest -> fprintf ppf "#val_from_option_not_nest"
+  | Poption_for_each -> fprintf ppf "#option_for_each"
   | Pis_poly_var_block -> fprintf ppf "#is_poly_var_block"
   | Pjs_raw_expr -> fprintf ppf "#raw_expr"
   | Pjs_raw_stmt -> fprintf ppf "#raw_stmt"

compiler/ml/translcore.ml

@@ -376,6 +376,7 @@ let primitives_table =
       ("%nullable_to_opt", Pnullable_to_opt);
       ("%function_arity", Pfn_arity);
       ("%wrap_exn", Pwrap_exn);
+      ("%option_for_each", Poption_for_each);
       ("%curry_apply1", Pcurry_apply 1);
       ("%curry_apply2", Pcurry_apply 2);
       ("%curry_apply3", Pcurry_apply 3);

lib/es6/Stdlib_Option.js

@@ -10,13 +10,6 @@ function filter(opt, p) {
 
 }
 
-function forEach(opt, f) {
-  if (opt !== undefined) {
-    return f(Primitive_option.valFromOption(opt));
-  }
-
-}
-
 function getOrThrow(x, message) {
   if (x !== undefined) {
     return Primitive_option.valFromOption(x);
@@ -205,7 +198,6 @@ let getWithDefault = getOr;
 
 export {
   filter,
-  forEach,
   getExn,
   getOrThrow,
   mapOr,

lib/js/Stdlib_Option.js

@@ -10,13 +10,6 @@ function filter(opt, p) {
 
 }
 
-function forEach(opt, f) {
-  if (opt !== undefined) {
-    return f(Primitive_option.valFromOption(opt));
-  }
-
-}
-
 function getOrThrow(x, message) {
   if (x !== undefined) {
     return Primitive_option.valFromOption(x);
@@ -204,7 +197,6 @@ let mapWithDefault = mapOr;
 let getWithDefault = getOr;
 
 exports.filter = filter;
-exports.forEach = forEach;
 exports.getExn = getExn;
 exports.getOrThrow = getOrThrow;
 exports.mapOr = mapOr;

runtime/Stdlib_Option.res

@@ -29,11 +29,7 @@ let filter = (opt, p) =>
   | _ => None
   }
 
-let forEach = (opt, f) =>
-  switch opt {
-  | Some(x) => f(x)
-  | None => ()
-  }
+external forEach: (option<'a>, 'a => unit) => unit = "%option_for_each"
 
 let getOrThrow = (x, ~message=?) =>
   switch x {

runtime/Stdlib_Option.resi

@@ -68,7 +68,7 @@ Option.forEach(Some("thing"), x => Console.log(x)) // logs "thing"
 Option.forEach(None, x => Console.log(x)) // returns ()
 ```
 */
-let forEach: (option<'a>, 'a => unit) => unit
+external forEach: (option<'a>, 'a => unit) => unit = "%option_for_each"
 
 /**
 `getExn(opt, ~message=?)` returns `value` if `opt` is `Some(value)`, otherwise throws an exception with the message provided, or a generic message if no message was provided.

tests/tests/src/OptionForEachTest.mjs

@@ -0,0 +1,39 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+
+function testSome(opt) {
+  if (opt !== undefined) {
+    console.log(opt);
+    return;
+  }
+
+}
+
+function testNone() {
+
+}
+
+function testWithSideEffect() {
+  let counter = {
+    contents: 0
+  };
+  (param => {
+    counter.contents = counter.contents + 1 | 0;
+  })(42);
+}
+
+function testDirect(opt) {
+  if (opt !== undefined) {
+    console.log(opt);
+    return;
+  }
+
+}
+
+export {
+  testSome,
+  testNone,
+  testWithSideEffect,
+  testDirect,
+}
+/* No side effect */

tests/tests/src/OptionForEachTest.res

@@ -0,0 +1,20 @@
+let testSome = (opt: option<int>) => {
+  opt->Option.forEach(x => Js.log(x))
+}
+
+let testNone = () => {
+  let opt: option<string> = None
+  opt->Option.forEach(x => Js.log(x))
+}
+
+let testWithSideEffect = () => {
+  let counter = ref(0)
+  Some(42)->Option.forEach(_ => counter := counter.contents + 1)
+  None->Option.forEach(_ => counter := counter.contents + 1)
+}
+
+external directPrimitive: (option<'a>, 'a => unit) => unit = "%option_for_each"
+
+let testDirect = (opt: option<float>) => {
+  directPrimitive(opt, x => Js.log(x))
+}