Improve option optimization for constants (#7913)

* Improve option optimization for constants * CHANGELOG

Author: cknitt

CHANGELOG.md

@@ -48,6 +48,7 @@
 - Add (dev-)dependencies to build schema. https://github.com/rescript-lang/rescript/pull/7892
 - Dedicated error for dict literal spreads. https://github.com/rescript-lang/rescript/pull/7901
 - Dedicated error message for when mixing up `:` and `=` in various positions. https://github.com/rescript-lang/rescript/pull/7900
+- Improve option optimization for constants. https://github.com/rescript-lang/rescript/pull/7913
 
 # 12.0.0-beta.11
 

compiler/core/lam_pass_remove_alias.ml

@@ -41,6 +41,12 @@ let id_is_for_sure_true_in_boolean (tbl : Lam_stats.ident_tbl) id =
  | None ->
  Eval_unknown
 
+let is_const_some (cst : Lam_constant.t) : bool =
+ match cst with
+ | Const_some _ -> true
+ | Const_block (_, (Lambda.Blk_some | Lambda.Blk_some_not_nested), _) -> true
+ | _ -> false
+
 let simplify_alias (meta : Lam_stats.t) (lam : Lam.t) : Lam.t =
  let rec simpl (lam : Lam.t) : Lam.t =
  match lam with
@@ -78,6 +84,7 @@ let simplify_alias (meta : Lam_stats.t) (lam : Lam.t) : Lam.t =
  ((Lprim {primitive = Pis_not_none; args = [Lvar id]} as l1), l2, l3)
  -> (
  match Hash_ident.find_opt meta.ident_tbl id with
+ | Some (Constant c) when is_const_some c -> simpl l2
  | Some (ImmutableBlock _ | MutableBlock _ | Normal_optional _) -> simpl l2
  | Some (OptionalBlock (l, Null)) ->
  Lam.if_

tests/tests/src/gpr_3980_test.mjs

@@ -2,46 +2,33 @@
 
 import * as Js_math from "@rescript/runtime/lib/es6/Js_math.js";
 
+if (1 !== 1) {
+ throw {
+ RE_EXN_ID: "Assert_failure",
+ _1: [
+ "gpr_3980_test.res",
+ 15,
+ 7
+ ],
+ Error: new Error()
+ };
+}
+
 let match = 1;
 
-if (match !== undefined) {
- if (match !== 1) {
+if (match !== 1) {
+ if (match !== 2) {
  throw {
  RE_EXN_ID: "Assert_failure",
  _1: [
  "gpr_3980_test.res",
- 15,
- 7
+ 13,
+ 9
  ],
  Error: new Error()
  };
  }
- let match$1 = 1;
- if (match$1 !== 1) {
- if (match$1 !== 2) {
- throw {
- RE_EXN_ID: "Assert_failure",
- _1: [
- "gpr_3980_test.res",
- 13,
- 9
- ],
- Error: new Error()
- };
- }
- Js_math.floor(1);
- }
- 
-} else {
- throw {
- RE_EXN_ID: "Assert_failure",
- _1: [
- "gpr_3980_test.res",
- 15,
- 7
- ],
- Error: new Error()
- };
+ Js_math.floor(1);
 }
 
 /* Not a pure module */

tests/tests/src/option_optimisation.mjs

@@ -28,8 +28,19 @@ function $$null(val1, val2) {
  }
 }
 
+function constant() {
+ console.log(42);
+}
+
+function param(opt) {
+ let x = opt;
+ console.log(x);
+}
+
 export {
  boolean,
  $$null,
+ constant,
+ param,
 }
 /* No side effect */

tests/tests/src/option_optimisation.res

@@ -19,3 +19,18 @@ let null = (~val1: Nullable.t<int>, ~val2: Nullable.t<int>) => {
  | _ => "b"
  }
 }
+
+let constant = () => {
+ let opt = Some(42)
+ switch opt {
+ | Some(x) => Console.log(x)
+ | None => ()
+ }
+}
+
+let param = (opt: int) => {
+ switch Some(opt) {
+ | Some(x) => Console.log(x)
+ | None => ()
+ }
+}

tests/tests/src/record_regression.mjs

@@ -99,66 +99,29 @@ pm0 = ir0.TAG === "V0" ? [
 
 let pm1;
 
-if (ir1.TAG === "V0") {
- let x1 = "v1";
- let x0 = "v0";
- pm1 = x1 !== undefined ? [
- x0,
- x1,
- 3
- ] : [
- x0,
- "n/a",
- 3
- ];
-} else {
- pm1 = [
+pm1 = ir1.TAG === "V0" ? [
+ "v0",
+ "v1",
+ 3
+ ] : [
  "v0",
  "n/a",
  "v1"
  ];
-}
 
 let pm2;
 
-if (ir2.TAG === "V0") {
- let x1$1 = "v1";
- let x0$1 = "v0";
- if (x1$1 !== undefined) {
- let x2 = 2;
- pm2 = x2 !== undefined ? [
- x0$1,
- x1$1,
- x2,
- 3
- ] : [
- x0$1,
- x1$1,
- 0,
- 3
- ];
- } else {
- let x2$1 = 2;
- pm2 = x2$1 !== undefined ? [
- x0$1,
- "n/a",
- x2$1,
- 3
- ] : [
- x0$1,
- "n/a",
- 0,
- 3
- ];
- }
-} else {
- pm2 = [
+pm2 = ir2.TAG === "V0" ? [
+ "v0",
+ "v1",
+ 2,
+ 3
+ ] : [
  "v0",
  "n/a",
  0,
  "v1"
  ];
-}
 
 function inlinedRecord(ir) {
  if (ir.TAG !== "V0") {