From d129a9317ff8c1c608ddf0e265b79dc7dd68b781 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Wed, 31 Jul 2024 16:27:55 +0200
Subject: [PATCH 01/13] Document non-trivial function Code.constant_equal
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Co-authored-by: Jérome Vouillon <jerome.vouillon@gmail.com>
---
 compiler/lib/code.mli | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/compiler/lib/code.mli b/compiler/lib/code.mli
index 2cbbf4721b..43c721a1ac 100644
--- a/compiler/lib/code.mli
+++ b/compiler/lib/code.mli
@@ -185,6 +185,8 @@ type constant =
   | Tuple of int * constant array * array_or_not
   | Int of int32
 
+(** Guaranteed equality in terms of OCaml [(=)]: if [constant_equal a b =
+  Some v], then [Poly.(=) a b = v]. This is used for optimization purposes. *)
 val constant_equal : constant -> constant -> bool option
 
 type loc =

From 3ae69856edab882f231cb359689eaef884f646b7 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Fri, 2 Aug 2024 11:36:09 +0200
Subject: [PATCH 02/13] Fix bugs related to constant equality

See #1659.
---
 CHANGES.md                                    |  1 +
 compiler/lib/code.ml                          | 76 ++++++++++---------
 compiler/lib/code.mli                         | 12 ++-
 compiler/lib/driver.ml                        | 30 ++++----
 compiler/lib/eval.ml                          | 33 +++++++-
 compiler/lib/flow.ml                          | 24 +++++-
 compiler/lib/generate.ml                      |  4 +-
 .../lib/{constant.ml => global_constant.ml}   |  0
 compiler/lib/javascript.ml                    |  4 +-
 compiler/lib/linker.ml                        |  6 +-
 compiler/lib/stdlib.ml                        |  2 +-
 compiler/tests-compiler/dune.inc              | 15 ++++
 compiler/tests-compiler/gh1659.ml             | 19 +++++
 13 files changed, 163 insertions(+), 63 deletions(-)
 rename compiler/lib/{constant.ml => global_constant.ml} (100%)
 create mode 100644 compiler/tests-compiler/gh1659.ml

diff --git a/CHANGES.md b/CHANGES.md
index f9fbc2d835..1d9de3f2a6 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -17,6 +17,7 @@
 * Runtime: fix parsing of unsigned integers (0u2147483648)
 * Toplevel: fix missing primitives with separate compilation
 * Compiler: fix link of packed modules with separate compilation
