Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 307 lines (253 sloc) 9.245 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 (**
19 Traversing JsAst
20 @author Mathieu Barbin
21 *)
22
23 module List = BaseList
24 module J = JsAst
25
26 let foldmapA traA traB acc e =
27 match e with
28 | J.Je_this _ ->
29 acc, e
30
31 | J.Je_ident (_, _) ->
32 acc, e
33
34 | J.Je_array (label, list) ->
35 let acc, flist = List.fold_left_map_stable traA acc list in
36 acc,
37 if list == flist then e else
38 J.Je_array (label, flist)
39
40 | J.Je_comma (label, list, last) ->
41 let acc, flist = List.fold_left_map_stable traA acc list in
42 let acc, flast = traA acc last in
43 acc,
44 if list == flist && last == flast then e else
45 J.Je_comma (label, flist, flast)
46
47 | J.Je_object (label, fields) ->
48 let fmap acc ((field, b) as c) =
49 let acc, fb = traA acc b in
50 acc,
51 if b == fb then c else
52 (field, fb)
53 in
54 let acc, ffields = List.fold_left_map_stable fmap acc fields in
55 acc,
56 if fields == ffields then e else
57 J.Je_object (label, ffields)
58
59 | J.Je_string (_, _, _) ->
60 acc, e
61
62 | J.Je_num (_, _) ->
63 acc, e
64
65 | J.Je_null _ ->
66 acc, e
67
68 | J.Je_undefined _ ->
69 acc, e
70
71 | J.Je_bool (_, _) ->
72 acc, e
73
74 | J.Je_regexp _ ->
75 acc, e
76
77 | J.Je_function (label, ident, params, body) ->
78 let acc, fbody = List.fold_left_map_stable traB acc body in
79 acc,
80 if body == fbody then e else
81 J.Je_function (label, ident, params, fbody)
82
83 | J.Je_dot (label, expr, field) ->
84 let acc, fexpr = traA acc expr in
85 acc,
86 if expr == fexpr then e else
87 J.Je_dot (label, fexpr, field)
88
89 | J.Je_unop (label, op, expr) ->
90 let acc, fexpr = traA acc expr in
91 acc,
92 if expr == fexpr then e else
93 J.Je_unop (label, op, fexpr)
94
95 | J.Je_binop (label, op, expr1, expr2) ->
96 let acc, fexpr1 = traA acc expr1 in
97 let acc, fexpr2 = traA acc expr2 in
98 acc,
99 if expr1 == fexpr1 && expr2 == fexpr2 then e else
100 J.Je_binop (label, op, fexpr1, fexpr2)
101
102 | J.Je_cond (label, cond, then_, else_) ->
103 let acc, fcond = traA acc cond in
104 let acc, fthen_ = traA acc then_ in
105 let acc, felse_ = traA acc else_ in
106 acc,
107 if cond == fcond && then_ == fthen_ && else_ == felse_ then e else
108 J.Je_cond (label, fcond, fthen_, felse_)
109
110 | J.Je_call (label, fun_, args, pure) ->
111 let acc, ffun_ = traA acc fun_ in
112 let acc, fargs = List.fold_left_map_stable traA acc args in
113 acc,
114 if fun_ == ffun_ && args == fargs then e else
115 J.Je_call (label, ffun_, fargs, pure)
116
117 | J.Je_new (label, obj, args) ->
118 let acc, fobj = traA acc obj in
119 let acc, fargs = List.fold_left_map_stable traA acc args in
120 acc,
121 if obj == fobj && args == fargs then e else
122 J.Je_new (label, fobj, fargs)
123
124 | J.Je_hole (_, _) ->
125 acc, e
126
127 | J.Je_runtime _ ->
128 acc, e
129
130 let foldmapB traB traA acc e =
131 match e with
132 | J.Js_var (_, _, None) ->
133 acc, e
134 | J.Js_var (label, ident, Some expr) ->
135 let acc, fexpr = traA acc expr in
136 acc,
137 if expr == fexpr then e else
138 J.Js_var (label, ident, Some fexpr)
139
140 | J.Js_function (label, ident, params, body) ->
141 let acc, fbody = List.fold_left_map_stable traB acc body in
142 acc,
143 if body == fbody then e else
144 J.Js_function (label, ident, params, fbody)
145
146 | J.Js_return (label, expr) ->
147 let acc, fexpr = Option.foldmap_stable traA acc expr in
148 acc,
149 if expr == fexpr then e else
150 J.Js_return (label, fexpr)
151
152 | J.Js_continue (_, _) ->
153 acc, e
154
155 | J.Js_break (_, _) ->
156 acc, e
157
158 | J.Js_switch (label, expr, cases, default) ->
159 let fmap acc ((expr, stat) as c) =
160 let acc, fexpr = traA acc expr in
161 let acc, fstat = traB acc stat in
162 acc,
163 if expr == fexpr && stat == fstat then c else
164 (fexpr, fstat)
165 in
166 let acc, fexpr = traA acc expr in
167 let acc, fcases = List.fold_left_map_stable fmap acc cases in
168 let acc, fdefault = Option.foldmap_stable traB acc default in
169 acc,
170 if expr == fexpr && cases == fcases && default == fdefault then e else
171 J.Js_switch (label, fexpr, fcases, fdefault)
172
173 | J.Js_if (label, cond, then_, else_) ->
174 let acc, fcond = traA acc cond in
175 let acc, fthen_ = traB acc then_ in
176 let acc, felse_ = Option.foldmap_stable traB acc else_ in
177 acc,
178 if cond == fcond && then_ == fthen_ && else_ == felse_ then e else
179 J.Js_if (label, fcond, fthen_, felse_)
180
181 | J.Js_throw (label, expr) ->
182 let acc, fexpr = traA acc expr in
183 acc,
184 if expr == fexpr then e else
185 J.Js_throw (label, fexpr)
186
187 | J.Js_expr (label, expr) ->
188 let acc, fexpr = traA acc expr in
189 acc,
190 if expr == fexpr then e else
191 J.Js_expr (label, fexpr)
192
193 | J.Js_trycatch (label, body, catches, finally) ->
194 let fmap acc ((ident, expr, stat) as t) =
195 let acc, fexpr = Option.foldmap_stable traA acc expr in
196 let acc, fstat = traB acc stat in
197 acc,
198 if expr == fexpr && stat = fstat then t else
199 (ident, fexpr, fstat)
200 in
201 let acc, fbody = traB acc body in
202 let acc, fcatches = List.fold_left_map_stable fmap acc catches in
203 let acc, ffinally = Option.foldmap_stable traB acc finally in
204 acc,
205 if body == fbody && catches == fcatches && finally == ffinally then e else
206 J.Js_trycatch (label, fbody, fcatches, ffinally)
207
208 | J.Js_for (label, init, cond, incr, body) ->
209 let acc, finit = Option.foldmap_stable traA acc init in
210 let acc, fcond = Option.foldmap_stable traA acc cond in
211 let acc, fincr = Option.foldmap_stable traA acc incr in
212 let acc, fbody = traB acc body in
213 acc,
214 if init == finit && cond == fcond && incr == fincr && body == fbody then e else
215 J.Js_for (label, finit, fcond, fincr, fbody)
216
217 | J.Js_forin (label, lhs, rhs, body) ->
218 let acc, flhs = traA acc lhs in
219 let acc, frhs = traA acc rhs in
220 let acc, fbody = traB acc body in
221 acc,
222 if flhs == lhs && frhs == rhs && fbody == body then e else
223 J.Js_forin (label, flhs, frhs, fbody)
224
225 | J.Js_dowhile (label, body, cond) ->
226 let acc, fbody = traB acc body in
227 let acc, fcond = traA acc cond in
228 acc,
229 if body == fbody && cond == fcond then e else
230 J.Js_dowhile (label, fbody, fcond)
231
232 | J.Js_while (label, cond, body) ->
233 let acc, fcond = traA acc cond in
234 let acc, fbody = traB acc body in
235 acc,
236 if cond == fcond && body == fbody then e else
237 J.Js_while (label, fcond, fbody)
238
239 | J.Js_block (label, body) ->
240 let acc, fbody = List.fold_left_map_stable traB acc body in
241 acc,
242 if body == fbody then e else
243 J.Js_block (label, fbody)
244
245 | J.Js_with (label, expr, body) ->
246 let acc, fexpr = traA acc expr in
247 let acc, fbody = traB acc body in
248 acc,
249 if expr == fexpr && body == fbody then e else
250 J.Js_with (label, fexpr, fbody)
251
252 | J.Js_label (label, string, stmt) ->
253 let acc, fstmt = traB acc stmt in
254 acc,
255 if stmt == fstmt then e else
256 J.Js_label (label, string, fstmt)
257
258 | J.Js_comment (_, _, _) ->
259 acc, e
260
261 module AB : TraverseInterface.AB
262 with type 'a tA = JsAst.expr
263 constraint 'a = 'b * 'c * 'd
264 and type 'a tB = JsAst.statement
265 constraint 'a = 'b * 'c * 'd
266 =
267 struct
268 type 'a tA = JsAst.expr
269 constraint 'a = 'b * 'c * 'd
270
271 type 'a tB = JsAst.statement
272 constraint 'a = 'b * 'c * 'd
273
274 let foldmapA = foldmapA
275 let foldmapB = foldmapB
276
277 let mapA traA traB e = Traverse.Unoptimized.mapAB foldmapA traA traB e
278 let mapB traB traA e = Traverse.Unoptimized.mapAB foldmapB traB traA e
279
280 let iterA traA traB e = Traverse.Unoptimized.iterAB foldmapA traA traB e
281 let iterB traB traA e = Traverse.Unoptimized.iterAB foldmapB traB traA e
282
283 let foldA traA traB acc e = Traverse.Unoptimized.foldAB foldmapA traA traB acc e
284 let foldB traB traA acc e = Traverse.Unoptimized.foldAB foldmapB traB traA acc e
285 end
286
287
288 module T = Traverse.MakeAB(AB)
289
290 module TExpr = T.A
291 module TStatement = T.B
292 module Expr = T.AinA
293 module Statement = T.BinB
294 module ExprInStatement = T.AinB
295 module StatementInExpr = T.BinA
296 module OnlyExpr = T.OnlyA
297 module OnlyStatement = T.OnlyB
298
299 (* Refreshing the annotations of an expression or a statement *)
300 module Refresh =
301 struct
302 let aux_expr expr = J.JNewAnnot.expr expr (Annot.next ())
303 let aux_stm stm = J.JNewAnnot.stm stm (Annot.next ())
304 let expr expr = TExpr.map aux_expr aux_stm expr
305 let stm stm = TStatement.map aux_stm aux_expr stm
306 end
Something went wrong with that request. Please try again.