Skip to content

Commit 8c44a40

Browse files
committed
Refactor: use records for const string in lam.
1 parent fa68a2d commit 8c44a40

15 files changed

+228
-240
lines changed

jscomp/core/lam.ml

+12-20
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,6 @@
2323
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
2424

2525
type ident = Ident.t
26-
2726
type apply_status = App_na | App_infer_full | App_uncurry
2827

2928
type ap_info = {
@@ -414,13 +413,12 @@ let switch lam (lam_switch : lambda_switch) : t =
414413

415414
let stringswitch (lam : t) cases default : t =
416415
match lam with
417-
| Lconst (Const_string a) -> Ext_list.assoc_by_string cases a default
416+
| Lconst (Const_string { s; unicode = false }) ->
417+
Ext_list.assoc_by_string cases s default
418418
| _ -> Lstringswitch (lam, cases, default)
419419

420420
let true_ : t = Lconst Const_js_true
421-
422421
let false_ : t = Lconst Const_js_false
423-
424422
let unit : t = Lconst Const_js_undefined
425423

426424
let rec seq (a : t) b : t =
@@ -436,28 +434,19 @@ let rec seq (a : t) b : t =
436434
| _ -> Lsequence (a, b)
437435

438436
let var id : t = Lvar id
439-
440437
let global_module id = Lglobal_module id
441-
442438
let const ct : t = Lconst ct
443439

444440
let function_ ~attr ~arity ~params ~body : t =
445441
Lfunction { arity; params; body; attr }
446442

447443
let let_ kind id e body : t = Llet (kind, id, e, body)
448-
449444
let letrec bindings body : t = Lletrec (bindings, body)
450-
451445
let while_ a b : t = Lwhile (a, b)
452-
453446
let try_ body id handler : t = Ltrywith (body, id, handler)
454-
455447
let for_ v e1 e2 dir e3 : t = Lfor (v, e1, e2, dir, e3)
456-
457448
let assign v l : t = Lassign (v, l)
458-
459449
let staticcatch a b c : t = Lstaticcatch (a, b, c)
460-
461450
let staticraise a b : t = Lstaticraise (a, b)
462451

463452
module Lift = struct
@@ -478,9 +467,7 @@ module Lift = struct
478467
Lconst ((Const_nativeint b)) *)
479468

480469
let int64 b : t = Lconst (Const_int64 b)
481-
482-
let string b : t = Lconst (Const_string b)
483-
470+
let string s : t = Lconst (Const_string { s; unicode = false })
484471
let char b : t = Lconst (Const_char b)
485472
end
486473

