Skip to content

Commit c966a8f

Browse files
hhugohhugo
committed
WIP
1 parent 6ba77eb commit c966a8f

26 files changed

+715
-747
lines changed

‎compiler/lib/code.ml

Lines changed: 9 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -289,14 +289,19 @@ end
289289

290290
type cont = Addr.t * Var.t list
291291

292+
type float_or_not =
293+
| Float
294+
| Not_float
295+
| Unknown
296+
292297
type prim =
293298
| Vectlength
294299
| Array_get
295300
| Extern of string
296301
| Not
297302
| IsInt
298-
| Eq
299-
| Neq
303+
| Eq of float_or_not
304+
| Neq of float_or_not
300305
| Lt
301306
| Le
302307
| Ult
@@ -557,8 +562,8 @@ module Print = struct
557562
| Extern s, _ -> Format.fprintf f "\"%s\"(%a)" s (list arg) l
558563
| Not, [ x ] -> Format.fprintf f "!%a" arg x
559564
| IsInt, [ x ] -> Format.fprintf f "is_int(%a)" arg x
560-
| Eq, [ x; y ] -> Format.fprintf f "%a === %a" arg x arg y
561-
| Neq, [ x; y ] -> Format.fprintf f "!(%a === %a)" arg x arg y
565+
| Eq _, [ x; y ] -> Format.fprintf f "%a === %a" arg x arg y
566+
| Neq _, [ x; y ] -> Format.fprintf f "!(%a === %a)" arg x arg y
562567
| Lt, [ x; y ] -> Format.fprintf f "%a < %a" arg x arg y
563568
| Le, [ x; y ] -> Format.fprintf f "%a <= %a" arg x arg y
564569
| Ult, [ x; y ] -> Format.fprintf f "%a <= %a" arg x arg y

‎compiler/lib/code.mli

Lines changed: 7 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -139,14 +139,19 @@ end
139139

140140
type cont = Addr.t * Var.t list
141141

142+
type float_or_not =
143+
| Float
144+
| Not_float
145+
| Unknown
146+
142147
type prim =
143148
| Vectlength
144149
| Array_get
145150
| Extern of string
146151
| Not
147152
| IsInt
148-
| Eq
149-
| Neq
153+
| Eq of float_or_not
154+
| Neq of float_or_not
150155
| Lt
151156
| Le
152157
| Ult

