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