Skip to content

HTTPS clone URL

Subversion checkout URL

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