‎compiler/lib/eval.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -83,8 +83,8 @@ let eval_prim x =
8383
| Not, [ Int i ] -> bool (Targetint.is_zero i)
8484
| Lt, [ Int i; Int j ] -> bool Targetint.(i < j)
8585
| Le, [ Int i; Int j ] -> bool Targetint.(i <= j)
86-
| Eq, [ Int i; Int j ] -> bool Targetint.(i = j)
87-
| Neq, [ Int i; Int j ] -> bool Targetint.(i <> j)
86+
| Eq _, [ Int i; Int j ] -> bool Targetint.(i = j)
87+
| Neq _, [ Int i; Int j ] -> bool Targetint.(i <> j)
8888
| Ult, [ Int i; Int j ] -> bool (Targetint.(j < zero) || Targetint.(i < j))
8989
| Extern name, l -> (
9090
let name = Primitive.resolve name in

‎compiler/lib/flow.ml

Lines changed: 63 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -206,7 +206,7 @@ let expr_escape st _x e =
206206
| Special _ | Constant _ | Closure _ | Block _ | Field _ -> ()
207207
| Apply { args; _ } -> List.iter args ~f:(fun x -> block_escape st x)
208208
| Prim (Array_get, [ Pv x; _ ]) -> block_escape st x
209-
| Prim ((Vectlength | Array_get | Not | IsInt | Eq | Neq | Lt | Le | Ult), _) -> ()
209+
| Prim ((Vectlength | Array_get | Not | IsInt | Eq _ | Neq _ | Lt | Le | Ult), _) -> ()
210210
| Prim (Extern name, l) ->
211211
let ka =
212212
match Primitive.kind_args name with
@@ -340,6 +340,68 @@ let the_def_of info x =
340340
x
341341
| Pc c -> Some (Constant c)
342342

343+
let float_or_not x : Code.float_or_not =
344+
match x with
345+
| Block _ -> Not_float
346+
| Closure _ -> Not_float
347+
| Special (Alias_prim _) -> Not_float
348+
| Field _ -> Unknown
349+
| Apply _ -> Unknown
350+
| Prim (prim, _) -> (
351+
match prim with
352+
| Extern
353+
( "caml_ml_string_length"
354+
| "caml_ml_bytes_length"
355+
| "caml_bytes_unsafe_get"
356+
| "caml_bytes_get"
357+
| "caml_string_unsafe_get"
358+
| "caml_string_get"
359+
| "%int_add"
360+
| "%int_sub"
361+
| "%int_mul"
362+
| "%direct_int_mul"
363+
| "%int_div"
364+
| "%direct_int_div"
365+
| "%int_mod"
366+
| "%direct_int_mod"
367+
| "caml_obj_tag" ) -> Not_float
368+
| Array_get -> Unknown
369+
| Extern _ -> Unknown
370+
| Vectlength -> Not_float
371+
| Not -> Not_float
372+
| IsInt -> Not_float
373+
| Eq _ | Neq _ -> Not_float
374+
| Lt | Le | Ult -> Not_float)
375+
| Constant
376+
( String _
377+
| NativeString _
378+
| Float_array _
379+
| Int _
380+
| Int32 _
381+
| Int64 _
382+
| Tuple _
383+
| NativeInt _ ) -> Not_float
384+
| Constant (Float _) -> Float
385+
386+
let the_float_or_not_of info x =
387+
match x with
388+
| Pv x ->
389+
get_approx
390+
info
391+
(fun x ->
392+
match info.info_defs.(Var.idx x) with
393+
| Expr e -> float_or_not e
394+
| Param | Phi _ -> Unknown)
395+
Unknown
396+
(fun a b ->
397+
match a, b with
398+
| Unknown, _ | _, Unknown -> Unknown
399+
| Float, Float -> Float
400+
| Not_float, Not_float -> Not_float
401+
| Float, Not_float | Not_float, Float -> Unknown)
402+
x
403+
| Pc c -> float_or_not (Constant c)
404+
343405
(* If [constant_identical a b = true], then the two values cannot be
344406
distinguished, i.e., they are not different objects (and [caml_js_equals a b
345407
= true]) and if both are floats, they are bitwise equal. *)

‎compiler/lib/flow.mli

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -52,6 +52,8 @@ val get_approx :
5252

5353
val the_def_of : Info.t -> Code.prim_arg -> Code.expr option
5454

55+
val the_float_or_not_of : Info.t -> Code.prim_arg -> Code.float_or_not
56+
5557
val the_const_of :
5658
target:[ `JavaScript | `Wasm ] -> Info.t -> Code.prim_arg -> Code.constant option
5759

‎compiler/lib/generate.ml

Lines changed: 22 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -978,6 +978,7 @@ let _ =
978978
register_un_prim "caml_obj_dup" `Mutable (fun cx loc ->
979979
J.call (J.dot cx (Utf8_string.of_string_exn "slice")) [] loc);
980980
register_un_prim "caml_int_of_float" `Pure (fun cx _loc -> to_int cx);
981+
register_un_prim "caml_float_of_int" `Pure (fun cx _loc -> cx);
981982
register_un_math_prim "caml_abs_float" "abs";
982983
register_un_math_prim "caml_acos_float" "acos";
983984
register_un_math_prim "caml_asin_float" "asin";
@@ -1056,15 +1057,6 @@ let remove_unused_tail_args ctx exact trampolined args =
10561057
else args
10571058
else args
10581059

1059-
let maybe_zero_or_nan = function
1060-
| J.ENum n -> (
1061-
match J.Num.to_string n with
1062-
| "NaN" -> true
1063-
| "-0." | "0." | "0" | "-0" -> true
1064-
| _ -> false)
1065-
| J.EBin ((J.Bor | J.Lsr), _, _) -> false
1066-
| _ -> true
1067-
10681060
let rec translate_expr ctx queue loc x e level : _ * J.statement_list =
10691061
match e with
10701062
| Apply { f; args; exact } ->
@@ -1359,32 +1351,32 @@ let rec translate_expr ctx queue loc x e level : _ * J.statement_list =
13591351
let (px, cx), queue = access_queue' ~ctx queue x in
13601352
let (py, cy), queue = access_queue' ~ctx queue y in
13611353
bool (J.EBin (J.LeInt, cx, cy)), or_p px py, queue
1362-
| Eq, [ x; y ] ->
1354+
| Eq k, [ x; y ] ->
13631355
let (px, cx), queue = access_queue' ~ctx queue x in
13641356
let (py, cy), queue = access_queue' ~ctx queue y in
13651357
let e =
1366-
if not (maybe_zero_or_nan cx && maybe_zero_or_nan cy)
1367-
then bool (J.EBin (J.EqEqEq, cx, cy))
1368-
else
1369-
bool
1370-
(J.call
1371-
(J.dot (s_var "Object") (Utf8_string.of_string_exn "is"))
1372-
[ cx; cy ]
1373-
loc)
1358+
match k with
1359+
| Not_float -> bool (J.EBin (J.EqEqEq, cx, cy))
1360+
| Float | Unknown ->
1361+
bool
1362+
(J.call
1363+
(J.dot (s_var "Object") (Utf8_string.of_string_exn "is"))
1364+
[ cx; cy ]
1365+
loc)
13741366
in
13751367
e, or_p px py, queue
1376-
| Neq, [ x; y ] ->
1368+
| Neq k, [ x; y ] ->
13771369
let (px, cx), queue = access_queue' ~ctx queue x in
13781370
let (py, cy), queue = access_queue' ~ctx queue y in
13791371
let e =
1380-
if not (maybe_zero_or_nan cx && maybe_zero_or_nan cy)
1381-
then bool (J.EBin (J.NotEqEq, cx, cy))
1382-
else
1383-
bool_not
1384-
(J.call
1385-
(J.dot (s_var "Object") (Utf8_string.of_string_exn "is"))
1386-
[ cx; cy ]
1387-
loc)
1372+
match k with
1373+
| Not_float -> bool (J.EBin (J.NotEqEq, cx, cy))
1374+
| Float | Unknown ->
1375+
bool_not
1376+
(J.call
1377+
(J.dot (s_var "Object") (Utf8_string.of_string_exn "is"))
1378+
[ cx; cy ]
1379+
loc)
13881380
in
13891381
e, or_p px py, queue
13901382
| IsInt, [ x ] ->
@@ -1394,7 +1386,7 @@ let rec translate_expr ctx queue loc x e level : _ * J.statement_list =
13941386
let (px, cx), queue = access_queue' ~ctx queue x in
13951387
let (py, cy), queue = access_queue' ~ctx queue y in
13961388
bool (J.EBin (J.LtInt, unsigned cx, unsigned cy)), or_p px py, queue
1397-
| (Vectlength | Array_get | Not | IsInt | Eq | Neq | Lt | Le | Ult), _ ->
1389+
| (Vectlength | Array_get | Not | IsInt | Eq _ | Neq _ | Lt | Le | Ult), _ ->
13981390
assert false
13991391
in
14001392
res, []
@@ -2062,7 +2054,7 @@ let init () =
20622054
; "caml_int32_of_int", "%identity"
20632055
; "caml_int32_to_int", "%identity"
20642056
; "caml_int32_of_float", "caml_int_of_float"
2065-
; "caml_int32_to_float", "%identity"
2057+
; "caml_int32_to_float", "caml_float_of_int"
20662058
; "caml_int32_format", "caml_format_int"
20672059
; "caml_int32_of_string", "caml_int_of_string"
20682060
; "caml_int32_compare", "caml_int_compare"
@@ -2081,7 +2073,7 @@ let init () =
20812073
; "caml_nativeint_of_int", "%identity"
20822074
; "caml_nativeint_to_int", "%identity"
20832075
; "caml_nativeint_of_float", "caml_int_of_float"
2084-
; "caml_nativeint_to_float", "%identity"
2076+
; "caml_nativeint_to_float", "caml_float_of_int"
20852077
; "caml_nativeint_of_int32", "%identity"
20862078
; "caml_nativeint_to_int32", "%identity"
20872079
; "caml_nativeint_format", "caml_format_int"
@@ -2092,7 +2084,6 @@ let init () =
20922084
; "caml_int64_to_int", "caml_int64_to_int32"
20932085
; "caml_int64_of_nativeint", "caml_int64_of_int32"
20942086
; "caml_int64_to_nativeint", "caml_int64_to_int32"
2095-
; "caml_float_of_int", "%identity"
20962087
; "caml_array_get_float", "caml_array_get"
20972088
; "caml_floatarray_get", "caml_array_get"
20982089
; "caml_array_get_addr", "caml_array_get"

‎compiler/lib/global_flow.ml

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -150,8 +150,9 @@ let possibly_mutable st x = Var.ISet.add st.variable_possibly_mutable x
150150

151151
let expr_deps blocks st x e =
152152
match e with
153-
| Constant _ | Prim ((Vectlength | Not | IsInt | Eq | Neq | Lt | Le | Ult), _) | Block _
154-
-> ()
153+
| Constant _
154+
| Prim ((Vectlength | Not | IsInt | Eq _ | Neq _ | Lt | Le | Ult), _)
155+
| Block _ -> ()
155156
| Special _ -> ()
156157
| Prim
157158
( ( Extern
@@ -480,7 +481,7 @@ let propagate st ~update approx x =
480481
known
481482
| Top -> Top)
482483
| Prim (Array_get, _) -> Domain.others
483-
| Prim ((Vectlength | Not | IsInt | Eq | Neq | Lt | Le | Ult), _) ->
484+
| Prim ((Vectlength | Not | IsInt | Eq _ | Neq _ | Lt | Le | Ult), _) ->
484485
(* The result of these primitive is neither a function nor a
485486
block *)
486487
Domain.bot

‎compiler/lib/javascript.ml

Lines changed: 0 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -42,8 +42,6 @@ module Num : sig
4242

4343
val is_neg : t -> bool
4444

45-
val is_int : t -> bool
46-
4745
(** Arithmetic *)
4846

4947
val add : t -> t -> t
@@ -135,13 +133,6 @@ end = struct
135133

136134
let is_neg s = Char.equal s.[0] '-'
137135

138-
let is_int = function
139-
| "-0" -> false
140-
| s ->
141-
String.for_all s ~f:(function
142-
| '0' .. '9' | '-' | '+' -> true
143-
| _ -> false)
144-
145136
let neg s =
146137
match String.drop_prefix s ~prefix:"-" with
147138
| None -> "-" ^ s

‎compiler/lib/javascript.mli

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -43,8 +43,6 @@ module Num : sig
4343

4444
val is_neg : t -> bool
4545

46-
val is_int : t -> bool
47-
4846
(** Arithmetic *)
4947

5048
val add : t -> t -> t

‎compiler/lib/parse_bytecode.ml

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -2207,7 +2207,7 @@ and compile infos pc state instrs =
22072207
infos
22082208
(pc + 1)
22092209
(State.pop 1 state)
2210-
((Let (x, Prim (Eq, [ Pv y; Pv z ])), loc) :: instrs)
2210+
((Let (x, Prim (Eq Unknown, [ Pv y; Pv z ])), loc) :: instrs)
22112211
| NEQ ->
22122212
let y, _ = State.accu state in
22132213
let z, _ = State.peek 0 state in
@@ -2219,7 +2219,7 @@ and compile infos pc state instrs =
22192219
infos
22202220
(pc + 1)
22212221
(State.pop 1 state)
2222-
((Let (x, Prim (Neq, [ Pv y; Pv z ])), loc) :: instrs)
2222+
((Let (x, Prim (Neq Unknown, [ Pv y; Pv z ])), loc) :: instrs)
22232223
| LTINT ->
22242224
let y, _ = State.accu state in
22252225
let z, _ = State.peek 0 state in
@@ -2303,7 +2303,8 @@ and compile infos pc state instrs =
23032303
let x, _ = State.accu state in
23042304
let y = Var.fresh () in
23052305

2306-
( (Let (y, Prim (Eq, [ Pc (Int (Targetint.of_int32_exn n)); Pv x ])), loc)
2306+
( ( Let (y, Prim (Eq Not_float, [ Pc (Int (Targetint.of_int32_exn n)); Pv x ]))
2307+
, loc )
23072308
:: instrs
23082309
, (Cond (y, (pc + offset + 2, []), (pc + 3, [])), loc)
23092310
, state )
@@ -2313,7 +2314,8 @@ and compile infos pc state instrs =
23132314
let x, _ = State.accu state in
23142315
let y = Var.fresh () in
23152316

2316-
( (Let (y, Prim (Eq, [ Pc (Int (Targetint.of_int32_exn n)); Pv x ])), loc)
2317+
( ( Let (y, Prim (Eq Not_float, [ Pc (Int (Targetint.of_int32_exn n)); Pv x ]))
2318+
, loc )
23172319
:: instrs
23182320
, (Cond (y, (pc + 3, []), (pc + offset + 2, [])), loc)
23192321
, state )

‎compiler/lib/specialize_js.ml

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -294,6 +294,26 @@ let specialize_instrs ~target info l =
294294
instr (Pv y') :: (Let (y', Prim (Extern check, [ y; z ])), noloc) :: acc
295295
in
296296
aux info ((y, idx) :: checks) r acc
297+
| Let (x, Prim (Eq Unknown, [ a; b ])) ->
298+
let i =
299+
match Flow.the_float_or_not_of info a, Flow.the_float_or_not_of info b with
300+
| Not_float, (Not_float | Unknown | Float) | (Float | Unknown), Not_float ->
301+
Let (x, Prim (Eq Not_float, [ a; b ]))
302+
| Float, Float -> Let (x, Prim (Eq Float, [ a; b ]))
303+
| Unknown, _ | _, Unknown -> i
304+
in
305+
306+
aux info checks r ((i, loc) :: acc)
307+
| Let (x, Prim (Neq Unknown, [ a; b ])) ->
308+
let i =
309+
match Flow.the_float_or_not_of info a, Flow.the_float_or_not_of info b with
310+
| Not_float, (Not_float | Unknown | Float) | (Float | Unknown), Not_float ->
311+
Let (x, Prim (Neq Not_float, [ a; b ]))
312+
| Float, Float -> Let (x, Prim (Neq Float, [ a; b ]))
313+
| Unknown, _ | _, Unknown -> i
314+
in
315+
316+
aux info checks r ((i, loc) :: acc)
297317
| _ ->
298318
let i = specialize_instr ~target info i in
299319
aux info checks r ((i, loc) :: acc))

‎compiler/tests-compiler/compact.ml

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,7 @@ let rec f x y z =
4242
function(a, b, c){
4343
var f = a, e = b, d = c;
4444
for(;;){
45-
if(Object.is(0, f) && Object.is(0, e) && Object.is(0, d)) return 1;
45+
if(0 === f && 0 === e && 0 === d) return 1;
4646
var g = (d + f | 0) + e | 0;
4747
f = f + d | 0;
4848
e = e - d | 0;
@@ -53,4 +53,5 @@ let rec f x y z =
5353
return;
5454
}
5555
(globalThis));
56-
//end |}]
56+
//end
57+
|}]

0 commit comments

Comments
 (0)