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