Skip to content

Commit 1e3ae98

Browse files
OlivierNicoleOlivierNicole
committed
Fix bugs related to constant equality
See #1659.
1 parent 90ab0c6 commit 1e3ae98

File tree

10 files changed

+98
-47
lines changed

10 files changed

+98
-47
lines changed

‎compiler/lib/code.ml‎

Lines changed: 40 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -367,42 +367,46 @@ type constant =
367367
| Tuple of int * constant array * array_or_not
368368
| Int of int32
369369

370-
let rec constant_equal a b =
371-
match a, b with
372-
| String a, String b -> Some (String.equal a b)
373-
| NativeString a, NativeString b -> Some (Native_string.equal a b)
374-
| Tuple (ta, a, _), Tuple (tb, b, _) ->
375-
if ta <> tb || Array.length a <> Array.length b
376-
then Some false
377-
else
378-
let same = ref (Some true) in
379-
for i = 0 to Array.length a - 1 do
380-
match !same, constant_equal a.(i) b.(i) with
381-
| None, _ -> ()
382-
| _, None -> same := None
383-
| Some s, Some c -> same := Some (s && c)
384-
done;
385-
!same
386-
| Int64 a, Int64 b -> Some (Int64.equal a b)
387-
| Float_array a, Float_array b -> Some (Array.equal Float.equal a b)
388-
| Int a, Int b -> Some (Int32.equal a b)
389-
| Float a, Float b -> Some (Float.equal a b)
390-
| String _, NativeString _ | NativeString _, String _ -> None
391-
| Int _, Float _ | Float _, Int _ -> None
392-
| Tuple ((0 | 254), _, _), Float_array _ -> None
393-
| Float_array _, Tuple ((0 | 254), _, _) -> None
394-
| Tuple _, (String _ | NativeString _ | Int64 _ | Int _ | Float _ | Float_array _) ->
395-
Some false
396-
| Float_array _, (String _ | NativeString _ | Int64 _ | Int _ | Float _ | Tuple _) ->
397-
Some false
398-
| String _, (Int64 _ | Int _ | Float _ | Tuple _ | Float_array _) -> Some false
399-
| NativeString _, (Int64 _ | Int _ | Float _ | Tuple _ | Float_array _) -> Some false
400-
| Int64 _, (String _ | NativeString _ | Int _ | Float _ | Tuple _ | Float_array _) ->
401-
Some false
402-
| Float _, (String _ | NativeString _ | Float_array _ | Int64 _ | Tuple (_, _, _)) ->
403-
Some false
404-
| Int _, (String _ | NativeString _ | Float_array _ | Int64 _ | Tuple (_, _, _)) ->
405-
Some false
370+
module Constant = struct
371+
type t = constant
372+
373+
let rec ocaml_equal a b =
374+
match a, b with
375+
| String a, String b -> Some (String.equal a b)
376+
| NativeString a, NativeString b -> Some (Native_string.equal a b)
377+
| Tuple (ta, a, _), Tuple (tb, b, _) ->
378+
if ta <> tb || Array.length a <> Array.length b
379+
then Some false
380+
else
381+
let same = ref (Some true) in
382+
for i = 0 to Array.length a - 1 do
383+
match !same, ocaml_equal a.(i) b.(i) with
384+
| None, _ -> ()
385+
| _, None -> same := None
386+
| Some s, Some c -> same := Some (s && c)
387+
done;
388+
!same
389+
| Int64 a, Int64 b -> Some (Int64.equal a b)
390+
| Float_array a, Float_array b -> Some (Array.equal Poly.equal a b)
391+
| Int a, Int b -> Some (Int32.equal a b)
392+
| Float a, Float b -> Some (Poly.equal a b)
393+
| String _, NativeString _ | NativeString _, String _ -> None
394+
| Int _, Float _ | Float _, Int _ -> None
395+
| Tuple ((0 | 254), _, _), Float_array _ -> None
396+
| Float_array _, Tuple ((0 | 254), _, _) -> None
397+
| Tuple _, (String _ | NativeString _ | Int64 _ | Int _ | Float _ | Float_array _) ->
398+
Some false
399+
| Float_array _, (String _ | NativeString _ | Int64 _ | Int _ | Float _ | Tuple _) ->
400+
Some false
401+
| String _, (Int64 _ | Int _ | Float _ | Tuple _ | Float_array _) -> Some false
402+
| NativeString _, (Int64 _ | Int _ | Float _ | Tuple _ | Float_array _) -> Some false
403+
| Int64 _, (String _ | NativeString _ | Int _ | Float _ | Tuple _ | Float_array _) ->
404+
Some false
405+
| Float _, (String _ | NativeString _ | Float_array _ | Int64 _ | Tuple (_, _, _)) ->
406+
Some false
407+
| Int _, (String _ | NativeString _ | Float_array _ | Int64 _ | Tuple (_, _, _)) ->
408+
Some false
409+
end
406410