@@ -496,8 +483,8 @@ let prim ~primitive:(prim : Lam_primitive.t) ~args loc : t =
496483
Lift.int (Int32.of_float (float_of_string a))
497484
(* | Pnegfloat -> Lift.float (-. a) *)
498485
(* | Pabsfloat -> Lift.float (abs_float a) *)
499-
| Pstringlength, Const_string a ->
500-
Lift.int (Int32.of_int (String.length a))
486+
| Pstringlength, Const_string { s; unicode = false } ->
487+
Lift.int (Int32.of_int (String.length s))
501488
(* | Pnegbint Pnativeint, ( (Const_nativeint i)) *)
502489
(* -> *)
503490
(* Lift.nativeint (Nativeint.neg i) *)
@@ -568,8 +555,13 @@ let prim ~primitive:(prim : Lam_primitive.t) ~args loc : t =
568555
| Psequor, Const_js_true, (Const_js_true | Const_js_false) -> true_
569556
| Psequor, Const_js_false, Const_js_true -> true_
570557
| Psequor, Const_js_false, Const_js_false -> false_
571-
| Pstringadd, Const_string a, Const_string b -> Lift.string (a ^ b)
572-
| (Pstringrefs | Pstringrefu), Const_string a, Const_int { i = b } -> (
558+
| ( Pstringadd,
559+
Const_string { s = a; unicode = false },
560+
Const_string { s = b; unicode = false } ) ->
561+
Lift.string (a ^ b)
562+
| ( (Pstringrefs | Pstringrefu),
563+
Const_string { s = a; unicode = false },
564+
Const_int { i = b } ) -> (
573565
try Lift.char (String.get a (Int32.to_int b)) with _ -> default ())
574566
| _ -> default ())
575567
| _ -> (

jscomp/core/lam_compile_const.ml

+2-1
Original file line numberDiff line numberDiff line change
@@ -70,7 +70,8 @@ and translate (x : Lam_constant.t) : J.expression =
7070
Js_long.of_const i
7171
(* https://github.com/google/closure-library/blob/master/closure%2Fgoog%2Fmath%2Flong.js *)
7272
| Const_float f -> E.float f (* TODO: preserve float *)
73-
| Const_string i (*TODO: here inline js*) -> E.str i
73+
| Const_string { s; unicode = false } -> E.str s
74+
| Const_string { s; unicode = true } -> E.str ~delim:(Some "j") s
7475
| Const_unicode i -> E.str ~delim:(Some "j") i
7576
| Const_pointer name -> E.str name
7677
| Const_block (tag, tag_info, xs) ->

jscomp/core/lam_constant.ml

+5-2
Original file line numberDiff line numberDiff line change
@@ -43,7 +43,7 @@ type t =
4343
| Const_js_false
4444
| Const_int of { i : int32; comment : pointer_info }
4545
| Const_char of char
46-
| Const_string of string (* use record later *)
46+
| Const_string of { s : string; unicode : bool }
4747
| Const_unicode of string
4848
| Const_float of string
4949
| Const_int64 of int64
@@ -65,7 +65,10 @@ let rec eq_approx (x : t) (y : t) =
6565
| Const_js_false -> y = Const_js_false
6666
| Const_int ix -> ( match y with Const_int iy -> ix.i = iy.i | _ -> false)
6767
| Const_char ix -> ( match y with Const_char iy -> ix = iy | _ -> false)
68-
| Const_string ix -> ( match y with Const_string iy -> ix = iy | _ -> false)
68+
| Const_string { s = sx; unicode = ux } -> (
69+
match y with
70+
| Const_string { s = sy; unicode = uy } -> sx = sy && ux = uy
71+
| _ -> false)
6972
| Const_unicode ix -> (
7073
match y with Const_unicode iy -> ix = iy | _ -> false)
7174
| Const_float ix -> ( match y with Const_float iy -> ix = iy | _ -> false)

jscomp/core/lam_constant.mli

+1-1
Original file line numberDiff line numberDiff line change
@@ -39,7 +39,7 @@ type t =
3939
| Const_js_false
4040
| Const_int of { i : int32; comment : pointer_info }
4141
| Const_char of char
42-
| Const_string of string (* use record later *)
42+
| Const_string of { s : string; unicode : bool }
4343
| Const_unicode of string
4444
| Const_float of string
4545
| Const_int64 of int64

jscomp/core/lam_constant_convert.ml

+9-7
Original file line numberDiff line numberDiff line change
@@ -26,11 +26,13 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam_constant.t =
2626
match const with
2727
| Const_base (Const_int i) -> Const_int { i = Int32.of_int i; comment = None }
2828
| Const_base (Const_char i) -> Const_char i
29-
| Const_base (Const_string (i, opt)) -> (
30-
match opt with
31-
| Some opt when Ast_utf8_string_interp.is_unicode_string opt ->
32-
Const_unicode i
33-
| _ -> Const_string i)
29+
| Const_base (Const_string (s, opt)) ->
30+
let unicode =
31+
match opt with
32+
| Some opt -> Ast_utf8_string_interp.is_unicode_string opt
33+
| _ -> false
34+
in
35+
Const_string { s; unicode }
3436
| Const_base (Const_float i) -> Const_float i
3537
| Const_base (Const_int32 i) -> Const_int { i; comment = None }
3638
| Const_base (Const_int64 i) -> Const_int64 i
@@ -58,7 +60,7 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam_constant.t =
5860
{ i = Ext_string.hash_number_as_i32_exn name; comment = None }
5961
else Const_pointer name)
6062
| Const_float_array s -> Const_float_array s
61-
| Const_immstring s -> Const_string s
63+
| Const_immstring s -> Const_string { s; unicode = false }
6264
| Const_block (t, xs) -> (
6365
let tag = Lambda.tag_of_tag_info t in
6466
match t with
@@ -76,7 +78,7 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam_constant.t =
7678
if Ext_string.is_valid_hash_number s then
7779
Const_int
7880
{ i = Ext_string.hash_number_as_i32_exn s; comment = None }
79-
else Const_string s
81+
else Const_string { s; unicode = false }
8082
in
8183
Const_block (tag, t, [ tag_val; convert_constant value ])
8284
| _ -> assert false)

jscomp/core/lam_convert.ml

+4-5
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,6 @@ let caml_id_field_info : Lambda.field_dbg_info =
2626
Fld_record { name = Literals.exception_id; mutable_flag = Immutable }
2727

2828
let lam_caml_id : Lam_primitive.t = Pfield (0, caml_id_field_info)
29-
3029
let prim = Lam.prim
3130

3231
let lam_extension_id loc (head : Lam.t) =
@@ -112,7 +111,6 @@ let exception_id_destructed (l : Lam.t) (fv : Ident.t) : bool =
112111
hit l
113112

114113
let abs_int x = if x < 0 then -x else x
115-
116114
let no_over_flow x = abs_int x < 0x1fff_ffff
117115

118116
let lam_is_var (x : Lam.t) (y : Ident.t) =
@@ -129,7 +127,7 @@ let happens_to_be_diff (sw_consts : (int * Lambda.lambda) list) : int option =
129127
:: ( b,
130128
Lconst
131129
(Const_pointer (b0, Pt_constructor _) | Const_base (Const_int b0)) )
132-
:: rest
130+
:: rest
133131
when no_over_flow a && no_over_flow a0 && no_over_flow b && no_over_flow b0
134132
->
135133
let diff = a0 - a in
@@ -188,7 +186,7 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
188186
if Ext_string.is_valid_hash_number s then
189187
Const_int
190188
{ i = Ext_string.hash_number_as_i32_exn s; comment = None }
191-
else Const_string s
189+
else Const_string { s; unicode = false }
192190
in
193191
prim
194192
~primitive:(Pmakeblock (tag, info, mutable_flag))
@@ -544,7 +542,8 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) :
544542
| Lprim (Pccall a, args, loc) -> convert_ccall a args loc
545543
| Lprim (Pgetglobal id, args, _) ->
546544
let args = Ext_list.map args convert_aux in
547-
if Ident.is_predef_exn id then Lam.const (Const_string id.name)
545+
if Ident.is_predef_exn id then
546+
Lam.const (Const_string { s = id.name; unicode = false })
548547
else (
549548
may_depend may_depends (Lam_module_ident.of_ml id);
550549
assert (args = []);

jscomp/core/lam_pass_lets_dce.ml

+7-7
Original file line numberDiff line numberDiff line change
@@ -67,7 +67,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
6767
*)
6868
->
6969
Hash_ident.add subst v (simplif l1); simplif l2
70-
| _, Lconst (Const_string s ) ->
70+
| _, Lconst (Const_string {s; unicode = false} ) ->
7171
(* only "" added for later inlining *)
7272
Hash_ident.add string_table v s;
7373
Lam.let_ Alias v l1 (simplif l2)
@@ -116,7 +116,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
116116
| _ ->
117117
let l1 = simplif l1 in
118118
begin match l1 with
119-
| Lconst(Const_string s) ->
119+
| Lconst(Const_string { s; unicode = false }) ->
120120
Hash_ident.add string_table v s;
121121
(* we need move [simplif lbody] later, since adding Hash does have side effect *)
122122
Lam.let_ Alias v l1 (simplif lbody)
@@ -138,7 +138,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
138138
let l1 = (simplif l1) in
139139

