Skip to content

Commit 1ffebf9

Browse files
cometkimcometkim
committed
remove/replace all remain caml_* primitives
1 parent d89201e commit 1ffebf9

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

70 files changed

+625
-701
lines changed

‎jscomp/core/js_exp_make.ml

Lines changed: 16 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -793,18 +793,6 @@ let rec float_equal ?comment (e0 : t) (e1 : t) : t =
793793

794794
let int_equal = float_equal
795795

796-
let string_equal ?comment (e0 : t) (e1 : t) : t =
797-
let default () : t = { expression_desc = Bin (EqEqEq, e0, e1); comment } in
798-
match (e0.expression_desc, e1.expression_desc) with
799-
| Str { txt = a0; delim = d0 }, Str { txt = a1; delim = d1 } when d0 = d1 ->
800-
(match str_equal a0 d0 a1 d1 with
801-
| Some b -> bool b
802-
| None -> default ())
803-
| _, _ -> default ()
804-
805-
let is_type_number ?comment (e : t) : t =
806-
string_equal ?comment (typeof e) (str "number")
807-
808796
let tag_type = function
809797
| Ast_untagged_variants.String s -> str s ~delim:DStarJ
810798
| Int i -> small_int i
@@ -853,11 +841,6 @@ let is_int_tag ?has_null_undefined_other e =
853841
let check = Ast_untagged_variants.DynamicChecks.is_int_tag ?has_null_undefined_other (Expr e) in
854842
emit_check check
855843

856-
let is_type_string ?comment (e : t) : t =
857-
string_equal ?comment (typeof e) (str "string")
858-
859-
let is_type_object (e : t) : t = string_equal (typeof e) (str "object")
860-
861844
(* we are calling [Caml_primitive.primitive_name], since it's under our
862845
control, we should make it follow the javascript name convention, and
863846
call plain [dot]
@@ -904,15 +887,26 @@ let to_int32 ?comment (e : J.expression) : J.expression =
904887
int32_bor ?comment e zero_int_literal
905888
(* TODO: if we already know the input is int32, [x|0] can be reduced into [x] *)
906889

907-
let string_comp (cmp : J.binop) ?comment (e0 : t) (e1 : t) =
890+
let string_comp (cmp : Lam_compat.comparison) ?comment (e0 : t) (e1 : t) =
908891
match (e0.expression_desc, e1.expression_desc) with
909892
| Str { txt = a0; delim = d0 }, Str { txt = a1; delim = d1 } -> (
910893
match cmp, str_equal a0 d0 a1 d1 with
911-
| EqEqEq, Some b -> bool b
912-
| NotEqEq, Some b -> bool (b = false)
894+
| Ceq, Some b -> bool b
895+
| Cneq, Some b -> bool (b = false)
913896
| _ ->
914-
bin ?comment cmp e0 e1)
915-
| _ -> bin ?comment cmp e0 e1
897+
bin ?comment (Lam_compile_util.jsop_of_comp cmp) e0 e1)
898+
| _ -> bin ?comment (Lam_compile_util.jsop_of_comp cmp) e0 e1
899+
900+
let string_equal ?comment (e0 : t) (e1 : t) : t =
901+
string_comp Ceq ?comment e0 e1
902+
903+
let is_type_number ?comment (e : t) : t =
904+
string_equal ?comment (typeof e) (str "number")
905+
906+
let is_type_string ?comment (e : t) : t =
907+
string_equal ?comment (typeof e) (str "string")
908+
909+
let is_type_object (e : t) : t = string_equal (typeof e) (str "object")
916910

917911
let obj_length ?comment e : t =
918912
to_int32 { expression_desc = Length (e, Caml_block); comment }

‎jscomp/core/js_exp_make.mli

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -269,7 +269,7 @@ val int_comp : Lam_compat.comparison -> ?comment:string -> t -> t -> t
269269

270270
val bool_comp : Lam_compat.comparison -> ?comment:string -> t -> t -> t
271271

272-
val string_comp : Js_op.binop -> ?comment:string -> t -> t -> t
272+
val string_comp : Lam_compat.comparison -> ?comment:string -> t -> t -> t
273273

274274
val float_comp : Lam_compat.comparison -> ?comment:string -> t -> t -> t
275275