+* Fixed the static evaluation of some equalities (#1659)
 
 # 5.8.2 (2024-05-26) - Luc
 
diff --git a/compiler/lib/code.ml b/compiler/lib/code.ml
index e26ebaa808..42c81c0321 100644
--- a/compiler/lib/code.ml
+++ b/compiler/lib/code.ml
@@ -367,42 +367,46 @@ type constant =
   | Tuple of int * constant array * array_or_not
   | Int of int32
 
-let rec constant_equal a b =
-  match a, b with
-  | String a, String b -> Some (String.equal a b)
-  | NativeString a, NativeString b -> Some (Native_string.equal a b)
-  | Tuple (ta, a, _), Tuple (tb, b, _) ->
-      if ta <> tb || Array.length a <> Array.length b
-      then Some false
-      else
-        let same = ref (Some true) in
-        for i = 0 to Array.length a - 1 do
-          match !same, constant_equal a.(i) b.(i) with
-          | None, _ -> ()
-          | _, None -> same := None
-          | Some s, Some c -> same := Some (s && c)
-        done;
-        !same
-  | Int64 a, Int64 b -> Some (Int64.equal a b)
-  | Float_array a, Float_array b -> Some (Array.equal Float.equal a b)
-  | Int a, Int b -> Some (Int32.equal a b)
-  | Float a, Float b -> Some (Float.equal a b)
-  | String _, NativeString _ | NativeString _, String _ -> None
-  | Int _, Float _ | Float _, Int _ -> None
-  | Tuple ((0 | 254), _, _), Float_array _ -> None
-  | Float_array _, Tuple ((0 | 254), _, _) -> None
-  | Tuple _, (String _ | NativeString _ | Int64 _ | Int _ | Float _ | Float_array _) ->
-      Some false
-  | Float_array _, (String _ | NativeString _ | Int64 _ | Int _ | Float _ | Tuple _) ->
-      Some false
-  | String _, (Int64 _ | Int _ | Float _ | Tuple _ | Float_array _) -> Some false
-  | NativeString _, (Int64 _ | Int _ | Float _ | Tuple _ | Float_array _) -> Some false
-  | Int64 _, (String _ | NativeString _ | Int _ | Float _ | Tuple _ | Float_array _) ->
-      Some false
-  | Float _, (String _ | NativeString _ | Float_array _ | Int64 _ | Tuple (_, _, _)) ->
-      Some false
-  | Int _, (String _ | NativeString _ | Float_array _ | Int64 _ | Tuple (_, _, _)) ->
-      Some false
+module Constant = struct
+  type t = constant
+
+  let rec ocaml_equal a b =
+    match a, b with
+    | String a, String b -> Some (String.equal a b)
+    | NativeString a, NativeString b -> Some (Native_string.equal a b)
+    | Tuple (ta, a, _), Tuple (tb, b, _) ->
+        if ta <> tb || Array.length a <> Array.length b
+        then Some false
+        else
+          let same = ref (Some true) in
+          for i = 0 to Array.length a - 1 do
+            match !same, ocaml_equal a.(i) b.(i) with
+            | None, _ -> ()
+            | _, None -> same := None
+            | Some s, Some c -> same := Some (s && c)
+          done;
+          !same
+    | Int64 a, Int64 b -> Some (Int64.equal a b)
+    | Float_array a, Float_array b -> Some (Array.equal Poly.equal a b)
+    | Int a, Int b -> Some (Int32.equal a b)
+    | Float a, Float b -> Some (Poly.equal a b)
+    | String _, NativeString _ | NativeString _, String _ -> None
+    | Int _, Float _ | Float _, Int _ -> None
+    | Tuple ((0 | 254), _, _), Float_array _ -> None
+    | Float_array _, Tuple ((0 | 254), _, _) -> None
+    | Tuple _, (String _ | NativeString _ | Int64 _ | Int _ | Float _ | Float_array _) ->
+        Some false
+    | Float_array _, (String _ | NativeString _ | Int64 _ | Int _ | Float _ | Tuple _) ->
+        Some false
+    | String _, (Int64 _ | Int _ | Float _ | Tuple _ | Float_array _) -> Some false
+    | NativeString _, (Int64 _ | Int _ | Float _ | Tuple _ | Float_array _) -> Some false
+    | Int64 _, (String _ | NativeString _ | Int _ | Float _ | Tuple _ | Float_array _) ->
+        Some false
+    | Float _, (String _ | NativeString _ | Float_array _ | Int64 _ | Tuple (_, _, _)) ->
+        Some false
+    | Int _, (String _ | NativeString _ | Float_array _ | Int64 _ | Tuple (_, _, _)) ->
+        Some false
+end
 
 type loc =
   | No
diff --git a/compiler/lib/code.mli b/compiler/lib/code.mli
index 43c721a1ac..1361302ad4 100644
--- a/compiler/lib/code.mli
+++ b/compiler/lib/code.mli
@@ -174,6 +174,8 @@ module Native_string : sig
   val of_string : string -> t
 
   val of_bytestring : string -> t
+
+  val equal : t -> t -> bool
 end
 
 type constant =
@@ -185,9 +187,13 @@ type constant =
   | Tuple of int * constant array * array_or_not
   | Int of int32
 
-(** Guaranteed equality in terms of OCaml [(=)]: if [constant_equal a b =
-  Some v], then [Poly.(=) a b = v]. This is used for optimization purposes. *)
-val constant_equal : constant -> constant -> bool option
+module Constant : sig
+  type t = constant
+
+  val ocaml_equal : t -> t -> bool option
+  (** Guaranteed equality in terms of OCaml [(=)]: if [constant_equal a b =
+    Some v], then [Poly.(=) a b = v]. This is used for optimization purposes. *)
+end
 
 type loc =
   | No
diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
index 655b396c7d..6c638469ee 100644
--- a/compiler/lib/driver.ml
+++ b/compiler/lib/driver.ml
@@ -255,9 +255,9 @@ let gen_missing js missing =
         , ( ECond
               ( EBin
                   ( NotEqEq
-                  , dot (EVar (ident Constant.global_object_)) prim
+                  , dot (EVar (ident Global_constant.global_object_)) prim
                   , EVar (ident_s "undefined") )
-              , dot (EVar (ident Constant.global_object_)) prim
+              , dot (EVar (ident Global_constant.global_object_)) prim
               , EFun
                   ( None
                   , fun_
@@ -380,7 +380,7 @@ let link' ~export_runtime ~standalone ~link (js : Javascript.statement_list) :
                    (EBin
                       ( Eq
                       , dot
-                          (EVar (ident Constant.global_object_))
+                          (EVar (ident Global_constant.global_object_))
                           (Utf8_string.of_string_exn "jsoo_runtime")
                       , EObj all ))
                , N )
@@ -391,7 +391,7 @@ let link' ~export_runtime ~standalone ~link (js : Javascript.statement_list) :
                          (EVar (ident (Utf8_string.of_string_exn "Object")))
                          (Utf8_string.of_string_exn "assign"))
                       [ dot
-                          (EVar (ident Constant.global_object_))
+                          (EVar (ident Global_constant.global_object_))
                           (Utf8_string.of_string_exn "jsoo_runtime")
                       ; EObj all
                       ]
@@ -420,7 +420,7 @@ let link' ~export_runtime ~standalone ~link (js : Javascript.statement_list) :
                          ; rest = None
                          }
                      , ( dot
-                           (EVar (ident Constant.global_object_))
+                           (EVar (ident Global_constant.global_object_))
                            (Utf8_string.of_string_exn "jsoo_runtime")
                        , N ) )
                  ] )