140140
begin match kind, l1 with
141-
| Strict, Lconst((Const_string s))
141+
| Strict, Lconst((Const_string { s; unicode = false }))
142142
->
143143
Hash_ident.add string_table v s;
144144
Lam.let_ Alias v l1 (simplif l2)
@@ -173,21 +173,21 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
173173
let r' = simplif r in
174174
let opt_l =
175175
match l' with
176-
| Lconst((Const_string ls)) -> Some ls
176+
| Lconst(Const_string { s = ls; unicode = false }) -> Some ls
177177
| Lvar i -> Hash_ident.find_opt string_table i
178178
| _ -> None in
179179
match opt_l with
180180
| None -> Lam.prim ~primitive:Pstringadd ~args:[l';r'] loc
181181
| Some l_s ->
182182
let opt_r =
183183
match r' with
184-
| Lconst ( (Const_string rs)) -> Some rs
184+
| Lconst (Const_string {s = rs; unicode = false}) -> Some rs
185185
| Lvar i -> Hash_ident.find_opt string_table i
186186
| _ -> None in
187187
begin match opt_r with
188188
| None -> Lam.prim ~primitive:Pstringadd ~args:[l';r'] loc
189189
| Some r_s ->
190-
Lam.const (Const_string(l_s^r_s))
190+
Lam.const (Const_string { s = l_s^r_s; unicode = false })
191191
end
192192
end
193193

