Skip to content

Commit 7d0d404

Browse files
committed
Merge pull request #63 from bloomberg/refine_kind_in_js
refine let_kind in js ir, simplify [string_of_int] and other micro-optimizations
2 parents defb90a + 534ca4d commit 7d0d404

37 files changed

+116
-148
lines changed

jscomp/j.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -100,7 +100,7 @@ and expression_desc =
100100
since GC does not rely on it
101101
*)
102102
| Array_copy of expression (* shallow copy, like [x.slice] *)
103-
| Array_append of expression * expression list (* For [caml_array_append]*)
103+
| Array_append of expression * expression (* For [caml_array_append]*)
104104
| Tag_ml_obj of expression
105105
| String_append of expression * expression
106106
| Int_of_boolean of expression

jscomp/js_dump.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -432,7 +432,7 @@ and
432432
P.group f 1 (fun _ ->
433433
let cxt = expression 15 cxt f e in
434434
P.string f ".concat";
435-
P.paren_group f 1 (fun _ -> arguments cxt f el))
435+
P.paren_group f 1 (fun _ -> arguments cxt f [el]))
436436

437437
| Array_copy e ->
438438
P.group f 1 (fun _ ->

jscomp/js_fold.ml

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -339,8 +339,7 @@ class virtual fold =
339339
| Array_of_size _x -> let o = o#expression _x in o
340340
| Array_copy _x -> let o = o#expression _x in o
341341
| Array_append (_x, _x_i1) ->
342-
let o = o#expression _x in
343-
let o = o#list (fun o -> o#expression) _x_i1 in o
342+
let o = o#expression _x in let o = o#expression _x_i1 in o
344343
| Tag_ml_obj _x -> let o = o#expression _x in o
345344
| String_append (_x, _x_i1) ->
346345
let o = o#expression _x in let o = o#expression _x_i1 in o

jscomp/js_helper.ml

Lines changed: 21 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -142,15 +142,26 @@ module Exp = struct
142142

143143
let str ?(pure=true) ?comment s : t = {expression_desc = Str (pure,s); comment}
144144

145-
let any_to_string ?comment (e : t) : t =
145+
let anything_to_string ?comment (e : t) : t =
146146
match e.expression_desc with
147147
| Str _ -> e
148148
| _ -> {expression_desc = Anything_to_string e ; comment}
149-
149+
150+
(* we can do constant folding here, but need to make sure the result is consistent
151+
{[
152+
let f x = string_of_int x
153+
;; f 3
154+
]}
155+
{[
156+
string_of_int 3
157+
]}
158+
*)
159+
let int_to_string ?comment (e : t) : t =
160+
anything_to_string ?comment e
150161
(* Shared mutable state is evil
151162
[Js_fun_env.empty] is a mutable state ..
152163
*)
153-
let efun ?comment ?immutable_mask
164+
let fun_ ?comment ?immutable_mask
154165
params block : t =
155166
let len = List.length params in
156167
{
@@ -308,6 +319,8 @@ module Exp = struct
308319
String_append ({expression_desc = Str(_,c)} ,d) ->
309320
string_append ?comment (string_append a (str (b ^ c))) d
310321
| Str (_,a), Str (_,b) -> str ?comment (a ^ b)
322+
| _, Anything_to_string b -> string_append ?comment e b
323+
| Anything_to_string b, _ -> string_append ?comment b el
311324
| _, _ -> {comment ; expression_desc = String_append(e,el)}
312325

313326

@@ -911,12 +924,7 @@ module Stmt = struct
911924
{ statement_desc = Exp e; comment}
912925

913926
let declare_variable ?comment ?ident_info ~kind (v:Ident.t) : t=
914-
let property : J.property =
915-
match (kind : Lambda.let_kind ) with
916-
| (Alias | Strict | StrictOpt )
917-
-> Immutable
918-
| Variable -> Mutable
919-
in
927+
let property : J.property = kind in
920928
let ident_info : J.ident_info =
921929
match ident_info with
922930
| None -> {used_stats = NA}
@@ -927,12 +935,7 @@ module Stmt = struct
927935
comment}
928936

929937
let define ?comment ?ident_info ~kind (v:Ident.t) exp : t=
930-
let property : J.property =
931-
match (kind : Lambda.let_kind ) with
932-
| (Alias | Strict | StrictOpt )
933-
-> Immutable
934-
| Variable -> Mutable
935-
in
938+
let property : J.property = kind in
936939
let ident_info : J.ident_info =
937940
match ident_info with
938941
| None -> {used_stats = NA}
@@ -1130,10 +1133,10 @@ module Stmt = struct
11301133

11311134

11321135

1133-
let const_variable ?comment ?exp (v:Ident.t) : t=
1136+
let alias_variable ?comment ?exp (v:Ident.t) : t=
11341137
{statement_desc =
11351138
Variable {
1136-
ident = v; value = exp; property = Immutable;
1139+
ident = v; value = exp; property = Alias;
11371140
ident_info = {used_stats = NA } };
11381141
comment}
11391142

@@ -1152,7 +1155,7 @@ module Stmt = struct
11521155
statement_desc =
11531156
J.Variable { ident = id;
11541157
value = Some (Exp.unit ()) ;
1155-
property = Mutable;
1158+
property = Variable;
11561159
ident_info = {used_stats = NA}
11571160
};
11581161
comment

jscomp/js_helper.mli

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -96,7 +96,7 @@ module Exp : sig
9696

9797
val str : ?pure:bool -> ?comment:string -> string -> t
9898

99-
val efun : ?comment:string ->
99+
val fun_ : ?comment:string ->
100100
?immutable_mask:bool array -> J.ident list -> J.block -> t
101101

102102
val econd : ?comment:string -> t -> t -> t -> t
@@ -126,7 +126,7 @@ module Exp : sig
126126

127127
val char_to_int : unary_op
128128

129-
val array_append : ?comment:string -> t -> t list -> t
129+
val array_append : binary_op
130130

131131
val array_copy : unary_op
132132
val string_append : binary_op
@@ -189,7 +189,8 @@ module Exp : sig
189189

190190
val dump : ?comment:string -> Js_op.level -> t list -> t
191191

192-
val any_to_string : unary_op
192+
val anything_to_string : unary_op
193+
val int_to_string : unary_op
193194
val to_json_string : unary_op
194195

195196
val new_ : ?comment:string -> J.expression -> J.expression list -> t
@@ -285,7 +286,7 @@ module Stmt : sig
285286
?ident_info:J.ident_info ->
286287
kind:Lambda.let_kind -> Ident.t -> J.expression -> t
287288

288-
val const_variable :
289+
val alias_variable :
289290
?comment:string -> ?exp:J.expression -> Ident.t -> t
290291
val assign : ?comment:string -> J.ident -> J.expression -> t
291292

jscomp/js_inline_and_eliminate.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -166,7 +166,7 @@ let subst name export_set stats =
166166
-> self#statement st :: self#block rest
167167

168168
| { value = Some {expression_desc = Fun (params, block, _env) ; comment = _};
169-
property = Immutable;
169+
property = (Alias | StrictOpt | Strict);
170170
ident_info = {used_stats = Once_pure };
171171
ident = _
172172
} as v

jscomp/js_map.ml

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -371,8 +371,7 @@ class virtual map =
371371
| Array_copy _x -> let _x = o#expression _x in Array_copy _x
372372
| Array_append (_x, _x_i1) ->
373373
let _x = o#expression _x in
374-
let _x_i1 = o#list (fun o -> o#expression) _x_i1
375-
in Array_append (_x, _x_i1)
374+
let _x_i1 = o#expression _x_i1 in Array_append (_x, _x_i1)
376375
| Tag_ml_obj _x -> let _x = o#expression _x in Tag_ml_obj _x
377376
| String_append (_x, _x_i1) ->
378377
let _x = o#expression _x in

jscomp/js_op.ml

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -127,9 +127,11 @@ type kind =
127127
| Runtime
128128
| External of string
129129

130-
type property =
131-
| Mutable
132-
| Immutable
130+
type property = Lambda.let_kind =
131+
| Strict
132+
| Alias
133+
| StrictOpt
134+
| Variable
133135

134136
type int_or_char =
135137
{ i : int;

jscomp/js_pass_flatten_and_mark_dead.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -172,7 +172,7 @@ let subst_map name = object (self)
172172
{v with statement_desc = (Exp x)}
173173

174174
| Variable ({ ident ;
175-
property = Immutable;
175+
property = (Strict | StrictOpt | Alias);
176176
value = Some ({expression_desc = (Array ( _:: _ :: _ as ls, Immutable))} as array)
177177
} as variable) ->
178178
(** If we do this, we should prevent incorrect inlning to inline it into an array :)

jscomp/js_pass_scope.ml

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -196,10 +196,10 @@ let scope_pass =
196196
| { ident ; value; property } ->
197197
let obj =
198198
(match self#get_in_loop, property with
199-
| true, Mutable
199+
| true, Variable
200200
->
201201
self#add_loop_mutable_variable ident
202-
| true, Immutable
202+
| true, (Strict | StrictOpt | Alias)
203203
(* Not real true immutable in javascript
204204
since it's in the loop
205205
@@ -235,10 +235,10 @@ let scope_pass =
235235
(* else *)
236236
self#add_loop_mutable_variable ident
237237
end
238-
| false, Mutable
238+
| false, Variable
239239
->
240240
self#add_mutable_variable ident
241-
| false, Immutable
241+
| false, (Strict | StrictOpt | Alias)
242242
-> self
243243
)#add_defined_ident ident
244244
in

jscomp/lam_compile.ml

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -90,7 +90,7 @@ and compile_recursive_let (cxt : Lam_compile_defs.cxt) (id : Ident.t) (arg : Lam
9090
jmp_table = Lam_compile_defs.empty_handler_map} body in
9191
if ret.triggered then
9292
let body_block = Js_output.to_block output in
93-
E.efun (* TODO: save computation of length several times *)
93+
E.fun_ (* TODO: save computation of length several times *)
9494
~immutable_mask:ret.immutable_mask
9595
(List.map (fun x ->
9696
try Ident_map.find x ret.new_params with Not_found -> x)
@@ -107,7 +107,7 @@ and compile_recursive_let (cxt : Lam_compile_defs.cxt) (id : Ident.t) (arg : Lam
107107
]
108108

109109
else (* TODO: save computation of length several times *)
110-
E.efun params (Js_output.to_block output )
110+
E.fun_ params (Js_output.to_block output )
111111
), []
112112
| (Lprim(Pmakeblock _ , _) ) ->
113113
(* Lconst should not appear here if we do [scc]
@@ -261,7 +261,7 @@ and
261261
match lam with
262262
| Lfunction(kind, params, body) ->
263263
Js_output.handle_name_tail st should_return lam
264-
(E.efun
264+
(E.fun_
265265
params
266266
(* Invariant: jmp_table can not across function boundary,
267267
here we share env
@@ -918,11 +918,11 @@ and
918918
(* | String_length e *)
919919
(* -> *)
920920
(* let len = Ext_ident.create "_length" in *)
921-
(* b2 @ [ S.const_variable len ~exp:e2 ], J.Finish (Id len ) *)
921+
(* b2 @ [ S.alias_variable len ~exp:e2 ], J.Finish (Id len ) *)
922922
(* | _ -> *)
923923
(* (\* TODO: guess a better name when possible*\) *)
924924
(* let len = Ext_ident.create "_finish" in *)
925-
(* b2 @ [S.const_variable len ~exp:e2], J.Finish (Id len) *)
925+
(* b2 @ [S.alias_variable len ~exp:e2], J.Finish (Id len) *)
926926
(* in *)
927927

928928
b1 @ (S.define ~kind:Variable id e1 :: b2 ) @ ([

jscomp/lam_compile_global.ml

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -115,10 +115,13 @@ let get_exp_with_args (id : Ident.t) (pos : int) env (args : J.expression list)
115115
id.flags
116116
pos
117117
))
118+
118119
~found:(fun {id; name;arity; _} ->
119120
match id, name, args with
120121
| {name = "Pervasives"; _}, "^", [ e0 ; e1] ->
121122
E.string_append e0 e1
123+
| {name = "Pervasives"; _}, "string_of_int", [e]
124+
-> E.int_to_string e
122125
| {name = "Pervasives"; _}, "print_endline", ([ _ ] as args) ->
123126
E.seq (E.dump Log args) (E.unit ())
124127
| {name = "Pervasives"; _}, "prerr_endline", ([ _ ] as args) ->

jscomp/lam_compile_group.ml

Lines changed: 28 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -36,10 +36,11 @@ let compile_group ({filename = file_name; env;} as meta : Lam_stats.meta)
3636
2. [E.builtin_dot] for javascript builtin
3737
3. [E.mldot]
3838
*)
39+
(* ATTENTION: check {!Lam_compile_global} for consistency *)
3940
(** Special handling for values in [Pervasives] *)
4041
| Single(_, ({name="stdout"|"stderr"|"stdin";_} as id),_ ),
4142
"pervasives.ml" ->
42-
Js_output.of_stmt @@ S.const_variable id
43+
Js_output.of_stmt @@ S.alias_variable id
4344
~exp:(E.runtime_ref Js_helper.io id.name)
4445
(*
4546
we delegate [stdout, stderr, and stdin] into [caml_io] module,
@@ -49,11 +50,11 @@ let compile_group ({filename = file_name; env;} as meta : Lam_stats.meta)
4950
*)
5051
| Single(_, ({name="infinity";_} as id),_ ), "pervasives.ml"
5152
-> (* TODO: check relative path to compiler*)
52-
Js_output.of_stmt @@ S.const_variable id ~exp:(E.js_global "Infinity")
53+
Js_output.of_stmt @@ S.alias_variable id ~exp:(E.js_global "Infinity")
5354
| Single(_, ({name="neg_infinity";_} as id),_ ), "pervasives.ml" ->
54-
Js_output.of_stmt @@ S.const_variable id ~exp:(E.js_global "-Infinity")
55+
Js_output.of_stmt @@ S.alias_variable id ~exp:(E.js_global "-Infinity")
5556
| Single(_, ({name="nan";_} as id),_ ), "pervasives.ml" ->
56-
Js_output.of_stmt @@ S.const_variable id ~exp:(E.js_global "NaN")
57+
Js_output.of_stmt @@ S.alias_variable id ~exp:(E.js_global "NaN")
5758

5859
(* TODO:
5960
Make it more safe, we should rewrite the last one...
@@ -62,55 +63,63 @@ let compile_group ({filename = file_name; env;} as meta : Lam_stats.meta)
6263
[Lam_dispatch_primitive], here it makes an exception since this function is not a primitive
6364
*)
6465
| Single(_, ({name="^";_} as id),_ ), "pervasives.ml" ->
65-
Js_output.of_stmt @@ S.const_variable id
66-
~exp:(E.runtime_ref Js_helper.string "add")
66+
Js_output.of_stmt @@ S.alias_variable id
67+
~exp:(let a = Ext_ident.create "a" in
68+
let b = Ext_ident.create "b" in
69+
E.fun_ [a;b] [S.return (E.string_append (E.var a) (E.var b))]
70+
)
6771

6872
(* QUICK hack to make hello world example nicer,
6973
Note the arity of [print_endline] is already analyzed before,
7074
so it should be safe
7175
*)
7276
| Single(_, ({name="print_endline";_} as id),_ ), "pervasives.ml" ->
73-
Js_output.of_stmt @@ S.const_variable id
77+
Js_output.of_stmt @@ S.alias_variable id
7478
~exp:(E.js_global "console.log")
7579
| Single(_, ({name="prerr_endline";_} as id),_ ), "pervasives.ml" ->
76-
Js_output.of_stmt @@ S.const_variable id
80+
Js_output.of_stmt @@ S.alias_variable id
7781
~exp:(E.js_global "console.error")
7882

7983

8084
| Single(_, ({name="string_of_int";_} as id),_ ), "pervasives.ml" ->
81-
Js_output.of_stmt @@ S.const_variable id ~exp:(E.runtime_ref
82-
Js_helper.prim "string_of_int")
85+
Js_output.of_stmt @@ S.alias_variable id
86+
~exp:(
87+
let arg = Ext_ident.create "param" in
88+
E.fun_ [arg] [S.return (E.anything_to_string (E.var arg))]
89+
)
8390

8491
| Single(_, ({name="max_float";_} as id),_ ), "pervasives.ml" ->
8592

86-
Js_output.of_stmt @@ S.const_variable id
93+
Js_output.of_stmt @@ S.alias_variable id
8794
~exp:(E.js_global_dot "Number" "MAX_VALUE")
8895
| Single(_, ({name="min_float";_} as id) ,_ ), "pervasives.ml" ->
89-
Js_output.of_stmt @@ S.const_variable id
96+
Js_output.of_stmt @@ S.alias_variable id
9097
~exp:(E.js_global_dot "Number" "MIN_VALUE")
9198
| Single(_, ({name="epsilon_float";_} as id) ,_ ), "pervasives.ml" ->
92-
Js_output.of_stmt @@ S.const_variable id
99+
Js_output.of_stmt @@ S.alias_variable id
93100
~exp:(E.js_global_dot "Number" "EPSILON")
94101
| Single(_, ({name="cat";_} as id) ,_ ), "bytes.ml" ->
95-
Js_output.of_stmt @@ S.const_variable id
96-
~exp:(E.runtime_ref
97-
Js_helper.string "bytes_cat")
102+
Js_output.of_stmt @@ S.alias_variable id
103+
~exp:(let a = Ext_ident.create "a" in
104+
let b = Ext_ident.create "b" in
105+
E.fun_ [a;b] [S.return (E.array_append (E.var a) (E.var b))]
106+
)
98107

99108
(** Special handling for values in [Sys] *)
100109
| Single(_, ({name="max_array_length" | "max_string_length";_} as id) ,_ ), "sys.ml" ->
101110
(* See [js_knowledge] Array size section, can not be expressed by OCaml int,
102111
note that casual handling of {!Sys.max_string_length} could result into
103112
negative value which could cause wrong behavior of {!Buffer.create}
104113
*)
105-
Js_output.of_stmt @@ S.const_variable id ~exp:(E.float "4_294_967_295.")
114+
Js_output.of_stmt @@ S.alias_variable id ~exp:(E.float "4_294_967_295.")
106115

107116
| Single(_, ({name="max_int";_} as id) ,_ ), ("sys.ml" | "nativeint.ml") ->
108117
(* See [js_knowledge] Max int section, (2. ** 53. -. 1.;;) can not be expressed by OCaml int *)
109-
Js_output.of_stmt @@ S.const_variable id ~exp:(E.float "9007199254740991.")
118+
Js_output.of_stmt @@ S.alias_variable id ~exp:(E.float "9007199254740991.")
110119

111120
| Single(_, ({name="min_int";_} as id) ,_ ), ("sys.ml" | "nativeint.ml") ->
112121
(* See [js_knowledge] Max int section, -. (2. ** 53. -. 1.);; can not be expressed by OCaml int *)
113-
Js_output.of_stmt @@ S.const_variable id ~exp:(E.float ("-9007199254740991."))
122+
Js_output.of_stmt @@ S.alias_variable id ~exp:(E.float ("-9007199254740991."))
114123

115124
| Single (kind, id, lam), _ ->
116125
(* let lam = Optimizer.simplify_lets [] lam in *)

0 commit comments

Comments
 (0)