@@ -526,27 +526,30 @@ let pack ~wrap_with_fun ~standalone { Linker.runtime_code = js; always_required_
       o#get_free
     in
     let export_shim js =
-      if J.IdentSet.mem (J.ident Constant.exports_) freenames
+      if J.IdentSet.mem (J.ident Global_constant.exports_) freenames
       then
         if should_export wrap_with_fun
-        then var Constant.exports_ (J.EObj []) :: js
+        then var Global_constant.exports_ (J.EObj []) :: js
         else
           let export_node =
             let s =
               Printf.sprintf
                 {|((typeof module === 'object' && module.exports) || %s)|}
-                Constant.global_object
+                Global_constant.global_object
             in
             let lex = Parse_js.Lexer.of_string s in
             Parse_js.parse_expr lex
           in
-          var Constant.exports_ export_node :: js
+          var Global_constant.exports_ export_node :: js
       else js
     in
     let old_global_object_shim js =
-      if J.IdentSet.mem (J.ident Constant.old_global_object_) freenames
+      if J.IdentSet.mem (J.ident Global_constant.old_global_object_) freenames
       then
-        var Constant.old_global_object_ (J.EVar (J.ident Constant.global_object_)) :: js
+        var
+          Global_constant.old_global_object_
+          (J.EVar (J.ident Global_constant.global_object_))
+        :: js
       else js
     in
 
@@ -560,14 +563,15 @@ let pack ~wrap_with_fun ~standalone { Linker.runtime_code = js; always_required_
         then expr (J.EStr (Utf8_string.of_string_exn "use strict")) :: js
         else js
       in
-      f [ J.ident Constant.global_object_ ] js
+      f [ J.ident Global_constant.global_object_ ] js
     in
     match wrap_with_fun with
     | `Anonymous -> expr (mk efun)
     | `Named name ->
         let name = Utf8_string.of_string_exn name in
         mk (sfun (J.ident name))
-    | `Iife -> expr (J.call (mk efun) [ J.EVar (J.ident Constant.global_object_) ] J.N)
+    | `Iife ->
+        expr (J.call (mk efun) [ J.EVar (J.ident Global_constant.global_object_) ] J.N)
   in
   let always_required_js =
     (* consider adding a comments in the generated file with original
diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index 40df068a7d..e90b81e4a3 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -233,12 +233,41 @@ let the_cont_of info x (a : cont array) =
       | _ -> None)
     x
 
+(* If [constant_js_equal a b = Some v], then [caml_js_equals a b = v]). *)
+let constant_js_equal a b =
+  match a, b with
+  | Int i, Int j -> Some (Int32.equal i j)
+  | Float a, Float b -> Some (Poly.equal a b)
+  | Int _, Float _ | Float _, Int _ -> None
+  (* All other values may be distinct objects and thus different by [caml_js_equals]. *)
+  | String _, _
+  | _, String _
+  | NativeString _, _
+  | _, NativeString _
+  | Float_array _, _
+  | _, Float_array _
+  | Int64 _, _
+  | _, Int64 _
+  | Tuple _, _
+  | _, Tuple _ -> None
+
 let eval_instr info ((x, loc) as i) =
   match x with
-  | Let (x, Prim (Extern ("caml_js_equals" | "caml_equal"), [ y; z ])) -> (
+  | Let (x, Prim (Extern "caml_equal", [ y; z ])) -> (
+      match the_const_of info y, the_const_of info z with
+      | Some e1, Some e2 -> (
+          match Code.Constant.ocaml_equal e1 e2 with
+          | None -> [ i ]
+          | Some c ->
+              let c = if c then 1l else 0l in
+              let c = Constant (Int c) in
+              Flow.Info.update_def info x c;
+              [ Let (x, c), loc ])
+      | _ -> [ i ])
+  | Let (x, Prim (Extern "caml_js_equals", [ y; z ])) -> (
       match the_const_of info y, the_const_of info z with
       | Some e1, Some e2 -> (
-          match constant_equal e1 e2 with
+          match constant_js_equal e1 e2 with
           | None -> [ i ]
           | Some c ->
               let c = if c then 1l else 0l in
diff --git a/compiler/lib/flow.ml b/compiler/lib/flow.ml
index 412af3089a..85ce73cd6c 100644
--- a/compiler/lib/flow.ml
+++ b/compiler/lib/flow.ml
@@ -337,6 +337,28 @@ let the_def_of info x =
         x
   | Pc c -> Some (Constant c)
 
+(* If [constant_identical a b = true], then the two values cannot be
+   distinguished, i.e., they are not different objects (and [caml_js_equals a b
+   = true]) and if both are floats, they are bitwise equal. *)
+let constant_identical a b =
+  match a, b with
+  | Int i, Int j -> Int32.equal i j
+  | Float a, Float b -> Float.bitwise_equal a b
+  | NativeString a, NativeString b -> Native_string.equal a b
+  | String a, String b -> Config.Flag.use_js_string () && String.equal a b
+  | Int _, Float _ | Float _, Int _ -> false
+  (* All other values may be distinct objects and thus different by [caml_js_equals]. *)
+  | String _, _
+  | _, String _
+  | NativeString _, _
+  | _, NativeString _
+  | Float_array _, _
+  | _, Float_array _
+  | Int64 _, _
+  | _, Int64 _
+  | Tuple _, _
+  | _, Tuple _ -> false
+
 let the_const_of info x =
   match x with
   | Pv x ->
@@ -352,7 +374,7 @@ let the_const_of info x =
         None
         (fun u v ->
           match u, v with
-          | Some i, Some j when Poly.(Code.constant_equal i j = Some true) -> u
+          | Some i, Some j when constant_identical i j -> u
           | _ -> None)
         x
   | Pc c -> Some c
diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
index 93cdf36cfe..a219cbee89 100644
--- a/compiler/lib/generate.ml
+++ b/compiler/lib/generate.ml
@@ -1737,7 +1737,7 @@ and compile_conditional st queue ~fall_through last scope_stack : _ * _ =
         true, flush_all queue (throw_statement st.ctx cx k loc)
     | Stop ->
         let e_opt =
-          if st.ctx.Ctx.should_export then Some (s_var Constant.exports) else None
+          if st.ctx.Ctx.should_export then Some (s_var Global_constant.exports) else None
         in
         true, flush_all queue [ J.Return_statement e_opt, loc ]
     | Branch cont -> compile_branch st queue cont scope_stack ~fall_through
@@ -1913,7 +1913,7 @@ let generate_shared_value ctx =
          | Some (v, _) ->
              [ ( J.V v
                , ( J.dot
-                     (s_var Constant.global_object)
+                     (s_var Global_constant.global_object)
                      (Utf8_string.of_string_exn "jsoo_runtime")
                  , J.N ) )
              ])
diff --git a/compiler/lib/constant.ml b/compiler/lib/global_constant.ml
similarity index 100%
rename from compiler/lib/constant.ml
rename to compiler/lib/global_constant.ml
diff --git a/compiler/lib/javascript.ml b/compiler/lib/javascript.ml
index e77d176190..9c1355c7d5 100644
--- a/compiler/lib/javascript.ml
+++ b/compiler/lib/javascript.ml
@@ -112,14 +112,14 @@ end = struct
     | FP_infinite -> if Float.(v < 0.) then "-Infinity" else "Infinity"
     | FP_normal | FP_subnormal -> (
         let vint = int_of_float v in
-        if Float.equal (float_of_int vint) v
+        if Poly.equal (float_of_int vint) v
         then Printf.sprintf "%d." vint
         else
           match
             find_smaller
               ~f:(fun prec ->
                 let s = float_to_string prec v in
-                if Float.equal v (float_of_string s) then Some s else None)
+                if Poly.equal v (float_of_string s) then Some s else None)
               ~bad:0
               ~good:18
               ~good_s:"max"
diff --git a/compiler/lib/linker.ml b/compiler/lib/linker.ml
index 1629afc5a8..fa50703f8a 100644
--- a/compiler/lib/linker.ml
+++ b/compiler/lib/linker.ml
@@ -134,9 +134,9 @@ module Check = struct
     in
     let freename = StringSet.diff freename Reserved.keyword in
     let freename = StringSet.diff freename Reserved.provided in
-    let freename = StringSet.remove Constant.global_object freename in
+    let freename = StringSet.remove Global_constant.global_object freename in
     let freename = if has_flags then StringSet.remove "FLAG" freename else freename in
-    if StringSet.mem Constant.old_global_object freename && false
+    if StringSet.mem Global_constant.old_global_object freename && false
        (* Don't warn yet, we want to give a transition period where both
           "globalThis" and "joo_global_object" are allowed without extra
           noise *)
@@ -145,7 +145,7 @@ module Check = struct
         "warning: %s: 'joo_global_object' is being deprecated, please use `globalThis` \
          instead@."
         (loc pi);
-    let freename = StringSet.remove Constant.old_global_object freename in
+    let freename = StringSet.remove Global_constant.old_global_object freename in
     let defname = to_stringset free#get_def in
     if not (StringSet.mem name defname)
     then
diff --git a/compiler/lib/stdlib.ml b/compiler/lib/stdlib.ml
index 72bd5f14ec..173641dde7 100644
--- a/compiler/lib/stdlib.ml
+++ b/compiler/lib/stdlib.ml
@@ -423,7 +423,7 @@ end
 module Float = struct
   type t = float
 
-  let equal (a : float) (b : float) =
+  let bitwise_equal (a : float) (b : float) =
     Int64.equal (Int64.bits_of_float a) (Int64.bits_of_float b)
 
   (* Re-defined here to stay compatible with OCaml 4.02 *)
diff --git a/compiler/tests-compiler/dune.inc b/compiler/tests-compiler/dune.inc
index 01f0f0da6a..2e5db3e098 100644
--- a/compiler/tests-compiler/dune.inc
+++ b/compiler/tests-compiler/dune.inc
@@ -419,6 +419,21 @@
  (preprocess
   (pps ppx_expect)))
 
+(library
+ ;; compiler/tests-compiler/gh1659.ml
+ (name gh1659_15)
+ (enabled_if true)
+ (modules gh1659)
+ (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
+ (inline_tests
+  (enabled_if true)
+  (deps
+   (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
+   (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
+ (flags (:standard -open Jsoo_compiler_expect_tests_helper))
+ (preprocess
+  (pps ppx_expect)))
+
 (library
  ;; compiler/tests-compiler/gh747.ml
  (name gh747_15)
diff --git a/compiler/tests-compiler/gh1659.ml b/compiler/tests-compiler/gh1659.ml
new file mode 100644
index 0000000000..bfdee50964
--- /dev/null
+++ b/compiler/tests-compiler/gh1659.ml
@@ -0,0 +1,19 @@
+let%expect_test _ =
+  let prog = {|
+let x = (0., 0.) = (-0., 0.);;
+
+Printf.printf "%B\n" x;;
+  |} in
+  Util.compile_and_run prog;
+  [%expect {|
+    true |}]
+
+let%expect_test _ =
+  let prog = {|
+external equals : 'a -> 'a -> bool = "caml_js_equals";;
+let x = equals (0, 0) (0, 0);;
+Printf.printf "%B\n" x;;
+  |} in
+  Util.compile_and_run prog;
+  [%expect {|
+    false |}]

From 8ff06a3b33b6beb4f151ed3e3b484992b8a1c51c Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Mon, 26 Aug 2024 16:30:53 +0200
Subject: [PATCH 03/13] More static evaluation of equalities in eval

---
 compiler/lib/eval.ml | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index e90b81e4a3..4b4923cdb8 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -238,6 +238,8 @@ let constant_js_equal a b =
   match a, b with
   | Int i, Int j -> Some (Int32.equal i j)
   | Float a, Float b -> Some (Poly.equal a b)
+  | NativeString a, NativeString b -> Some (Native_string.equal a b)
+  | String a, String b when Config.Flag.use_js_string () -> Some (String.equal a b)
   | Int _, Float _ | Float _, Int _ -> None
   (* All other values may be distinct objects and thus different by [caml_js_equals]. *)
   | String _, _

From 7cc2d3406246179cccde73845c114b35088ffacd Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Mon, 26 Aug 2024 16:31:23 +0200
Subject: [PATCH 04/13] Statically evaluate caml_js_strict_equals too

---
 compiler/lib/eval.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index 4b4923cdb8..02738eb0c9 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -266,7 +266,7 @@ let eval_instr info ((x, loc) as i) =
               Flow.Info.update_def info x c;
               [ Let (x, c), loc ])
       | _ -> [ i ])
-  | Let (x, Prim (Extern "caml_js_equals", [ y; z ])) -> (
+  | Let (x, Prim (Extern ("caml_js_equals" | "caml_js_strict_equals"), [ y; z ])) -> (
       match the_const_of info y, the_const_of info z with
       | Some e1, Some e2 -> (
           match constant_js_equal e1 e2 with

From 445c347cccabfd44b86f50105dd5921fcea3eee4 Mon Sep 17 00:00:00 2001
From: Olivier Nicole <olivier@chnik.fr>
Date: Mon, 26 Aug 2024 16:36:44 +0200
Subject: [PATCH 05/13] Keep Float.equal in our stdlib but make it the standard
 one

---
 compiler/lib/stdlib.ml | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/compiler/lib/stdlib.ml b/compiler/lib/stdlib.ml
index 173641dde7..1b6c4bb5e2 100644
--- a/compiler/lib/stdlib.ml
+++ b/compiler/lib/stdlib.ml
@@ -423,6 +423,8 @@ end
 module Float = struct
   type t = float
 
+  let equal = Float.equal
+
   let bitwise_equal (a : float) (b : float) =
     Int64.equal (Int64.bits_of_float a) (Int64.bits_of_float b)
 

From 963eb3c3e6358b2583061a557d1b05a0afe54fda Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Mon, 26 Aug 2024 20:49:24 +0200
Subject: [PATCH 06/13] FMT

---
 compiler/tests-compiler/gh1659.ml | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/compiler/tests-compiler/gh1659.ml b/compiler/tests-compiler/gh1659.ml
index bfdee50964..c2728ba97d 100644
--- a/compiler/tests-compiler/gh1659.ml
+++ b/compiler/tests-compiler/gh1659.ml
@@ -9,11 +9,13 @@ Printf.printf "%B\n" x;;
     true |}]
 
 let%expect_test _ =
-  let prog = {|
+  let prog =
+    {|
 external equals : 'a -> 'a -> bool = "caml_js_equals";;
 let x = equals (0, 0) (0, 0);;
 Printf.printf "%B\n" x;;
-  |} in
+  |}
+  in
   Util.compile_and_run prog;
   [%expect {|
     false |}]

From 3a5f2725d6f10c2df3d1d5cb068d807f93ae3174 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Mon, 26 Aug 2024 20:54:22 +0200
Subject: [PATCH 07/13] restore Float.equal

---
 compiler/lib/code.ml       | 4 ++--
 compiler/lib/eval.ml       | 2 +-
 compiler/lib/javascript.ml | 4 ++--
 3 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/compiler/lib/code.ml b/compiler/lib/code.ml
index 42c81c0321..e7e3d05d09 100644
--- a/compiler/lib/code.ml
+++ b/compiler/lib/code.ml
@@ -387,9 +387,9 @@ module Constant = struct
           done;
           !same
     | Int64 a, Int64 b -> Some (Int64.equal a b)
-    | Float_array a, Float_array b -> Some (Array.equal Poly.equal a b)
+    | Float_array a, Float_array b -> Some (Array.equal Float.equal a b)
     | Int a, Int b -> Some (Int32.equal a b)
-    | Float a, Float b -> Some (Poly.equal a b)
+    | Float a, Float b -> Some (Float.equal a b)
     | String _, NativeString _ | NativeString _, String _ -> None
     | Int _, Float _ | Float _, Int _ -> None
     | Tuple ((0 | 254), _, _), Float_array _ -> None
diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index 02738eb0c9..bcb965e7ae 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -237,7 +237,7 @@ let the_cont_of info x (a : cont array) =
 let constant_js_equal a b =
   match a, b with
   | Int i, Int j -> Some (Int32.equal i j)
-  | Float a, Float b -> Some (Poly.equal a b)
+  | Float a, Float b -> Some (Float.equal a b)
   | NativeString a, NativeString b -> Some (Native_string.equal a b)
   | String a, String b when Config.Flag.use_js_string () -> Some (String.equal a b)
   | Int _, Float _ | Float _, Int _ -> None
diff --git a/compiler/lib/javascript.ml b/compiler/lib/javascript.ml
index 9c1355c7d5..e77d176190 100644
--- a/compiler/lib/javascript.ml
+++ b/compiler/lib/javascript.ml
@@ -112,14 +112,14 @@ end = struct
     | FP_infinite -> if Float.(v < 0.) then "-Infinity" else "Infinity"
     | FP_normal | FP_subnormal -> (
         let vint = int_of_float v in
-        if Poly.equal (float_of_int vint) v
+        if Float.equal (float_of_int vint) v
         then Printf.sprintf "%d." vint
         else
           match
             find_smaller
               ~f:(fun prec ->
                 let s = float_to_string prec v in
-                if Poly.equal v (float_of_string s) then Some s else None)
+                if Float.equal v (float_of_string s) then Some s else None)
               ~bad:0
               ~good:18
               ~good_s:"max"

From 89c73bfbc6016e3d1d6dc5b4dbe077ae772717d5 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Mon, 26 Aug 2024 22:58:00 +0200
Subject: [PATCH 08/13] fixup! restore Float.equal

---
 compiler/lib/code.ml       | 4 ++--
 compiler/lib/eval.ml       | 2 +-
 compiler/lib/javascript.ml | 4 ++--
 compiler/lib/stdlib.ml     | 4 +++-
 4 files changed, 8 insertions(+), 6 deletions(-)

diff --git a/compiler/lib/code.ml b/compiler/lib/code.ml
index e7e3d05d09..0dda239870 100644
--- a/compiler/lib/code.ml
+++ b/compiler/lib/code.ml
@@ -387,9 +387,9 @@ module Constant = struct
           done;
           !same
     | Int64 a, Int64 b -> Some (Int64.equal a b)
-    | Float_array a, Float_array b -> Some (Array.equal Float.equal a b)
+    | Float_array a, Float_array b -> Some (Array.equal Float.ieee_equal a b)
     | Int a, Int b -> Some (Int32.equal a b)
-    | Float a, Float b -> Some (Float.equal a b)
+    | Float a, Float b -> Some (Float.ieee_equal a b)
     | String _, NativeString _ | NativeString _, String _ -> None
     | Int _, Float _ | Float _, Int _ -> None
     | Tuple ((0 | 254), _, _), Float_array _ -> None
diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index bcb965e7ae..ab7bd46eec 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -237,7 +237,7 @@ let the_cont_of info x (a : cont array) =
 let constant_js_equal a b =
   match a, b with
   | Int i, Int j -> Some (Int32.equal i j)
-  | Float a, Float b -> Some (Float.equal a b)
+  | Float a, Float b -> Some (Float.ieee_equal a b)
   | NativeString a, NativeString b -> Some (Native_string.equal a b)
   | String a, String b when Config.Flag.use_js_string () -> Some (String.equal a b)
   | Int _, Float _ | Float _, Int _ -> None
diff --git a/compiler/lib/javascript.ml b/compiler/lib/javascript.ml
index e77d176190..1a13813fe1 100644
--- a/compiler/lib/javascript.ml
+++ b/compiler/lib/javascript.ml
@@ -112,14 +112,14 @@ end = struct
     | FP_infinite -> if Float.(v < 0.) then "-Infinity" else "Infinity"
     | FP_normal | FP_subnormal -> (
         let vint = int_of_float v in
-        if Float.equal (float_of_int vint) v
+        if Float.ieee_equal (float_of_int vint) v
         then Printf.sprintf "%d." vint
         else
           match
             find_smaller
               ~f:(fun prec ->
                 let s = float_to_string prec v in
-                if Float.equal v (float_of_string s) then Some s else None)
+                if Float.ieee_equal v (float_of_string s) then Some s else None)
               ~bad:0
               ~good:18
               ~good_s:"max"
diff --git a/compiler/lib/stdlib.ml b/compiler/lib/stdlib.ml
index 1b6c4bb5e2..d67f4b0483 100644
--- a/compiler/lib/stdlib.ml
+++ b/compiler/lib/stdlib.ml
@@ -423,7 +423,9 @@ end
 module Float = struct
   type t = float
 
-  let equal = Float.equal
+  let equal (_ : float) (_ : float) = `Use_ieee_equal_or_bitwise_equal
+
+  let ieee_equal (a : float) (b : float) = Poly.equal a b
 
   let bitwise_equal (a : float) (b : float) =
     Int64.equal (Int64.bits_of_float a) (Int64.bits_of_float b)

From dc93b8e53d39439516d8a7f42f2a8404e2626091 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Tue, 27 Aug 2024 10:02:02 +0200
Subject: [PATCH 09/13] Revert "fixup! restore Float.equal"

This reverts commit 94493de686813c0faa74826d9f0af47316ff855f.
---
 compiler/lib/code.ml       | 4 ++--
 compiler/lib/eval.ml       | 2 +-
 compiler/lib/javascript.ml | 4 ++--
 compiler/lib/stdlib.ml     | 4 +---
 4 files changed, 6 insertions(+), 8 deletions(-)

diff --git a/compiler/lib/code.ml b/compiler/lib/code.ml
index 0dda239870..e7e3d05d09 100644
--- a/compiler/lib/code.ml
+++ b/compiler/lib/code.ml
@@ -387,9 +387,9 @@ module Constant = struct
           done;
           !same
     | Int64 a, Int64 b -> Some (Int64.equal a b)
-    | Float_array a, Float_array b -> Some (Array.equal Float.ieee_equal a b)
+    | Float_array a, Float_array b -> Some (Array.equal Float.equal a b)
     | Int a, Int b -> Some (Int32.equal a b)
-    | Float a, Float b -> Some (Float.ieee_equal a b)
+    | Float a, Float b -> Some (Float.equal a b)
     | String _, NativeString _ | NativeString _, String _ -> None
     | Int _, Float _ | Float _, Int _ -> None
     | Tuple ((0 | 254), _, _), Float_array _ -> None
diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index ab7bd46eec..bcb965e7ae 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -237,7 +237,7 @@ let the_cont_of info x (a : cont array) =
 let constant_js_equal a b =
   match a, b with
   | Int i, Int j -> Some (Int32.equal i j)
-  | Float a, Float b -> Some (Float.ieee_equal a b)
+  | Float a, Float b -> Some (Float.equal a b)
   | NativeString a, NativeString b -> Some (Native_string.equal a b)
   | String a, String b when Config.Flag.use_js_string () -> Some (String.equal a b)
   | Int _, Float _ | Float _, Int _ -> None
diff --git a/compiler/lib/javascript.ml b/compiler/lib/javascript.ml
index 1a13813fe1..e77d176190 100644
--- a/compiler/lib/javascript.ml
+++ b/compiler/lib/javascript.ml
@@ -112,14 +112,14 @@ end = struct
     | FP_infinite -> if Float.(v < 0.) then "-Infinity" else "Infinity"
     | FP_normal | FP_subnormal -> (
         let vint = int_of_float v in
-        if Float.ieee_equal (float_of_int vint) v
+        if Float.equal (float_of_int vint) v
         then Printf.sprintf "%d." vint
         else
           match
             find_smaller
               ~f:(fun prec ->
                 let s = float_to_string prec v in
-                if Float.ieee_equal v (float_of_string s) then Some s else None)
+                if Float.equal v (float_of_string s) then Some s else None)
               ~bad:0
               ~good:18
               ~good_s:"max"
diff --git a/compiler/lib/stdlib.ml b/compiler/lib/stdlib.ml
index d67f4b0483..1b6c4bb5e2 100644
--- a/compiler/lib/stdlib.ml
+++ b/compiler/lib/stdlib.ml
@@ -423,9 +423,7 @@ end
 module Float = struct
   type t = float
 
-  let equal (_ : float) (_ : float) = `Use_ieee_equal_or_bitwise_equal
-
-  let ieee_equal (a : float) (b : float) = Poly.equal a b
+  let equal = Float.equal
 
   let bitwise_equal (a : float) (b : float) =
     Int64.equal (Int64.bits_of_float a) (Int64.bits_of_float b)

From f4d950e47008c7931893355b97cb16b45f53182c Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Tue, 27 Aug 2024 10:20:27 +0200
Subject: [PATCH 10/13] fix

---
 compiler/tests-compiler/gh1659.ml | 25 +++++++++++++++++++++++++
 1 file changed, 25 insertions(+)

diff --git a/compiler/tests-compiler/gh1659.ml b/compiler/tests-compiler/gh1659.ml
index c2728ba97d..3ff9d4165e 100644
--- a/compiler/tests-compiler/gh1659.ml
+++ b/compiler/tests-compiler/gh1659.ml
@@ -8,6 +8,31 @@ Printf.printf "%B\n" x;;
   [%expect {|
     true |}]
 
+let%expect_test _ =
+  let prog = {|
+let f a b = a = b
+let x = f 0. (-0.);;
+
+Printf.printf "%B\n" x;;
+  |} in
+  Util.compile_and_run prog;
+  [%expect {|
+    true |}]
+
+let%expect_test _ =
+  let prog =
+    {|
+
+let nan = 0. /. 0.
+let f x y = x = y
+let x = f nan nan;;
+Printf.printf "%B\n" x;;
+  |}
+  in
+  Util.compile_and_run prog;
+  [%expect {|
+            true |}]
+
 let%expect_test _ =
   let prog =
     {|

From eb2bd2949c73352633644bd96805b19dba544c48 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Tue, 27 Aug 2024 10:20:37 +0200
Subject: [PATCH 11/13] Reapply "fixup! restore Float.equal"

This reverts commit fece17d8bc601e7bb1717ecc04dedafa10bdb64f.
---
 compiler/lib/code.ml       | 4 ++--
 compiler/lib/eval.ml       | 2 +-
 compiler/lib/javascript.ml | 4 ++--
 compiler/lib/stdlib.ml     | 4 +++-
 4 files changed, 8 insertions(+), 6 deletions(-)

diff --git a/compiler/lib/code.ml b/compiler/lib/code.ml
index e7e3d05d09..0dda239870 100644
--- a/compiler/lib/code.ml
+++ b/compiler/lib/code.ml
@@ -387,9 +387,9 @@ module Constant = struct
           done;
           !same
     | Int64 a, Int64 b -> Some (Int64.equal a b)
-    | Float_array a, Float_array b -> Some (Array.equal Float.equal a b)
+    | Float_array a, Float_array b -> Some (Array.equal Float.ieee_equal a b)
     | Int a, Int b -> Some (Int32.equal a b)
-    | Float a, Float b -> Some (Float.equal a b)
+    | Float a, Float b -> Some (Float.ieee_equal a b)
     | String _, NativeString _ | NativeString _, String _ -> None
     | Int _, Float _ | Float _, Int _ -> None
     | Tuple ((0 | 254), _, _), Float_array _ -> None
diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index bcb965e7ae..ab7bd46eec 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -237,7 +237,7 @@ let the_cont_of info x (a : cont array) =
 let constant_js_equal a b =
   match a, b with
   | Int i, Int j -> Some (Int32.equal i j)
-  | Float a, Float b -> Some (Float.equal a b)
+  | Float a, Float b -> Some (Float.ieee_equal a b)
   | NativeString a, NativeString b -> Some (Native_string.equal a b)
   | String a, String b when Config.Flag.use_js_string () -> Some (String.equal a b)
   | Int _, Float _ | Float _, Int _ -> None
diff --git a/compiler/lib/javascript.ml b/compiler/lib/javascript.ml
index e77d176190..1a13813fe1 100644
--- a/compiler/lib/javascript.ml
+++ b/compiler/lib/javascript.ml
@@ -112,14 +112,14 @@ end = struct
     | FP_infinite -> if Float.(v < 0.) then "-Infinity" else "Infinity"
     | FP_normal | FP_subnormal -> (
         let vint = int_of_float v in
-        if Float.equal (float_of_int vint) v
+        if Float.ieee_equal (float_of_int vint) v
         then Printf.sprintf "%d." vint
         else
           match
             find_smaller
               ~f:(fun prec ->
                 let s = float_to_string prec v in
-                if Float.equal v (float_of_string s) then Some s else None)
+                if Float.ieee_equal v (float_of_string s) then Some s else None)
               ~bad:0
               ~good:18
               ~good_s:"max"
diff --git a/compiler/lib/stdlib.ml b/compiler/lib/stdlib.ml
index 1b6c4bb5e2..d67f4b0483 100644
--- a/compiler/lib/stdlib.ml
+++ b/compiler/lib/stdlib.ml
@@ -423,7 +423,9 @@ end
 module Float = struct
   type t = float
 
-  let equal = Float.equal
+  let equal (_ : float) (_ : float) = `Use_ieee_equal_or_bitwise_equal
+
+  let ieee_equal (a : float) (b : float) = Poly.equal a b
 
   let bitwise_equal (a : float) (b : float) =
     Int64.equal (Int64.bits_of_float a) (Int64.bits_of_float b)

From 49ac969537e1ece7a70516757ea1fb4d9ed554c4 Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Tue, 27 Aug 2024 10:33:50 +0200
Subject: [PATCH 12/13] complete the tests

---
 compiler/tests-compiler/gh1659.ml | 74 +++++++++++++++++++------------
 1 file changed, 45 insertions(+), 29 deletions(-)

diff --git a/compiler/tests-compiler/gh1659.ml b/compiler/tests-compiler/gh1659.ml
index 3ff9d4165e..3607703f22 100644
--- a/compiler/tests-compiler/gh1659.ml
+++ b/compiler/tests-compiler/gh1659.ml
@@ -1,46 +1,62 @@
 let%expect_test _ =
-  let prog = {|
-let x = (0., 0.) = (-0., 0.);;
-
-Printf.printf "%B\n" x;;
-  |} in
-  Util.compile_and_run prog;
-  [%expect {|
-    true |}]
-
-let%expect_test _ =
-  let prog = {|
+  let prog =
+    {|
 let f a b = a = b
-let x = f 0. (-0.);;
-
-Printf.printf "%B\n" x;;
-  |} in
+let () = Printf.printf "(0., 0.) = (-0., 0.) => %B\n" (f (0., 0.) (-0., 0.))
+let f a b = a = b
+let () = Printf.printf "0. = -0. => %B\n" (f 0. (-0.));;
+let f a b = a = b
+let nan1 = 0. /. 0.
+let nan2 = 0. /. 0.
+let () = Printf.printf "nan = nan => %B\n" (f nan1 nan2);;
+  |}
+  in
   Util.compile_and_run prog;
-  [%expect {|
-    true |}]
+  [%expect
+    {|
+    (0., 0.) = (-0., 0.) => true
+    0. = -0. => true
+    nan = nan => false
+    |}]
 
 let%expect_test _ =
   let prog =
     {|
-
-let nan = 0. /. 0.
-let f x y = x = y
-let x = f nan nan;;
-Printf.printf "%B\n" x;;
+external equals : 'a -> 'a -> bool = "caml_js_equals";;
+let () = Printf.printf "x = (0., 0.); x = x => %B\n" (let x = (0., 0.) in equals x x)
+let () = Printf.printf "(0., 0.) = (0., 0.) => %B\n" (equals (0., 0.) (0., 0.))
+let () = Printf.printf "0. = -0. => %B\n" (equals 0. (-0.));;
+let nan1 = 0. /. 0.
+let nan2 = 0. /. 0.
+let () = Printf.printf "nan = nan => %B\n" (equals nan1 nan2);;
   |}
   in
   Util.compile_and_run prog;
-  [%expect {|
-            true |}]
+  [%expect
+    {|
+    x = (0., 0.); x = x => true
+    (0., 0.) = (0., 0.) => false
+    0. = -0. => true
+    nan = nan => false
+    |}]
 
 let%expect_test _ =
   let prog =
     {|
-external equals : 'a -> 'a -> bool = "caml_js_equals";;
-let x = equals (0, 0) (0, 0);;
-Printf.printf "%B\n" x;;
+external equals : 'a -> 'a -> bool = "caml_js_strict_equals";;
+let () = Printf.printf "x = (0., 0.); x = x => %B\n" (let x = (0., 0.) in equals x x)
+let () = Printf.printf "(0., 0.) = (0., 0.) => %B\n" (equals (0., 0.) (0., 0.))
+let () = Printf.printf "0. = -0. => %B\n" (equals 0. (-0.));;
+let nan1 = 0. /. 0.
+let nan2 = 0. /. 0.
+let () = Printf.printf "nan = nan => %B\n" (equals nan1 nan2);;
   |}
   in
   Util.compile_and_run prog;
-  [%expect {|
-    false |}]
+  [%expect
+    {|
+    x = (0., 0.); x = x => true
+    (0., 0.) = (0., 0.) => false
+    0. = -0. => true
+    nan = nan => false
+    |}]

From 9764c330396b310fca0fef2eb89c578a984b426e Mon Sep 17 00:00:00 2001
From: Hugo Heuzard <hugo.heuzard@gmail.com>
Date: Tue, 27 Aug 2024 10:54:58 +0200
Subject: [PATCH 13/13] Compiler: small refactoring in eval

---
 compiler/lib/eval.ml | 26 +++++++++++++++-----------
 1 file changed, 15 insertions(+), 11 deletions(-)

diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml
index ab7bd46eec..10615cca24 100644
--- a/compiler/lib/eval.ml
+++ b/compiler/lib/eval.ml
@@ -65,14 +65,15 @@ let float_unop l f =
   | [ Int i ] -> Some (Float (f (Int32.to_float i)))
   | _ -> None
 
+let bool' b = Int (if b then 1l else 0l)
+
+let bool b = Some (bool' b)
+
 let float_binop_bool l f =
   match float_binop_aux l f with
-  | Some true -> Some (Int 1l)
-  | Some false -> Some (Int 0l)
+  | Some b -> bool b
   | None -> None
 
-let bool b = Some (Int (if b then 1l else 0l))
-
 let eval_prim x =
   match x with
   | Not, [ Int i ] -> bool Int32.(i = 0l)
@@ -255,14 +256,19 @@ let constant_js_equal a b =
 
 let eval_instr info ((x, loc) as i) =
   match x with
-  | Let (x, Prim (Extern "caml_equal", [ y; z ])) -> (
+  | Let (x, Prim (Extern (("caml_equal" | "caml_notequal") as prim), [ y; z ])) -> (
       match the_const_of info y, the_const_of info z with
       | Some e1, Some e2 -> (
           match Code.Constant.ocaml_equal e1 e2 with
           | None -> [ i ]
           | Some c ->
-              let c = if c then 1l else 0l in
-              let c = Constant (Int c) in
+              let c =
+                match prim with
+                | "caml_equal" -> c
+                | "caml_notequal" -> not c
+                | _ -> assert false
+              in
+              let c = Constant (bool' c) in
               Flow.Info.update_def info x c;
               [ Let (x, c), loc ])
       | _ -> [ i ])
@@ -272,8 +278,7 @@ let eval_instr info ((x, loc) as i) =
           match constant_js_equal e1 e2 with
           | None -> [ i ]
           | Some c ->
-              let c = if c then 1l else 0l in
-              let c = Constant (Int c) in
+              let c = Constant (bool' c) in
               Flow.Info.update_def info x c;
               [ Let (x, c), loc ])
       | _ -> [ i ])
@@ -299,8 +304,7 @@ let eval_instr info ((x, loc) as i) =
       match is_int info y with
       | Unknown -> [ i ]
       | (Y | N) as b ->
-          let b = if Poly.(b = N) then 0l else 1l in
-          let c = Constant (Int b) in
+          let c = Constant (bool' Poly.(b = Y)) in
           Flow.Info.update_def info x c;
           [ Let (x, c), loc ])
   | Let (x, Prim (Extern "%direct_obj_tag", [ y ])) -> (