Commit | Line | Data |
---|---|---|
f537ebc4 | 1 | (* |
17ba0788 C |
2 | * Copyright 2012, INRIA |
3 | * Julia Lawall, Gilles Muller | |
4 | * Copyright 2010-2011, INRIA, University of Copenhagen | |
f537ebc4 C |
5 | * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix |
6 | * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen | |
7 | * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix | |
8 | * This file is part of Coccinelle. | |
9 | * | |
10 | * Coccinelle is free software: you can redistribute it and/or modify | |
11 | * it under the terms of the GNU General Public License as published by | |
12 | * the Free Software Foundation, according to version 2 of the License. | |
d6ce1786 C |
13 | * |
14 | * Coccinelle is distributed in the hope that it will be useful, | |
15 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | * GNU General Public License for more details. | |
18 | * | |
19 | * You should have received a copy of the GNU General Public License | |
20 | * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>. | |
21 | * | |
22 | * The authors reserve the right to distribute this or future versions of | |
23 | * Coccinelle under other licenses. | |
24 | *) | |
25 | ||
26 | ||
27 | # 0 "./iso_pattern.ml" | |
28 | (* | |
29 | * Copyright 2012, INRIA | |
30 | * Julia Lawall, Gilles Muller | |
31 | * Copyright 2010-2011, INRIA, University of Copenhagen | |
32 | * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix | |
33 | * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen | |
34 | * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix | |
35 | * This file is part of Coccinelle. | |
36 | * | |
37 | * Coccinelle is free software: you can redistribute it and/or modify | |
38 | * it under the terms of the GNU General Public License as published by | |
39 | * the Free Software Foundation, according to version 2 of the License. | |
f537ebc4 C |
40 | * |
41 | * Coccinelle is distributed in the hope that it will be useful, | |
42 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
43 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
44 | * GNU General Public License for more details. | |
45 | * | |
46 | * You should have received a copy of the GNU General Public License | |
47 | * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>. | |
48 | * | |
49 | * The authors reserve the right to distribute this or future versions of | |
50 | * Coccinelle under other licenses. | |
51 | *) | |
52 | ||
53 | ||
feec80c3 | 54 | # 0 "./iso_pattern.ml" |
34e49164 C |
55 | (* Potential problem: offset of mcode is not updated when an iso is |
56 | instantiated, implying that a term may end up with many mcodes with the | |
57 | same offset. On the other hand, at the moment offset only seems to be used | |
58 | before this phase. Furthermore add_dot_binding relies on the offset to | |
59 | remain the same between matching an iso and instantiating it with bindings. *) | |
60 | ||
90aeb998 C |
61 | (* Consider whether ... in iso should match <... ...> in smpl? *) |
62 | ||
34e49164 C |
63 | (* --------------------------------------------------------------------- *) |
64 | (* match a SmPL expression against a SmPL abstract syntax tree, | |
65 | either - or + *) | |
66 | ||
67 | module Ast = Ast_cocci | |
68 | module Ast0 = Ast0_cocci | |
69 | module V0 = Visitor_ast0 | |
b1b2de81 | 70 | module VT0 = Visitor_ast0_types |
34e49164 C |
71 | |
72 | let current_rule = ref "" | |
73 | ||
74 | (* --------------------------------------------------------------------- *) | |
75 | ||
76 | type isomorphism = | |
77 | Ast_cocci.metavar list * Ast0_cocci.anything list list * string (* name *) | |
78 | ||
79 | let strip_info = | |
708f4980 | 80 | let mcode (term,_,_,_,_,_) = |
951c7801 | 81 | (term,Ast0.NONE,Ast0.default_info(),Ast0.PLUS Ast.ONE, |
8f657093 | 82 | ref [],-1) in |
34e49164 C |
83 | let donothing r k e = |
84 | let x = k e in | |
85 | {(Ast0.wrap (Ast0.unwrap x)) with | |
951c7801 | 86 | Ast0.mcodekind = ref (Ast0.PLUS Ast.ONE); |
34e49164 | 87 | Ast0.true_if_test = x.Ast0.true_if_test} in |
b1b2de81 | 88 | V0.flat_rebuilder |
34e49164 | 89 | mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode |
34e49164 C |
90 | donothing donothing donothing donothing donothing donothing |
91 | donothing donothing donothing donothing donothing donothing donothing | |
92 | donothing donothing | |
93 | ||
94 | let anything_equal = function | |
95 | (Ast0.DotsExprTag(d1),Ast0.DotsExprTag(d2)) -> | |
96 | failwith "not a possible variable binding" (*not sure why these are pbs*) | |
97 | | (Ast0.DotsInitTag(d1),Ast0.DotsInitTag(d2)) -> | |
98 | failwith "not a possible variable binding" | |
99 | | (Ast0.DotsParamTag(d1),Ast0.DotsParamTag(d2)) -> | |
100 | failwith "not a possible variable binding" | |
101 | | (Ast0.DotsStmtTag(d1),Ast0.DotsStmtTag(d2)) -> | |
b1b2de81 C |
102 | (strip_info.VT0.rebuilder_rec_statement_dots d1) = |
103 | (strip_info.VT0.rebuilder_rec_statement_dots d2) | |
34e49164 C |
104 | | (Ast0.DotsDeclTag(d1),Ast0.DotsDeclTag(d2)) -> |
105 | failwith "not a possible variable binding" | |
106 | | (Ast0.DotsCaseTag(d1),Ast0.DotsCaseTag(d2)) -> | |
107 | failwith "not a possible variable binding" | |
108 | | (Ast0.IdentTag(d1),Ast0.IdentTag(d2)) -> | |
fc1ad971 C |
109 | (strip_info.VT0.rebuilder_rec_ident d1) = |
110 | (strip_info.VT0.rebuilder_rec_ident d2) | |
34e49164 | 111 | | (Ast0.ExprTag(d1),Ast0.ExprTag(d2)) -> |
b1b2de81 C |
112 | (strip_info.VT0.rebuilder_rec_expression d1) = |
113 | (strip_info.VT0.rebuilder_rec_expression d2) | |
34e49164 C |
114 | | (Ast0.ArgExprTag(_),_) | (_,Ast0.ArgExprTag(_)) -> |
115 | failwith "not possible - only in isos1" | |
116 | | (Ast0.TestExprTag(_),_) | (_,Ast0.TestExprTag(_)) -> | |
117 | failwith "not possible - only in isos1" | |
118 | | (Ast0.TypeCTag(d1),Ast0.TypeCTag(d2)) -> | |
b1b2de81 C |
119 | (strip_info.VT0.rebuilder_rec_typeC d1) = |
120 | (strip_info.VT0.rebuilder_rec_typeC d2) | |
34e49164 | 121 | | (Ast0.InitTag(d1),Ast0.InitTag(d2)) -> |
b1b2de81 C |
122 | (strip_info.VT0.rebuilder_rec_initialiser d1) = |
123 | (strip_info.VT0.rebuilder_rec_initialiser d2) | |
34e49164 | 124 | | (Ast0.ParamTag(d1),Ast0.ParamTag(d2)) -> |
b1b2de81 C |
125 | (strip_info.VT0.rebuilder_rec_parameter d1) = |
126 | (strip_info.VT0.rebuilder_rec_parameter d2) | |
34e49164 | 127 | | (Ast0.DeclTag(d1),Ast0.DeclTag(d2)) -> |
b1b2de81 C |
128 | (strip_info.VT0.rebuilder_rec_declaration d1) = |
129 | (strip_info.VT0.rebuilder_rec_declaration d2) | |
34e49164 | 130 | | (Ast0.StmtTag(d1),Ast0.StmtTag(d2)) -> |
b1b2de81 C |
131 | (strip_info.VT0.rebuilder_rec_statement d1) = |
132 | (strip_info.VT0.rebuilder_rec_statement d2) | |
34e49164 | 133 | | (Ast0.CaseLineTag(d1),Ast0.CaseLineTag(d2)) -> |
b1b2de81 C |
134 | (strip_info.VT0.rebuilder_rec_case_line d1) = |
135 | (strip_info.VT0.rebuilder_rec_case_line d2) | |
34e49164 | 136 | | (Ast0.TopTag(d1),Ast0.TopTag(d2)) -> |
b1b2de81 C |
137 | (strip_info.VT0.rebuilder_rec_top_level d1) = |
138 | (strip_info.VT0.rebuilder_rec_top_level d2) | |
1be43e12 C |
139 | | (Ast0.IsoWhenTTag(_),_) | (_,Ast0.IsoWhenTTag(_)) -> |
140 | failwith "only for isos within iso phase" | |
141 | | (Ast0.IsoWhenFTag(_),_) | (_,Ast0.IsoWhenFTag(_)) -> | |
142 | failwith "only for isos within iso phase" | |
34e49164 C |
143 | | (Ast0.IsoWhenTag(_),_) | (_,Ast0.IsoWhenTag(_)) -> |
144 | failwith "only for isos within iso phase" | |
145 | | _ -> false | |
146 | ||
708f4980 C |
147 | let term (var1,_,_,_,_,_) = var1 |
148 | let dot_term (var1,_,info,_,_,_) = | |
0708f913 | 149 | ("", var1 ^ (string_of_int info.Ast0.pos_info.Ast0.offset)) |
34e49164 C |
150 | |
151 | ||
152 | type reason = | |
ae4735db C |
153 | NotPure of Ast0.pure * Ast.meta_name * Ast0.anything |
154 | | NotPureLength of Ast.meta_name | |
34e49164 C |
155 | | ContextRequired of Ast0.anything |
156 | | NonMatch | |
157 | | Braces of Ast0.statement | |
c491d8ee | 158 | | Nest of Ast0.statement |
ae4735db | 159 | | Position of Ast.meta_name |
485bce71 | 160 | | TypeMatch of reason list |
34e49164 | 161 | |
485bce71 | 162 | let rec interpret_reason name line reason printer = |
34e49164 C |
163 | Printf.printf |
164 | "warning: iso %s does not match the code below on line %d\n" name line; | |
165 | printer(); Format.print_newline(); | |
166 | match reason with | |
167 | NotPure(Ast0.Pure,(_,var),nonpure) -> | |
168 | Printf.printf | |
169 | "pure metavariable %s is matched against the following nonpure code:\n" | |
170 | var; | |
171 | Unparse_ast0.unparse_anything nonpure | |
172 | | NotPure(Ast0.Context,(_,var),nonpure) -> | |
173 | Printf.printf | |
174 | "context metavariable %s is matched against the following\nnoncontext code:\n" | |
175 | var; | |
176 | Unparse_ast0.unparse_anything nonpure | |
177 | | NotPure(Ast0.PureContext,(_,var),nonpure) -> | |
178 | Printf.printf | |
179 | "pure context metavariable %s is matched against the following\nnonpure or noncontext code:\n" | |
180 | var; | |
181 | Unparse_ast0.unparse_anything nonpure | |
182 | | NotPureLength((_,var)) -> | |
183 | Printf.printf | |
184 | "pure metavariable %s is matched against too much or too little code\n" | |
185 | var; | |
186 | | ContextRequired(term) -> | |
187 | Printf.printf | |
188 | "the following code matched is not uniformly minus or context,\nor contains a disjunction:\n"; | |
189 | Unparse_ast0.unparse_anything term | |
190 | | Braces(s) -> | |
191 | Printf.printf "braces must be all minus (plus code allowed) or all\ncontext (plus code not allowed in the body) to match:\n"; | |
192 | Unparse_ast0.statement "" s; | |
193 | Format.print_newline() | |
c491d8ee C |
194 | | Nest(s) -> |
195 | Printf.printf "iso with nest doesn't match whencode (TODO):\n"; | |
196 | Unparse_ast0.statement "" s; | |
197 | Format.print_newline() | |
34e49164 C |
198 | | Position(rule,name) -> |
199 | Printf.printf "position variable %s.%s conflicts with an isomorphism\n" | |
8f657093 | 200 | rule name |
17ba0788 | 201 | | TypeMatch reason_list -> |
485bce71 C |
202 | List.iter (function r -> interpret_reason name line r printer) |
203 | reason_list | |
34e49164 C |
204 | | _ -> failwith "not possible" |
205 | ||
206 | type 'a either = OK of 'a | Fail of reason | |
207 | ||
208 | let add_binding var exp bindings = | |
209 | let var = term var in | |
210 | let attempt bindings = | |
211 | try | |
212 | let cur = List.assoc var bindings in | |
213 | if anything_equal(exp,cur) then [bindings] else [] | |
214 | with Not_found -> [((var,exp)::bindings)] in | |
215 | match List.concat(List.map attempt bindings) with | |
216 | [] -> Fail NonMatch | |
217 | | x -> OK x | |
218 | ||
219 | let add_dot_binding var exp bindings = | |
220 | let var = dot_term var in | |
221 | let attempt bindings = | |
222 | try | |
223 | let cur = List.assoc var bindings in | |
224 | if anything_equal(exp,cur) then [bindings] else [] | |
225 | with Not_found -> [((var,exp)::bindings)] in | |
226 | match List.concat(List.map attempt bindings) with | |
227 | [] -> Fail NonMatch | |
228 | | x -> OK x | |
229 | ||
230 | (* multi-valued *) | |
231 | let add_multi_dot_binding var exp bindings = | |
232 | let var = dot_term var in | |
233 | let attempt bindings = [((var,exp)::bindings)] in | |
234 | match List.concat(List.map attempt bindings) with | |
235 | [] -> Fail NonMatch | |
236 | | x -> OK x | |
237 | ||
238 | let rec nub ls = | |
239 | match ls with | |
240 | [] -> [] | |
241 | | (x::xs) when (List.mem x xs) -> nub xs | |
242 | | (x::xs) -> x::(nub xs) | |
243 | ||
244 | (* --------------------------------------------------------------------- *) | |
245 | ||
246 | let init_env = [[]] | |
247 | ||
248 | let debug str m binding = | |
249 | let res = m binding in | |
250 | (match res with | |
251 | None -> Printf.printf "%s: failed\n" str | |
252 | | Some binding -> | |
253 | List.iter | |
254 | (function binding -> | |
255 | Printf.printf "%s: %s\n" str | |
256 | (String.concat " " (List.map (function (x,_) -> x) binding))) | |
257 | binding); | |
258 | res | |
259 | ||
260 | let conjunct_bindings | |
261 | (m1 : 'binding -> 'binding either) | |
262 | (m2 : 'binding -> 'binding either) | |
263 | (binding : 'binding) : 'binding either = | |
264 | match m1 binding with Fail(reason) -> Fail(reason) | OK binding -> m2 binding | |
265 | ||
266 | let rec conjunct_many_bindings = function | |
267 | [] -> failwith "not possible" | |
268 | | [x] -> x | |
269 | | x::xs -> conjunct_bindings x (conjunct_many_bindings xs) | |
270 | ||
708f4980 | 271 | let mcode_equal (x,_,_,_,_,_) (y,_,_,_,_,_) = x = y |
34e49164 C |
272 | |
273 | let return b binding = if b then OK binding else Fail NonMatch | |
274 | let return_false reason binding = Fail reason | |
275 | ||
276 | let match_option f t1 t2 = | |
277 | match (t1,t2) with | |
278 | (Some t1, Some t2) -> f t1 t2 | |
279 | | (None, None) -> return true | |
280 | | _ -> return false | |
281 | ||
282 | let bool_match_option f t1 t2 = | |
283 | match (t1,t2) with | |
284 | (Some t1, Some t2) -> f t1 t2 | |
285 | | (None, None) -> true | |
286 | | _ -> false | |
287 | ||
288 | (* context_required is for the example | |
289 | if ( | |
290 | + (int * ) | |
291 | x == NULL) | |
292 | where we can't change x == NULL to eg NULL == x. So there can either be | |
293 | nothing attached to the root or the term has to be all removed. | |
294 | if would be nice if we knew more about the relationship between the - and + | |
295 | code, because in the case where the + code is a separate statement in a | |
296 | sequence, this is not a problem. Perhaps something could be done in | |
297 | insert_plus | |
298 | ||
299 | The example seems strange. Why isn't the cast attached to x? | |
300 | *) | |
301 | let is_context e = | |
302 | !Flag.sgrep_mode2 or (* everything is context for sgrep *) | |
303 | (match Ast0.get_mcodekind e with | |
304 | Ast0.CONTEXT(cell) -> true | |
305 | | _ -> false) | |
306 | ||
307 | (* needs a special case when there is a Disj or an empty DOTS | |
308 | the following stops at the statement level, and gives true if one | |
309 | statement is replaced by another *) | |
310 | let rec is_pure_context s = | |
311 | !Flag.sgrep_mode2 or (* everything is context for sgrep *) | |
312 | (match Ast0.unwrap s with | |
313 | Ast0.Disj(starter,statement_dots_list,mids,ender) -> | |
314 | List.for_all | |
315 | (function x -> | |
316 | match Ast0.undots x with | |
317 | [s] -> is_pure_context s | |
318 | | _ -> false (* could we do better? *)) | |
319 | statement_dots_list | |
320 | | _ -> | |
321 | (match Ast0.get_mcodekind s with | |
322 | Ast0.CONTEXT(mc) -> | |
323 | (match !mc with | |
324 | (Ast.NOTHING,_,_) -> true | |
325 | | _ -> false) | |
326 | | Ast0.MINUS(mc) -> | |
327 | (match !mc with | |
97111a47 | 328 | (* do better for the common case of replacing a stmt by another one *) |
8babbc8f | 329 | (Ast.REPLACEMENT([[Ast.StatementTag(s)]],_),_) -> |
34e49164 C |
330 | (match Ast.unwrap s with |
331 | Ast.IfThen(_,_,_) -> false (* potentially dangerous *) | |
332 | | _ -> true) | |
951c7801 | 333 | | (_,_) -> false) |
34e49164 C |
334 | | _ -> false)) |
335 | ||
336 | let is_minus e = | |
337 | match Ast0.get_mcodekind e with Ast0.MINUS(cell) -> true | _ -> false | |
338 | ||
339 | let match_list matcher is_list_matcher do_list_match la lb = | |
340 | let rec loop = function | |
341 | ([],[]) -> return true | |
342 | | ([x],lb) when is_list_matcher x -> do_list_match x lb | |
343 | | (x::xs,y::ys) -> conjunct_bindings (matcher x y) (loop (xs,ys)) | |
344 | | _ -> return false in | |
345 | loop (la,lb) | |
346 | ||
c3e37e97 C |
347 | let all_caps = Str.regexp "^[A-Z_][A-Z_0-9]*$" |
348 | ||
34e49164 C |
349 | let match_maker checks_needed context_required whencode_allowed = |
350 | ||
8f657093 | 351 | let check_mcode pmc (*pattern*) cmc (*code*) binding = |
34e49164 C |
352 | if checks_needed |
353 | then | |
354 | match Ast0.get_pos cmc with | |
17ba0788 C |
355 | [] -> OK binding (* no hidden vars in smpl code, so nothing to do *) |
356 | | ((a::_) as hidden_code) -> | |
357 | let hidden_pattern = | |
358 | List.filter (function Ast0.HiddenVarTag _ -> true | _ -> false) | |
359 | (Ast0.get_pos pmc) in | |
360 | (match hidden_pattern with | |
361 | [Ast0.HiddenVarTag([Ast0.MetaPosTag(Ast0.MetaPos (name1,_,_))])] -> | |
362 | add_binding name1 (Ast0.HiddenVarTag(hidden_code)) binding | |
363 | | [] -> Fail(Position(Ast0.unwrap_mcode(Ast0.meta_pos_name a))) | |
364 | | _ -> failwith "badly compiled iso - multiple hidden variable") | |
34e49164 C |
365 | else OK binding in |
366 | ||
367 | let match_dots matcher is_list_matcher do_list_match d1 d2 = | |
368 | match (Ast0.unwrap d1, Ast0.unwrap d2) with | |
369 | (Ast0.DOTS(la),Ast0.DOTS(lb)) | |
370 | | (Ast0.CIRCLES(la),Ast0.CIRCLES(lb)) | |
371 | | (Ast0.STARS(la),Ast0.STARS(lb)) -> | |
372 | match_list matcher is_list_matcher (do_list_match d2) la lb | |
373 | | _ -> return false in | |
374 | ||
375 | let is_elist_matcher el = | |
376 | match Ast0.unwrap el with Ast0.MetaExprList(_,_,_) -> true | _ -> false in | |
377 | ||
378 | let is_plist_matcher pl = | |
379 | match Ast0.unwrap pl with Ast0.MetaParamList(_,_,_) -> true | _ -> false in | |
380 | ||
381 | let is_slist_matcher pl = | |
382 | match Ast0.unwrap pl with Ast0.MetaStmtList(_,_) -> true | _ -> false in | |
383 | ||
384 | let no_list _ = false in | |
385 | ||
386 | let build_dots pattern data = | |
387 | match Ast0.unwrap pattern with | |
388 | Ast0.DOTS(_) -> Ast0.rewrap pattern (Ast0.DOTS(data)) | |
389 | | Ast0.CIRCLES(_) -> Ast0.rewrap pattern (Ast0.CIRCLES(data)) | |
390 | | Ast0.STARS(_) -> Ast0.rewrap pattern (Ast0.STARS(data)) in | |
391 | ||
392 | let pure_sp_code = | |
393 | let bind = Ast0.lub_pure in | |
394 | let option_default = Ast0.Context in | |
485bce71 C |
395 | let pure_mcodekind mc = |
396 | if !Flag.sgrep_mode2 | |
397 | then Ast0.PureContext | |
398 | else | |
399 | match mc with | |
400 | Ast0.CONTEXT(mc) -> | |
401 | (match !mc with | |
402 | (Ast.NOTHING,_,_) -> Ast0.PureContext | |
403 | | _ -> Ast0.Context) | |
404 | | Ast0.MINUS(mc) -> | |
8babbc8f C |
405 | (match !mc with |
406 | (Ast.NOREPLACEMENT,_) -> Ast0.Pure | |
407 | | _ -> Ast0.Impure) | |
485bce71 | 408 | | _ -> Ast0.Impure in |
34e49164 C |
409 | let donothing r k e = |
410 | bind (pure_mcodekind (Ast0.get_mcodekind e)) (k e) in | |
411 | ||
412 | let mcode m = pure_mcodekind (Ast0.get_mcode_mcodekind m) in | |
413 | ||
414 | (* a case for everything that has a metavariable *) | |
415 | (* pure is supposed to match only unitary metavars, not anything that | |
416 | contains only unitary metavars *) | |
417 | let ident r k i = | |
418 | bind (bind (pure_mcodekind (Ast0.get_mcodekind i)) (k i)) | |
419 | (match Ast0.unwrap i with | |
8babbc8f | 420 | Ast0.MetaId(name,_,_,pure) | Ast0.MetaFunc(name,_,pure) |
34e49164 C |
421 | | Ast0.MetaLocalFunc(name,_,pure) -> pure |
422 | | _ -> Ast0.Impure) in | |
423 | ||
424 | let expression r k e = | |
425 | bind (bind (pure_mcodekind (Ast0.get_mcodekind e)) (k e)) | |
426 | (match Ast0.unwrap e with | |
427 | Ast0.MetaErr(name,_,pure) | |
428 | | Ast0.MetaExpr(name,_,_,_,pure) | Ast0.MetaExprList(name,_,pure) -> | |
429 | pure | |
430 | | _ -> Ast0.Impure) in | |
431 | ||
432 | let typeC r k t = | |
433 | bind (bind (pure_mcodekind (Ast0.get_mcodekind t)) (k t)) | |
434 | (match Ast0.unwrap t with | |
435 | Ast0.MetaType(name,pure) -> pure | |
436 | | _ -> Ast0.Impure) in | |
437 | ||
113803cf C |
438 | let init r k t = |
439 | bind (bind (pure_mcodekind (Ast0.get_mcodekind t)) (k t)) | |
440 | (match Ast0.unwrap t with | |
8f657093 | 441 | Ast0.MetaInit(name,pure) | Ast0.MetaInitList(name,_,pure) -> pure |
113803cf C |
442 | | _ -> Ast0.Impure) in |
443 | ||
34e49164 C |
444 | let param r k p = |
445 | bind (bind (pure_mcodekind (Ast0.get_mcodekind p)) (k p)) | |
446 | (match Ast0.unwrap p with | |
447 | Ast0.MetaParam(name,pure) | Ast0.MetaParamList(name,_,pure) -> pure | |
448 | | _ -> Ast0.Impure) in | |
449 | ||
413ffc02 C |
450 | let decl r k d = |
451 | bind (bind (pure_mcodekind (Ast0.get_mcodekind d)) (k d)) | |
452 | (match Ast0.unwrap d with | |
190f1acf C |
453 | Ast0.MetaDecl(name,pure) | Ast0.MetaField(name,pure) |
454 | | Ast0.MetaFieldList(name,_,pure) -> | |
455 | pure | |
413ffc02 C |
456 | | _ -> Ast0.Impure) in |
457 | ||
34e49164 C |
458 | let stmt r k s = |
459 | bind (bind (pure_mcodekind (Ast0.get_mcodekind s)) (k s)) | |
460 | (match Ast0.unwrap s with | |
461 | Ast0.MetaStmt(name,pure) | Ast0.MetaStmtList(name,pure) -> pure | |
462 | | _ -> Ast0.Impure) in | |
463 | ||
b1b2de81 | 464 | V0.flat_combiner bind option_default |
34e49164 | 465 | mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode |
34e49164 | 466 | donothing donothing donothing donothing donothing donothing |
413ffc02 | 467 | ident expression typeC init param decl stmt donothing |
34e49164 C |
468 | donothing in |
469 | ||
470 | let add_pure_list_binding name pure is_pure builder1 builder2 lst = | |
471 | match (checks_needed,pure) with | |
472 | (true,Ast0.Pure) | (true,Ast0.Context) | (true,Ast0.PureContext) -> | |
473 | (match lst with | |
474 | [x] -> | |
475 | if (Ast0.lub_pure (is_pure x) pure) = pure | |
476 | then add_binding name (builder1 lst) | |
477 | else return_false (NotPure (pure,term name,builder1 lst)) | |
478 | | _ -> return_false (NotPureLength (term name))) | |
479 | | (false,_) | (_,Ast0.Impure) -> add_binding name (builder2 lst) in | |
480 | ||
481 | let add_pure_binding name pure is_pure builder x = | |
482 | match (checks_needed,pure) with | |
483 | (true,Ast0.Pure) | (true,Ast0.Context) | (true,Ast0.PureContext) -> | |
484 | if (Ast0.lub_pure (is_pure x) pure) = pure | |
485 | then add_binding name (builder x) | |
486 | else return_false (NotPure (pure,term name, builder x)) | |
487 | | (false,_) | (_,Ast0.Impure) -> add_binding name (builder x) in | |
488 | ||
489 | let do_elist_match builder el lst = | |
490 | match Ast0.unwrap el with | |
491 | Ast0.MetaExprList(name,lenname,pure) -> | |
492 | (*how to handle lenname? should it be an option type and always None?*) | |
493 | failwith "expr list pattern not supported in iso" | |
494 | (*add_pure_list_binding name pure | |
495 | pure_sp_code.V0.combiner_expression | |
496 | (function lst -> Ast0.ExprTag(List.hd lst)) | |
497 | (function lst -> Ast0.DotsExprTag(build_dots builder lst)) | |
498 | lst*) | |
499 | | _ -> failwith "not possible" in | |
500 | ||
501 | let do_plist_match builder pl lst = | |
502 | match Ast0.unwrap pl with | |
503 | Ast0.MetaParamList(name,lename,pure) -> | |
504 | failwith "param list pattern not supported in iso" | |
505 | (*add_pure_list_binding name pure | |
506 | pure_sp_code.V0.combiner_parameter | |
507 | (function lst -> Ast0.ParamTag(List.hd lst)) | |
508 | (function lst -> Ast0.DotsParamTag(build_dots builder lst)) | |
509 | lst*) | |
510 | | _ -> failwith "not possible" in | |
511 | ||
512 | let do_slist_match builder sl lst = | |
513 | match Ast0.unwrap sl with | |
514 | Ast0.MetaStmtList(name,pure) -> | |
515 | add_pure_list_binding name pure | |
b1b2de81 | 516 | pure_sp_code.VT0.combiner_rec_statement |
34e49164 C |
517 | (function lst -> Ast0.StmtTag(List.hd lst)) |
518 | (function lst -> Ast0.DotsStmtTag(build_dots builder lst)) | |
519 | lst | |
520 | | _ -> failwith "not possible" in | |
521 | ||
522 | let do_nolist_match _ _ = failwith "not possible" in | |
523 | ||
524 | let rec match_ident pattern id = | |
525 | match Ast0.unwrap pattern with | |
8babbc8f | 526 | Ast0.MetaId(name,_,_,pure) -> |
b1b2de81 | 527 | (add_pure_binding name pure pure_sp_code.VT0.combiner_rec_ident |
34e49164 C |
528 | (function id -> Ast0.IdentTag id) id) |
529 | | Ast0.MetaFunc(name,_,pure) -> failwith "metafunc not supported" | |
530 | | Ast0.MetaLocalFunc(name,_,pure) -> failwith "metalocalfunc not supported" | |
531 | | up -> | |
532 | if not(checks_needed) or not(context_required) or is_context id | |
533 | then | |
534 | match (up,Ast0.unwrap id) with | |
535 | (Ast0.Id(namea),Ast0.Id(nameb)) -> | |
536 | if mcode_equal namea nameb | |
537 | then check_mcode namea nameb | |
538 | else return false | |
d3f655c6 C |
539 | | (Ast0.DisjId(_,ids,_,_),_) -> |
540 | failwith "not allowed in the pattern of an isomorphism" | |
34e49164 C |
541 | | (Ast0.OptIdent(ida),Ast0.OptIdent(idb)) |
542 | | (Ast0.UniqueIdent(ida),Ast0.UniqueIdent(idb)) -> | |
543 | match_ident ida idb | |
544 | | (_,Ast0.OptIdent(idb)) | |
545 | | (_,Ast0.UniqueIdent(idb)) -> match_ident pattern idb | |
546 | | _ -> return false | |
547 | else return_false (ContextRequired (Ast0.IdentTag id)) in | |
548 | ||
549 | (* should we do something about matching metavars against ...? *) | |
550 | let rec match_expr pattern expr = | |
551 | match Ast0.unwrap pattern with | |
552 | Ast0.MetaExpr(name,_,ty,form,pure) -> | |
553 | let form_ok = | |
554 | match (form,expr) with | |
555 | (Ast.ANY,_) -> true | |
556 | | (Ast.CONST,e) -> | |
557 | let rec matches e = | |
558 | match Ast0.unwrap e with | |
559 | Ast0.Constant(c) -> true | |
c3e37e97 C |
560 | | Ast0.Ident(c) -> |
561 | (match Ast0.unwrap c with | |
562 | Ast0.Id(nm) -> | |
563 | let nm = Ast0.unwrap_mcode nm in | |
564 | (* all caps is a const *) | |
565 | Str.string_match all_caps nm 0 | |
566 | | _ -> false) | |
34e49164 C |
567 | | Ast0.Cast(lp,ty,rp,e) -> matches e |
568 | | Ast0.SizeOfExpr(se,exp) -> true | |
569 | | Ast0.SizeOfType(se,lp,ty,rp) -> true | |
570 | | Ast0.MetaExpr(nm,_,_,Ast.CONST,p) -> | |
571 | (Ast0.lub_pure p pure) = pure | |
572 | | _ -> false in | |
573 | matches e | |
574 | | (Ast.ID,e) | (Ast.LocalID,e) -> | |
575 | let rec matches e = | |
576 | match Ast0.unwrap e with | |
577 | Ast0.Ident(c) -> true | |
578 | | Ast0.Cast(lp,ty,rp,e) -> matches e | |
579 | | Ast0.MetaExpr(nm,_,_,Ast.ID,p) -> | |
580 | (Ast0.lub_pure p pure) = pure | |
581 | | _ -> false in | |
582 | matches e in | |
583 | if form_ok | |
584 | then | |
585 | match ty with | |
586 | Some ts -> | |
587 | if List.exists | |
588 | (function Type_cocci.MetaType(_,_,_) -> true | _ -> false) | |
589 | ts | |
590 | then | |
591 | (match ts with | |
592 | [Type_cocci.MetaType(tyname,_,_)] -> | |
593 | let expty = | |
594 | match (Ast0.unwrap expr,Ast0.get_type expr) with | |
595 | (* easier than updating type inferencer to manage multiple | |
596 | types *) | |
597 | (Ast0.MetaExpr(_,_,Some tts,_,_),_) -> Some tts | |
598 | | (_,Some ty) -> Some [ty] | |
599 | | _ -> None in | |
600 | (match expty with | |
601 | Some expty -> | |
602 | let tyname = Ast0.rewrap_mcode name tyname in | |
485bce71 C |
603 | conjunct_bindings |
604 | (add_pure_binding name pure | |
b1b2de81 | 605 | pure_sp_code.VT0.combiner_rec_expression |
485bce71 C |
606 | (function expr -> Ast0.ExprTag expr) |
607 | expr) | |
608 | (function bindings -> | |
609 | let attempts = | |
610 | List.map | |
611 | (function expty -> | |
612 | (try | |
613 | add_pure_binding tyname Ast0.Impure | |
614 | (function _ -> Ast0.Impure) | |
615 | (function ty -> Ast0.TypeCTag ty) | |
616 | (Ast0.rewrap expr | |
617 | (Ast0.reverse_type expty)) | |
618 | bindings | |
619 | with Ast0.TyConv -> | |
620 | Printf.printf | |
621 | "warning: unconvertible type"; | |
622 | return false bindings)) | |
623 | expty in | |
624 | if List.exists | |
625 | (function Fail _ -> false | OK x -> true) | |
626 | attempts | |
627 | then | |
628 | (* not sure why this is ok. can there be more | |
97111a47 | 629 | than one OK? *) |
485bce71 C |
630 | OK (List.concat |
631 | (List.map | |
632 | (function Fail _ -> [] | OK x -> x) | |
633 | attempts)) | |
634 | else | |
635 | Fail | |
636 | (TypeMatch | |
637 | (List.map | |
638 | (function | |
639 | Fail r -> r | |
640 | | OK x -> failwith "not possible") | |
641 | attempts))) | |
642 | | _ -> | |
34e49164 C |
643 | (*Printf.printf |
644 | "warning: type metavar can only match one type";*) | |
645 | return false) | |
646 | | _ -> | |
647 | failwith | |
648 | "mixture of metatype and other types not supported") | |
649 | else | |
650 | let expty = Ast0.get_type expr in | |
651 | if List.exists (function t -> Type_cocci.compatible t expty) ts | |
652 | then | |
653 | add_pure_binding name pure | |
b1b2de81 | 654 | pure_sp_code.VT0.combiner_rec_expression |
34e49164 C |
655 | (function expr -> Ast0.ExprTag expr) |
656 | expr | |
657 | else return false | |
658 | | None -> | |
fc1ad971 C |
659 | add_pure_binding name pure |
660 | pure_sp_code.VT0.combiner_rec_expression | |
34e49164 C |
661 | (function expr -> Ast0.ExprTag expr) |
662 | expr | |
663 | else return false | |
664 | | Ast0.MetaErr(namea,_,pure) -> failwith "metaerr not supported" | |
665 | | Ast0.MetaExprList(_,_,_) -> failwith "metaexprlist not supported" | |
666 | | up -> | |
667 | if not(checks_needed) or not(context_required) or is_context expr | |
668 | then | |
669 | match (up,Ast0.unwrap expr) with | |
670 | (Ast0.Ident(ida),Ast0.Ident(idb)) -> | |
671 | match_ident ida idb | |
672 | | (Ast0.Constant(consta),Ast0.Constant(constb)) -> | |
673 | if mcode_equal consta constb | |
674 | then check_mcode consta constb | |
675 | else return false | |
676 | | (Ast0.FunCall(fna,lp1,argsa,rp1),Ast0.FunCall(fnb,lp,argsb,rp)) -> | |
677 | conjunct_many_bindings | |
678 | [check_mcode lp1 lp; check_mcode rp1 rp; match_expr fna fnb; | |
679 | match_dots match_expr is_elist_matcher do_elist_match | |
680 | argsa argsb] | |
681 | | (Ast0.Assignment(lefta,opa,righta,_), | |
682 | Ast0.Assignment(leftb,opb,rightb,_)) -> | |
683 | if mcode_equal opa opb | |
684 | then | |
685 | conjunct_many_bindings | |
686 | [check_mcode opa opb; match_expr lefta leftb; | |
687 | match_expr righta rightb] | |
688 | else return false | |
17ba0788 C |
689 | | (Ast0.Sequence(lefta,opa,righta), |
690 | Ast0.Sequence(leftb,opb,rightb)) -> | |
691 | if mcode_equal opa opb | |
692 | then | |
693 | conjunct_many_bindings | |
694 | [check_mcode opa opb; match_expr lefta leftb; | |
695 | match_expr righta rightb] | |
696 | else return false | |
34e49164 C |
697 | | (Ast0.CondExpr(exp1a,lp1,exp2a,rp1,exp3a), |
698 | Ast0.CondExpr(exp1b,lp,exp2b,rp,exp3b)) -> | |
699 | conjunct_many_bindings | |
700 | [check_mcode lp1 lp; check_mcode rp1 rp; | |
701 | match_expr exp1a exp1b; match_option match_expr exp2a exp2b; | |
702 | match_expr exp3a exp3b] | |
703 | | (Ast0.Postfix(expa,opa),Ast0.Postfix(expb,opb)) -> | |
704 | if mcode_equal opa opb | |
705 | then | |
706 | conjunct_bindings (check_mcode opa opb) (match_expr expa expb) | |
707 | else return false | |
708 | | (Ast0.Infix(expa,opa),Ast0.Infix(expb,opb)) -> | |
709 | if mcode_equal opa opb | |
710 | then | |
711 | conjunct_bindings (check_mcode opa opb) (match_expr expa expb) | |
712 | else return false | |
713 | | (Ast0.Unary(expa,opa),Ast0.Unary(expb,opb)) -> | |
714 | if mcode_equal opa opb | |
715 | then | |
716 | conjunct_bindings (check_mcode opa opb) (match_expr expa expb) | |
717 | else return false | |
718 | | (Ast0.Binary(lefta,opa,righta),Ast0.Binary(leftb,opb,rightb)) -> | |
719 | if mcode_equal opa opb | |
720 | then | |
721 | conjunct_many_bindings | |
722 | [check_mcode opa opb; match_expr lefta leftb; | |
723 | match_expr righta rightb] | |
724 | else return false | |
725 | | (Ast0.Paren(lp1,expa,rp1),Ast0.Paren(lp,expb,rp)) -> | |
726 | conjunct_many_bindings | |
727 | [check_mcode lp1 lp; check_mcode rp1 rp; match_expr expa expb] | |
728 | | (Ast0.ArrayAccess(exp1a,lb1,exp2a,rb1), | |
729 | Ast0.ArrayAccess(exp1b,lb,exp2b,rb)) -> | |
730 | conjunct_many_bindings | |
731 | [check_mcode lb1 lb; check_mcode rb1 rb; | |
732 | match_expr exp1a exp1b; match_expr exp2a exp2b] | |
733 | | (Ast0.RecordAccess(expa,opa,fielda), | |
734 | Ast0.RecordAccess(expb,op,fieldb)) | |
735 | | (Ast0.RecordPtAccess(expa,opa,fielda), | |
736 | Ast0.RecordPtAccess(expb,op,fieldb)) -> | |
737 | conjunct_many_bindings | |
738 | [check_mcode opa op; match_expr expa expb; | |
739 | match_ident fielda fieldb] | |
740 | | (Ast0.Cast(lp1,tya,rp1,expa),Ast0.Cast(lp,tyb,rp,expb)) -> | |
741 | conjunct_many_bindings | |
742 | [check_mcode lp1 lp; check_mcode rp1 rp; | |
743 | match_typeC tya tyb; match_expr expa expb] | |
744 | | (Ast0.SizeOfExpr(szf1,expa),Ast0.SizeOfExpr(szf,expb)) -> | |
745 | conjunct_bindings (check_mcode szf1 szf) (match_expr expa expb) | |
746 | | (Ast0.SizeOfType(szf1,lp1,tya,rp1), | |
747 | Ast0.SizeOfType(szf,lp,tyb,rp)) -> | |
748 | conjunct_many_bindings | |
749 | [check_mcode lp1 lp; check_mcode rp1 rp; | |
750 | check_mcode szf1 szf; match_typeC tya tyb] | |
7fe62b65 C |
751 | | (Ast0.Constructor(lp1,tya,rp1,inita), |
752 | Ast0.Constructor(lp,tyb,rp,initb)) -> | |
97111a47 C |
753 | conjunct_many_bindings |
754 | [check_mcode lp1 lp; check_mcode rp1 rp; | |
755 | match_typeC tya tyb; match_init inita initb] | |
34e49164 C |
756 | | (Ast0.TypeExp(tya),Ast0.TypeExp(tyb)) -> |
757 | match_typeC tya tyb | |
758 | | (Ast0.EComma(cm1),Ast0.EComma(cm)) -> check_mcode cm1 cm | |
759 | | (Ast0.DisjExpr(_,expsa,_,_),_) -> | |
760 | failwith "not allowed in the pattern of an isomorphism" | |
761 | | (Ast0.NestExpr(_,exp_dotsa,_,_,_),_) -> | |
762 | failwith "not allowed in the pattern of an isomorphism" | |
763 | | (Ast0.Edots(d,None),Ast0.Edots(d1,None)) | |
764 | | (Ast0.Ecircles(d,None),Ast0.Ecircles(d1,None)) | |
765 | | (Ast0.Estars(d,None),Ast0.Estars(d1,None)) -> check_mcode d d1 | |
766 | | (Ast0.Edots(ed,None),Ast0.Edots(ed1,Some wc)) | |
767 | | (Ast0.Ecircles(ed,None),Ast0.Ecircles(ed1,Some wc)) | |
768 | | (Ast0.Estars(ed,None),Ast0.Estars(ed1,Some wc)) -> | |
769 | (* hope that mcode of edots is unique somehow *) | |
770 | conjunct_bindings (check_mcode ed ed1) | |
771 | (let (edots_whencode_allowed,_,_) = whencode_allowed in | |
772 | if edots_whencode_allowed | |
773 | then add_dot_binding ed (Ast0.ExprTag wc) | |
774 | else | |
775 | (Printf.printf | |
776 | "warning: not applying iso because of whencode"; | |
777 | return false)) | |
778 | | (Ast0.Edots(_,Some _),_) | (Ast0.Ecircles(_,Some _),_) | |
779 | | (Ast0.Estars(_,Some _),_) -> | |
780 | failwith "whencode not allowed in a pattern1" | |
781 | | (Ast0.OptExp(expa),Ast0.OptExp(expb)) | |
17ba0788 C |
782 | | (Ast0.UniqueExp(expa),Ast0.UniqueExp(expb)) -> |
783 | match_expr expa expb | |
34e49164 C |
784 | | (_,Ast0.OptExp(expb)) |
785 | | (_,Ast0.UniqueExp(expb)) -> match_expr pattern expb | |
786 | | _ -> return false | |
787 | else return_false (ContextRequired (Ast0.ExprTag expr)) | |
faf9a90c | 788 | |
34e49164 C |
789 | (* the special case for function types prevents the eg T X; -> T X = E; iso |
790 | from applying, which doesn't seem very relevant, but it also avoids a | |
791 | mysterious bug that is obtained with eg int attach(...); *) | |
792 | and match_typeC pattern t = | |
793 | match Ast0.unwrap pattern with | |
794 | Ast0.MetaType(name,pure) -> | |
795 | (match Ast0.unwrap t with | |
796 | Ast0.FunctionType(tya,lp1a,paramsa,rp1a) -> return false | |
797 | | _ -> | |
b1b2de81 | 798 | add_pure_binding name pure pure_sp_code.VT0.combiner_rec_typeC |
34e49164 C |
799 | (function ty -> Ast0.TypeCTag ty) |
800 | t) | |
801 | | up -> | |
802 | if not(checks_needed) or not(context_required) or is_context t | |
803 | then | |
804 | match (up,Ast0.unwrap t) with | |
805 | (Ast0.ConstVol(cva,tya),Ast0.ConstVol(cvb,tyb)) -> | |
806 | if mcode_equal cva cvb | |
807 | then | |
808 | conjunct_bindings (check_mcode cva cvb) (match_typeC tya tyb) | |
809 | else return false | |
faf9a90c C |
810 | | (Ast0.BaseType(tya,stringsa),Ast0.BaseType(tyb,stringsb)) -> |
811 | if tya = tyb | |
34e49164 | 812 | then |
faf9a90c C |
813 | match_list check_mcode |
814 | (function _ -> false) (function _ -> failwith "") | |
815 | stringsa stringsb | |
34e49164 | 816 | else return false |
faf9a90c | 817 | | (Ast0.Signed(signa,tya),Ast0.Signed(signb,tyb)) -> |
34e49164 | 818 | if mcode_equal signa signb |
faf9a90c C |
819 | then |
820 | conjunct_bindings (check_mcode signa signb) | |
821 | (match_option match_typeC tya tyb) | |
34e49164 C |
822 | else return false |
823 | | (Ast0.Pointer(tya,star1),Ast0.Pointer(tyb,star)) -> | |
824 | conjunct_bindings (check_mcode star1 star) (match_typeC tya tyb) | |
825 | | (Ast0.FunctionPointer(tya,lp1a,stara,rp1a,lp2a,paramsa,rp2a), | |
826 | Ast0.FunctionPointer(tyb,lp1b,starb,rp1b,lp2b,paramsb,rp2b)) -> | |
827 | conjunct_many_bindings | |
828 | [check_mcode stara starb; check_mcode lp1a lp1b; | |
829 | check_mcode rp1a rp1b; check_mcode lp2a lp2b; | |
830 | check_mcode rp2a rp2b; match_typeC tya tyb; | |
831 | match_dots match_param is_plist_matcher | |
832 | do_plist_match paramsa paramsb] | |
833 | | (Ast0.FunctionType(tya,lp1a,paramsa,rp1a), | |
834 | Ast0.FunctionType(tyb,lp1b,paramsb,rp1b)) -> | |
835 | conjunct_many_bindings | |
836 | [check_mcode lp1a lp1b; check_mcode rp1a rp1b; | |
837 | match_option match_typeC tya tyb; | |
838 | match_dots match_param is_plist_matcher do_plist_match | |
839 | paramsa paramsb] | |
840 | | (Ast0.Array(tya,lb1,sizea,rb1),Ast0.Array(tyb,lb,sizeb,rb)) -> | |
841 | conjunct_many_bindings | |
842 | [check_mcode lb1 lb; check_mcode rb1 rb; | |
843 | match_typeC tya tyb; match_option match_expr sizea sizeb] | |
c491d8ee C |
844 | | (Ast0.EnumName(kinda,Some namea), |
845 | Ast0.EnumName(kindb,Some nameb)) -> | |
97111a47 C |
846 | conjunct_bindings (check_mcode kinda kindb) |
847 | (match_ident namea nameb) | |
c491d8ee C |
848 | | (Ast0.EnumDef(tya,lb1,idsa,rb1), |
849 | Ast0.EnumDef(tyb,lb,idsb,rb)) -> | |
850 | conjunct_many_bindings | |
851 | [check_mcode lb1 lb; check_mcode rb1 rb; | |
852 | match_typeC tya tyb; | |
853 | match_dots match_expr no_list do_nolist_match idsa idsb] | |
34e49164 C |
854 | | (Ast0.StructUnionName(kinda,Some namea), |
855 | Ast0.StructUnionName(kindb,Some nameb)) -> | |
856 | if mcode_equal kinda kindb | |
857 | then | |
858 | conjunct_bindings (check_mcode kinda kindb) | |
859 | (match_ident namea nameb) | |
860 | else return false | |
861 | | (Ast0.StructUnionDef(tya,lb1,declsa,rb1), | |
862 | Ast0.StructUnionDef(tyb,lb,declsb,rb)) -> | |
863 | conjunct_many_bindings | |
864 | [check_mcode lb1 lb; check_mcode rb1 rb; | |
865 | match_typeC tya tyb; | |
866 | match_dots match_decl no_list do_nolist_match declsa declsb] | |
867 | | (Ast0.TypeName(namea),Ast0.TypeName(nameb)) -> | |
868 | if mcode_equal namea nameb | |
869 | then check_mcode namea nameb | |
870 | else return false | |
d3f655c6 | 871 | | (Ast0.DisjType(_,typesa,_,_),_) -> |
34e49164 C |
872 | failwith "not allowed in the pattern of an isomorphism" |
873 | | (Ast0.OptType(tya),Ast0.OptType(tyb)) | |
874 | | (Ast0.UniqueType(tya),Ast0.UniqueType(tyb)) -> match_typeC tya tyb | |
875 | | (_,Ast0.OptType(tyb)) | |
876 | | (_,Ast0.UniqueType(tyb)) -> match_typeC pattern tyb | |
877 | | _ -> return false | |
878 | else return_false (ContextRequired (Ast0.TypeCTag t)) | |
faf9a90c | 879 | |
34e49164 | 880 | and match_decl pattern d = |
413ffc02 C |
881 | match Ast0.unwrap pattern with |
882 | Ast0.MetaDecl(name,pure) -> | |
883 | add_pure_binding name pure pure_sp_code.VT0.combiner_rec_declaration | |
884 | (function d -> Ast0.DeclTag d) | |
885 | d | |
886 | | Ast0.MetaField(name,pure) -> | |
887 | add_pure_binding name pure pure_sp_code.VT0.combiner_rec_declaration | |
888 | (function d -> Ast0.DeclTag d) | |
889 | d | |
190f1acf | 890 | | Ast0.MetaFieldList(name,_,pure) -> failwith "metafieldlist not supporte" |
413ffc02 C |
891 | | up -> |
892 | if not(checks_needed) or not(context_required) or is_context d | |
893 | then | |
894 | match (up,Ast0.unwrap d) with | |
895 | (Ast0.Init(stga,tya,ida,eq1,inia,sc1), | |
896 | Ast0.Init(stgb,tyb,idb,eq,inib,sc)) -> | |
897 | if bool_match_option mcode_equal stga stgb | |
898 | then | |
899 | conjunct_many_bindings | |
900 | [check_mcode eq1 eq; check_mcode sc1 sc; | |
901 | match_option check_mcode stga stgb; | |
902 | match_typeC tya tyb; match_ident ida idb; | |
903 | match_init inia inib] | |
904 | else return false | |
905 | | (Ast0.UnInit(stga,tya,ida,sc1),Ast0.UnInit(stgb,tyb,idb,sc)) -> | |
906 | if bool_match_option mcode_equal stga stgb | |
907 | then | |
908 | conjunct_many_bindings | |
909 | [check_mcode sc1 sc; match_option check_mcode stga stgb; | |
910 | match_typeC tya tyb; match_ident ida idb] | |
911 | else return false | |
912 | | (Ast0.MacroDecl(namea,lp1,argsa,rp1,sc1), | |
913 | Ast0.MacroDecl(nameb,lp,argsb,rp,sc)) -> | |
914 | conjunct_many_bindings | |
915 | [match_ident namea nameb; | |
916 | check_mcode lp1 lp; check_mcode rp1 rp; | |
917 | check_mcode sc1 sc; | |
918 | match_dots match_expr is_elist_matcher do_elist_match | |
919 | argsa argsb] | |
17ba0788 C |
920 | | (Ast0.MacroDeclInit(namea,lp1,argsa,rp1,eq1,ini1,sc1), |
921 | Ast0.MacroDeclInit(nameb,lp,argsb,rp,eq,ini,sc)) -> | |
922 | conjunct_many_bindings | |
923 | [match_ident namea nameb; | |
924 | check_mcode lp1 lp; check_mcode rp1 rp; | |
925 | check_mcode eq1 eq; | |
926 | check_mcode sc1 sc; | |
927 | match_dots match_expr is_elist_matcher do_elist_match | |
928 | argsa argsb; | |
929 | match_init ini1 ini] | |
413ffc02 C |
930 | | (Ast0.TyDecl(tya,sc1),Ast0.TyDecl(tyb,sc)) -> |
931 | conjunct_bindings (check_mcode sc1 sc) (match_typeC tya tyb) | |
932 | | (Ast0.Typedef(stga,tya,ida,sc1),Ast0.Typedef(stgb,tyb,idb,sc)) -> | |
933 | conjunct_bindings (check_mcode sc1 sc) | |
934 | (conjunct_bindings (match_typeC tya tyb) (match_typeC ida idb)) | |
d3f655c6 | 935 | | (Ast0.DisjDecl(_,declsa,_,_),_) -> |
413ffc02 C |
936 | failwith "not allowed in the pattern of an isomorphism" |
937 | | (Ast0.Ddots(d1,None),Ast0.Ddots(d,None)) -> check_mcode d1 d | |
938 | | (Ast0.Ddots(dd,None),Ast0.Ddots(d,Some wc)) -> | |
939 | conjunct_bindings (check_mcode dd d) | |
34e49164 | 940 | (* hope that mcode of ddots is unique somehow *) |
413ffc02 C |
941 | (let (ddots_whencode_allowed,_,_) = whencode_allowed in |
942 | if ddots_whencode_allowed | |
943 | then add_dot_binding dd (Ast0.DeclTag wc) | |
944 | else | |
945 | (Printf.printf "warning: not applying iso because of whencode"; | |
946 | return false)) | |
947 | | (Ast0.Ddots(_,Some _),_) -> | |
948 | failwith "whencode not allowed in a pattern1" | |
949 | ||
950 | | (Ast0.OptDecl(decla),Ast0.OptDecl(declb)) | |
951 | | (Ast0.UniqueDecl(decla),Ast0.UniqueDecl(declb)) -> | |
952 | match_decl decla declb | |
953 | | (_,Ast0.OptDecl(declb)) | |
954 | | (_,Ast0.UniqueDecl(declb)) -> | |
955 | match_decl pattern declb | |
956 | | _ -> return false | |
957 | else return_false (ContextRequired (Ast0.DeclTag d)) | |
97111a47 | 958 | |
34e49164 | 959 | and match_init pattern i = |
113803cf C |
960 | match Ast0.unwrap pattern with |
961 | Ast0.MetaInit(name,pure) -> | |
b1b2de81 | 962 | add_pure_binding name pure pure_sp_code.VT0.combiner_rec_initialiser |
113803cf C |
963 | (function ini -> Ast0.InitTag ini) |
964 | i | |
965 | | up -> | |
966 | if not(checks_needed) or not(context_required) or is_context i | |
967 | then | |
968 | match (up,Ast0.unwrap i) with | |
969 | (Ast0.InitExpr(expa),Ast0.InitExpr(expb)) -> | |
970 | match_expr expa expb | |
c491d8ee C |
971 | | (Ast0.InitList(lb1,initlista,rb1,oa), |
972 | Ast0.InitList(lb,initlistb,rb,ob)) | |
973 | when oa = ob -> | |
113803cf C |
974 | conjunct_many_bindings |
975 | [check_mcode lb1 lb; check_mcode rb1 rb; | |
976 | match_dots match_init no_list do_nolist_match | |
977 | initlista initlistb] | |
978 | | (Ast0.InitGccExt(designators1,e1,inia), | |
979 | Ast0.InitGccExt(designators2,e2,inib)) -> | |
980 | conjunct_many_bindings | |
981 | [match_list match_designator | |
982 | (function _ -> false) (function _ -> failwith "") | |
983 | designators1 designators2; | |
984 | check_mcode e1 e2; | |
985 | match_init inia inib] | |
986 | | (Ast0.InitGccName(namea,c1,inia),Ast0.InitGccName(nameb,c,inib)) -> | |
987 | conjunct_many_bindings | |
988 | [check_mcode c1 c; match_ident namea nameb; | |
989 | match_init inia inib] | |
990 | | (Ast0.IComma(c1),Ast0.IComma(c)) -> check_mcode c1 c | |
991 | | (Ast0.Idots(d1,None),Ast0.Idots(d,None)) -> check_mcode d1 d | |
992 | | (Ast0.Idots(id,None),Ast0.Idots(d,Some wc)) -> | |
993 | conjunct_bindings (check_mcode id d) | |
34e49164 | 994 | (* hope that mcode of edots is unique somehow *) |
113803cf C |
995 | (let (_,idots_whencode_allowed,_) = whencode_allowed in |
996 | if idots_whencode_allowed | |
997 | then add_dot_binding id (Ast0.InitTag wc) | |
998 | else | |
999 | (Printf.printf | |
1000 | "warning: not applying iso because of whencode"; | |
1001 | return false)) | |
1002 | | (Ast0.Idots(_,Some _),_) -> | |
1003 | failwith "whencode not allowed in a pattern2" | |
1004 | | (Ast0.OptIni(ia),Ast0.OptIni(ib)) | |
1005 | | (Ast0.UniqueIni(ia),Ast0.UniqueIni(ib)) -> match_init ia ib | |
1006 | | (_,Ast0.OptIni(ib)) | |
1007 | | (_,Ast0.UniqueIni(ib)) -> match_init pattern ib | |
1008 | | _ -> return false | |
1009 | else return_false (ContextRequired (Ast0.InitTag i)) | |
1010 | ||
1011 | and match_designator pattern d = | |
1012 | match (pattern,d) with | |
1013 | (Ast0.DesignatorField(dota,ida),Ast0.DesignatorField(dotb,idb)) -> | |
1014 | conjunct_bindings (check_mcode dota dotb) (match_ident ida idb) | |
1015 | | (Ast0.DesignatorIndex(lba,expa,rba), | |
1016 | Ast0.DesignatorIndex(lbb,expb,rbb)) -> | |
1017 | conjunct_many_bindings | |
1018 | [check_mcode lba lbb; match_expr expa expb; | |
1019 | check_mcode rba rbb] | |
1020 | | (Ast0.DesignatorRange(lba,mina,dotsa,maxa,rba), | |
1021 | Ast0.DesignatorRange(lbb,minb,dotsb,maxb,rbb)) -> | |
1022 | conjunct_many_bindings | |
1023 | [check_mcode lba lbb; match_expr mina minb; | |
1024 | check_mcode dotsa dotsb; match_expr maxa maxb; | |
1025 | check_mcode rba rbb] | |
1026 | | _ -> return false | |
faf9a90c | 1027 | |
34e49164 C |
1028 | and match_param pattern p = |
1029 | match Ast0.unwrap pattern with | |
1030 | Ast0.MetaParam(name,pure) -> | |
b1b2de81 | 1031 | add_pure_binding name pure pure_sp_code.VT0.combiner_rec_parameter |
34e49164 C |
1032 | (function p -> Ast0.ParamTag p) |
1033 | p | |
1034 | | Ast0.MetaParamList(name,_,pure) -> failwith "metaparamlist not supported" | |
1035 | | up -> | |
1036 | if not(checks_needed) or not(context_required) or is_context p | |
1037 | then | |
1038 | match (up,Ast0.unwrap p) with | |
1039 | (Ast0.VoidParam(tya),Ast0.VoidParam(tyb)) -> match_typeC tya tyb | |
1040 | | (Ast0.Param(tya,ida),Ast0.Param(tyb,idb)) -> | |
1041 | conjunct_bindings (match_typeC tya tyb) | |
1042 | (match_option match_ident ida idb) | |
1043 | | (Ast0.PComma(c1),Ast0.PComma(c)) -> check_mcode c1 c | |
1044 | | (Ast0.Pdots(d1),Ast0.Pdots(d)) | |
1045 | | (Ast0.Pcircles(d1),Ast0.Pcircles(d)) -> check_mcode d1 d | |
1046 | | (Ast0.OptParam(parama),Ast0.OptParam(paramb)) | |
1047 | | (Ast0.UniqueParam(parama),Ast0.UniqueParam(paramb)) -> | |
1048 | match_param parama paramb | |
1049 | | (_,Ast0.OptParam(paramb)) | |
1050 | | (_,Ast0.UniqueParam(paramb)) -> match_param pattern paramb | |
1051 | | _ -> return false | |
1052 | else return_false (ContextRequired (Ast0.ParamTag p)) | |
faf9a90c | 1053 | |
34e49164 C |
1054 | and match_statement pattern s = |
1055 | match Ast0.unwrap pattern with | |
1056 | Ast0.MetaStmt(name,pure) -> | |
1057 | (match Ast0.unwrap s with | |
1058 | Ast0.Dots(_,_) | Ast0.Circles(_,_) | Ast0.Stars(_,_) -> | |
1059 | return false (* ... is not a single statement *) | |
1060 | | _ -> | |
b1b2de81 | 1061 | add_pure_binding name pure pure_sp_code.VT0.combiner_rec_statement |
34e49164 C |
1062 | (function ty -> Ast0.StmtTag ty) |
1063 | s) | |
1064 | | Ast0.MetaStmtList(name,pure) -> failwith "metastmtlist not supported" | |
1065 | | up -> | |
1066 | if not(checks_needed) or not(context_required) or is_context s | |
1067 | then | |
1068 | match (up,Ast0.unwrap s) with | |
1069 | (Ast0.FunDecl(_,fninfoa,namea,lp1,paramsa,rp1,lb1,bodya,rb1), | |
1070 | Ast0.FunDecl(_,fninfob,nameb,lp,paramsb,rp,lb,bodyb,rb)) -> | |
1071 | conjunct_many_bindings | |
1072 | [check_mcode lp1 lp; check_mcode rp1 rp; | |
1073 | check_mcode lb1 lb; check_mcode rb1 rb; | |
1074 | match_fninfo fninfoa fninfob; match_ident namea nameb; | |
1075 | match_dots match_param is_plist_matcher do_plist_match | |
1076 | paramsa paramsb; | |
1077 | match_dots match_statement is_slist_matcher do_slist_match | |
1078 | bodya bodyb] | |
1079 | | (Ast0.Decl(_,decla),Ast0.Decl(_,declb)) -> | |
1080 | match_decl decla declb | |
1081 | | (Ast0.Seq(lb1,bodya,rb1),Ast0.Seq(lb,bodyb,rb)) -> | |
1082 | (* seqs can only match if they are all minus (plus code | |
1083 | allowed) or all context (plus code not allowed in the body). | |
1084 | we could be more permissive if the expansions of the isos are | |
1085 | also all seqs, but this would be hard to check except at top | |
1086 | level, and perhaps not worth checking even in that case. | |
1087 | Overall, the issue is that braces are used where single | |
1088 | statements are required, and something not satisfying these | |
1089 | conditions can cause a single statement to become a | |
1090 | non-single statement after the transformation. | |
1091 | ||
1092 | example: if { ... -foo(); ... } | |
1093 | if we let the sequence convert to just -foo(); | |
1094 | then we produce invalid code. For some reason, | |
1095 | single_statement can't deal with this case, perhaps because | |
1096 | it starts introducing too many braces? don't remember the | |
1097 | exact problem... | |
97111a47 | 1098 | *) |
34e49164 C |
1099 | conjunct_bindings (check_mcode lb1 lb) |
1100 | (conjunct_bindings (check_mcode rb1 rb) | |
1101 | (if not(checks_needed) or is_minus s or | |
1102 | (is_context s && | |
1103 | List.for_all is_pure_context (Ast0.undots bodyb)) | |
1104 | then | |
1105 | match_dots match_statement is_slist_matcher do_slist_match | |
1106 | bodya bodyb | |
1107 | else return_false (Braces(s)))) | |
1108 | | (Ast0.ExprStatement(expa,sc1),Ast0.ExprStatement(expb,sc)) -> | |
8babbc8f C |
1109 | conjunct_bindings (check_mcode sc1 sc) |
1110 | (match_option match_expr expa expb) | |
34e49164 C |
1111 | | (Ast0.IfThen(if1,lp1,expa,rp1,branch1a,_), |
1112 | Ast0.IfThen(if2,lp2,expb,rp2,branch1b,_)) -> | |
1113 | conjunct_many_bindings | |
1114 | [check_mcode if1 if2; check_mcode lp1 lp2; | |
1115 | check_mcode rp1 rp2; | |
1116 | match_expr expa expb; | |
1117 | match_statement branch1a branch1b] | |
1118 | | (Ast0.IfThenElse(if1,lp1,expa,rp1,branch1a,e1,branch2a,_), | |
1119 | Ast0.IfThenElse(if2,lp2,expb,rp2,branch1b,e2,branch2b,_)) -> | |
1120 | conjunct_many_bindings | |
1121 | [check_mcode if1 if2; check_mcode lp1 lp2; | |
1122 | check_mcode rp1 rp2; check_mcode e1 e2; | |
1123 | match_expr expa expb; | |
1124 | match_statement branch1a branch1b; | |
1125 | match_statement branch2a branch2b] | |
1126 | | (Ast0.While(w1,lp1,expa,rp1,bodya,_), | |
1127 | Ast0.While(w,lp,expb,rp,bodyb,_)) -> | |
1128 | conjunct_many_bindings | |
1129 | [check_mcode w1 w; check_mcode lp1 lp; | |
1130 | check_mcode rp1 rp; match_expr expa expb; | |
1131 | match_statement bodya bodyb] | |
1132 | | (Ast0.Do(d1,bodya,w1,lp1,expa,rp1,_), | |
1133 | Ast0.Do(d,bodyb,w,lp,expb,rp,_)) -> | |
1134 | conjunct_many_bindings | |
1135 | [check_mcode d1 d; check_mcode w1 w; check_mcode lp1 lp; | |
1136 | check_mcode rp1 rp; match_statement bodya bodyb; | |
1137 | match_expr expa expb] | |
1138 | | (Ast0.For(f1,lp1,e1a,sc1a,e2a,sc2a,e3a,rp1,bodya,_), | |
1139 | Ast0.For(f,lp,e1b,sc1b,e2b,sc2b,e3b,rp,bodyb,_)) -> | |
1140 | conjunct_many_bindings | |
1141 | [check_mcode f1 f; check_mcode lp1 lp; check_mcode sc1a sc1b; | |
1142 | check_mcode sc2a sc2b; check_mcode rp1 rp; | |
1143 | match_option match_expr e1a e1b; | |
1144 | match_option match_expr e2a e2b; | |
1145 | match_option match_expr e3a e3b; | |
1146 | match_statement bodya bodyb] | |
1147 | | (Ast0.Iterator(nma,lp1,argsa,rp1,bodya,_), | |
1148 | Ast0.Iterator(nmb,lp,argsb,rp,bodyb,_)) -> | |
1149 | conjunct_many_bindings | |
1150 | [match_ident nma nmb; | |
1151 | check_mcode lp1 lp; check_mcode rp1 rp; | |
1152 | match_dots match_expr is_elist_matcher do_elist_match | |
1153 | argsa argsb; | |
1154 | match_statement bodya bodyb] | |
fc1ad971 C |
1155 | | (Ast0.Switch(s1,lp1,expa,rp1,lb1,declsa,casesa,rb1), |
1156 | Ast0.Switch(s,lp,expb,rp,lb,declsb,casesb,rb)) -> | |
34e49164 C |
1157 | conjunct_many_bindings |
1158 | [check_mcode s1 s; check_mcode lp1 lp; check_mcode rp1 rp; | |
1159 | check_mcode lb1 lb; check_mcode rb1 rb; | |
1160 | match_expr expa expb; | |
fc1ad971 C |
1161 | match_dots match_statement is_slist_matcher do_slist_match |
1162 | declsa declsb; | |
34e49164 C |
1163 | match_dots match_case_line no_list do_nolist_match |
1164 | casesa casesb] | |
1165 | | (Ast0.Break(b1,sc1),Ast0.Break(b,sc)) | |
1166 | | (Ast0.Continue(b1,sc1),Ast0.Continue(b,sc)) -> | |
1167 | conjunct_bindings (check_mcode b1 b) (check_mcode sc1 sc) | |
1168 | | (Ast0.Label(l1,c1),Ast0.Label(l2,c)) -> | |
1169 | conjunct_bindings (match_ident l1 l2) (check_mcode c1 c) | |
1170 | | (Ast0.Goto(g1,l1,sc1),Ast0.Goto(g,l2,sc)) -> | |
1171 | conjunct_many_bindings | |
1172 | [check_mcode g1 g; check_mcode sc1 sc; match_ident l1 l2] | |
1173 | | (Ast0.Return(r1,sc1),Ast0.Return(r,sc)) -> | |
1174 | conjunct_bindings (check_mcode r1 r) (check_mcode sc1 sc) | |
1175 | | (Ast0.ReturnExpr(r1,expa,sc1),Ast0.ReturnExpr(r,expb,sc)) -> | |
1176 | conjunct_many_bindings | |
1177 | [check_mcode r1 r; check_mcode sc1 sc; match_expr expa expb] | |
1178 | | (Ast0.Disj(_,statement_dots_lista,_,_),_) -> | |
1179 | failwith "disj not supported in patterns" | |
c491d8ee C |
1180 | | (Ast0.Nest(_,stmt_dotsa,_,[],multia), |
1181 | Ast0.Nest(_,stmt_dotsb,_,wc,multib)) -> | |
1182 | if multia = multib | |
1183 | then | |
1184 | (match wc with | |
1185 | [] -> | |
97111a47 | 1186 | (* not sure this is correct, perhaps too restrictive *) |
c491d8ee C |
1187 | if not(checks_needed) or is_minus s or |
1188 | (is_context s && | |
1189 | List.for_all is_pure_context (Ast0.undots stmt_dotsb)) | |
1190 | then | |
1191 | match_dots match_statement | |
1192 | is_slist_matcher do_slist_match | |
1193 | stmt_dotsa stmt_dotsb | |
1194 | else return_false (Braces(s)) | |
1195 | | _ -> return_false (Nest(s))) | |
1196 | else return false (* diff kind of nest *) | |
34e49164 | 1197 | | (Ast0.Nest(_,stmt_dotsa,_,_,_),_) -> |
c491d8ee | 1198 | failwith "nest with whencode not supported in patterns" |
34e49164 C |
1199 | | (Ast0.Exp(expa),Ast0.Exp(expb)) -> match_expr expa expb |
1200 | | (Ast0.TopExp(expa),Ast0.TopExp(expb)) -> match_expr expa expb | |
1201 | | (Ast0.Exp(expa),Ast0.TopExp(expb)) -> match_expr expa expb | |
1be43e12 | 1202 | | (Ast0.TopInit(inita),Ast0.TopInit(initb)) -> match_init inita initb |
34e49164 C |
1203 | | (Ast0.Ty(tya),Ast0.Ty(tyb)) -> match_typeC tya tyb |
1204 | | (Ast0.Dots(d,[]),Ast0.Dots(d1,wc)) | |
1205 | | (Ast0.Circles(d,[]),Ast0.Circles(d1,wc)) | |
1206 | | (Ast0.Stars(d,[]),Ast0.Stars(d1,wc)) -> | |
1207 | (match wc with | |
1208 | [] -> check_mcode d d1 | |
1209 | | _ -> | |
1210 | let (_,_,dots_whencode_allowed) = whencode_allowed in | |
1211 | if dots_whencode_allowed | |
1212 | then | |
1213 | conjunct_bindings (check_mcode d d1) | |
1214 | (List.fold_left | |
1215 | (function prev -> | |
1216 | function | |
1217 | | Ast0.WhenNot wc -> | |
1218 | conjunct_bindings prev | |
1219 | (add_multi_dot_binding d | |
1220 | (Ast0.DotsStmtTag wc)) | |
1221 | | Ast0.WhenAlways wc -> | |
1222 | conjunct_bindings prev | |
1223 | (add_multi_dot_binding d (Ast0.StmtTag wc)) | |
1be43e12 C |
1224 | | Ast0.WhenNotTrue wc -> |
1225 | conjunct_bindings prev | |
1226 | (add_multi_dot_binding d | |
1227 | (Ast0.IsoWhenTTag wc)) | |
1228 | | Ast0.WhenNotFalse wc -> | |
1229 | conjunct_bindings prev | |
1230 | (add_multi_dot_binding d | |
1231 | (Ast0.IsoWhenFTag wc)) | |
34e49164 C |
1232 | | Ast0.WhenModifier(x) -> |
1233 | conjunct_bindings prev | |
1234 | (add_multi_dot_binding d | |
1235 | (Ast0.IsoWhenTag x))) | |
1236 | (return true) wc) | |
1237 | else | |
1238 | (Printf.printf | |
1239 | "warning: not applying iso because of whencode"; | |
1240 | return false)) | |
1241 | | (Ast0.Dots(_,_::_),_) | (Ast0.Circles(_,_::_),_) | |
1242 | | (Ast0.Stars(_,_::_),_) -> | |
1243 | failwith "whencode not allowed in a pattern3" | |
1244 | | (Ast0.OptStm(rea),Ast0.OptStm(reb)) | |
1245 | | (Ast0.UniqueStm(rea),Ast0.UniqueStm(reb)) -> | |
1246 | match_statement rea reb | |
1247 | | (_,Ast0.OptStm(reb)) | |
1248 | | (_,Ast0.UniqueStm(reb)) -> match_statement pattern reb | |
1249 | | _ -> return false | |
1250 | else return_false (ContextRequired (Ast0.StmtTag s)) | |
faf9a90c | 1251 | |
34e49164 C |
1252 | (* first should provide a subset of the information in the second *) |
1253 | and match_fninfo patterninfo cinfo = | |
1254 | let patterninfo = List.sort compare patterninfo in | |
1255 | let cinfo = List.sort compare cinfo in | |
1256 | let rec loop = function | |
1257 | (Ast0.FStorage(sta)::resta,Ast0.FStorage(stb)::restb) -> | |
1258 | if mcode_equal sta stb | |
1259 | then conjunct_bindings (check_mcode sta stb) (loop (resta,restb)) | |
1260 | else return false | |
1261 | | (Ast0.FType(tya)::resta,Ast0.FType(tyb)::restb) -> | |
1262 | conjunct_bindings (match_typeC tya tyb) (loop (resta,restb)) | |
1263 | | (Ast0.FInline(ia)::resta,Ast0.FInline(ib)::restb) -> | |
1264 | if mcode_equal ia ib | |
1265 | then conjunct_bindings (check_mcode ia ib) (loop (resta,restb)) | |
1266 | else return false | |
1267 | | (Ast0.FAttr(ia)::resta,Ast0.FAttr(ib)::restb) -> | |
1268 | if mcode_equal ia ib | |
1269 | then conjunct_bindings (check_mcode ia ib) (loop (resta,restb)) | |
1270 | else return false | |
1271 | | (x::resta,((y::_) as restb)) -> | |
1272 | (match compare x y with | |
1273 | -1 -> return false | |
1274 | | 1 -> loop (resta,restb) | |
1275 | | _ -> failwith "not possible") | |
1276 | | _ -> return false in | |
1277 | loop (patterninfo,cinfo) | |
faf9a90c | 1278 | |
34e49164 C |
1279 | and match_case_line pattern c = |
1280 | if not(checks_needed) or not(context_required) or is_context c | |
1281 | then | |
1282 | match (Ast0.unwrap pattern,Ast0.unwrap c) with | |
1283 | (Ast0.Default(d1,c1,codea),Ast0.Default(d,c,codeb)) -> | |
1284 | conjunct_many_bindings | |
1285 | [check_mcode d1 d; check_mcode c1 c; | |
1286 | match_dots match_statement is_slist_matcher do_slist_match | |
1287 | codea codeb] | |
1288 | | (Ast0.Case(ca1,expa,c1,codea),Ast0.Case(ca,expb,c,codeb)) -> | |
1289 | conjunct_many_bindings | |
1290 | [check_mcode ca1 ca; check_mcode c1 c; match_expr expa expb; | |
1291 | match_dots match_statement is_slist_matcher do_slist_match | |
1292 | codea codeb] | |
fc1ad971 C |
1293 | | (Ast0.DisjCase(_,case_linesa,_,_),_) -> |
1294 | failwith "not allowed in the pattern of an isomorphism" | |
34e49164 C |
1295 | | (Ast0.OptCase(ca),Ast0.OptCase(cb)) -> match_case_line ca cb |
1296 | | (_,Ast0.OptCase(cb)) -> match_case_line pattern cb | |
1297 | | _ -> return false | |
1298 | else return_false (ContextRequired (Ast0.CaseLineTag c)) in | |
faf9a90c | 1299 | |
34e49164 C |
1300 | let match_statement_dots x y = |
1301 | match_dots match_statement is_slist_matcher do_slist_match x y in | |
faf9a90c | 1302 | |
34e49164 C |
1303 | (match_expr, match_decl, match_statement, match_typeC, |
1304 | match_statement_dots) | |
faf9a90c | 1305 | |
34e49164 C |
1306 | let match_expr dochecks context_required whencode_allowed = |
1307 | let (fn,_,_,_,_) = match_maker dochecks context_required whencode_allowed in | |
1308 | fn | |
faf9a90c | 1309 | |
34e49164 C |
1310 | let match_decl dochecks context_required whencode_allowed = |
1311 | let (_,fn,_,_,_) = match_maker dochecks context_required whencode_allowed in | |
1312 | fn | |
faf9a90c | 1313 | |
34e49164 C |
1314 | let match_statement dochecks context_required whencode_allowed = |
1315 | let (_,_,fn,_,_) = match_maker dochecks context_required whencode_allowed in | |
1316 | fn | |
faf9a90c | 1317 | |
34e49164 C |
1318 | let match_typeC dochecks context_required whencode_allowed = |
1319 | let (_,_,_,fn,_) = match_maker dochecks context_required whencode_allowed in | |
1320 | fn | |
faf9a90c | 1321 | |
34e49164 C |
1322 | let match_statement_dots dochecks context_required whencode_allowed = |
1323 | let (_,_,_,_,fn) = match_maker dochecks context_required whencode_allowed in | |
1324 | fn | |
faf9a90c | 1325 | |
34e49164 C |
1326 | (* --------------------------------------------------------------------- *) |
1327 | (* make an entire tree MINUS *) | |
faf9a90c | 1328 | |
34e49164 | 1329 | let make_minus = |
708f4980 | 1330 | let mcode (term,arity,info,mcodekind,pos,adj) = |
34e49164 C |
1331 | let new_mcodekind = |
1332 | match mcodekind with | |
1333 | Ast0.CONTEXT(mc) -> | |
1334 | (match !mc with | |
8babbc8f C |
1335 | (Ast.NOTHING,_,_) -> |
1336 | Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info)) | |
34e49164 C |
1337 | | _ -> failwith "make_minus: unexpected befaft") |
1338 | | Ast0.MINUS(mc) -> mcodekind (* in the part copied from the src term *) | |
1339 | | _ -> failwith "make_minus mcode: unexpected mcodekind" in | |
708f4980 | 1340 | (term,arity,info,new_mcodekind,pos,adj) in |
faf9a90c | 1341 | |
34e49164 C |
1342 | let update_mc mcodekind e = |
1343 | match !mcodekind with | |
1344 | Ast0.CONTEXT(mc) -> | |
1345 | (match !mc with | |
1346 | (Ast.NOTHING,_,_) -> | |
8babbc8f C |
1347 | mcodekind := |
1348 | Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info)) | |
34e49164 C |
1349 | | _ -> failwith "make_minus: unexpected befaft") |
1350 | | Ast0.MINUS(_mc) -> () (* in the part copied from the src term *) | |
951c7801 | 1351 | | Ast0.PLUS _ -> failwith "make_minus donothing: unexpected plus mcodekind" |
34e49164 | 1352 | | _ -> failwith "make_minus donothing: unexpected mcodekind" in |
faf9a90c | 1353 | |
34e49164 C |
1354 | let donothing r k e = |
1355 | let mcodekind = Ast0.get_mcodekind_ref e in | |
1356 | let e = k e in update_mc mcodekind e; e in | |
faf9a90c | 1357 | |
34e49164 C |
1358 | (* special case for whencode, because it isn't processed by contextneg, |
1359 | since it doesn't appear in the + code *) | |
1360 | (* cases for dots and nests *) | |
1361 | let expression r k e = | |
1362 | let mcodekind = Ast0.get_mcodekind_ref e in | |
1363 | match Ast0.unwrap e with | |
1364 | Ast0.Edots(d,whencode) -> | |
97111a47 | 1365 | (*don't recurse because whencode hasn't been processed by context_neg*) |
34e49164 C |
1366 | update_mc mcodekind e; Ast0.rewrap e (Ast0.Edots(mcode d,whencode)) |
1367 | | Ast0.Ecircles(d,whencode) -> | |
97111a47 | 1368 | (*don't recurse because whencode hasn't been processed by context_neg*) |
34e49164 C |
1369 | update_mc mcodekind e; Ast0.rewrap e (Ast0.Ecircles(mcode d,whencode)) |
1370 | | Ast0.Estars(d,whencode) -> | |
97111a47 | 1371 | (*don't recurse because whencode hasn't been processed by context_neg*) |
34e49164 C |
1372 | update_mc mcodekind e; Ast0.rewrap e (Ast0.Estars(mcode d,whencode)) |
1373 | | Ast0.NestExpr(starter,expr_dots,ender,whencode,multi) -> | |
1374 | update_mc mcodekind e; | |
1375 | Ast0.rewrap e | |
1376 | (Ast0.NestExpr(mcode starter, | |
b1b2de81 | 1377 | r.VT0.rebuilder_rec_expression_dots expr_dots, |
34e49164 C |
1378 | mcode ender,whencode,multi)) |
1379 | | _ -> donothing r k e in | |
faf9a90c | 1380 | |
34e49164 C |
1381 | let declaration r k e = |
1382 | let mcodekind = Ast0.get_mcodekind_ref e in | |
1383 | match Ast0.unwrap e with | |
1384 | Ast0.Ddots(d,whencode) -> | |
97111a47 | 1385 | (*don't recurse because whencode hasn't been processed by context_neg*) |
34e49164 C |
1386 | update_mc mcodekind e; Ast0.rewrap e (Ast0.Ddots(mcode d,whencode)) |
1387 | | _ -> donothing r k e in | |
faf9a90c | 1388 | |
34e49164 C |
1389 | let statement r k e = |
1390 | let mcodekind = Ast0.get_mcodekind_ref e in | |
1391 | match Ast0.unwrap e with | |
1392 | Ast0.Dots(d,whencode) -> | |
97111a47 | 1393 | (*don't recurse because whencode hasn't been processed by context_neg*) |
34e49164 C |
1394 | update_mc mcodekind e; Ast0.rewrap e (Ast0.Dots(mcode d,whencode)) |
1395 | | Ast0.Circles(d,whencode) -> | |
1396 | update_mc mcodekind e; Ast0.rewrap e (Ast0.Circles(mcode d,whencode)) | |
1397 | | Ast0.Stars(d,whencode) -> | |
1398 | update_mc mcodekind e; Ast0.rewrap e (Ast0.Stars(mcode d,whencode)) | |
1399 | | Ast0.Nest(starter,stmt_dots,ender,whencode,multi) -> | |
1400 | update_mc mcodekind e; | |
1401 | Ast0.rewrap e | |
b1b2de81 C |
1402 | (Ast0.Nest |
1403 | (mcode starter,r.VT0.rebuilder_rec_statement_dots stmt_dots, | |
1404 | mcode ender,whencode,multi)) | |
34e49164 | 1405 | | _ -> donothing r k e in |
faf9a90c | 1406 | |
34e49164 C |
1407 | let initialiser r k e = |
1408 | let mcodekind = Ast0.get_mcodekind_ref e in | |
1409 | match Ast0.unwrap e with | |
1410 | Ast0.Idots(d,whencode) -> | |
97111a47 | 1411 | (*don't recurse because whencode hasn't been processed by context_neg*) |
34e49164 C |
1412 | update_mc mcodekind e; Ast0.rewrap e (Ast0.Idots(mcode d,whencode)) |
1413 | | _ -> donothing r k e in | |
faf9a90c | 1414 | |
34e49164 C |
1415 | let dots r k e = |
1416 | let info = Ast0.get_info e in | |
1417 | let mcodekind = Ast0.get_mcodekind_ref e in | |
1418 | match Ast0.unwrap e with | |
1419 | Ast0.DOTS([]) -> | |
1420 | (* if context is - this should be - as well. There are no tokens | |
1421 | here though, so the bottom-up minusifier in context_neg leaves it | |
485bce71 C |
1422 | as mixed (or context for sgrep2). It would be better to fix |
1423 | context_neg, but that would | |
34e49164 C |
1424 | require a special case for each term with a dots subterm. *) |
1425 | (match !mcodekind with | |
485bce71 | 1426 | Ast0.MIXED(mc) | Ast0.CONTEXT(mc) -> |
34e49164 C |
1427 | (match !mc with |
1428 | (Ast.NOTHING,_,_) -> | |
8babbc8f C |
1429 | mcodekind := |
1430 | Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info)); | |
34e49164 C |
1431 | e |
1432 | | _ -> failwith "make_minus: unexpected befaft") | |
1433 | (* code already processed by an enclosing iso *) | |
1434 | | Ast0.MINUS(mc) -> e | |
1435 | | _ -> | |
1436 | failwith | |
1437 | (Printf.sprintf | |
485bce71 | 1438 | "%d: make_minus donothingxxx: unexpected mcodekind: %s" |
0708f913 | 1439 | info.Ast0.pos_info.Ast0.line_start (Dumper.dump e))) |
34e49164 | 1440 | | _ -> donothing r k e in |
faf9a90c | 1441 | |
b1b2de81 | 1442 | V0.flat_rebuilder |
34e49164 | 1443 | mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode |
34e49164 C |
1444 | dots dots dots dots dots dots |
1445 | donothing expression donothing initialiser donothing declaration | |
1446 | statement donothing donothing | |
faf9a90c | 1447 | |
34e49164 C |
1448 | (* --------------------------------------------------------------------- *) |
1449 | (* rebuild mcode cells in an instantiated alt *) | |
faf9a90c | 1450 | |
34e49164 C |
1451 | (* mcodes will be side effected later with plus code, so we have to copy |
1452 | them on instantiating an isomorphism. One could wonder whether it would | |
1453 | be better not to use side-effects, but they are convenient for insert_plus | |
1454 | where is it useful to manipulate a list of the mcodes but side-effect a | |
1455 | tree *) | |
1456 | (* hmm... Insert_plus is called before Iso_pattern... *) | |
1457 | let rebuild_mcode start_line = | |
1458 | let copy_mcodekind = function | |
1459 | Ast0.CONTEXT(mc) -> Ast0.CONTEXT(ref (!mc)) | |
951c7801 C |
1460 | | Ast0.MINUS(mc) -> Ast0.MINUS(ref (!mc)) |
1461 | | Ast0.MIXED(mc) -> Ast0.MIXED(ref (!mc)) | |
1462 | | Ast0.PLUS count -> | |
34e49164 C |
1463 | (* this function is used elsewhere where we need to rebuild the |
1464 | indices, and so we allow PLUS code as well *) | |
97111a47 | 1465 | Ast0.PLUS count in |
faf9a90c | 1466 | |
708f4980 | 1467 | let mcode (term,arity,info,mcodekind,pos,adj) = |
34e49164 C |
1468 | let info = |
1469 | match start_line with | |
0708f913 C |
1470 | Some x -> |
1471 | let new_pos_info = | |
1472 | {info.Ast0.pos_info with | |
1473 | Ast0.line_start = x; | |
1474 | Ast0.line_end = x; } in | |
1475 | {info with Ast0.pos_info = new_pos_info} | |
34e49164 | 1476 | | None -> info in |
708f4980 | 1477 | (term,arity,info,copy_mcodekind mcodekind,pos,adj) in |
faf9a90c | 1478 | |
34e49164 C |
1479 | let copy_one x = |
1480 | let old_info = Ast0.get_info x in | |
1481 | let info = | |
1482 | match start_line with | |
0708f913 C |
1483 | Some x -> |
1484 | let new_pos_info = | |
1485 | {old_info.Ast0.pos_info with | |
1486 | Ast0.line_start = x; | |
1487 | Ast0.line_end = x; } in | |
1488 | {old_info with Ast0.pos_info = new_pos_info} | |
34e49164 C |
1489 | | None -> old_info in |
1490 | {x with Ast0.info = info; Ast0.index = ref(Ast0.get_index x); | |
1491 | Ast0.mcodekind = ref (copy_mcodekind (Ast0.get_mcodekind x))} in | |
faf9a90c | 1492 | |
34e49164 | 1493 | let donothing r k e = copy_one (k e) in |
faf9a90c | 1494 | |
34e49164 C |
1495 | (* case for control operators (if, etc) *) |
1496 | let statement r k e = | |
1497 | let s = k e in | |
1498 | let res = | |
1499 | copy_one | |
1500 | (Ast0.rewrap s | |
1501 | (match Ast0.unwrap s with | |
1502 | Ast0.Decl((info,mc),decl) -> | |
1503 | Ast0.Decl((info,copy_mcodekind mc),decl) | |
1504 | | Ast0.IfThen(iff,lp,tst,rp,branch,(info,mc)) -> | |
1505 | Ast0.IfThen(iff,lp,tst,rp,branch,(info,copy_mcodekind mc)) | |
1506 | | Ast0.IfThenElse(iff,lp,tst,rp,branch1,els,branch2,(info,mc)) -> | |
1507 | Ast0.IfThenElse(iff,lp,tst,rp,branch1,els,branch2, | |
1508 | (info,copy_mcodekind mc)) | |
1509 | | Ast0.While(whl,lp,exp,rp,body,(info,mc)) -> | |
1510 | Ast0.While(whl,lp,exp,rp,body,(info,copy_mcodekind mc)) | |
1511 | | Ast0.For(fr,lp,e1,sem1,e2,sem2,e3,rp,body,(info,mc)) -> | |
1512 | Ast0.For(fr,lp,e1,sem1,e2,sem2,e3,rp,body, | |
1513 | (info,copy_mcodekind mc)) | |
1514 | | Ast0.Iterator(nm,lp,args,rp,body,(info,mc)) -> | |
1515 | Ast0.Iterator(nm,lp,args,rp,body,(info,copy_mcodekind mc)) | |
1516 | | Ast0.FunDecl | |
1517 | ((info,mc),fninfo,name,lp,params,rp,lbrace,body,rbrace) -> | |
1518 | Ast0.FunDecl | |
1519 | ((info,copy_mcodekind mc), | |
1520 | fninfo,name,lp,params,rp,lbrace,body,rbrace) | |
1521 | | s -> s)) in | |
1522 | Ast0.set_dots_bef_aft res | |
1523 | (match Ast0.get_dots_bef_aft res with | |
1524 | Ast0.NoDots -> Ast0.NoDots | |
1525 | | Ast0.AddingBetweenDots s -> | |
b1b2de81 | 1526 | Ast0.AddingBetweenDots(r.VT0.rebuilder_rec_statement s) |
34e49164 | 1527 | | Ast0.DroppingBetweenDots s -> |
b1b2de81 | 1528 | Ast0.DroppingBetweenDots(r.VT0.rebuilder_rec_statement s)) in |
faf9a90c | 1529 | |
b1b2de81 | 1530 | V0.flat_rebuilder |
34e49164 | 1531 | mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode |
34e49164 C |
1532 | donothing donothing donothing donothing donothing donothing |
1533 | donothing donothing donothing donothing donothing | |
1534 | donothing statement donothing donothing | |
faf9a90c | 1535 | |
34e49164 C |
1536 | (* --------------------------------------------------------------------- *) |
1537 | (* The problem of whencode. If an isomorphism contains dots in multiple | |
1538 | rules, then the code that is matched cannot contain whencode, because we | |
1539 | won't know which dots it goes with. Should worry about nests, but they | |
1540 | aren't allowed in isomorphisms for the moment. *) | |
faf9a90c | 1541 | |
34e49164 | 1542 | let count_edots = |
34e49164 C |
1543 | let option_default = 0 in |
1544 | let bind x y = x + y in | |
34e49164 C |
1545 | let exprfn r k e = |
1546 | match Ast0.unwrap e with | |
1547 | Ast0.Edots(_,_) | Ast0.Ecircles(_,_) | Ast0.Estars(_,_) -> 1 | |
1548 | | _ -> 0 in | |
faf9a90c | 1549 | |
34e49164 | 1550 | V0.combiner bind option_default |
b1b2de81 | 1551 | {V0.combiner_functions with VT0.combiner_exprfn = exprfn} |
faf9a90c | 1552 | |
34e49164 | 1553 | let count_idots = |
34e49164 C |
1554 | let option_default = 0 in |
1555 | let bind x y = x + y in | |
34e49164 C |
1556 | let initfn r k e = |
1557 | match Ast0.unwrap e with Ast0.Idots(_,_) -> 1 | _ -> 0 in | |
faf9a90c | 1558 | |
34e49164 | 1559 | V0.combiner bind option_default |
b1b2de81 | 1560 | {V0.combiner_functions with VT0.combiner_initfn = initfn} |
faf9a90c | 1561 | |
34e49164 | 1562 | let count_dots = |
34e49164 C |
1563 | let option_default = 0 in |
1564 | let bind x y = x + y in | |
34e49164 C |
1565 | let stmtfn r k e = |
1566 | match Ast0.unwrap e with | |
1567 | Ast0.Dots(_,_) | Ast0.Circles(_,_) | Ast0.Stars(_,_) -> 1 | |
1568 | | _ -> 0 in | |
faf9a90c | 1569 | |
34e49164 | 1570 | V0.combiner bind option_default |
b1b2de81 | 1571 | {V0.combiner_functions with VT0.combiner_stmtfn = stmtfn} |
faf9a90c | 1572 | |
34e49164 | 1573 | (* --------------------------------------------------------------------- *) |
faf9a90c | 1574 | |
34e49164 C |
1575 | let lookup name bindings mv_bindings = |
1576 | try Common.Left (List.assoc (term name) bindings) | |
1577 | with | |
1578 | Not_found -> | |
1579 | (* failure is not possible anymore *) | |
1580 | Common.Right (List.assoc (term name) mv_bindings) | |
1581 | ||
1582 | (* mv_bindings is for the fresh metavariables that are introduced by the | |
97111a47 | 1583 | isomorphism *) |
34e49164 C |
1584 | let instantiate bindings mv_bindings = |
1585 | let mcode x = | |
17ba0788 C |
1586 | let (hidden,others) = |
1587 | List.partition | |
1588 | (function Ast0.HiddenVarTag _ -> true | _ -> false) | |
1589 | (Ast0.get_pos x) in | |
8f657093 | 1590 | let new_names = |
17ba0788 C |
1591 | match hidden with |
1592 | [Ast0.HiddenVarTag([Ast0.MetaPosTag(Ast0.MetaPos (name,_,_))])] -> | |
1593 | (try | |
1594 | (* not at all sure that this is good enough *) | |
1595 | match lookup name bindings mv_bindings with | |
1596 | Common.Left(Ast0.HiddenVarTag(ids)) -> ids | |
1597 | | _ -> failwith "not possible" | |
1598 | with Not_found -> | |
1599 | (*can't fail because checks_needed could be false?*) | |
1600 | []) | |
1601 | | [] -> [] (* no hidden metavars allowed *) | |
1602 | | _ -> failwith "badly compiled mcode" in | |
1603 | Ast0.set_pos (new_names@others) x in | |
34e49164 C |
1604 | let donothing r k e = k e in |
1605 | ||
1606 | (* cases where metavariables can occur *) | |
1607 | let identfn r k e = | |
1608 | let e = k e in | |
1609 | match Ast0.unwrap e with | |
8babbc8f | 1610 | Ast0.MetaId(name,constraints,seed,pure) -> |
b1b2de81 | 1611 | (rebuild_mcode None).VT0.rebuilder_rec_ident |
34e49164 C |
1612 | (match lookup name bindings mv_bindings with |
1613 | Common.Left(Ast0.IdentTag(id)) -> id | |
1614 | | Common.Left(_) -> failwith "not possible 1" | |
1615 | | Common.Right(new_mv) -> | |
1616 | Ast0.rewrap e | |
1617 | (Ast0.MetaId | |
8babbc8f | 1618 | (Ast0.set_mcode_data new_mv name,constraints,seed,pure))) |
34e49164 C |
1619 | | Ast0.MetaFunc(name,_,pure) -> failwith "metafunc not supported" |
1620 | | Ast0.MetaLocalFunc(name,_,pure) -> failwith "metalocalfunc not supported" | |
1621 | | _ -> e in | |
1622 | ||
1623 | (* case for list metavariables *) | |
1624 | let rec elist r same_dots = function | |
1625 | [] -> [] | |
1626 | | [x] -> | |
1627 | (match Ast0.unwrap x with | |
1628 | Ast0.MetaExprList(name,lenname,pure) -> | |
1629 | failwith "meta_expr_list in iso not supported" | |
1630 | (*match lookup name bindings mv_bindings with | |
1631 | Common.Left(Ast0.DotsExprTag(exp)) -> | |
1632 | (match same_dots exp with | |
1633 | Some l -> l | |
1634 | | None -> failwith "dots put in incompatible context") | |
1635 | | Common.Left(Ast0.ExprTag(exp)) -> [exp] | |
1636 | | Common.Left(_) -> failwith "not possible 1" | |
1637 | | Common.Right(new_mv) -> | |
1638 | failwith "MetaExprList in SP not supported"*) | |
b1b2de81 C |
1639 | | _ -> [r.VT0.rebuilder_rec_expression x]) |
1640 | | x::xs -> (r.VT0.rebuilder_rec_expression x)::(elist r same_dots xs) in | |
34e49164 C |
1641 | |
1642 | let rec plist r same_dots = function | |
1643 | [] -> [] | |
1644 | | [x] -> | |
1645 | (match Ast0.unwrap x with | |
1646 | Ast0.MetaParamList(name,lenname,pure) -> | |
1647 | failwith "meta_param_list in iso not supported" | |
1648 | (*match lookup name bindings mv_bindings with | |
97111a47 | 1649 | Common.Left(Ast0.DotsParamTag(param)) -> |
34e49164 | 1650 | (match same_dots param with |
97111a47 | 1651 | Some l -> l |
34e49164 | 1652 | | None -> failwith "dots put in incompatible context") |
97111a47 C |
1653 | | Common.Left(Ast0.ParamTag(param)) -> [param] |
1654 | | Common.Left(_) -> failwith "not possible 1" | |
1655 | | Common.Right(new_mv) -> | |
34e49164 | 1656 | failwith "MetaExprList in SP not supported"*) |
b1b2de81 C |
1657 | | _ -> [r.VT0.rebuilder_rec_parameter x]) |
1658 | | x::xs -> (r.VT0.rebuilder_rec_parameter x)::(plist r same_dots xs) in | |
34e49164 C |
1659 | |
1660 | let rec slist r same_dots = function | |
1661 | [] -> [] | |
1662 | | [x] -> | |
1663 | (match Ast0.unwrap x with | |
1664 | Ast0.MetaStmtList(name,pure) -> | |
1665 | (match lookup name bindings mv_bindings with | |
1666 | Common.Left(Ast0.DotsStmtTag(stm)) -> | |
1667 | (match same_dots stm with | |
1668 | Some l -> l | |
1669 | | None -> failwith "dots put in incompatible context") | |
1670 | | Common.Left(Ast0.StmtTag(stm)) -> [stm] | |
1671 | | Common.Left(_) -> failwith "not possible 1" | |
1672 | | Common.Right(new_mv) -> | |
1673 | failwith "MetaExprList in SP not supported") | |
b1b2de81 C |
1674 | | _ -> [r.VT0.rebuilder_rec_statement x]) |
1675 | | x::xs -> (r.VT0.rebuilder_rec_statement x)::(slist r same_dots xs) in | |
34e49164 C |
1676 | |
1677 | let same_dots d = | |
1678 | match Ast0.unwrap d with Ast0.DOTS(l) -> Some l |_ -> None in | |
1679 | let same_circles d = | |
1680 | match Ast0.unwrap d with Ast0.CIRCLES(l) -> Some l |_ -> None in | |
1681 | let same_stars d = | |
1682 | match Ast0.unwrap d with Ast0.STARS(l) -> Some l |_ -> None in | |
1683 | ||
1684 | let dots list_fn r k d = | |
1685 | Ast0.rewrap d | |
1686 | (match Ast0.unwrap d with | |
1687 | Ast0.DOTS(l) -> Ast0.DOTS(list_fn r same_dots l) | |
1688 | | Ast0.CIRCLES(l) -> Ast0.CIRCLES(list_fn r same_circles l) | |
1689 | | Ast0.STARS(l) -> Ast0.STARS(list_fn r same_stars l)) in | |
1690 | ||
1691 | let exprfn r k old_e = (* need to keep the original code for ! optim *) | |
1692 | let e = k old_e in | |
1693 | let e1 = | |
1694 | match Ast0.unwrap e with | |
1695 | Ast0.MetaExpr(name,constraints,x,form,pure) -> | |
b1b2de81 | 1696 | (rebuild_mcode None).VT0.rebuilder_rec_expression |
34e49164 C |
1697 | (match lookup name bindings mv_bindings with |
1698 | Common.Left(Ast0.ExprTag(exp)) -> exp | |
1699 | | Common.Left(_) -> failwith "not possible 1" | |
1700 | | Common.Right(new_mv) -> | |
1701 | let new_types = | |
1702 | match x with | |
1703 | None -> None | |
1704 | | Some types -> | |
1705 | let rec renamer = function | |
1706 | Type_cocci.MetaType(name,keep,inherited) -> | |
1707 | (match | |
97111a47 C |
1708 | lookup (name,(),(),(),None,-1) |
1709 | bindings mv_bindings | |
34e49164 C |
1710 | with |
1711 | Common.Left(Ast0.TypeCTag(t)) -> | |
1712 | Ast0.ast0_type_to_type t | |
1713 | | Common.Left(_) -> | |
1714 | failwith "iso pattern: unexpected type" | |
1715 | | Common.Right(new_mv) -> | |
1716 | Type_cocci.MetaType(new_mv,keep,inherited)) | |
1717 | | Type_cocci.ConstVol(cv,ty) -> | |
1718 | Type_cocci.ConstVol(cv,renamer ty) | |
1719 | | Type_cocci.Pointer(ty) -> | |
1720 | Type_cocci.Pointer(renamer ty) | |
1721 | | Type_cocci.FunctionPointer(ty) -> | |
1722 | Type_cocci.FunctionPointer(renamer ty) | |
1723 | | Type_cocci.Array(ty) -> | |
1724 | Type_cocci.Array(renamer ty) | |
1725 | | t -> t in | |
1726 | Some(List.map renamer types) in | |
1727 | Ast0.rewrap e | |
1728 | (Ast0.MetaExpr | |
1729 | (Ast0.set_mcode_data new_mv name,constraints, | |
1730 | new_types,form,pure))) | |
1731 | | Ast0.MetaErr(namea,_,pure) -> failwith "metaerr not supported" | |
1732 | | Ast0.MetaExprList(namea,lenname,pure) -> | |
1733 | failwith "metaexprlist not supported" | |
1734 | | Ast0.Unary(exp,unop) -> | |
1735 | (match Ast0.unwrap_mcode unop with | |
fc1ad971 C |
1736 | (* propagate negation only when the propagated and the encountered |
1737 | negation have the same transformation, when there is nothing | |
1738 | added to the original one, and when there is nothing added to | |
1739 | the expression into which we are doing the propagation. This | |
1740 | may be too conservative. *) | |
34e49164 C |
1741 | Ast.Not -> |
1742 | let was_meta = | |
1743 | (* k e doesn't change the outer structure of the term, | |
1744 | only the metavars *) | |
1745 | match Ast0.unwrap old_e with | |
1746 | Ast0.Unary(exp,_) -> | |
1747 | (match Ast0.unwrap exp with | |
1748 | Ast0.MetaExpr(name,constraints,x,form,pure) -> true | |
1749 | | _ -> false) | |
1750 | | _ -> failwith "not possible" in | |
fc1ad971 | 1751 | let nomodif = function |
34e49164 C |
1752 | Ast0.MINUS(x) -> |
1753 | (match !x with | |
8babbc8f | 1754 | (Ast.NOREPLACEMENT,_) -> true |
34e49164 C |
1755 | | _ -> false) |
1756 | | Ast0.CONTEXT(x) | Ast0.MIXED(x) -> | |
1757 | (match !x with | |
1758 | (Ast.NOTHING,_,_) -> true | |
1759 | | _ -> false) | |
1760 | | _ -> failwith "plus not possible" in | |
fc1ad971 C |
1761 | let same_modif newop oldop = |
1762 | (* only propagate ! is they have the same modification | |
1763 | and no + code on the old one (the new one from the iso | |
1764 | surely has no + code) *) | |
1765 | match (newop,oldop) with | |
1766 | (Ast0.MINUS(x1),Ast0.MINUS(x2)) -> nomodif oldop | |
97111a47 C |
1767 | | (Ast0.CONTEXT(x1),Ast0.CONTEXT(x2)) -> nomodif oldop |
1768 | | (Ast0.MIXED(x1),Ast0.MIXED(x2)) -> nomodif oldop | |
1769 | | _ -> false in | |
fc1ad971 | 1770 | if was_meta |
34e49164 | 1771 | then |
91eba41f C |
1772 | let idcont x = x in |
1773 | let rec negate e (*for rewrapping*) res (*code to process*) k = | |
1774 | (* k accumulates parens, to keep negation outside if no | |
1775 | propagation is possible *) | |
fc1ad971 C |
1776 | if nomodif (Ast0.get_mcodekind e) |
1777 | then | |
1778 | match Ast0.unwrap res with | |
1779 | Ast0.Unary(e1,op) when Ast0.unwrap_mcode op = Ast.Not && | |
1780 | same_modif | |
1781 | (Ast0.get_mcode_mcodekind unop) | |
1782 | (Ast0.get_mcode_mcodekind op) -> | |
1783 | k e1 | |
1784 | | Ast0.Edots(_,_) -> k (Ast0.rewrap e (Ast0.unwrap res)) | |
951c7801 C |
1785 | | Ast0.Paren(lp,e1,rp) -> |
1786 | negate e e1 | |
fc1ad971 C |
1787 | (function x -> |
1788 | k (Ast0.rewrap res (Ast0.Paren(lp,x,rp)))) | |
1789 | | Ast0.Binary(e1,op,e2) when | |
1790 | same_modif | |
1791 | (Ast0.get_mcode_mcodekind unop) | |
c3e37e97 | 1792 | (Ast0.get_mcode_mcodekind op) -> |
fc1ad971 C |
1793 | let reb nop = |
1794 | Ast0.rewrap_mcode op (Ast.Logical(nop)) in | |
1795 | let k1 x = k (Ast0.rewrap e x) in | |
1796 | (match Ast0.unwrap_mcode op with | |
1797 | Ast.Logical(Ast.Inf) -> | |
1798 | k1 (Ast0.Binary(e1,reb Ast.SupEq,e2)) | |
1799 | | Ast.Logical(Ast.Sup) -> | |
1800 | k1 (Ast0.Binary(e1,reb Ast.InfEq,e2)) | |
1801 | | Ast.Logical(Ast.InfEq) -> | |
1802 | k1 (Ast0.Binary(e1,reb Ast.Sup,e2)) | |
1803 | | Ast.Logical(Ast.SupEq) -> | |
1804 | k1 (Ast0.Binary(e1,reb Ast.Inf,e2)) | |
1805 | | Ast.Logical(Ast.Eq) -> | |
1806 | k1 (Ast0.Binary(e1,reb Ast.NotEq,e2)) | |
1807 | | Ast.Logical(Ast.NotEq) -> | |
1808 | k1 (Ast0.Binary(e1,reb Ast.Eq,e2)) | |
1809 | | Ast.Logical(Ast.AndLog) -> | |
c3e37e97 | 1810 | k1 (Ast0.Binary(negate_reb e e1 idcont, |
fc1ad971 | 1811 | reb Ast.OrLog, |
c3e37e97 | 1812 | negate_reb e e2 idcont)) |
fc1ad971 | 1813 | | Ast.Logical(Ast.OrLog) -> |
c3e37e97 | 1814 | k1 (Ast0.Binary(negate_reb e e1 idcont, |
fc1ad971 | 1815 | reb Ast.AndLog, |
c3e37e97 | 1816 | negate_reb e e2 idcont)) |
fc1ad971 C |
1817 | | _ -> |
1818 | Ast0.rewrap e | |
1819 | (Ast0.Unary(k res, | |
1820 | Ast0.rewrap_mcode op Ast.Not))) | |
1821 | | Ast0.DisjExpr(lp,exps,mids,rp) -> | |
34e49164 | 1822 | (* use res because it is the transformed argument *) |
c3e37e97 C |
1823 | let exps = |
1824 | List.map (function e1 -> negate_reb e e1 k) exps in | |
fc1ad971 C |
1825 | Ast0.rewrap res (Ast0.DisjExpr(lp,exps,mids,rp)) |
1826 | | _ -> | |
34e49164 | 1827 | (*use e, because this might be the toplevel expression*) |
fc1ad971 C |
1828 | Ast0.rewrap e |
1829 | (Ast0.Unary(k res,Ast0.rewrap_mcode unop Ast.Not)) | |
1830 | else | |
1831 | Ast0.rewrap e | |
c3e37e97 C |
1832 | (Ast0.Unary(k res,Ast0.rewrap_mcode unop Ast.Not)) |
1833 | and negate_reb e e1 k = | |
1834 | (* used when ! is propagated to multiple places, to avoid | |
1835 | duplicating mcode cells *) | |
1836 | let start_line = | |
1837 | Some ((Ast0.get_info e).Ast0.pos_info.Ast0.line_start) in | |
1838 | (rebuild_mcode start_line).VT0.rebuilder_rec_expression | |
1839 | (negate e e1 k) in | |
91eba41f | 1840 | negate e exp idcont |
34e49164 C |
1841 | else e |
1842 | | _ -> e) | |
1843 | | Ast0.Edots(d,_) -> | |
1844 | (try | |
1845 | (match List.assoc (dot_term d) bindings with | |
1846 | Ast0.ExprTag(exp) -> Ast0.rewrap e (Ast0.Edots(d,Some exp)) | |
1847 | | _ -> failwith "unexpected binding") | |
1848 | with Not_found -> e) | |
1849 | | Ast0.Ecircles(d,_) -> | |
1850 | (try | |
1851 | (match List.assoc (dot_term d) bindings with | |
1852 | Ast0.ExprTag(exp) -> Ast0.rewrap e (Ast0.Ecircles(d,Some exp)) | |
1853 | | _ -> failwith "unexpected binding") | |
1854 | with Not_found -> e) | |
1855 | | Ast0.Estars(d,_) -> | |
1856 | (try | |
1857 | (match List.assoc (dot_term d) bindings with | |
1858 | Ast0.ExprTag(exp) -> Ast0.rewrap e (Ast0.Estars(d,Some exp)) | |
1859 | | _ -> failwith "unexpected binding") | |
1860 | with Not_found -> e) | |
1861 | | _ -> e in | |
1862 | if Ast0.get_test_exp old_e then Ast0.set_test_exp e1 else e1 in | |
1863 | ||
1864 | let tyfn r k e = | |
1865 | let e = k e in | |
1866 | match Ast0.unwrap e with | |
1867 | Ast0.MetaType(name,pure) -> | |
b1b2de81 | 1868 | (rebuild_mcode None).VT0.rebuilder_rec_typeC |
34e49164 C |
1869 | (match lookup name bindings mv_bindings with |
1870 | Common.Left(Ast0.TypeCTag(ty)) -> ty | |
1871 | | Common.Left(_) -> failwith "not possible 1" | |
1872 | | Common.Right(new_mv) -> | |
1873 | Ast0.rewrap e | |
1874 | (Ast0.MetaType(Ast0.set_mcode_data new_mv name,pure))) | |
1875 | | _ -> e in | |
1876 | ||
113803cf C |
1877 | let initfn r k e = |
1878 | let e = k e in | |
1879 | match Ast0.unwrap e with | |
1880 | Ast0.MetaInit(name,pure) -> | |
b1b2de81 | 1881 | (rebuild_mcode None).VT0.rebuilder_rec_initialiser |
113803cf C |
1882 | (match lookup name bindings mv_bindings with |
1883 | Common.Left(Ast0.InitTag(ty)) -> ty | |
1884 | | Common.Left(_) -> failwith "not possible 1" | |
1885 | | Common.Right(new_mv) -> | |
1886 | Ast0.rewrap e | |
1887 | (Ast0.MetaInit(Ast0.set_mcode_data new_mv name,pure))) | |
1888 | | _ -> e in | |
1889 | ||
34e49164 C |
1890 | let declfn r k e = |
1891 | let e = k e in | |
1892 | match Ast0.unwrap e with | |
413ffc02 C |
1893 | Ast0.MetaDecl(name,pure) -> |
1894 | (rebuild_mcode None).VT0.rebuilder_rec_declaration | |
1895 | (match lookup name bindings mv_bindings with | |
1896 | Common.Left(Ast0.DeclTag(d)) -> d | |
1897 | | Common.Left(_) -> failwith "not possible 1" | |
1898 | | Common.Right(new_mv) -> | |
1899 | Ast0.rewrap e | |
1900 | (Ast0.MetaDecl(Ast0.set_mcode_data new_mv name, pure))) | |
1901 | | Ast0.MetaField(name,pure) -> | |
1902 | (rebuild_mcode None).VT0.rebuilder_rec_declaration | |
1903 | (match lookup name bindings mv_bindings with | |
1904 | Common.Left(Ast0.DeclTag(d)) -> d | |
1905 | | Common.Left(_) -> failwith "not possible 1" | |
1906 | | Common.Right(new_mv) -> | |
1907 | Ast0.rewrap e | |
1908 | (Ast0.MetaField(Ast0.set_mcode_data new_mv name, pure))) | |
190f1acf C |
1909 | | Ast0.MetaFieldList(name,lenname,pure) -> |
1910 | failwith "metafieldlist not supported" | |
413ffc02 | 1911 | | Ast0.Ddots(d,_) -> |
34e49164 C |
1912 | (try |
1913 | (match List.assoc (dot_term d) bindings with | |
1914 | Ast0.DeclTag(exp) -> Ast0.rewrap e (Ast0.Ddots(d,Some exp)) | |
1915 | | _ -> failwith "unexpected binding") | |
1916 | with Not_found -> e) | |
1917 | | _ -> e in | |
1918 | ||
1919 | let paramfn r k e = | |
1920 | let e = k e in | |
1921 | match Ast0.unwrap e with | |
1922 | Ast0.MetaParam(name,pure) -> | |
b1b2de81 | 1923 | (rebuild_mcode None).VT0.rebuilder_rec_parameter |
34e49164 C |
1924 | (match lookup name bindings mv_bindings with |
1925 | Common.Left(Ast0.ParamTag(param)) -> param | |
1926 | | Common.Left(_) -> failwith "not possible 1" | |
1927 | | Common.Right(new_mv) -> | |
1928 | Ast0.rewrap e | |
1929 | (Ast0.MetaParam(Ast0.set_mcode_data new_mv name, pure))) | |
1930 | | Ast0.MetaParamList(name,lenname,pure) -> | |
1931 | failwith "metaparamlist not supported" | |
1932 | | _ -> e in | |
1933 | ||
1be43e12 C |
1934 | let whenfn (_,v) = |
1935 | match v with | |
1936 | Ast0.DotsStmtTag(stms) -> Ast0.WhenNot stms | |
1937 | | Ast0.StmtTag(stm) -> Ast0.WhenAlways stm | |
1938 | | Ast0.IsoWhenTTag(stm) -> Ast0.WhenNotTrue stm | |
1939 | | Ast0.IsoWhenFTag(stm) -> Ast0.WhenNotFalse stm | |
1940 | | Ast0.IsoWhenTag(x) -> Ast0.WhenModifier(x) | |
1941 | | _ -> failwith "unexpected binding" in | |
1942 | ||
34e49164 C |
1943 | let stmtfn r k e = |
1944 | let e = k e in | |
1945 | match Ast0.unwrap e with | |
413ffc02 | 1946 | Ast0.MetaStmt(name,pure) -> |
b1b2de81 | 1947 | (rebuild_mcode None).VT0.rebuilder_rec_statement |
34e49164 C |
1948 | (match lookup name bindings mv_bindings with |
1949 | Common.Left(Ast0.StmtTag(stm)) -> stm | |
1950 | | Common.Left(_) -> failwith "not possible 1" | |
1951 | | Common.Right(new_mv) -> | |
1952 | Ast0.rewrap e | |
1953 | (Ast0.MetaStmt(Ast0.set_mcode_data new_mv name,pure))) | |
1954 | | Ast0.MetaStmtList(name,pure) -> failwith "metastmtlist not supported" | |
1955 | | Ast0.Dots(d,_) -> | |
1956 | Ast0.rewrap e | |
1957 | (Ast0.Dots | |
1958 | (d, | |
1be43e12 | 1959 | List.map whenfn |
34e49164 C |
1960 | (List.filter (function (x,v) -> x = (dot_term d)) bindings))) |
1961 | | Ast0.Circles(d,_) -> | |
1962 | Ast0.rewrap e | |
1963 | (Ast0.Circles | |
1964 | (d, | |
1be43e12 | 1965 | List.map whenfn |
34e49164 C |
1966 | (List.filter (function (x,v) -> x = (dot_term d)) bindings))) |
1967 | | Ast0.Stars(d,_) -> | |
1968 | Ast0.rewrap e | |
1969 | (Ast0.Stars | |
1970 | (d, | |
1be43e12 | 1971 | List.map whenfn |
34e49164 C |
1972 | (List.filter (function (x,v) -> x = (dot_term d)) bindings))) |
1973 | | _ -> e in | |
1974 | ||
b1b2de81 | 1975 | V0.flat_rebuilder |
34e49164 | 1976 | mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode |
34e49164 | 1977 | (dots elist) donothing (dots plist) (dots slist) donothing donothing |
113803cf | 1978 | identfn exprfn tyfn initfn paramfn declfn stmtfn donothing donothing |
34e49164 C |
1979 | |
1980 | (* --------------------------------------------------------------------- *) | |
1981 | ||
1982 | let is_minus e = | |
1983 | match Ast0.get_mcodekind e with Ast0.MINUS(cell) -> true | _ -> false | |
1984 | ||
1985 | let context_required e = not(is_minus e) && not !Flag.sgrep_mode2 | |
1986 | ||
1987 | let disj_fail bindings e = | |
1988 | match bindings with | |
1989 | Some x -> Printf.fprintf stderr "no disj available at this type"; e | |
1990 | | None -> e | |
1991 | ||
1992 | (* isomorphism code is by default CONTEXT *) | |
1993 | let merge_plus model_mcode e_mcode = | |
1994 | match model_mcode with | |
1995 | Ast0.MINUS(mc) -> | |
1996 | (* add the replacement information at the root *) | |
1997 | (match e_mcode with | |
1998 | Ast0.MINUS(emc) -> | |
1999 | emc := | |
2000 | (match (!mc,!emc) with | |
8babbc8f C |
2001 | ((Ast.NOREPLACEMENT,_),(x,t)) |
2002 | | ((x,_),(Ast.NOREPLACEMENT,t)) -> (x,t) | |
34e49164 C |
2003 | | _ -> failwith "how can we combine minuses?") |
2004 | | _ -> failwith "not possible 6") | |
2005 | | Ast0.CONTEXT(mc) -> | |
2006 | (match e_mcode with | |
2007 | Ast0.CONTEXT(emc) -> | |
2008 | (* keep the logical line info as in the model *) | |
2009 | let (mba,tb,ta) = !mc in | |
2010 | let (eba,_,_) = !emc in | |
2011 | (* merging may be required when a term is replaced by a subterm *) | |
2012 | let merged = | |
2013 | match (mba,eba) with | |
2014 | (x,Ast.NOTHING) | (Ast.NOTHING,x) -> x | |
951c7801 C |
2015 | | (Ast.BEFORE(b1,it1),Ast.BEFORE(b2,it2)) -> |
2016 | Ast.BEFORE(b1@b2,Ast.lub_count it1 it2) | |
2017 | | (Ast.BEFORE(b,it1),Ast.AFTER(a,it2)) -> | |
2018 | Ast.BEFOREAFTER(b,a,Ast.lub_count it1 it2) | |
2019 | | (Ast.BEFORE(b1,it1),Ast.BEFOREAFTER(b2,a,it2)) -> | |
2020 | Ast.BEFOREAFTER(b1@b2,a,Ast.lub_count it1 it2) | |
2021 | | (Ast.AFTER(a,it1),Ast.BEFORE(b,it2)) -> | |
2022 | Ast.BEFOREAFTER(b,a,Ast.lub_count it1 it2) | |
2023 | | (Ast.AFTER(a1,it1),Ast.AFTER(a2,it2)) -> | |
2024 | Ast.AFTER(a2@a1,Ast.lub_count it1 it2) | |
2025 | | (Ast.AFTER(a1,it1),Ast.BEFOREAFTER(b,a2,it2)) -> | |
2026 | Ast.BEFOREAFTER(b,a2@a1,Ast.lub_count it1 it2) | |
2027 | | (Ast.BEFOREAFTER(b1,a,it1),Ast.BEFORE(b2,it2)) -> | |
2028 | Ast.BEFOREAFTER(b1@b2,a,Ast.lub_count it1 it2) | |
2029 | | (Ast.BEFOREAFTER(b,a1,it1),Ast.AFTER(a2,it2)) -> | |
2030 | Ast.BEFOREAFTER(b,a2@a1,Ast.lub_count it1 it2) | |
2031 | | (Ast.BEFOREAFTER(b1,a1,it1),Ast.BEFOREAFTER(b2,a2,it2)) -> | |
97111a47 | 2032 | Ast.BEFOREAFTER(b1@b2,a2@a1,Ast.lub_count it1 it2) in |
34e49164 C |
2033 | emc := (merged,tb,ta) |
2034 | | Ast0.MINUS(emc) -> | |
2035 | let (anything_bef_aft,_,_) = !mc in | |
2036 | let (anythings,t) = !emc in | |
8babbc8f C |
2037 | (match (anything_bef_aft,anythings) with |
2038 | (Ast.BEFORE(b1,it1),Ast.NOREPLACEMENT) -> | |
2039 | emc := (Ast.REPLACEMENT(b1,it1),t) | |
2040 | | (Ast.AFTER(a1,it1),Ast.NOREPLACEMENT) -> | |
2041 | emc := (Ast.REPLACEMENT(a1,it1),t) | |
2042 | | (Ast.BEFOREAFTER(b1,a1,it1),Ast.NOREPLACEMENT) -> | |
2043 | emc := (Ast.REPLACEMENT(b1@a1,it1),t) | |
2044 | | (Ast.NOTHING,Ast.NOREPLACEMENT) -> | |
2045 | emc := (Ast.NOREPLACEMENT,t) | |
2046 | | (Ast.BEFORE(b1,it1),Ast.REPLACEMENT(a2,it2)) -> | |
2047 | emc := (Ast.REPLACEMENT(b1@a2,Ast.lub_count it1 it2),t) | |
2048 | | (Ast.AFTER(a1,it1),Ast.REPLACEMENT(a2,it2)) -> | |
2049 | emc := (Ast.REPLACEMENT(a2@a1,Ast.lub_count it1 it2),t) | |
2050 | | (Ast.BEFOREAFTER(b1,a1,it1),Ast.REPLACEMENT(a2,it2)) -> | |
2051 | emc := (Ast.REPLACEMENT(b1@a2@a1,Ast.lub_count it1 it2),t) | |
2052 | | (Ast.NOTHING,Ast.REPLACEMENT(a2,it2)) -> ()) (* no change *) | |
978fd7e5 | 2053 | | Ast0.MIXED(_) -> failwith "how did this become mixed?" |
34e49164 C |
2054 | | _ -> failwith "not possible 7") |
2055 | | Ast0.MIXED(_) -> failwith "not possible 8" | |
951c7801 | 2056 | | Ast0.PLUS _ -> failwith "not possible 9" |
34e49164 C |
2057 | |
2058 | let copy_plus printer minusify model e = | |
2059 | if !Flag.sgrep_mode2 | |
2060 | then e (* no plus code, can cause a "not possible" error, so just avoid it *) | |
2061 | else | |
c3e37e97 C |
2062 | begin |
2063 | let e = | |
2064 | match Ast0.get_mcodekind model with | |
2065 | Ast0.MINUS(mc) -> minusify e | |
2066 | | Ast0.CONTEXT(mc) -> e | |
2067 | | _ -> failwith "not possible: copy_plus\n" in | |
2068 | merge_plus (Ast0.get_mcodekind model) (Ast0.get_mcodekind e); | |
2069 | e | |
2070 | end | |
34e49164 C |
2071 | |
2072 | let copy_minus printer minusify model e = | |
2073 | match Ast0.get_mcodekind model with | |
2074 | Ast0.MINUS(mc) -> minusify e | |
2075 | | Ast0.CONTEXT(mc) -> e | |
2076 | | Ast0.MIXED(_) -> | |
2077 | if !Flag.sgrep_mode2 | |
2078 | then e | |
2079 | else failwith "not possible 8" | |
951c7801 | 2080 | | Ast0.PLUS _ -> failwith "not possible 9" |
34e49164 C |
2081 | |
2082 | let whencode_allowed prev_ecount prev_icount prev_dcount | |
2083 | ecount icount dcount rest = | |
2084 | (* actually, if ecount or dcount is 0, the flag doesn't matter, because it | |
2085 | won't be tested *) | |
2086 | let other_ecount = (* number of edots *) | |
2087 | List.fold_left (function rest -> function (_,ec,ic,dc) -> ec + rest) | |
2088 | prev_ecount rest in | |
2089 | let other_icount = (* number of dots *) | |
2090 | List.fold_left (function rest -> function (_,ec,ic,dc) -> ic + rest) | |
2091 | prev_icount rest in | |
2092 | let other_dcount = (* number of dots *) | |
2093 | List.fold_left (function rest -> function (_,ec,ic,dc) -> dc + rest) | |
2094 | prev_dcount rest in | |
2095 | (ecount = 0 or other_ecount = 0, icount = 0 or other_icount = 0, | |
2096 | dcount = 0 or other_dcount = 0) | |
2097 | ||
2098 | (* copy the befores and afters to the instantiated code *) | |
2099 | let extra_copy_stmt_plus model e = | |
2100 | (if not !Flag.sgrep_mode2 (* sgrep has no plus code, so nothing to do *) | |
2101 | then | |
2102 | (match Ast0.unwrap model with | |
2103 | Ast0.FunDecl((info,bef),_,_,_,_,_,_,_,_) | |
2104 | | Ast0.Decl((info,bef),_) -> | |
2105 | (match Ast0.unwrap e with | |
2106 | Ast0.FunDecl((info,bef1),_,_,_,_,_,_,_,_) | |
2107 | | Ast0.Decl((info,bef1),_) -> | |
2108 | merge_plus bef bef1 | |
2109 | | _ -> merge_plus bef (Ast0.get_mcodekind e)) | |
2110 | | Ast0.IfThen(_,_,_,_,_,(info,aft)) | |
2111 | | Ast0.IfThenElse(_,_,_,_,_,_,_,(info,aft)) | |
2112 | | Ast0.While(_,_,_,_,_,(info,aft)) | |
2113 | | Ast0.For(_,_,_,_,_,_,_,_,_,(info,aft)) | |
2114 | | Ast0.Iterator(_,_,_,_,_,(info,aft)) -> | |
2115 | (match Ast0.unwrap e with | |
2116 | Ast0.IfThen(_,_,_,_,_,(info,aft1)) | |
2117 | | Ast0.IfThenElse(_,_,_,_,_,_,_,(info,aft1)) | |
2118 | | Ast0.While(_,_,_,_,_,(info,aft1)) | |
2119 | | Ast0.For(_,_,_,_,_,_,_,_,_,(info,aft1)) | |
2120 | | Ast0.Iterator(_,_,_,_,_,(info,aft1)) -> | |
2121 | merge_plus aft aft1 | |
2122 | | _ -> merge_plus aft (Ast0.get_mcodekind e)) | |
2123 | | _ -> ())); | |
2124 | e | |
2125 | ||
2126 | let extra_copy_other_plus model e = e | |
2127 | ||
2128 | (* --------------------------------------------------------------------- *) | |
2129 | ||
2130 | let mv_count = ref 0 | |
2131 | let new_mv (_,s) = | |
2132 | let ct = !mv_count in | |
2133 | mv_count := !mv_count + 1; | |
2134 | "_"^s^"_"^(string_of_int ct) | |
2135 | ||
2136 | let get_name = function | |
b23ff9c7 C |
2137 | Ast.MetaMetaDecl(ar,nm) -> |
2138 | (nm,function nm -> Ast.MetaMetaDecl(ar,nm)) | |
2139 | | Ast.MetaIdDecl(ar,nm) -> | |
34e49164 | 2140 | (nm,function nm -> Ast.MetaIdDecl(ar,nm)) |
b1b2de81 C |
2141 | | Ast.MetaFreshIdDecl(nm,seed) -> |
2142 | (nm,function nm -> Ast.MetaFreshIdDecl(nm,seed)) | |
34e49164 C |
2143 | | Ast.MetaTypeDecl(ar,nm) -> |
2144 | (nm,function nm -> Ast.MetaTypeDecl(ar,nm)) | |
113803cf C |
2145 | | Ast.MetaInitDecl(ar,nm) -> |
2146 | (nm,function nm -> Ast.MetaInitDecl(ar,nm)) | |
8f657093 C |
2147 | | Ast.MetaInitListDecl(ar,nm,nm1) -> |
2148 | (nm,function nm -> Ast.MetaInitListDecl(ar,nm,nm1)) | |
34e49164 C |
2149 | | Ast.MetaListlenDecl(nm) -> |
2150 | failwith "should not be rebuilt" | |
2151 | | Ast.MetaParamDecl(ar,nm) -> | |
2152 | (nm,function nm -> Ast.MetaParamDecl(ar,nm)) | |
2153 | | Ast.MetaParamListDecl(ar,nm,nm1) -> | |
2154 | (nm,function nm -> Ast.MetaParamListDecl(ar,nm,nm1)) | |
2155 | | Ast.MetaConstDecl(ar,nm,ty) -> | |
2156 | (nm,function nm -> Ast.MetaConstDecl(ar,nm,ty)) | |
2157 | | Ast.MetaErrDecl(ar,nm) -> | |
2158 | (nm,function nm -> Ast.MetaErrDecl(ar,nm)) | |
2159 | | Ast.MetaExpDecl(ar,nm,ty) -> | |
2160 | (nm,function nm -> Ast.MetaExpDecl(ar,nm,ty)) | |
2161 | | Ast.MetaIdExpDecl(ar,nm,ty) -> | |
2162 | (nm,function nm -> Ast.MetaIdExpDecl(ar,nm,ty)) | |
2163 | | Ast.MetaLocalIdExpDecl(ar,nm,ty) -> | |
2164 | (nm,function nm -> Ast.MetaLocalIdExpDecl(ar,nm,ty)) | |
2165 | | Ast.MetaExpListDecl(ar,nm,nm1) -> | |
2166 | (nm,function nm -> Ast.MetaExpListDecl(ar,nm,nm1)) | |
413ffc02 C |
2167 | | Ast.MetaDeclDecl(ar,nm) -> |
2168 | (nm,function nm -> Ast.MetaDeclDecl(ar,nm)) | |
190f1acf C |
2169 | | Ast.MetaFieldListDecl(ar,nm,nm1) -> |
2170 | (nm,function nm -> Ast.MetaFieldListDecl(ar,nm,nm1)) | |
413ffc02 C |
2171 | | Ast.MetaFieldDecl(ar,nm) -> |
2172 | (nm,function nm -> Ast.MetaFieldDecl(ar,nm)) | |
34e49164 C |
2173 | | Ast.MetaStmDecl(ar,nm) -> |
2174 | (nm,function nm -> Ast.MetaStmDecl(ar,nm)) | |
2175 | | Ast.MetaStmListDecl(ar,nm) -> | |
2176 | (nm,function nm -> Ast.MetaStmListDecl(ar,nm)) | |
2177 | | Ast.MetaFuncDecl(ar,nm) -> | |
2178 | (nm,function nm -> Ast.MetaFuncDecl(ar,nm)) | |
2179 | | Ast.MetaLocalFuncDecl(ar,nm) -> | |
2180 | (nm,function nm -> Ast.MetaLocalFuncDecl(ar,nm)) | |
2181 | | Ast.MetaPosDecl(ar,nm) -> | |
2182 | (nm,function nm -> Ast.MetaPosDecl(ar,nm)) | |
2183 | | Ast.MetaDeclarerDecl(ar,nm) -> | |
2184 | (nm,function nm -> Ast.MetaDeclarerDecl(ar,nm)) | |
2185 | | Ast.MetaIteratorDecl(ar,nm) -> | |
2186 | (nm,function nm -> Ast.MetaIteratorDecl(ar,nm)) | |
2187 | ||
2188 | let make_new_metavars metavars bindings = | |
2189 | let new_metavars = | |
2190 | List.filter | |
2191 | (function mv -> | |
2192 | let (s,_) = get_name mv in | |
2193 | try let _ = List.assoc s bindings in false with Not_found -> true) | |
2194 | metavars in | |
2195 | List.split | |
2196 | (List.map | |
2197 | (function mv -> | |
2198 | let (s,rebuild) = get_name mv in | |
2199 | let new_s = (!current_rule,new_mv s) in | |
2200 | (rebuild new_s, (s,new_s))) | |
2201 | new_metavars) | |
2202 | ||
2203 | (* --------------------------------------------------------------------- *) | |
2204 | ||
2205 | let do_nothing x = x | |
2206 | ||
2207 | let mkdisj matcher metavars alts e instantiater mkiso disj_maker minusify | |
c3e37e97 | 2208 | rebuild_mcodes name printer extra_plus update_others has_context = |
413ffc02 | 2209 | let call_instantiate bindings mv_bindings alts pattern has_context = |
34e49164 C |
2210 | List.concat |
2211 | (List.map | |
2212 | (function (a,_,_,_) -> | |
2213 | nub | |
2214 | (* no need to create duplicates when the bindings have no effect *) | |
2215 | (List.map | |
2216 | (function bindings -> | |
c3e37e97 C |
2217 | let instantiated = |
2218 | instantiater bindings mv_bindings (rebuild_mcodes a) in | |
2219 | let plus_added = | |
2220 | if has_context (* ie if pat is not just a metavara *) | |
2221 | then | |
2222 | copy_plus printer minusify e (extra_plus e instantiated) | |
2223 | else instantiated in | |
413ffc02 C |
2224 | if pattern = a |
2225 | then plus_added | |
2226 | else (* iso tracking *) | |
c3e37e97 | 2227 | Ast0.set_iso plus_added |
b1b2de81 | 2228 | ((name,mkiso a)::(Ast0.get_iso e))) (* keep count, not U *) |
34e49164 C |
2229 | bindings)) |
2230 | alts) in | |
2231 | let rec inner_loop all_alts prev_ecount prev_icount prev_dcount = function | |
2232 | [] -> Common.Left (prev_ecount, prev_icount, prev_dcount) | |
2233 | | ((pattern,ecount,icount,dcount)::rest) -> | |
2234 | let wc = | |
2235 | whencode_allowed prev_ecount prev_icount prev_dcount | |
2236 | ecount dcount icount rest in | |
2237 | (match matcher true (context_required e) wc pattern e init_env with | |
2238 | Fail(reason) -> | |
2239 | if reason = NonMatch || not !Flag_parsing_cocci.show_iso_failures | |
2240 | then () | |
2241 | else | |
2242 | (match matcher false false wc pattern e init_env with | |
2243 | OK _ -> | |
2244 | interpret_reason name (Ast0.get_line e) reason | |
2245 | (function () -> printer e) | |
2246 | | _ -> ()); | |
2247 | inner_loop all_alts (prev_ecount + ecount) (prev_icount + icount) | |
2248 | (prev_dcount + dcount) rest | |
ae4735db | 2249 | | OK (bindings : ((Ast.meta_name * 'a) list list)) -> |
34e49164 C |
2250 | let all_alts = |
2251 | (* apply update_others to all patterns other than the matched | |
2252 | one. This is used to desigate the others as test | |
2253 | expressions in the TestExpression case *) | |
2254 | (List.map | |
2255 | (function (x,e,i,d) as all -> | |
2256 | if x = pattern | |
2257 | then all | |
2258 | else (update_others x,e,i,d)) | |
2259 | (List.hd all_alts)) :: | |
2260 | (List.map | |
2261 | (List.map (function (x,e,i,d) -> (update_others x,e,i,d))) | |
2262 | (List.tl all_alts)) in | |
2263 | (match List.concat all_alts with | |
2264 | [x] -> Common.Left (prev_ecount, prev_icount, prev_dcount) | |
2265 | | all_alts -> | |
2266 | let (new_metavars,mv_bindings) = | |
2267 | make_new_metavars metavars (nub(List.concat bindings)) in | |
2268 | Common.Right | |
2269 | (new_metavars, | |
413ffc02 | 2270 | call_instantiate bindings mv_bindings all_alts pattern |
c3e37e97 | 2271 | (has_context pattern)))) in |
34e49164 | 2272 | let rec outer_loop prev_ecount prev_icount prev_dcount = function |
b1b2de81 | 2273 | [] | [[_]] (*only one alternative*) -> (0,[],e) (* nothing matched *) |
34e49164 C |
2274 | | (alts::rest) as all_alts -> |
2275 | match inner_loop all_alts prev_ecount prev_icount prev_dcount alts with | |
2276 | Common.Left(prev_ecount, prev_icount, prev_dcount) -> | |
2277 | outer_loop prev_ecount prev_icount prev_dcount rest | |
2278 | | Common.Right (new_metavars,res) -> | |
b1b2de81 | 2279 | (1,new_metavars, |
34e49164 | 2280 | copy_minus printer minusify e (disj_maker res)) in |
b1b2de81 C |
2281 | let (count,metavars,e) = outer_loop 0 0 0 alts in |
2282 | (count, metavars, e) | |
34e49164 C |
2283 | |
2284 | (* no one should ever look at the information stored in these mcodes *) | |
2285 | let disj_starter lst = | |
2286 | let old_info = Ast0.get_info(List.hd lst) in | |
0708f913 C |
2287 | let new_pos_info = |
2288 | { old_info.Ast0.pos_info with | |
2289 | Ast0.line_end = old_info.Ast0.pos_info.Ast0.line_start; | |
2290 | Ast0.logical_end = old_info.Ast0.pos_info.Ast0.logical_start; } in | |
34e49164 | 2291 | let info = |
0708f913 | 2292 | { Ast0.pos_info = new_pos_info; |
34e49164 C |
2293 | Ast0.attachable_start = false; Ast0.attachable_end = false; |
2294 | Ast0.mcode_start = []; Ast0.mcode_end = []; | |
97111a47 C |
2295 | Ast0.strings_before = []; Ast0.strings_after = []; |
2296 | Ast0.isSymbolIdent = false; } in | |
34e49164 C |
2297 | Ast0.make_mcode_info "(" info |
2298 | ||
2299 | let disj_ender lst = | |
2300 | let old_info = Ast0.get_info(List.hd lst) in | |
0708f913 C |
2301 | let new_pos_info = |
2302 | { old_info.Ast0.pos_info with | |
2303 | Ast0.line_start = old_info.Ast0.pos_info.Ast0.line_end; | |
2304 | Ast0.logical_start = old_info.Ast0.pos_info.Ast0.logical_end; } in | |
34e49164 | 2305 | let info = |
0708f913 | 2306 | { Ast0.pos_info = new_pos_info; |
34e49164 C |
2307 | Ast0.attachable_start = false; Ast0.attachable_end = false; |
2308 | Ast0.mcode_start = []; Ast0.mcode_end = []; | |
97111a47 C |
2309 | Ast0.strings_before = []; Ast0.strings_after = []; |
2310 | Ast0.isSymbolIdent = false; } in | |
34e49164 C |
2311 | Ast0.make_mcode_info ")" info |
2312 | ||
2313 | let disj_mid _ = Ast0.make_mcode "|" | |
2314 | ||
2315 | let make_disj_type tl = | |
2316 | let mids = | |
2317 | match tl with | |
2318 | [] -> failwith "bad disjunction" | |
2319 | | x::xs -> List.map disj_mid xs in | |
2320 | Ast0.context_wrap (Ast0.DisjType(disj_starter tl,tl,mids,disj_ender tl)) | |
2321 | let make_disj_stmt_list tl = | |
2322 | let mids = | |
2323 | match tl with | |
2324 | [] -> failwith "bad disjunction" | |
2325 | | x::xs -> List.map disj_mid xs in | |
2326 | Ast0.context_wrap (Ast0.Disj(disj_starter tl,tl,mids,disj_ender tl)) | |
2327 | let make_disj_expr model el = | |
2328 | let mids = | |
2329 | match el with | |
2330 | [] -> failwith "bad disjunction" | |
2331 | | x::xs -> List.map disj_mid xs in | |
2332 | let update_arg x = | |
2333 | if Ast0.get_arg_exp model then Ast0.set_arg_exp x else x in | |
2334 | let update_test x = | |
2335 | let x = if Ast0.get_test_pos model then Ast0.set_test_pos x else x in | |
2336 | if Ast0.get_test_exp model then Ast0.set_test_exp x else x in | |
2337 | let el = List.map update_arg (List.map update_test el) in | |
2338 | Ast0.context_wrap (Ast0.DisjExpr(disj_starter el,el,mids,disj_ender el)) | |
2339 | let make_disj_decl dl = | |
2340 | let mids = | |
2341 | match dl with | |
2342 | [] -> failwith "bad disjunction" | |
2343 | | x::xs -> List.map disj_mid xs in | |
2344 | Ast0.context_wrap (Ast0.DisjDecl(disj_starter dl,dl,mids,disj_ender dl)) | |
2345 | let make_disj_stmt sl = | |
2346 | let dotify x = Ast0.context_wrap (Ast0.DOTS[x]) in | |
2347 | let mids = | |
2348 | match sl with | |
2349 | [] -> failwith "bad disjunction" | |
2350 | | x::xs -> List.map disj_mid xs in | |
2351 | Ast0.context_wrap | |
2352 | (Ast0.Disj(disj_starter sl,List.map dotify sl,mids,disj_ender sl)) | |
2353 | ||
2354 | let transform_type (metavars,alts,name) e = | |
2355 | match alts with | |
2356 | (Ast0.TypeCTag(_)::_)::_ -> | |
2357 | (* start line is given to any leaves in the iso code *) | |
0708f913 C |
2358 | let start_line = |
2359 | Some ((Ast0.get_info e).Ast0.pos_info.Ast0.line_start) in | |
34e49164 C |
2360 | let alts = |
2361 | List.map | |
2362 | (List.map | |
2363 | (function | |
2364 | Ast0.TypeCTag(p) -> | |
b1b2de81 C |
2365 | (p,count_edots.VT0.combiner_rec_typeC p, |
2366 | count_idots.VT0.combiner_rec_typeC p, | |
2367 | count_dots.VT0.combiner_rec_typeC p) | |
34e49164 C |
2368 | | _ -> failwith "invalid alt")) |
2369 | alts in | |
2370 | mkdisj match_typeC metavars alts e | |
2371 | (function b -> function mv_b -> | |
b1b2de81 | 2372 | (instantiate b mv_b).VT0.rebuilder_rec_typeC) |
34e49164 | 2373 | (function t -> Ast0.TypeCTag t) |
b1b2de81 C |
2374 | make_disj_type make_minus.VT0.rebuilder_rec_typeC |
2375 | (rebuild_mcode start_line).VT0.rebuilder_rec_typeC | |
34e49164 | 2376 | name Unparse_ast0.typeC extra_copy_other_plus do_nothing |
c3e37e97 C |
2377 | (function x -> |
2378 | match Ast0.unwrap x with Ast0.MetaType _ -> false | _ -> true) | |
b1b2de81 | 2379 | | _ -> (0,[],e) |
34e49164 C |
2380 | |
2381 | ||
2382 | let transform_expr (metavars,alts,name) e = | |
2383 | let process update_others = | |
2384 | (* start line is given to any leaves in the iso code *) | |
0708f913 C |
2385 | let start_line = |
2386 | Some ((Ast0.get_info e).Ast0.pos_info.Ast0.line_start) in | |
34e49164 C |
2387 | let alts = |
2388 | List.map | |
2389 | (List.map | |
2390 | (function | |
2391 | Ast0.ExprTag(p) | Ast0.ArgExprTag(p) | Ast0.TestExprTag(p) -> | |
b1b2de81 C |
2392 | (p,count_edots.VT0.combiner_rec_expression p, |
2393 | count_idots.VT0.combiner_rec_expression p, | |
2394 | count_dots.VT0.combiner_rec_expression p) | |
34e49164 C |
2395 | | _ -> failwith "invalid alt")) |
2396 | alts in | |
2397 | mkdisj match_expr metavars alts e | |
2398 | (function b -> function mv_b -> | |
b1b2de81 | 2399 | (instantiate b mv_b).VT0.rebuilder_rec_expression) |
34e49164 | 2400 | (function e -> Ast0.ExprTag e) |
485bce71 | 2401 | (make_disj_expr e) |
b1b2de81 C |
2402 | make_minus.VT0.rebuilder_rec_expression |
2403 | (rebuild_mcode start_line).VT0.rebuilder_rec_expression | |
c3e37e97 C |
2404 | name Unparse_ast0.expression extra_copy_other_plus update_others |
2405 | (function x -> | |
97111a47 C |
2406 | match Ast0.unwrap x with |
2407 | Ast0.MetaExpr _ | Ast0.MetaExprList _ | Ast0.MetaErr _ -> false | |
2408 | | _ -> true) | |
c3e37e97 | 2409 | in |
34e49164 | 2410 | match alts with |
c3e37e97 C |
2411 | (Ast0.ExprTag(_)::r)::rs -> |
2412 | (* hack to accomodate ToTestExpression case, where the first pattern is | |
2413 | a normal expression, but the others are test expressions *) | |
2414 | let others = r @ (List.concat rs) in | |
2415 | let is_test = function Ast0.TestExprTag(_) -> true | _ -> false in | |
2416 | if List.for_all is_test others then process Ast0.set_test_exp | |
2417 | else if List.exists is_test others then failwith "inconsistent iso" | |
2418 | else process do_nothing | |
ae4735db | 2419 | | (Ast0.ArgExprTag(_)::_)::_ when Ast0.get_arg_exp e -> process do_nothing |
34e49164 | 2420 | | (Ast0.TestExprTag(_)::_)::_ when Ast0.get_test_pos e -> |
ae4735db | 2421 | process Ast0.set_test_exp |
b1b2de81 | 2422 | | _ -> (0,[],e) |
34e49164 C |
2423 | |
2424 | let transform_decl (metavars,alts,name) e = | |
2425 | match alts with | |
2426 | (Ast0.DeclTag(_)::_)::_ -> | |
2427 | (* start line is given to any leaves in the iso code *) | |
0708f913 C |
2428 | let start_line = |
2429 | Some (Ast0.get_info e).Ast0.pos_info.Ast0.line_start in | |
34e49164 C |
2430 | let alts = |
2431 | List.map | |
2432 | (List.map | |
2433 | (function | |
2434 | Ast0.DeclTag(p) -> | |
b1b2de81 C |
2435 | (p,count_edots.VT0.combiner_rec_declaration p, |
2436 | count_idots.VT0.combiner_rec_declaration p, | |
2437 | count_dots.VT0.combiner_rec_declaration p) | |
34e49164 C |
2438 | | _ -> failwith "invalid alt")) |
2439 | alts in | |
2440 | mkdisj match_decl metavars alts e | |
2441 | (function b -> function mv_b -> | |
b1b2de81 | 2442 | (instantiate b mv_b).VT0.rebuilder_rec_declaration) |
34e49164 C |
2443 | (function d -> Ast0.DeclTag d) |
2444 | make_disj_decl | |
b1b2de81 C |
2445 | make_minus.VT0.rebuilder_rec_declaration |
2446 | (rebuild_mcode start_line).VT0.rebuilder_rec_declaration | |
34e49164 | 2447 | name Unparse_ast0.declaration extra_copy_other_plus do_nothing |
c3e37e97 | 2448 | (function _ -> true (* no metavars *)) |
b1b2de81 | 2449 | | _ -> (0,[],e) |
34e49164 C |
2450 | |
2451 | let transform_stmt (metavars,alts,name) e = | |
2452 | match alts with | |
2453 | (Ast0.StmtTag(_)::_)::_ -> | |
2454 | (* start line is given to any leaves in the iso code *) | |
0708f913 C |
2455 | let start_line = |
2456 | Some (Ast0.get_info e).Ast0.pos_info.Ast0.line_start in | |
34e49164 C |
2457 | let alts = |
2458 | List.map | |
2459 | (List.map | |
2460 | (function | |
2461 | Ast0.StmtTag(p) -> | |
b1b2de81 C |
2462 | (p,count_edots.VT0.combiner_rec_statement p, |
2463 | count_idots.VT0.combiner_rec_statement p, | |
2464 | count_dots.VT0.combiner_rec_statement p) | |
34e49164 C |
2465 | | _ -> failwith "invalid alt")) |
2466 | alts in | |
2467 | mkdisj match_statement metavars alts e | |
2468 | (function b -> function mv_b -> | |
b1b2de81 | 2469 | (instantiate b mv_b).VT0.rebuilder_rec_statement) |
34e49164 | 2470 | (function s -> Ast0.StmtTag s) |
b1b2de81 C |
2471 | make_disj_stmt make_minus.VT0.rebuilder_rec_statement |
2472 | (rebuild_mcode start_line).VT0.rebuilder_rec_statement | |
34e49164 | 2473 | name (Unparse_ast0.statement "") extra_copy_stmt_plus do_nothing |
c3e37e97 C |
2474 | (function x -> |
2475 | match Ast0.unwrap x with | |
2476 | Ast0.MetaStmt _ | Ast0.MetaStmtList _ -> false | |
2477 | | _ -> true) | |
b1b2de81 | 2478 | | _ -> (0,[],e) |
34e49164 C |
2479 | |
2480 | (* sort of a hack, because there is no disj at top level *) | |
2481 | let transform_top (metavars,alts,name) e = | |
2482 | match Ast0.unwrap e with | |
65038c61 | 2483 | Ast0.NONDECL(declstm) -> |
34e49164 C |
2484 | (try |
2485 | let strip alts = | |
2486 | List.map | |
2487 | (List.map | |
2488 | (function | |
2489 | Ast0.DotsStmtTag(d) -> | |
2490 | (match Ast0.unwrap d with | |
2491 | Ast0.DOTS([s]) -> Ast0.StmtTag(s) | |
2492 | | _ -> raise (Failure "")) | |
2493 | | _ -> raise (Failure ""))) | |
2494 | alts in | |
b1b2de81 | 2495 | let (count,mv,s) = transform_stmt (metavars,strip alts,name) declstm in |
65038c61 | 2496 | (count,mv,Ast0.rewrap e (Ast0.NONDECL(s))) |
b1b2de81 | 2497 | with Failure _ -> (0,[],e)) |
34e49164 | 2498 | | Ast0.CODE(stmts) -> |
b1b2de81 | 2499 | let (count,mv,res) = |
34e49164 C |
2500 | match alts with |
2501 | (Ast0.DotsStmtTag(_)::_)::_ -> | |
97111a47 | 2502 | (* start line is given to any leaves in the iso code *) |
0708f913 C |
2503 | let start_line = |
2504 | Some ((Ast0.get_info e).Ast0.pos_info.Ast0.line_start) in | |
34e49164 C |
2505 | let alts = |
2506 | List.map | |
2507 | (List.map | |
2508 | (function | |
2509 | Ast0.DotsStmtTag(p) -> | |
b1b2de81 C |
2510 | (p,count_edots.VT0.combiner_rec_statement_dots p, |
2511 | count_idots.VT0.combiner_rec_statement_dots p, | |
2512 | count_dots.VT0.combiner_rec_statement_dots p) | |
34e49164 C |
2513 | | _ -> failwith "invalid alt")) |
2514 | alts in | |
2515 | mkdisj match_statement_dots metavars alts stmts | |
2516 | (function b -> function mv_b -> | |
b1b2de81 | 2517 | (instantiate b mv_b).VT0.rebuilder_rec_statement_dots) |
34e49164 C |
2518 | (function s -> Ast0.DotsStmtTag s) |
2519 | (function x -> | |
2520 | Ast0.rewrap e (Ast0.DOTS([make_disj_stmt_list x]))) | |
485bce71 | 2521 | (function x -> |
b1b2de81 C |
2522 | make_minus.VT0.rebuilder_rec_statement_dots x) |
2523 | (rebuild_mcode start_line).VT0.rebuilder_rec_statement_dots | |
34e49164 | 2524 | name Unparse_ast0.statement_dots extra_copy_other_plus do_nothing |
c3e37e97 | 2525 | (function _ -> true) |
b1b2de81 C |
2526 | | _ -> (0,[],stmts) in |
2527 | (count,mv,Ast0.rewrap e (Ast0.CODE res)) | |
2528 | | _ -> (0,[],e) | |
34e49164 C |
2529 | |
2530 | (* --------------------------------------------------------------------- *) | |
2531 | ||
2532 | let transform (alts : isomorphism) t = | |
2533 | (* the following ugliness is because rebuilder only returns a new term *) | |
2534 | let extra_meta_decls = ref ([] : Ast_cocci.metavar list) in | |
b1b2de81 C |
2535 | let in_limit n = function |
2536 | None -> true | |
2537 | | Some n1 -> | |
2538 | n < n1 or | |
2539 | ((if !Flag_parsing_cocci.show_iso_failures | |
2540 | then Common.pr2_once "execeeded iso threshold, see -iso_limit option"); | |
2541 | false) in | |
2542 | let bind x y = x + y in | |
2543 | let option_default = 0 in | |
34e49164 | 2544 | let exprfn r k e = |
b1b2de81 C |
2545 | let (e_count,e) = k e in |
2546 | if in_limit e_count !Flag_parsing_cocci.iso_limit | |
2547 | then | |
2548 | let (count,extra_meta,exp) = transform_expr alts e in | |
2549 | extra_meta_decls := extra_meta @ !extra_meta_decls; | |
2550 | (bind count e_count,exp) | |
2551 | else (e_count,e) in | |
34e49164 C |
2552 | |
2553 | let declfn r k e = | |
b1b2de81 C |
2554 | let (e_count,e) = k e in |
2555 | if in_limit e_count !Flag_parsing_cocci.iso_limit | |
2556 | then | |
2557 | let (count,extra_meta,dec) = transform_decl alts e in | |
2558 | extra_meta_decls := extra_meta @ !extra_meta_decls; | |
2559 | (bind count e_count,dec) | |
2560 | else (e_count,e) in | |
34e49164 C |
2561 | |
2562 | let stmtfn r k e = | |
b1b2de81 C |
2563 | let (e_count,e) = k e in |
2564 | if in_limit e_count !Flag_parsing_cocci.iso_limit | |
2565 | then | |
2566 | let (count,extra_meta,stm) = transform_stmt alts e in | |
2567 | extra_meta_decls := extra_meta @ !extra_meta_decls; | |
2568 | (bind count e_count,stm) | |
2569 | else (e_count,e) in | |
faf9a90c | 2570 | |
34e49164 | 2571 | let typefn r k e = |
b1b2de81 C |
2572 | let (continue,e_count,e) = |
2573 | match Ast0.unwrap e with | |
2574 | Ast0.Signed(signb,tyb) -> | |
faf9a90c C |
2575 | (* Hack! How else to prevent iso from applying under an |
2576 | unsigned??? *) | |
b1b2de81 C |
2577 | (true,0,e) |
2578 | | _ -> | |
2579 | let (e_count,e) = k e in | |
2580 | if in_limit e_count !Flag_parsing_cocci.iso_limit | |
2581 | then (true,e_count,e) | |
2582 | else (false,e_count,e) in | |
2583 | if continue | |
2584 | then | |
2585 | let (count,extra_meta,ty) = transform_type alts e in | |
2586 | extra_meta_decls := extra_meta @ !extra_meta_decls; | |
2587 | (bind count e_count,ty) | |
2588 | else (e_count,e) in | |
faf9a90c | 2589 | |
34e49164 | 2590 | let topfn r k e = |
b1b2de81 C |
2591 | let (e_count,e) = k e in |
2592 | if in_limit e_count !Flag_parsing_cocci.iso_limit | |
2593 | then | |
2594 | let (count,extra_meta,ty) = transform_top alts e in | |
2595 | extra_meta_decls := extra_meta @ !extra_meta_decls; | |
2596 | (bind count e_count,ty) | |
2597 | else (e_count,e) in | |
faf9a90c | 2598 | |
34e49164 | 2599 | let res = |
b1b2de81 C |
2600 | V0.combiner_rebuilder bind option_default |
2601 | {V0.combiner_rebuilder_functions with | |
2602 | VT0.combiner_rebuilder_exprfn = exprfn; | |
2603 | VT0.combiner_rebuilder_tyfn = typefn; | |
2604 | VT0.combiner_rebuilder_declfn = declfn; | |
2605 | VT0.combiner_rebuilder_stmtfn = stmtfn; | |
2606 | VT0.combiner_rebuilder_topfn = topfn} in | |
2607 | let (_,res) = res.VT0.top_level t in | |
34e49164 C |
2608 | (!extra_meta_decls,res) |
2609 | ||
2610 | (* --------------------------------------------------------------------- *) | |
2611 | ||
2612 | (* should be done by functorizing the parser to use wrap or context_wrap *) | |
2613 | let rewrap = | |
708f4980 | 2614 | let mcode (x,a,i,mc,pos,adj) = (x,a,i,Ast0.context_befaft(),pos,adj) in |
34e49164 | 2615 | let donothing r k e = Ast0.context_wrap(Ast0.unwrap(k e)) in |
b1b2de81 | 2616 | V0.flat_rebuilder |
34e49164 | 2617 | mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode |
34e49164 C |
2618 | donothing donothing donothing donothing donothing donothing |
2619 | donothing donothing donothing donothing donothing donothing donothing | |
2620 | donothing donothing | |
2621 | ||
2622 | let rewrap_anything = function | |
2623 | Ast0.DotsExprTag(d) -> | |
b1b2de81 | 2624 | Ast0.DotsExprTag(rewrap.VT0.rebuilder_rec_expression_dots d) |
34e49164 | 2625 | | Ast0.DotsInitTag(d) -> |
b1b2de81 | 2626 | Ast0.DotsInitTag(rewrap.VT0.rebuilder_rec_initialiser_list d) |
34e49164 | 2627 | | Ast0.DotsParamTag(d) -> |
b1b2de81 | 2628 | Ast0.DotsParamTag(rewrap.VT0.rebuilder_rec_parameter_list d) |
34e49164 | 2629 | | Ast0.DotsStmtTag(d) -> |
b1b2de81 | 2630 | Ast0.DotsStmtTag(rewrap.VT0.rebuilder_rec_statement_dots d) |
34e49164 | 2631 | | Ast0.DotsDeclTag(d) -> |
b1b2de81 | 2632 | Ast0.DotsDeclTag(rewrap.VT0.rebuilder_rec_declaration_dots d) |
34e49164 | 2633 | | Ast0.DotsCaseTag(d) -> |
b1b2de81 C |
2634 | Ast0.DotsCaseTag(rewrap.VT0.rebuilder_rec_case_line_dots d) |
2635 | | Ast0.IdentTag(d) -> Ast0.IdentTag(rewrap.VT0.rebuilder_rec_ident d) | |
2636 | | Ast0.ExprTag(d) -> Ast0.ExprTag(rewrap.VT0.rebuilder_rec_expression d) | |
2637 | | Ast0.ArgExprTag(d) -> | |
2638 | Ast0.ArgExprTag(rewrap.VT0.rebuilder_rec_expression d) | |
2639 | | Ast0.TestExprTag(d) -> | |
2640 | Ast0.TestExprTag(rewrap.VT0.rebuilder_rec_expression d) | |
2641 | | Ast0.TypeCTag(d) -> Ast0.TypeCTag(rewrap.VT0.rebuilder_rec_typeC d) | |
2642 | | Ast0.InitTag(d) -> Ast0.InitTag(rewrap.VT0.rebuilder_rec_initialiser d) | |
2643 | | Ast0.ParamTag(d) -> Ast0.ParamTag(rewrap.VT0.rebuilder_rec_parameter d) | |
2644 | | Ast0.DeclTag(d) -> Ast0.DeclTag(rewrap.VT0.rebuilder_rec_declaration d) | |
2645 | | Ast0.StmtTag(d) -> Ast0.StmtTag(rewrap.VT0.rebuilder_rec_statement d) | |
2646 | | Ast0.CaseLineTag(d) -> | |
2647 | Ast0.CaseLineTag(rewrap.VT0.rebuilder_rec_case_line d) | |
2648 | | Ast0.TopTag(d) -> Ast0.TopTag(rewrap.VT0.rebuilder_rec_top_level d) | |
1be43e12 C |
2649 | | Ast0.IsoWhenTag(_) | Ast0.IsoWhenTTag(_) | Ast0.IsoWhenFTag(_) -> |
2650 | failwith "only for isos within iso phase" | |
34e49164 | 2651 | | Ast0.MetaPosTag(p) -> Ast0.MetaPosTag(p) |
17ba0788 | 2652 | | Ast0.HiddenVarTag(p) -> Ast0.HiddenVarTag(p) (* not sure it is possible *) |
34e49164 C |
2653 | |
2654 | (* --------------------------------------------------------------------- *) | |
2655 | ||
2656 | let apply_isos isos rule rule_name = | |
2657 | if isos = [] | |
2658 | then ([],rule) | |
2659 | else | |
2660 | begin | |
2661 | current_rule := rule_name; | |
2662 | let isos = | |
2663 | List.map | |
2664 | (function (metavars,iso,name) -> | |
2665 | (metavars,List.map (List.map rewrap_anything) iso,name)) | |
2666 | isos in | |
2667 | let (extra_meta,rule) = | |
2668 | List.split | |
2669 | (List.map | |
2670 | (function t -> | |
2671 | List.fold_left | |
2672 | (function (extra_meta,t) -> function iso -> | |
2673 | let (new_extra_meta,t) = transform iso t in | |
2674 | (new_extra_meta@extra_meta,t)) | |
2675 | ([],t) isos) | |
2676 | rule) in | |
978fd7e5 | 2677 | (List.concat extra_meta, (Compute_lines.compute_lines true) rule) |
34e49164 | 2678 | end |