‎jscomp/core/lam.ml

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -581,9 +581,13 @@ let has_boolean_type (x : t) =
581581
| Lprim
582582
{
583583
primitive =
584-
( Pnot | Psequand | Psequor | Pisout _ | Pintcomp _ | Pis_not_none
584+
( Pnot | Psequand | Psequor | Pisout _ | Pis_not_none
585+
| Pobjcomp _
586+
| Pboolcomp _
587+
| Pintcomp _
585588
| Pfloatcomp _
586-
| Pccall { prim_name = "caml_string_equal" | "caml_string_notequal" }
589+
| Pbigintcomp _
590+
| Pstringcomp _
587591
);
588592
loc;
589593
} ->

‎jscomp/core/lam_analysis.ml

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -64,9 +64,12 @@ let rec no_side_effects (lam : Lam.t) : bool =
6464
| Pfield _ | Pval_from_option | Pval_from_option_not_nest
6565
(* NOP The compiler already [t option] is the same as t *)
6666
| Pduprecord
67+
(* generic primitives *)
68+
| Pobjcomp _
69+
| Pobjorder | Pobjmin | Pobjmax
6770
(* bool primitives *)
6871
| Psequand | Psequor | Pnot
69-
| Pboolorder | Pboolmin | Pboolmax
72+
| Pboolcomp _ | Pboolorder | Pboolmin | Pboolmax
7073
(* int primitives *)
7174
| Pnegint | Paddint | Psubint | Pmulint | Pandint | Porint | Pxorint
7275
| Plslint | Plsrint | Pasrint | Pintcomp _
@@ -81,7 +84,7 @@ let rec no_side_effects (lam : Lam.t) : bool =
8184
| Pbigintcomp _ | Pbigintorder | Pbigintmin | Pbigintmax
8285
(* string primitives *)
8386
| Pstringlength | Pstringrefu | Pstringrefs
84-
| Pstringorder | Pstringmin | Pstringmax
87+
| Pstringcomp _ | Pstringorder | Pstringmin | Pstringmax
8588
(* array primitives *)
8689
| Pmakearray | Parraylength | Parrayrefu | Parrayrefs
8790
(* Test if the argument is a block or an immediate integer *)

‎jscomp/core/lam_compile.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -446,7 +446,7 @@ and compile_recursive_let ~all_bindings (cxt : Lam_compile_context.t)
446446
(Ext_list.append b
447447
[
448448
S.exp
449-
(E.runtime_call Js_runtime_modules.obj_runtime
449+
(E.runtime_call Js_runtime_modules.object_
450450
"update_dummy" [ E.var id; v ]);
451451
]),
452452
[ S.define_variable ~kind:Variable id (E.dummy_obj tag_info) ] )

‎jscomp/core/lam_compile_primitive.ml

Lines changed: 37 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -251,6 +251,9 @@ let translate output_prefix loc (cxt : Lam_compile_context.t)
251251
match args with [ e1; e2 ] -> E.bigint_op Bxor e1 e2 | _ -> assert false)
252252
| Pjscomp cmp -> (
253253
match args with [ l; r ] -> E.js_comp cmp l r | _ -> assert false)
254+
| Pboolcomp cmp -> (
255+
match args with [ e1; e2 ] -> E.bool_comp cmp e1 e2 | _ -> assert false
256+
)
254257
| Pfloatcomp cmp | Pintcomp cmp -> (
255258
(* Global Builtin Exception is an int, like
256259
[Not_found] or [Invalid_argument] ?
@@ -261,6 +264,9 @@ let translate output_prefix loc (cxt : Lam_compile_context.t)
261264
(* List --> stamp = 0
262265
Assert_false --> stamp = 26
263266
*)
267+
| Pstringcomp cmp -> (
268+
match args with [ e1; e2 ] -> E.string_comp cmp e1 e2 | _ -> assert false
269+
)
264270
| Pintoffloat -> (
265271
match args with [ e ] -> E.to_int32 e | _ -> assert false)
266272
| Pfloatofint -> Ext_list.singleton_exn args
@@ -304,6 +310,37 @@ let translate output_prefix loc (cxt : Lam_compile_context.t)
304310
match args with
305311
| [ e; e1 ] -> Js_of_lam_string.ref_string e e1
306312
| _ -> assert false)
313+
(* polymorphic operations *)
314+
| Pobjcomp cmp -> (
315+
match args with
316+
| [ e1; e2 ]
317+
when cmp = Ceq && (E.for_sure_js_null_undefined e1 || E.for_sure_js_null_undefined e2)
318+
->
319+
E.eq_null_undefined_boolean e1 e2
320+
| [ e1; e2 ]
321+
when cmp = Cneq && (E.for_sure_js_null_undefined e1 || E.for_sure_js_null_undefined e2)
322+
->
323+
E.neq_null_undefined_boolean e1 e2
324+
| [ e1; e2 ] ->
325+
Location.prerr_warning loc Warnings.Bs_polymorphic_comparison;
326+
E.runtime_call Js_runtime_modules.object_
327+
(Lam_compile_util.runtime_of_comp cmp) args
328+
| _ -> assert false)
329+
| Pobjorder -> (
330+
Location.prerr_warning loc Warnings.Bs_polymorphic_comparison;
331+
match args with
332+
| [ a; b ] -> E.runtime_call Js_runtime_modules.object_ "compare" args
333+
| _ -> assert false)
334+
| Pobjmin -> (
335+
Location.prerr_warning loc Warnings.Bs_polymorphic_comparison;
336+
match args with
337+
| [ a; b ] -> E.runtime_call Js_runtime_modules.object_ "min" args
338+
| _ -> assert false)
339+
| Pobjmax -> (
340+
Location.prerr_warning loc Warnings.Bs_polymorphic_comparison;
341+
match args with
342+
| [ a; b ] -> E.runtime_call Js_runtime_modules.object_ "max" args
343+
| _ -> assert false)
307344
| Pboolorder -> (
308345
match args with
309346
| [ { expression_desc = Bool a }; { expression_desc = Bool b } ] ->

‎jscomp/core/lam_compile_util.ml

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -30,3 +30,12 @@ let jsop_of_comp (cmp : Lam_compat.comparison) : Js_op.binop =
3030
| Cgt -> Gt
3131
| Cle -> Le
3232
| Cge -> Ge
33+
34+
let runtime_of_comp (cmp : Lam_compat.comparison) : string =
35+
match cmp with
36+
| Ceq -> "equal"
37+
| Cneq -> "notequal"
38+
| Clt -> "lessthan"
39+
| Cgt -> "greaterthan"
40+
| Cle -> "lessequal"
41+
| Cge -> "greaterequal"

‎jscomp/core/lam_compile_util.mli

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -25,3 +25,5 @@
2525
(** Some utilities for lambda compilation*)
2626

2727
val jsop_of_comp : Lam_compat.comparison -> Js_op.binop
28+
29+
val runtime_of_comp : Lam_compat.comparison -> string

‎jscomp/core/lam_convert.ml

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -215,9 +215,14 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
215215
| Pduprecord -> prim ~primitive:Pduprecord ~args loc
216216
| Plazyforce -> prim ~primitive:Plazyforce ~args loc
217217
| Praise _ -> prim ~primitive:Praise ~args loc
218+
| Pobjcomp x -> prim ~primitive:(Pobjcomp x) ~args loc
219+
| Pobjorder -> prim ~primitive:Pobjorder ~args loc
220+
| Pobjmin -> prim ~primitive:Pobjmin ~args loc
221+
| Pobjmax -> prim ~primitive:Pobjmax ~args loc
218222
| Psequand -> prim ~primitive:Psequand ~args loc
219223
| Psequor -> prim ~primitive:Psequor ~args loc
220224
| Pnot -> prim ~primitive:Pnot ~args loc
225+
| Pboolcomp x -> prim ~primitive:(Pboolcomp x) ~args loc
221226
| Pboolorder -> prim ~primitive:Pboolorder ~args loc
222227
| Pboolmin -> prim ~primitive:Pboolmin ~args loc
223228
| Pboolmax -> prim ~primitive:Pboolmax ~args loc
@@ -238,6 +243,7 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
238243
| Pintmax -> prim ~primitive:Pintmax ~args loc
239244
| Pstringlength -> prim ~primitive:Pstringlength ~args loc
240245
| Pstringrefu -> prim ~primitive:Pstringrefu ~args loc
246+
| Pstringcomp x -> prim ~primitive:(Pstringcomp x) ~args loc
241247
| Pstringorder -> prim ~primitive:Pstringorder ~args loc
242248
| Pstringmin -> prim ~primitive:Pstringmin ~args loc
243249
| Pstringmax -> prim ~primitive:Pstringmax ~args loc
@@ -402,7 +408,7 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) :
402408
match Ext_list.map args convert_aux with
403409
| [ lhs; rhs ] ->
404410
prim
405-
~primitive:(Pccall { prim_name = "caml_string_equal" })
411+
~primitive:(Pstringcomp Ceq)
406412
~args:[ lam_extension_id loc lhs; rhs ]
407413
loc
408414
| _ -> assert false)

