Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 227 lines (185 sloc) 6.439 kB
750fba9 [cleanup] qmljsimp: removing some dead code (and slighly refactoring …
Valentin Gatien-Baron 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 module J = JsAst
20 module Cons = JsCons
21
22 let (|>) = InfixOperator.(|>)
23
24 module IdentMap = JsAst.IdentMap;;
25 module IdentSet = JsAst.IdentSet;;
26
27 module List = Base.List
28 module String = Base.String
29
30 type jsp = JsAst.code -> JsAst.code
31
32 (*
33 If we need to have unicity of annotation,
34 we must replace rlabel by :
35 {[
36 let rlabel = Annot.refresh
37 ]}
38 *)
39 external rlabel : Annot.label -> Annot.label = "%identity"
40
41 module Rename :
42 sig
43 type env
44 val empty : env
45 val add : JsAst.ident -> env -> env
46 val new_binding : env -> JsAst.ident -> env * JsAst.ident
47 val resolve : env -> JsAst.ident -> JsAst.ident
48 val assert_resolve : env -> JsAst.ident -> JsAst.ident
49 end =
50 struct
51
52 (*
53 Generate a short JS identifier from an int.
54 In case the identifier returned is a js keyword,
55 skip it, and inspect the next generated one.
56
57 The function return the next int to use for generating
58 the next short ident.
59 *)
60 let rec name_of_int i =
61 let name = IdentGenerator.alphanum i in
62 if JsAst.is_keyword name then name_of_int (i+1) else JsCons.Ident.native name, (i+1)
63
64 type env = JsAst.ident IdentMap.t * int
65 let empty = (IdentMap.empty, 0)
66
67 let new_binding (map, number) ident =
68 let new_ident, number = name_of_int number in
69 let map = IdentMap.add ident new_ident map in
70 (map, number), new_ident
71
72 let add ident (map, number) =
73 let new_ident, number = name_of_int number in
74 let map = IdentMap.add ident new_ident map in
75 (map, number)
76
77 let resolve (map, _) ident =
78 match IdentMap.find_opt ident map with
79 | Some ident -> ident
80 | None -> ident
81
82 let assert_resolve (map, _) ident =
83 match IdentMap.find_opt ident map with
84 | Some ident -> ident
85 | None ->
86 assert false
87 end
88
89 (*
90 Collect vars and function local to a statement, without entering
91 internal function inside other functions.
92 *)
93 let stmt_collect_locals acc s =
94 JsWalk.OnlyStatement.traverse_fold (
95 fun tra acc -> function
96 | J.Js_var (_, ident, _) -> Rename.add ident acc
97 | J.Js_function (_, ident, _, _) -> Rename.add ident acc (* NOT traversing *)
98 | J.Js_trycatch (_,_,catches,_) ->
99 let acc = List.fold_left (fun acc (ident,_,_) -> Rename.add ident acc) acc catches in
100 tra acc s
101 | s ->
102 tra acc s
103 ) acc s
104
105 (*
106 Cf the notice for the 3 following recursive functions.
107
108 {[
109 let rec rename_expr
110 and rename_function
111 and rename_statement
112 ]}
113 *)
114
115 let rec rename_expr (acc : Rename.env) e =
116 JsWalk.OnlyExpr.traverse_map (
117 fun tra e ->
118 match e with
119 | J.Je_function (label, ident, params, body) ->
120 let recons (ident, params, body) = J.Je_function (label, ident, params, body) in
121 recons (rename_function acc ident params body)
122
123 | J.Je_ident (label, ident) ->
124 let ident = Rename.resolve acc ident in
125 let e = J.Je_ident (label, ident) in
126 e
127
128 | e ->
129 tra e
130 ) e
131
132 and rename_function acc ident params body =
133 let ident = Option.map (Rename.resolve acc) ident in
134 let acc, params = List.fold_left_map Rename.new_binding acc params in
135 let acc = List.fold_left stmt_collect_locals acc body in
136 let body = List.tail_map (rename_statement acc) body in
137 (ident, params, body)
138
139 and rename_statement acc stmt =
140 JsWalk.TStatement.traverse_map (
141 fun traS _traE s ->
142 match s with
143 | J.Js_var (label, ident, expr) ->
144 let ident = Rename.resolve acc ident in
145 let expr = Option.map (rename_expr acc) expr in
146 J.Js_var (label, ident, expr)
147
148 | J.Js_function (label, ident, params, body) ->
149 let recons (ident, params, body) =
150 let ident = Option.get ident in
151 J.Js_function (label, ident, params, body) in
152 recons (rename_function acc (Some ident) params body)
153
154 | J.Js_trycatch (label, body, catches, finally) ->
155 let catches = List.map (fun (ident, e, s) -> (Rename.resolve acc ident, e, s)) catches in
156 let s = J.Js_trycatch (label, body, catches, finally) in
157 traS s
158
159 (*
160 the node with is not supported by the local renaming
161 *)
162 | J.Js_with _ -> assert false
163
164 | s -> traS s
165 )
166 (fun _traE _traS e -> rename_expr acc e)
167 stmt
168
169
170 (*
171 Renaming function parameters, and local variables.
172 This renaming does not affect toplevel identifiers
173 *)
174 let local_alpha_stm stm =
175 let acc = Rename.empty in
176 rename_statement acc stm
177 let local_alpha code =
178 let acc = Rename.empty in
179 List.tail_map (rename_statement acc) code
180
181 (*
182 NOTICE:
183
184 let rec rename_expr (acc : Rename.env) e =
185 let rec aux e =
186 ExprOnly.map_down
187 ou un traverse_map_down où on fait gaffe aux je_function
188 map_down utilisant acc
189 sauf dans le cas Je_function,
190 où on appelle une regle de renommage des fonctions
191 qui appelle rename_statement avec (acc + quelque chose)
192 in
193 aux_expr e
194
195 and rename_function recons acc ident params body =
196 1) on rename ident avec ce acc,
197
198 2) collect les var et les function dans body sans rentrer dans les function
199 fold sur statement only, pas de tra sur Js_function
200 StatementOnly.traverse_fold
201
202 3) ca en fait un acc2,
203 on met params dans acc2
204 on renomme le body avec acc2 (rename_statement)
205 et on recons
206
207 and rename_statement acc s =
208
209 - si tombe sur Js_function, simplement appliquer rename_function
210 - si var : simplement appliquer le renommage
211
212 sinon : rename_expr avec le meme acc
213 et tra acc sur les statement
214 TStatement.traverse_map
215 avec rename_expr sur les expr
216 et tra sur les statement
217
218 TStatement.traverse_map
219 (fun traS traE e -> rename_expr acc e)
220 (fun traS traE s ->
221 match s with
222 | Js_function -> rename_function
223 | JsVar -> lookup acc pour renommer
224 | s -> traS s)
225 s
226 *)
Something went wrong with that request. Please try again.