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