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