feat: respect Sys.opaque_identity

jscomp/core/lam_analysis.ml

@@ -123,6 +123,8 @@ let rec no_side_effects (lam : Lam.t) : bool =
       (* byte swap *)
       | Pbswap16 | Pbbswap _ | Parraysetu | Poffsetref _ | Praise | Plazyforce
       | Psetfield _ | Psetfield_computed ->
+          false
+      | Popaque ->
           false)
   | Llet (_, _, arg, body) | Lmutlet (_, arg, body) ->
       no_side_effects arg && no_side_effects body

jscomp/core/lam_compile.ml

@@ -1626,9 +1626,17 @@ and compile_prim (prim_info : Lam.prim_info)
      [
        Lprim
          {
-           primitive =
-             Pjs_unsafe_downgrade { name = property; setter = true; _ };
-           args = [ obj ];
+           primitive = Popaque;
+           args =
+             [
+               Lprim
+                 {
+                   primitive =
+                     Pjs_unsafe_downgrade { name = property; setter = true; _ };
+                   args = [ obj ];
+                   _;
+                 };
+             ];
            _;
          };
        setter_val;
@@ -1655,7 +1663,16 @@ and compile_prim (prim_info : Lam.prim_info)
   | {
    primitive = Pfull_apply;
    args =
-     Lprim { primitive = Pjs_unsafe_downgrade { setter = true; _ }; _ } :: _;
+     Lprim
+       {
+         primitive = Popaque;
+         args =
+           [
+             Lprim { primitive = Pjs_unsafe_downgrade { setter = true; _ }; _ };
+           ];
+         _;
+       }
+     :: _;
    _;
   } ->
       assert false

jscomp/core/lam_compile_primitive.ml

@@ -367,6 +367,7 @@ let translate loc (cxt : Lam_compile_context.t) (prim : Lam_primitive.t)
   | Pbbswap Pint32 ->
       E.runtime_call ~module_name:Js_runtime_modules.bytes ~fn_name:"bswap32"
         args
+  | Popaque -> List.hd args
   | Pbbswap Pint64 ->
       E.runtime_call ~module_name:Js_runtime_modules.bytes ~fn_name:"bswap64"
         args

jscomp/core/lam_convert.cppo.ml

@@ -433,7 +433,7 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
       | Pnativeint | Pint32 -> Lam.prim ~primitive:(Pintcomp b) ~args loc
       | Pint64 -> Lam.prim ~primitive:(Pint64comp b) ~args loc)
   | Pfield_computed -> Lam.prim ~primitive:Pfield_computed ~args loc
-  | Popaque -> List.hd args
+  | Popaque -> Lam.prim ~primitive:Popaque ~args loc
   | Psetfield_computed _ -> Lam.prim ~primitive:Psetfield_computed ~args loc
   | Pbbswap i -> Lam.prim ~primitive:(Pbbswap i) ~args loc
   | Pbswap16 -> Lam.prim ~primitive:Pbswap16 ~args loc

jscomp/core/lam_primitive.ml

@@ -149,6 +149,9 @@ type t =
       Lam_compat.compile_time_constant (* Integer to external pointer *)
   | Pbswap16
   | Pbbswap of Lam_compat.boxed_integer
+  (* Inhibition of optimisation *)
+  | Popaque
+  (* JS specific *)
   | Pdebugger
   | Pjs_unsafe_downgrade of { name : string; setter : bool; loc : Location.t }
   | Pinit_mod
@@ -372,6 +375,7 @@ let eq_primitive_approx (lhs : t) (rhs : t) =
       | _ -> false)
   | Pbswap16 -> rhs = Pbswap16
   | Pbbswap i1 -> ( match rhs with Pbbswap i2 -> i1 = i2 | _ -> false)
+  | Popaque -> ( match rhs with Popaque -> true | _ -> false)
   | Pjs_unsafe_downgrade { name; loc = _; setter } -> (
       match rhs with
       | Pjs_unsafe_downgrade rhs -> name = rhs.name && setter = rhs.setter

jscomp/core/lam_primitive.mli

@@ -141,6 +141,8 @@ type t =
   | Pctconst of Lam_compat.compile_time_constant
   | Pbswap16
   | Pbbswap of Lam_compat.boxed_integer
+  (* Inhibition of optimisation *)
+  | Popaque
   (* Integer to external pointer *)
   | Pdebugger
   | Pjs_unsafe_downgrade of { name : string; setter : bool; loc : Location.t }

jscomp/core/lam_print.ml

@@ -190,6 +190,7 @@ let primitive ppf (prim : Lam_primitive.t) =
   | Pbbswap Pnativeint -> fprintf ppf "bswap_nativeint"
   | Pbbswap Pint32 -> fprintf ppf "bswap32"
   | Pbbswap Pint64 -> fprintf ppf "bswap64"
+  | Popaque -> fprintf ppf "opaque"
   | Pisint -> fprintf ppf "isint"
   | Pis_poly_var_const -> fprintf ppf "#is_poly_var_const"
   | Pisout i -> fprintf ppf "isout %d" i