-
Notifications
You must be signed in to change notification settings - Fork 125
/
jsstat.ml
238 lines (223 loc) · 9.43 KB
/
jsstat.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
(*
Copyright © 2011 MLstate
This file is part of Opa.
Opa is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.
Opa is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.
You should have received a copy of the GNU Affero General Public License
along with Opa. If not, see <http://www.gnu.org/licenses/>.
*)
module J = JsAst
module StringMap = StringMap
module String = BaseString
module List = BaseList
module Format = BaseFormat
module Arg = BaseArg
type category = string
module CategoryMap = StringMap
type kind =
| Var of string * J.expr
| Function of string * string list * J.statement list
| Other of J.statement
let native_of_ident = function
| J.Native (_, i) -> i
| J.ExprIdent _ -> assert false
let kind_of_statement = function
| J.Js_var (_,i,Some e) ->
Var (native_of_ident i,e)
| J.Js_function (_,i,params,body) ->
Function (native_of_ident i,
List.map native_of_ident params,
body
)
| stm -> Other stm
type state = {
has_seen_closure_or_ei : bool;
map : (kind * J.statement) list CategoryMap.t;
}
let empty_state = {
has_seen_closure_or_ei = false;
map = CategoryMap.empty;
}
let category_of_kind has_seen_closure_or_ei = function
| Other (J.Js_expr (_, J.Je_call (_, J.Je_ident (_, J.Native (_, s)), _, _))) when String.is_contained "set_distant" s ->
"closure_creation"
| Other _ -> "bsl_static"
| Function (s,_,_) when String.is_contained "clos_env" s
|| String.is_contained "clos_args" s -> "closure_dyn"
| Function (s,_,_) when String.is_contained "_bsl_" s -> "bsl_proj"
| Var (s,_) when String.is_prefix "_sei" s
|| String.is_contained "type_def_map" s -> "ei"
| Function (s,_,_) when String.is_contained "_stub_" s -> "rpc_stub"
| Function (s,_,_) when String.is_contained "_skeleton_" s -> "rpc_skeleton"
| Var (_,e) when
JsWalk.Expr.exists
(function
| J.Je_ident (_,i) when String.is_contained "BslClosure_create" (native_of_ident i)
|| String.is_contained "BslClosure_define" (native_of_ident i) -> true
| _ -> false) e -> "closure_creation"
| Function (s,_,body)
when String.is_contained "_choice_" s ||
List.exists
(JsWalk.ExprInStatement.exists
(function
| J.Je_ident (_,i) when
String.is_contained "check_partial" (native_of_ident i)
|| String.is_contained "primary_list" (native_of_ident i)
|| String.is_contained "itsub" (native_of_ident i)
-> true
| _ -> false)) body
-> "usercode_parser"
| Function _
| Var _ -> if has_seen_closure_or_ei then "usercode" else "bsl_static"
let rec flatten_block stm =
match stm with
| J.Js_block (_,stms) -> flatten_blocks stms
| _ -> [stm]
and flatten_blocks stms =
List.concat_map flatten_block stms
let analyse ~code_to_analyse ~code_to_display =
let state =
List.fold_left2
(fun state stm_to_display stm_to_analyse ->
let kind_to_analyse = kind_of_statement stm_to_analyse in
let kind_to_display = kind_of_statement stm_to_display in
let category = category_of_kind state.has_seen_closure_or_ei kind_to_analyse in
let state =
if category = "closure_dyn" || category = "ei"
then {state with has_seen_closure_or_ei = true}
else state in
let prev = try CategoryMap.find category state.map with Not_found -> [] in
let map = CategoryMap.add category ((kind_to_display,stm_to_display) :: prev) state.map in
{state with map}
) empty_state code_to_display code_to_analyse in
{state with map = CategoryMap.map List.rev state.map}
let sizeof_stm acc stm =
JsWalk.TStatement.fold
(fun acc _ -> acc + 1)
(fun acc _ -> acc + 1)
acc stm
let repartition_of_fields acc stm =
JsWalk.ExprInStatement.fold
(fun acc e ->
match e with
| J.Je_dot (_, _, field)
| J.Je_binop (_, J.Jb_hashref _, _, J.Je_string (_, field, _)) ->
StringMap.add field ((try StringMap.find field acc with Not_found -> 0) + 1) acc
| _ -> acc)
acc stm
let display ?experiment filename state code =
(match experiment with
| None ->
Printf.printf "### Stats for %s\n" filename;
let total_number = List.length code in
Printf.printf "Total number of statements: %d\n" total_number;
CategoryMap.iter
(fun category kinds ->
let number = List.length kinds in
Printf.printf " %s: %d statements, %.2f%%\n" category number (100. *. (float) number /. (float) total_number)
) state.map;
Printf.printf "\n%!";
CategoryMap.iter
(fun category kinds ->
let filename = filename ^ "_" ^ category in
let out = open_out filename in
let f = Format.formatter_of_out_channel out in
List.iteri
(fun (_,stm) i ->
Format.fprintf f "// statement n°%d@\n%a@\n" i JsPrint.pp#code [stm]
) kinds;
Format.fprintf f "@.";
close_out out
) state.map;
Printf.printf "(files dumped)\n\n";
let total_size = List.fold_left sizeof_stm 0 code in
Printf.printf "Size in ast nodes:\n";
Printf.printf "Total is %d nodes\n" total_size;
CategoryMap.iter
(fun category kinds ->
let size = List.fold_left (fun acc (_,stm) -> sizeof_stm acc stm) 0 kinds in
Printf.printf " %s: %d nodes, %.2f%%\n" category size (100. *. (float) size /. (float) total_size)
) state.map;
Printf.printf "\n%!";
let total_size = String.length (Format.to_string JsPrint.pp#code code) in
Printf.printf "Size in source length:\n";
Printf.printf "Total size is %d chars\n%!" total_size;
CategoryMap.iter
(fun category kinds ->
let size = String.length (Format.to_string JsPrint.pp#code (List.map snd kinds)) in
Printf.printf " %s: %d chars, %.2f%%\n" category size (100. *. (float) size /. (float) total_size)
) state.map;
Printf.printf "\n%!";
Printf.printf "Length of the fields:\n";
let map =
CategoryMap.fold
(fun category kinds map ->
let new_map = List.fold_left (fun acc (_, stm) -> repartition_of_fields acc stm) StringMap.empty kinds in
let full_map = StringMap.merge (+) map new_map in
let full_length = StringMap.fold (fun k v acc -> v * String.length k + acc) new_map 0 in
let renamed_length = StringMap.fold (fun _k v acc -> v * 2 + acc) new_map 0 in
Printf.printf " %s: normal: %d, renamed: %d\n%!" category full_length renamed_length;
full_map
) state.map StringMap.empty in
let full_length = StringMap.fold (fun k v acc -> v * String.length k + acc) map 0 in
let renamed_length = StringMap.fold (fun _k v acc -> v * 2 + acc) map 0 in
Printf.printf "Total: normal: %d, renamed: %d\n%!" full_length renamed_length;
Printf.printf "\n%!";
| Some _ -> ());
let total_size = String.length (JsMinify.minify (Format.to_string JsPrint.pp#code code)) in
if experiment = None then Printf.printf "Size in minified source length:\n";
(match experiment with
| None -> Printf.printf "Total minified size is %d chars\n%!" total_size
| Some experiment_name -> Printf.printf "%s.total_size %d\n" experiment_name total_size);
CategoryMap.iter
(fun category kinds ->
let str = JsMinify.minify (Format.to_string JsPrint.pp#code (List.map snd kinds)) in
let size = String.length str in
match experiment with
| None ->
let filename = filename ^ "_min_" ^ category in
let out = open_out filename in
Printf.fprintf out "%s\n%!" str;
close_out out;
Printf.printf " %s: %d chars, %.2f%%\n" category size (100. *. (float) size /. (float) total_size)
| Some experiment_name ->
Printf.printf "%s.%s %d\n" experiment_name category size
) state.map;
Printf.printf "\n%!"
let parse filename =
let code = JsParse.File.code filename in
flatten_blocks code
let experiment_name = ref None
let file_for_analysis = ref None
let file_for_display = ref None
let arguments = [
"--experiment", Arg.String (fun s -> experiment_name := Some s), "";
"--alpha", Arg.String (fun s -> file_for_display := Some s), "";
"--no-alpha", Arg.String (fun s -> file_for_analysis := Some s), "";
]
let anon_fun = fun s -> file_for_analysis := Some s
let () =
Arg.parse arguments anon_fun "You are brave, you don't need help!";
let file1, o =
match !file_for_analysis, !file_for_display with
| None, None -> exit 0
| Some f, o -> f, o
| None, Some _ ->
Printf.eprintf "You must set the file that should be analysed\n%!";
exit 1 in
let code_to_analyse = parse file1 in
let code_to_display =
match o with
| None -> code_to_analyse
| Some filename -> parse filename in
let filename_to_display =
match o with
| None -> file1
| Some file -> file in
let state = analyse ~code_to_analyse ~code_to_display in
display ?experiment:!experiment_name filename_to_display state code_to_display