@@ -198,7 +198,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
198198
let r' = simplif r in
199199
let opt_l =
200200
match l' with
201-
| Lconst (Const_string ls) ->
201+
| Lconst (Const_string { s = ls; unicode = false }) ->
202202
Some ls
203203
| Lvar i -> Hash_ident.find_opt string_table i
204204
| _ -> None in

jscomp/core/lam_pass_lets_dce.pp.ml

+7-7
Original file line numberDiff line numberDiff line change
@@ -66,7 +66,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
6666
*)
6767
->
6868
Hash_ident.add subst v (simplif l1); simplif l2
69-
| _, Lconst (Const_string s ) ->
69+
| _, Lconst (Const_string {s; unicode = false} ) ->
7070
(* only "" added for later inlining *)
7171
Hash_ident.add string_table v s;
7272
Lam.let_ Alias v l1 (simplif l2)
@@ -115,7 +115,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
115115
| _ ->
116116
let l1 = simplif l1 in
117117
begin match l1 with
118-
| Lconst(Const_string s) ->
118+
| Lconst(Const_string { s; unicode = false }) ->
119119
Hash_ident.add string_table v s;
120120
(* we need move [simplif lbody] later, since adding Hash does have side effect *)
121121
Lam.let_ Alias v l1 (simplif lbody)
@@ -137,7 +137,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
137137
let l1 = (simplif l1) in
138138

139139
begin match kind, l1 with
140-
| Strict, Lconst((Const_string s))
140+
| Strict, Lconst((Const_string { s; unicode = false }))
141141
->
142142
Hash_ident.add string_table v s;
143143
Lam.let_ Alias v l1 (simplif l2)
@@ -172,21 +172,21 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
172172
let r' = simplif r in
173173
let opt_l =
174174
match l' with
175-
| Lconst((Const_string ls)) -> Some ls
175+
| Lconst(Const_string { s = ls; unicode = false }) -> Some ls
176176
| Lvar i -> Hash_ident.find_opt string_table i
177177
| _ -> None in
178178
match opt_l with
179179
| None -> Lam.prim ~primitive:Pstringadd ~args:[l';r'] loc
180180
| Some l_s ->
181181
let opt_r =
182182
match r' with
183-
| Lconst ( (Const_string rs)) -> Some rs
183+
| Lconst (Const_string {s = rs; unicode = false}) -> Some rs
184184
| Lvar i -> Hash_ident.find_opt string_table i
185185
| _ -> None in
186186
begin match opt_r with
187187
| None -> Lam.prim ~primitive:Pstringadd ~args:[l';r'] loc
188188
| Some r_s ->
189-
Lam.const (Const_string(l_s^r_s))
189+
Lam.const (Const_string { s = l_s^r_s; unicode = false })
190190
end
191191
end
192192

@@ -197,7 +197,7 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
197197
let r' = simplif r in
198198
let opt_l =
199199
match l' with
200-
| Lconst (Const_string ls) ->
200+
| Lconst (Const_string { s = ls; unicode = false }) ->
201201
Some ls
202202
| Lvar i -> Hash_ident.find_opt string_table i
203203
| _ -> None in

jscomp/core/lam_print.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ let rec struct_const ppf (cst : Lam_constant.t) =
2222
| Const_js_undefined -> fprintf ppf "#undefined"
2323
| Const_int { i } -> fprintf ppf "%ld" i
2424
| Const_char c -> fprintf ppf "%C" c
25-
| Const_string s -> fprintf ppf "%S" s
25+
| Const_string { s } -> fprintf ppf "%S" s
2626
| Const_unicode s -> fprintf ppf "%S" s
2727
| Const_float f -> fprintf ppf "%s" f
2828
| Const_int64 n -> fprintf ppf "%LiL" n

jscomp/frontend/external_ffi_types.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -314,7 +314,7 @@ let inline_string_primitive (s : string) (op : string option) : string list =
314314
when Ast_utf8_string_interp.is_unicode_string op ->
315315
Const_unicode s
316316
| _ ->
317-
(Const_string s) in
317+
(Const_string { s; unicode = false }) in
318318
[""; to_string (Ffi_inline_const lam )]
319319

320320
(* Let's only do it for string ATM

jscomp/frontend/external_ffi_types.pp.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -316,7 +316,7 @@ let inline_string_primitive (s : string) (op : string option) : string list =
316316
when Ast_utf8_string_interp.is_unicode_string op ->
317317
Const_unicode s
318318
| _ ->
319-
(Const_string s) in
319+
(Const_string { s; unicode = false }) in
320320
[""; to_string (Ffi_inline_const lam )]
321321

322322
(* Let's only do it for string ATM

0 commit comments

Comments
 (0)