407411
type loc =
408412
| No

‎compiler/lib/code.mli‎

Lines changed: 7 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -185,9 +185,13 @@ type constant =
185185
| Tuple of int * constant array * array_or_not
186186
| Int of int32
187187

188-
(** Guaranteed equality in terms of both OCaml [(=)]: if [constant_equal a b =
189-
Some v], then [Poly.(=) a b = v]. This is used for optimization purposes. *)
190-
val constant_equal : constant -> constant -> bool option
188+
module Constant : sig
189+
type t = constant
190+
191+
(** Guaranteed equality in terms of both OCaml [(=)]: if [constant_equal a b =
192+
Some v], then [Poly.(=) a b = v]. This is used for optimization purposes. *)
193+
val ocaml_equal : t -> t -> bool option
194+
end
191195

192196
type loc =
193197
| No

‎compiler/lib/driver.ml‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,8 @@
1919
*)
2020
open! Stdlib
2121

22+
module Constant = Global_constant
23+
2224
let debug = Debug.find "main"
2325

2426
let times = Debug.find "times"

‎compiler/lib/eval.ml‎

Lines changed: 26 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -233,12 +233,36 @@ let the_cont_of info x (a : cont array) =
233233
| _ -> None)
234234
x
235235

236+
(* If [constant_js_equal a b = Some v], then [caml_js_equals a b = Some v]). *)
237+
let constant_js_equal a b =
238+
match a,b with
239+
| Int i, Int j -> Some (Int32.equal i j)
240+
| Float a, Float b -> Some (Poly.equal a b)
241+
| Int _, Float _ | Float _, Int _ -> None
242+
(* All other values may be distinct objects and thus different by [caml_js_equals]. *)
243+
| String _, _ | _, String _
244+
| NativeString _, _ | _, NativeString _
245+
| Float_array _, _ | _, Float_array _
246+
| Int64 _, _ | _, Int64 _
247+
| Tuple _, _ | _, Tuple _ -> None
248+
236249
let eval_instr info ((x, loc) as i) =
237250
match x with
238-
| Let (x, Prim (Extern ("caml_js_equals" | "caml_equal"), [ y; z ])) -> (
251+
| Let (x, Prim (Extern "caml_equal", [ y; z ])) -> (
252+
match the_const_of info y, the_const_of info z with
253+
| Some e1, Some e2 -> (
254+
match Code.Constant.ocaml_equal e1 e2 with
255+
| None -> [ i ]
256+
| Some c ->
257+
let c = if c then 1l else 0l in
258+
let c = Constant (Int c) in
259+
Flow.Info.update_def info x c;
260+
[ Let (x, c), loc ])
261+
| _ -> [ i ])
262+
| Let (x, Prim (Extern "caml_js_equals", [ y; z ])) -> (
239263
match the_const_of info y, the_const_of info z with
240264
| Some e1, Some e2 -> (
241-
match constant_equal e1 e2 with
265+
match constant_js_equal e1 e2 with
242266
| None -> [ i ]
243267
| Some c ->
244268
let c = if c then 1l else 0l in

‎compiler/lib/flow.ml‎

Lines changed: 16 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -337,6 +337,21 @@ let the_def_of info x =
337337
x
338338
| Pc c -> Some (Constant c)
339339

340+
(* If [constant_identical a b = Some true], then the two values cannot be
341+
distinguished, i.e., they are not different objects (and [caml_js_equals a b
342+
= true]) and if both are floats, they are bitwise equal. *)
343+
let constant_identical a b =
344+
match a,b with
345+
| Int i, Int j -> Some (Int32.equal i j)
346+
| Float a, Float b -> Some (Float.bitwise_equal a b)
347+
| Int _, Float _ | Float _, Int _ -> None
348+
(* All other values may be distinct objects and thus different by [caml_js_equals]. *)
349+
| String _, _ | _, String _
350+
| NativeString _, _ | _, NativeString _
351+
| Float_array _, _ | _, Float_array _
352+
| Int64 _, _ | _, Int64 _
353+
| Tuple _, _ | _, Tuple _ -> None
354+
340355
let the_const_of info x =
341356
match x with
342357
| Pv x ->
@@ -352,7 +367,7 @@ let the_const_of info x =
352367
None
353368
(fun u v ->
354369
match u, v with
355-
| Some i, Some j when Poly.(Code.constant_equal i j = Some true) -> u
370+
| Some i, Some j when Poly.(constant_identical i j = Some true) -> u
356371
| _ -> None)
357372
x
358373
| Pc c -> Some c

‎compiler/lib/generate.ml‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1733,7 +1733,7 @@ and compile_conditional st queue ~fall_through last scope_stack : _ * _ =
17331733
true, flush_all queue (throw_statement st.ctx cx k loc)
17341734
| Stop ->
17351735
let e_opt =
1736-
if st.ctx.Ctx.should_export then Some (s_var Constant.exports) else None
1736+
if st.ctx.Ctx.should_export then Some (s_var Global_constant.exports) else None
17371737
in
17381738
true, flush_all queue [ J.Return_statement e_opt, loc ]
17391739
| Branch cont -> compile_branch st queue cont scope_stack ~fall_through
@@ -1909,7 +1909,7 @@ let generate_shared_value ctx =
19091909
| Some (v, _) ->
19101910
[ ( J.V v
19111911
, ( J.dot
1912-
(s_var Constant.global_object)
1912+
(s_var Global_constant.global_object)
19131913
(Utf8_string.of_string_exn "jsoo_runtime")
19141914
, J.N ) )
19151915
])

‎compiler/lib/constant.ml‎ renamed to ‎compiler/lib/global_constant.ml‎

File renamed without changes.

‎compiler/lib/javascript.ml‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -112,14 +112,14 @@ end = struct
112112
| FP_infinite -> if Float.(v < 0.) then "-Infinity" else "Infinity"
113113
| FP_normal | FP_subnormal -> (
114114
let vint = int_of_float v in
115-
if Float.equal (float_of_int vint) v
115+
if Poly.equal (float_of_int vint) v
116116
then Printf.sprintf "%d." vint
117117
else
118118
match
119119
find_smaller
120120
~f:(fun prec ->
121121
let s = float_to_string prec v in
122-
if Float.equal v (float_of_string s) then Some s else None)
122+
if Poly.equal v (float_of_string s) then Some s else None)
123123
~bad:0
124124
~good:18
125125
~good_s:"max"

‎compiler/lib/linker.ml‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,8 @@
2020

2121
open! Stdlib
2222

23+
module Constant = Global_constant
24+
2325
type 'a pack =
2426
| Ok of 'a
2527
| Pack of string

‎compiler/lib/stdlib.ml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -401,7 +401,7 @@ end
401401
module Float = struct
402402
type t = float
403403

404-
let equal (a : float) (b : float) =
404+
let bitwise_equal (a : float) (b : float) =
405405
Int64.equal (Int64.bits_of_float a) (Int64.bits_of_float b)
406406

407407
(* Re-defined here to stay compatible with OCaml 4.02 *)

0 commit comments

Comments
 (0)