‎jscomp/core/lam_dispatch_primitive.ml

Lines changed: 2 additions & 75 deletions
Original file line numberDiff line numberDiff line change
@@ -43,85 +43,12 @@ let translate loc (prim_name : string) (args : J.expression list) : J.expression
4343
| None ->
4444
if prim_name.[0] = '?' then
4545
String.sub prim_name 1 (String.length prim_name - 1)
46-
else if Ext_string.starts_with prim_name "caml_" then
47-
String.sub prim_name 5 (String.length prim_name - 5)
48-
else assert false (* prim_name *)
46+
else prim_name
4947
| Some x -> x
5048
in
5149
E.runtime_call m name args
5250
in
5351
match prim_name with
54-
| "caml_notequal" -> (
55-
match args with
56-
| [ a1; b1 ]
57-
when E.for_sure_js_null_undefined a1 || E.for_sure_js_null_undefined b1
58-
->
59-
E.neq_null_undefined_boolean a1 b1
60-
(* FIXME address_equal *)
61-
| _ ->
62-
Location.prerr_warning loc Warnings.Bs_polymorphic_comparison;
63-
call Js_runtime_modules.obj_runtime)
64-
| "caml_equal" -> (
65-
match args with
66-
| [ a1; b1 ]
67-
when E.for_sure_js_null_undefined a1 || E.for_sure_js_null_undefined b1
68-
->
69-
E.eq_null_undefined_boolean a1 b1
70-
(* FIXME address_equal *)
71-
| _ ->
72-
Location.prerr_warning loc Warnings.Bs_polymorphic_comparison;
73-
call Js_runtime_modules.obj_runtime)
74-
| "caml_min" | "caml_max" | "caml_compare" | "caml_greaterequal"
75-
| "caml_greaterthan" | "caml_lessequal" | "caml_lessthan" | "caml_equal_null"
76-
| "caml_equal_undefined" | "caml_equal_nullable" ->
77-
Location.prerr_warning loc Warnings.Bs_polymorphic_comparison;
78-
call Js_runtime_modules.obj_runtime
79-
(* generated by the compiler, not user facing *)
80-
| "caml_string_equal" -> (
81-
match args with [ e0; e1 ] -> E.string_equal e0 e1 | _ -> assert false)
82-
| "caml_string_notequal" -> (
83-
match args with
84-
| [ e0; e1 ] -> E.string_comp NotEqEq e0 e1
85-
(* TODO: convert to ocaml ones*)
86-
| _ -> assert false)
87-
| "caml_string_lessequal" -> (
88-
match args with [ e0; e1 ] -> E.string_comp Le e0 e1 | _ -> assert false)
89-
| "caml_string_lessthan" -> (
90-
match args with [ e0; e1 ] -> E.string_comp Lt e0 e1 | _ -> assert false)
91-
| "caml_string_greaterequal" -> (
92-
match args with [ e0; e1 ] -> E.string_comp Ge e0 e1 | _ -> assert false)
93-
| "caml_string_greaterthan" -> (
94-
match args with [ e0; e1 ] -> E.string_comp Gt e0 e1 | _ -> assert false)
95-
| "caml_bool_notequal" -> (
96-
match args with
97-
| [ e0; e1 ] -> E.bool_comp Cneq e0 e1
98-
(* TODO: specialized in OCaml ones*)
99-
| _ -> assert false)
100-
| "caml_bool_lessequal" -> (
101-
match args with [ e0; e1 ] -> E.bool_comp Cle e0 e1 | _ -> assert false)
102-
| "caml_bool_lessthan" -> (
103-
match args with [ e0; e1 ] -> E.bool_comp Clt e0 e1 | _ -> assert false)
104-
| "caml_bool_greaterequal" -> (
105-
match args with [ e0; e1 ] -> E.bool_comp Cge e0 e1 | _ -> assert false)
106-
| "caml_bool_greaterthan" -> (
107-
match args with [ e0; e1 ] -> E.bool_comp Cgt e0 e1 | _ -> assert false)
108-
| "caml_bool_equal" | "caml_bool_equal_null" | "caml_bool_equal_nullable"
109-
| "caml_bool_equal_undefined" -> (
110-
match args with [ e0; e1 ] -> E.bool_comp Ceq e0 e1 | _ -> assert false)
111-
| "caml_int_equal_null" | "caml_int_equal_nullable"
112-
| "caml_int_equal_undefined" -> (
113-
match args with [ e0; e1 ] -> E.int_comp Ceq e0 e1 | _ -> assert false)
114-
| "caml_float_equal_null" | "caml_float_equal_nullable"
115-
| "caml_float_equal_undefined" -> (
116-
match args with [ e0; e1 ] -> E.float_comp Ceq e0 e1 | _ -> assert false)
117-
| "caml_bigint_equal_null" | "caml_bigint_equal_nullable"
118-
| "caml_bigint_equal_undefined" -> (
119-
match args with [ e0; e1 ] -> E.bigint_comp Ceq e0 e1 | _ -> assert false)
120-
| "caml_string_equal_null" | "caml_string_equal_nullable"
121-
| "caml_string_equal_undefined" -> (
122-
match args with
123-
| [ e0; e1 ] -> E.string_comp EqEqEq e0 e1
124-
| _ -> assert false)
12552
(******************************************************************************)
12653
(************************* customized primitives ******************************)
12754
(******************************************************************************)
@@ -136,7 +63,7 @@ let translate loc (prim_name : string) (args : J.expression list) : J.expression
13663
like normal one to set the identifier *)
13764
| "?exn_slot_name" | "?is_extension" -> call Js_runtime_modules.exceptions
13865
| "?as_js_exn" -> call Js_runtime_modules.caml_js_exceptions
139-
| "?obj_dup" -> call Js_runtime_modules.obj_runtime
66+
| "?obj_dup" -> call Js_runtime_modules.object_
14067
| "?obj_tag" -> (
14168
(* Note that in ocaml, [int] has tag [1000] and [string] has tag [252]
14269
also now we need do nullary check

‎jscomp/core/lam_primitive.ml

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -57,10 +57,17 @@ type t =
5757
(* Exceptions *)
5858
| Praise
5959

60+
(* object primitives *)
61+
| Pobjcomp of Lam_compat.comparison
62+
| Pobjorder
63+
| Pobjmin
64+
| Pobjmax
65+
6066
(* Boolean primitives *)
6167
| Psequand
6268
| Psequor
6369
| Pnot
70+
| Pboolcomp of Lam_compat.comparison
6471
| Pboolorder
6572
| Pboolmin
6673
| Pboolmax
@@ -122,6 +129,7 @@ type t =
122129
| Pstringrefu
123130
| Pstringrefs
124131
| Pstringadd
132+
| Pstringcomp of Lam_compat.comparison
125133
| Pstringorder
126134
| Pstringmin
127135
| Pstringmax
@@ -191,10 +199,15 @@ let eq_primitive_approx (lhs : t) (rhs : t) =
191199
match lhs with
192200
| Pwrap_exn
193201
| Praise
202+
(* generic comparison *)
203+
| Pobjorder
204+
| Pobjmin
205+
| Pobjmax
194206
(* bool primitives *)
195207
| Psequand
196208
| Psequor
197209
| Pnot
210+
| Pboolcomp _
198211
| Pboolorder
199212
| Pboolmin
200213
| Pboolmax
@@ -247,6 +260,7 @@ let eq_primitive_approx (lhs : t) (rhs : t) =
247260
| Pstringrefu
248261
| Pstringrefs
249262
| Pstringadd
263+
| Pstringcomp _
250264
| Pstringorder
251265
| Pstringmin
252266
| Pstringmax
@@ -317,6 +331,10 @@ let eq_primitive_approx (lhs : t) (rhs : t) =
317331
match rhs with
318332
| Pjs_object_create obj_create1 -> obj_create = obj_create1
319333
| _ -> false)
334+
| Pobjcomp comparison -> (
335+
match rhs with
336+
| Pobjcomp comparison1 -> Lam_compat.eq_comparison comparison comparison1
337+
| _ -> false)
320338
| Pintcomp comparison -> (
321339
match rhs with
322340
| Pintcomp comparison1 -> Lam_compat.eq_comparison comparison comparison1

0 commit comments

Comments
 (0)