2 * Copyright 2005-2008, Ecole des Mines de Nantes, University of Copenhagen
3 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
4 * This file is part of Coccinelle.
6 * Coccinelle is free software: you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation, according to version 2 of the License.
10 * Coccinelle is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
15 * You should have received a copy of the GNU General Public License
16 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
18 * The authors reserve the right to distribute this or future versions of
19 * Coccinelle under other licenses.
23 (* Potential problem: offset of mcode is not updated when an iso is
24 instantiated, implying that a term may end up with many mcodes with the
25 same offset. On the other hand, at the moment offset only seems to be used
26 before this phase. Furthermore add_dot_binding relies on the offset to
27 remain the same between matching an iso and instantiating it with bindings. *)
29 (* --------------------------------------------------------------------- *)
30 (* match a SmPL expression against a SmPL abstract syntax tree,
33 module Ast = Ast_cocci
34 module Ast0 = Ast0_cocci
35 module V0 = Visitor_ast0
37 let current_rule = ref ""
39 (* --------------------------------------------------------------------- *)
42 Ast_cocci.metavar list * Ast0_cocci.anything list list * string (* name *)
45 let mcode (term,_,_,_,_) =
46 (term,Ast0.NONE,Ast0.default_info(),Ast0.PLUS,ref Ast0.NoMetaPos) in
49 {(Ast0.wrap (Ast0.unwrap x)) with
50 Ast0.mcodekind = ref Ast0.PLUS;
51 Ast0.true_if_test = x.Ast0.true_if_test} in
53 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
55 donothing donothing donothing donothing donothing donothing
56 donothing donothing donothing donothing donothing donothing donothing
59 let anything_equal = function
60 (Ast0.DotsExprTag(d1),Ast0.DotsExprTag(d2)) ->
61 failwith "not a possible variable binding" (*not sure why these are pbs*)
62 | (Ast0.DotsInitTag(d1),Ast0.DotsInitTag(d2)) ->
63 failwith "not a possible variable binding"
64 | (Ast0.DotsParamTag(d1),Ast0.DotsParamTag(d2)) ->
65 failwith "not a possible variable binding"
66 | (Ast0.DotsStmtTag(d1),Ast0.DotsStmtTag(d2)) ->
67 (strip_info.V0.rebuilder_statement_dots d1) =
68 (strip_info.V0.rebuilder_statement_dots d2)
69 | (Ast0.DotsDeclTag(d1),Ast0.DotsDeclTag(d2)) ->
70 failwith "not a possible variable binding"
71 | (Ast0.DotsCaseTag(d1),Ast0.DotsCaseTag(d2)) ->
72 failwith "not a possible variable binding"
73 | (Ast0.IdentTag(d1),Ast0.IdentTag(d2)) ->
74 (strip_info.V0.rebuilder_ident d1) = (strip_info.V0.rebuilder_ident d2)
75 | (Ast0.ExprTag(d1),Ast0.ExprTag(d2)) ->
76 (strip_info.V0.rebuilder_expression d1) =
77 (strip_info.V0.rebuilder_expression d2)
78 | (Ast0.ArgExprTag(_),_) | (_,Ast0.ArgExprTag(_)) ->
79 failwith "not possible - only in isos1"
80 | (Ast0.TestExprTag(_),_) | (_,Ast0.TestExprTag(_)) ->
81 failwith "not possible - only in isos1"
82 | (Ast0.TypeCTag(d1),Ast0.TypeCTag(d2)) ->
83 (strip_info.V0.rebuilder_typeC d1) =
84 (strip_info.V0.rebuilder_typeC d2)
85 | (Ast0.InitTag(d1),Ast0.InitTag(d2)) ->
86 (strip_info.V0.rebuilder_initialiser d1) =
87 (strip_info.V0.rebuilder_initialiser d2)
88 | (Ast0.ParamTag(d1),Ast0.ParamTag(d2)) ->
89 (strip_info.V0.rebuilder_parameter d1) =
90 (strip_info.V0.rebuilder_parameter d2)
91 | (Ast0.DeclTag(d1),Ast0.DeclTag(d2)) ->
92 (strip_info.V0.rebuilder_declaration d1) =
93 (strip_info.V0.rebuilder_declaration d2)
94 | (Ast0.StmtTag(d1),Ast0.StmtTag(d2)) ->
95 (strip_info.V0.rebuilder_statement d1) =
96 (strip_info.V0.rebuilder_statement d2)
97 | (Ast0.CaseLineTag(d1),Ast0.CaseLineTag(d2)) ->
98 (strip_info.V0.rebuilder_case_line d1) =
99 (strip_info.V0.rebuilder_case_line d2)
100 | (Ast0.TopTag(d1),Ast0.TopTag(d2)) ->
101 (strip_info.V0.rebuilder_top_level d1) =
102 (strip_info.V0.rebuilder_top_level d2)
103 | (Ast0.IsoWhenTag(_),_) | (_,Ast0.IsoWhenTag(_)) ->
104 failwith "only for isos within iso phase"
107 let term (var1,_,_,_,_) = var1
108 let dot_term (var1,_,info,_,_) = ("", var1 ^ (string_of_int info.Ast0.offset))
112 NotPure of Ast0.pure * (string * string) * Ast0.anything
113 | NotPureLength of (string * string)
114 | ContextRequired of Ast0.anything
116 | Braces of Ast0.statement
117 | Position of string * string
119 let interpret_reason name line reason printer =
121 "warning: iso %s does not match the code below on line %d\n" name line;
122 printer(); Format.print_newline();
124 NotPure(Ast0.Pure,(_,var),nonpure) ->
126 "pure metavariable %s is matched against the following nonpure code:\n"
128 Unparse_ast0.unparse_anything nonpure
129 | NotPure(Ast0.Context,(_,var),nonpure) ->
131 "context metavariable %s is matched against the following\nnoncontext code:\n"
133 Unparse_ast0.unparse_anything nonpure
134 | NotPure(Ast0.PureContext,(_,var),nonpure) ->
136 "pure context metavariable %s is matched against the following\nnonpure or noncontext code:\n"
138 Unparse_ast0.unparse_anything nonpure
139 | NotPureLength((_,var)) ->
141 "pure metavariable %s is matched against too much or too little code\n"
143 | ContextRequired(term) ->
145 "the following code matched is not uniformly minus or context,\nor contains a disjunction:\n";
146 Unparse_ast0.unparse_anything term
148 Printf.printf "braces must be all minus (plus code allowed) or all\ncontext (plus code not allowed in the body) to match:\n";
149 Unparse_ast0.statement "" s;
150 Format.print_newline()
151 | Position(rule,name) ->
152 Printf.printf "position variable %s.%s conflicts with an isomorphism\n"
154 | _ -> failwith "not possible"
156 type 'a either = OK of 'a | Fail of reason
158 let add_binding var exp bindings =
159 let var = term var in
160 let attempt bindings =
162 let cur = List.assoc var bindings in
163 if anything_equal(exp,cur) then [bindings] else []
164 with Not_found -> [((var,exp)::bindings)] in
165 match List.concat(List.map attempt bindings) with
169 let add_dot_binding var exp bindings =
170 let var = dot_term var in
171 let attempt bindings =
173 let cur = List.assoc var bindings in
174 if anything_equal(exp,cur) then [bindings] else []
175 with Not_found -> [((var,exp)::bindings)] in
176 match List.concat(List.map attempt bindings) with
181 let add_multi_dot_binding var exp bindings =
182 let var = dot_term var in
183 let attempt bindings = [((var,exp)::bindings)] in
184 match List.concat(List.map attempt bindings) with
191 | (x::xs) when (List.mem x xs) -> nub xs
192 | (x::xs) -> x::(nub xs)
194 (* --------------------------------------------------------------------- *)
198 let debug str m binding =
199 let res = m binding in
201 None -> Printf.printf "%s: failed\n" str
205 Printf.printf "%s: %s\n" str
206 (String.concat " " (List.map (function (x,_) -> x) binding)))
210 let conjunct_bindings
211 (m1 : 'binding -> 'binding either)
212 (m2 : 'binding -> 'binding either)
213 (binding : 'binding) : 'binding either =
214 match m1 binding with Fail(reason) -> Fail(reason) | OK binding -> m2 binding
216 let rec conjunct_many_bindings = function
217 [] -> failwith "not possible"
219 | x::xs -> conjunct_bindings x (conjunct_many_bindings xs)
221 let mcode_equal (x,_,_,_,_) (y,_,_,_,_) = x = y
223 let return b binding = if b then OK binding else Fail NonMatch
224 let return_false reason binding = Fail reason
226 let match_option f t1 t2 =
228 (Some t1, Some t2) -> f t1 t2
229 | (None, None) -> return true
232 let bool_match_option f t1 t2 =
234 (Some t1, Some t2) -> f t1 t2
235 | (None, None) -> true
238 (* context_required is for the example
242 where we can't change x == NULL to eg NULL == x. So there can either be
243 nothing attached to the root or the term has to be all removed.
244 if would be nice if we knew more about the relationship between the - and +
245 code, because in the case where the + code is a separate statement in a
246 sequence, this is not a problem. Perhaps something could be done in
249 The example seems strange. Why isn't the cast attached to x?
252 !Flag.sgrep_mode2 or (* everything is context for sgrep *)
253 (match Ast0.get_mcodekind e with
254 Ast0.CONTEXT(cell) -> true
257 (* needs a special case when there is a Disj or an empty DOTS
258 the following stops at the statement level, and gives true if one
259 statement is replaced by another *)
260 let rec is_pure_context s =
261 !Flag.sgrep_mode2 or (* everything is context for sgrep *)
262 (match Ast0.unwrap s with
263 Ast0.Disj(starter,statement_dots_list,mids,ender) ->
266 match Ast0.undots x with
267 [s] -> is_pure_context s
268 | _ -> false (* could we do better? *))
271 (match Ast0.get_mcodekind s with
274 (Ast.NOTHING,_,_) -> true
278 (* do better for the common case of replacing a stmt by another one *)
279 ([[Ast.StatementTag(s)]],_) ->
280 (match Ast.unwrap s with
281 Ast.IfThen(_,_,_) -> false (* potentially dangerous *)
287 match Ast0.get_mcodekind e with Ast0.MINUS(cell) -> true | _ -> false
289 let match_list matcher is_list_matcher do_list_match la lb =
290 let rec loop = function
291 ([],[]) -> return true
292 | ([x],lb) when is_list_matcher x -> do_list_match x lb
293 | (x::xs,y::ys) -> conjunct_bindings (matcher x y) (loop (xs,ys))
294 | _ -> return false in
297 let match_maker checks_needed context_required whencode_allowed =
299 let check_mcode pmc cmc binding =
302 match Ast0.get_pos cmc with
303 (Ast0.MetaPos (name,_,_)) as x ->
304 (match Ast0.get_pos pmc with
305 Ast0.MetaPos (name1,_,_) ->
306 add_binding name1 (Ast0.MetaPosTag x) binding
308 let (rule,name) = Ast0.unwrap_mcode name in
309 Fail (Position(rule,name)))
310 | Ast0.NoMetaPos -> OK binding
313 let match_dots matcher is_list_matcher do_list_match d1 d2 =
314 match (Ast0.unwrap d1, Ast0.unwrap d2) with
315 (Ast0.DOTS(la),Ast0.DOTS(lb))
316 | (Ast0.CIRCLES(la),Ast0.CIRCLES(lb))
317 | (Ast0.STARS(la),Ast0.STARS(lb)) ->
318 match_list matcher is_list_matcher (do_list_match d2) la lb
319 | _ -> return false in
321 let is_elist_matcher el =
322 match Ast0.unwrap el with Ast0.MetaExprList(_,_,_) -> true | _ -> false in
324 let is_plist_matcher pl =
325 match Ast0.unwrap pl with Ast0.MetaParamList(_,_,_) -> true | _ -> false in
327 let is_slist_matcher pl =
328 match Ast0.unwrap pl with Ast0.MetaStmtList(_,_) -> true | _ -> false in
330 let no_list _ = false in
332 let build_dots pattern data =
333 match Ast0.unwrap pattern with
334 Ast0.DOTS(_) -> Ast0.rewrap pattern (Ast0.DOTS(data))
335 | Ast0.CIRCLES(_) -> Ast0.rewrap pattern (Ast0.CIRCLES(data))
336 | Ast0.STARS(_) -> Ast0.rewrap pattern (Ast0.STARS(data)) in
339 let bind = Ast0.lub_pure in
340 let option_default = Ast0.Context in
341 let pure_mcodekind = function
344 (Ast.NOTHING,_,_) -> Ast0.PureContext
347 (match !mc with ([],_) -> Ast0.Pure | _ -> Ast0.Impure)
348 | _ -> Ast0.Impure in
349 let donothing r k e =
350 bind (pure_mcodekind (Ast0.get_mcodekind e)) (k e) in
352 let mcode m = pure_mcodekind (Ast0.get_mcode_mcodekind m) in
354 (* a case for everything that has a metavariable *)
355 (* pure is supposed to match only unitary metavars, not anything that
356 contains only unitary metavars *)
358 bind (bind (pure_mcodekind (Ast0.get_mcodekind i)) (k i))
359 (match Ast0.unwrap i with
360 Ast0.MetaId(name,_,pure) | Ast0.MetaFunc(name,_,pure)
361 | Ast0.MetaLocalFunc(name,_,pure) -> pure
362 | _ -> Ast0.Impure) in
364 let expression r k e =
365 bind (bind (pure_mcodekind (Ast0.get_mcodekind e)) (k e))
366 (match Ast0.unwrap e with
367 Ast0.MetaErr(name,_,pure)
368 | Ast0.MetaExpr(name,_,_,_,pure) | Ast0.MetaExprList(name,_,pure) ->
370 | _ -> Ast0.Impure) in
373 bind (bind (pure_mcodekind (Ast0.get_mcodekind t)) (k t))
374 (match Ast0.unwrap t with
375 Ast0.MetaType(name,pure) -> pure
376 | _ -> Ast0.Impure) in
379 bind (bind (pure_mcodekind (Ast0.get_mcodekind p)) (k p))
380 (match Ast0.unwrap p with
381 Ast0.MetaParam(name,pure) | Ast0.MetaParamList(name,_,pure) -> pure
382 | _ -> Ast0.Impure) in
385 bind (bind (pure_mcodekind (Ast0.get_mcodekind s)) (k s))
386 (match Ast0.unwrap s with
387 Ast0.MetaStmt(name,pure) | Ast0.MetaStmtList(name,pure) -> pure
388 | _ -> Ast0.Impure) in
390 V0.combiner bind option_default
391 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
393 donothing donothing donothing donothing donothing donothing
394 ident expression typeC donothing param donothing stmt donothing
397 let add_pure_list_binding name pure is_pure builder1 builder2 lst =
398 match (checks_needed,pure) with
399 (true,Ast0.Pure) | (true,Ast0.Context) | (true,Ast0.PureContext) ->
402 if (Ast0.lub_pure (is_pure x) pure) = pure
403 then add_binding name (builder1 lst)
404 else return_false (NotPure (pure,term name,builder1 lst))
405 | _ -> return_false (NotPureLength (term name)))
406 | (false,_) | (_,Ast0.Impure) -> add_binding name (builder2 lst) in
408 let add_pure_binding name pure is_pure builder x =
409 match (checks_needed,pure) with
410 (true,Ast0.Pure) | (true,Ast0.Context) | (true,Ast0.PureContext) ->
411 if (Ast0.lub_pure (is_pure x) pure) = pure
412 then add_binding name (builder x)
413 else return_false (NotPure (pure,term name, builder x))
414 | (false,_) | (_,Ast0.Impure) -> add_binding name (builder x) in
416 let do_elist_match builder el lst =
417 match Ast0.unwrap el with
418 Ast0.MetaExprList(name,lenname,pure) ->
419 (*how to handle lenname? should it be an option type and always None?*)
420 failwith "expr list pattern not supported in iso"
421 (*add_pure_list_binding name pure
422 pure_sp_code.V0.combiner_expression
423 (function lst -> Ast0.ExprTag(List.hd lst))
424 (function lst -> Ast0.DotsExprTag(build_dots builder lst))
426 | _ -> failwith "not possible" in
428 let do_plist_match builder pl lst =
429 match Ast0.unwrap pl with
430 Ast0.MetaParamList(name,lename,pure) ->
431 failwith "param list pattern not supported in iso"
432 (*add_pure_list_binding name pure
433 pure_sp_code.V0.combiner_parameter
434 (function lst -> Ast0.ParamTag(List.hd lst))
435 (function lst -> Ast0.DotsParamTag(build_dots builder lst))
437 | _ -> failwith "not possible" in
439 let do_slist_match builder sl lst =
440 match Ast0.unwrap sl with
441 Ast0.MetaStmtList(name,pure) ->
442 add_pure_list_binding name pure
443 pure_sp_code.V0.combiner_statement
444 (function lst -> Ast0.StmtTag(List.hd lst))
445 (function lst -> Ast0.DotsStmtTag(build_dots builder lst))
447 | _ -> failwith "not possible" in
449 let do_nolist_match _ _ = failwith "not possible" in
451 let rec match_ident pattern id =
452 match Ast0.unwrap pattern with
453 Ast0.MetaId(name,_,pure) ->
454 (add_pure_binding name pure pure_sp_code.V0.combiner_ident
455 (function id -> Ast0.IdentTag id) id)
456 | Ast0.MetaFunc(name,_,pure) -> failwith "metafunc not supported"
457 | Ast0.MetaLocalFunc(name,_,pure) -> failwith "metalocalfunc not supported"
459 if not(checks_needed) or not(context_required) or is_context id
461 match (up,Ast0.unwrap id) with
462 (Ast0.Id(namea),Ast0.Id(nameb)) ->
463 if mcode_equal namea nameb
464 then check_mcode namea nameb
466 | (Ast0.OptIdent(ida),Ast0.OptIdent(idb))
467 | (Ast0.UniqueIdent(ida),Ast0.UniqueIdent(idb)) ->
469 | (_,Ast0.OptIdent(idb))
470 | (_,Ast0.UniqueIdent(idb)) -> match_ident pattern idb
472 else return_false (ContextRequired (Ast0.IdentTag id)) in
474 (* should we do something about matching metavars against ...? *)
475 let rec match_expr pattern expr =
476 match Ast0.unwrap pattern with
477 Ast0.MetaExpr(name,_,ty,form,pure) ->
479 match (form,expr) with
483 match Ast0.unwrap e with
484 Ast0.Constant(c) -> true
485 | Ast0.Cast(lp,ty,rp,e) -> matches e
486 | Ast0.SizeOfExpr(se,exp) -> true
487 | Ast0.SizeOfType(se,lp,ty,rp) -> true
488 | Ast0.MetaExpr(nm,_,_,Ast.CONST,p) ->
489 (Ast0.lub_pure p pure) = pure
492 | (Ast.ID,e) | (Ast.LocalID,e) ->
494 match Ast0.unwrap e with
495 Ast0.Ident(c) -> true
496 | Ast0.Cast(lp,ty,rp,e) -> matches e
497 | Ast0.MetaExpr(nm,_,_,Ast.ID,p) ->
498 (Ast0.lub_pure p pure) = pure
506 (function Type_cocci.MetaType(_,_,_) -> true | _ -> false)
510 [Type_cocci.MetaType(tyname,_,_)] ->
512 match (Ast0.unwrap expr,Ast0.get_type expr) with
513 (* easier than updating type inferencer to manage multiple
515 (Ast0.MetaExpr(_,_,Some tts,_,_),_) -> Some tts
516 | (_,Some ty) -> Some [ty]
520 let tyname = Ast0.rewrap_mcode name tyname in
521 (function bindings ->
527 (add_pure_binding tyname Ast0.Impure
528 (function _ -> Ast0.Impure)
529 (function ty -> Ast0.TypeCTag ty)
531 (Ast0.reverse_type expty)))
532 (add_pure_binding name pure
533 pure_sp_code.V0.combiner_expression
534 (function expr -> Ast0.ExprTag expr)
538 Printf.printf "warning: unconvertible type";
539 return false bindings))
543 (List.map (function Fail _ -> [] | OK x -> x)
550 "warning: type metavar can only match one type";*)
554 "mixture of metatype and other types not supported")
556 let expty = Ast0.get_type expr in
557 if List.exists (function t -> Type_cocci.compatible t expty) ts
559 add_pure_binding name pure
560 pure_sp_code.V0.combiner_expression
561 (function expr -> Ast0.ExprTag expr)
565 add_pure_binding name pure pure_sp_code.V0.combiner_expression
566 (function expr -> Ast0.ExprTag expr)
569 | Ast0.MetaErr(namea,_,pure) -> failwith "metaerr not supported"
570 | Ast0.MetaExprList(_,_,_) -> failwith "metaexprlist not supported"
572 if not(checks_needed) or not(context_required) or is_context expr
574 match (up,Ast0.unwrap expr) with
575 (Ast0.Ident(ida),Ast0.Ident(idb)) ->
577 | (Ast0.Constant(consta),Ast0.Constant(constb)) ->
578 if mcode_equal consta constb
579 then check_mcode consta constb
581 | (Ast0.FunCall(fna,lp1,argsa,rp1),Ast0.FunCall(fnb,lp,argsb,rp)) ->
582 conjunct_many_bindings
583 [check_mcode lp1 lp; check_mcode rp1 rp; match_expr fna fnb;
584 match_dots match_expr is_elist_matcher do_elist_match
586 | (Ast0.Assignment(lefta,opa,righta,_),
587 Ast0.Assignment(leftb,opb,rightb,_)) ->
588 if mcode_equal opa opb
590 conjunct_many_bindings
591 [check_mcode opa opb; match_expr lefta leftb;
592 match_expr righta rightb]
594 | (Ast0.CondExpr(exp1a,lp1,exp2a,rp1,exp3a),
595 Ast0.CondExpr(exp1b,lp,exp2b,rp,exp3b)) ->
596 conjunct_many_bindings
597 [check_mcode lp1 lp; check_mcode rp1 rp;
598 match_expr exp1a exp1b; match_option match_expr exp2a exp2b;
599 match_expr exp3a exp3b]
600 | (Ast0.Postfix(expa,opa),Ast0.Postfix(expb,opb)) ->
601 if mcode_equal opa opb
603 conjunct_bindings (check_mcode opa opb) (match_expr expa expb)
605 | (Ast0.Infix(expa,opa),Ast0.Infix(expb,opb)) ->
606 if mcode_equal opa opb
608 conjunct_bindings (check_mcode opa opb) (match_expr expa expb)
610 | (Ast0.Unary(expa,opa),Ast0.Unary(expb,opb)) ->
611 if mcode_equal opa opb
613 conjunct_bindings (check_mcode opa opb) (match_expr expa expb)
615 | (Ast0.Binary(lefta,opa,righta),Ast0.Binary(leftb,opb,rightb)) ->
616 if mcode_equal opa opb
618 conjunct_many_bindings
619 [check_mcode opa opb; match_expr lefta leftb;
620 match_expr righta rightb]
622 | (Ast0.Paren(lp1,expa,rp1),Ast0.Paren(lp,expb,rp)) ->
623 conjunct_many_bindings
624 [check_mcode lp1 lp; check_mcode rp1 rp; match_expr expa expb]
625 | (Ast0.ArrayAccess(exp1a,lb1,exp2a,rb1),
626 Ast0.ArrayAccess(exp1b,lb,exp2b,rb)) ->
627 conjunct_many_bindings
628 [check_mcode lb1 lb; check_mcode rb1 rb;
629 match_expr exp1a exp1b; match_expr exp2a exp2b]
630 | (Ast0.RecordAccess(expa,opa,fielda),
631 Ast0.RecordAccess(expb,op,fieldb))
632 | (Ast0.RecordPtAccess(expa,opa,fielda),
633 Ast0.RecordPtAccess(expb,op,fieldb)) ->
634 conjunct_many_bindings
635 [check_mcode opa op; match_expr expa expb;
636 match_ident fielda fieldb]
637 | (Ast0.Cast(lp1,tya,rp1,expa),Ast0.Cast(lp,tyb,rp,expb)) ->
638 conjunct_many_bindings
639 [check_mcode lp1 lp; check_mcode rp1 rp;
640 match_typeC tya tyb; match_expr expa expb]
641 | (Ast0.SizeOfExpr(szf1,expa),Ast0.SizeOfExpr(szf,expb)) ->
642 conjunct_bindings (check_mcode szf1 szf) (match_expr expa expb)
643 | (Ast0.SizeOfType(szf1,lp1,tya,rp1),
644 Ast0.SizeOfType(szf,lp,tyb,rp)) ->
645 conjunct_many_bindings
646 [check_mcode lp1 lp; check_mcode rp1 rp;
647 check_mcode szf1 szf; match_typeC tya tyb]
648 | (Ast0.TypeExp(tya),Ast0.TypeExp(tyb)) ->
650 | (Ast0.EComma(cm1),Ast0.EComma(cm)) -> check_mcode cm1 cm
651 | (Ast0.DisjExpr(_,expsa,_,_),_) ->
652 failwith "not allowed in the pattern of an isomorphism"
653 | (Ast0.NestExpr(_,exp_dotsa,_,_,_),_) ->
654 failwith "not allowed in the pattern of an isomorphism"
655 | (Ast0.Edots(d,None),Ast0.Edots(d1,None))
656 | (Ast0.Ecircles(d,None),Ast0.Ecircles(d1,None))
657 | (Ast0.Estars(d,None),Ast0.Estars(d1,None)) -> check_mcode d d1
658 | (Ast0.Edots(ed,None),Ast0.Edots(ed1,Some wc))
659 | (Ast0.Ecircles(ed,None),Ast0.Ecircles(ed1,Some wc))
660 | (Ast0.Estars(ed,None),Ast0.Estars(ed1,Some wc)) ->
661 (* hope that mcode of edots is unique somehow *)
662 conjunct_bindings (check_mcode ed ed1)
663 (let (edots_whencode_allowed,_,_) = whencode_allowed in
664 if edots_whencode_allowed
665 then add_dot_binding ed (Ast0.ExprTag wc)
668 "warning: not applying iso because of whencode";
670 | (Ast0.Edots(_,Some _),_) | (Ast0.Ecircles(_,Some _),_)
671 | (Ast0.Estars(_,Some _),_) ->
672 failwith "whencode not allowed in a pattern1"
673 | (Ast0.OptExp(expa),Ast0.OptExp(expb))
674 | (Ast0.UniqueExp(expa),Ast0.UniqueExp(expb)) -> match_expr expa expb
675 | (_,Ast0.OptExp(expb))
676 | (_,Ast0.UniqueExp(expb)) -> match_expr pattern expb
678 else return_false (ContextRequired (Ast0.ExprTag expr))
680 (* the special case for function types prevents the eg T X; -> T X = E; iso
681 from applying, which doesn't seem very relevant, but it also avoids a
682 mysterious bug that is obtained with eg int attach(...); *)
683 and match_typeC pattern t =
684 match Ast0.unwrap pattern with
685 Ast0.MetaType(name,pure) ->
686 (match Ast0.unwrap t with
687 Ast0.FunctionType(tya,lp1a,paramsa,rp1a) -> return false
689 add_pure_binding name pure pure_sp_code.V0.combiner_typeC
690 (function ty -> Ast0.TypeCTag ty)
693 if not(checks_needed) or not(context_required) or is_context t
695 match (up,Ast0.unwrap t) with
696 (Ast0.ConstVol(cva,tya),Ast0.ConstVol(cvb,tyb)) ->
697 if mcode_equal cva cvb
699 conjunct_bindings (check_mcode cva cvb) (match_typeC tya tyb)
701 | (Ast0.BaseType(tya,signa),Ast0.BaseType(tyb,signb)) ->
702 if (mcode_equal tya tyb &&
703 bool_match_option mcode_equal signa signb)
705 conjunct_bindings (check_mcode tya tyb)
706 (match_option check_mcode signa signb)
708 | (Ast0.ImplicitInt(signa),Ast0.ImplicitInt(signb)) ->
709 if mcode_equal signa signb
710 then check_mcode signa signb
712 | (Ast0.Pointer(tya,star1),Ast0.Pointer(tyb,star)) ->
713 conjunct_bindings (check_mcode star1 star) (match_typeC tya tyb)
714 | (Ast0.FunctionPointer(tya,lp1a,stara,rp1a,lp2a,paramsa,rp2a),
715 Ast0.FunctionPointer(tyb,lp1b,starb,rp1b,lp2b,paramsb,rp2b)) ->
716 conjunct_many_bindings
717 [check_mcode stara starb; check_mcode lp1a lp1b;
718 check_mcode rp1a rp1b; check_mcode lp2a lp2b;
719 check_mcode rp2a rp2b; match_typeC tya tyb;
720 match_dots match_param is_plist_matcher
721 do_plist_match paramsa paramsb]
722 | (Ast0.FunctionType(tya,lp1a,paramsa,rp1a),
723 Ast0.FunctionType(tyb,lp1b,paramsb,rp1b)) ->
724 conjunct_many_bindings
725 [check_mcode lp1a lp1b; check_mcode rp1a rp1b;
726 match_option match_typeC tya tyb;
727 match_dots match_param is_plist_matcher do_plist_match
729 | (Ast0.Array(tya,lb1,sizea,rb1),Ast0.Array(tyb,lb,sizeb,rb)) ->
730 conjunct_many_bindings
731 [check_mcode lb1 lb; check_mcode rb1 rb;
732 match_typeC tya tyb; match_option match_expr sizea sizeb]
733 | (Ast0.StructUnionName(kinda,Some namea),
734 Ast0.StructUnionName(kindb,Some nameb)) ->
735 if mcode_equal kinda kindb
737 conjunct_bindings (check_mcode kinda kindb)
738 (match_ident namea nameb)
740 | (Ast0.StructUnionDef(tya,lb1,declsa,rb1),
741 Ast0.StructUnionDef(tyb,lb,declsb,rb)) ->
742 conjunct_many_bindings
743 [check_mcode lb1 lb; check_mcode rb1 rb;
745 match_dots match_decl no_list do_nolist_match declsa declsb]
746 | (Ast0.TypeName(namea),Ast0.TypeName(nameb)) ->
747 if mcode_equal namea nameb
748 then check_mcode namea nameb
750 | (Ast0.DisjType(_,typesa,_,_),Ast0.DisjType(_,typesb,_,_)) ->
751 failwith "not allowed in the pattern of an isomorphism"
752 | (Ast0.OptType(tya),Ast0.OptType(tyb))
753 | (Ast0.UniqueType(tya),Ast0.UniqueType(tyb)) -> match_typeC tya tyb
754 | (_,Ast0.OptType(tyb))
755 | (_,Ast0.UniqueType(tyb)) -> match_typeC pattern tyb
757 else return_false (ContextRequired (Ast0.TypeCTag t))
759 and match_decl pattern d =
760 if not(checks_needed) or not(context_required) or is_context d
762 match (Ast0.unwrap pattern,Ast0.unwrap d) with
763 (Ast0.Init(stga,tya,ida,eq1,inia,sc1),
764 Ast0.Init(stgb,tyb,idb,eq,inib,sc)) ->
765 if bool_match_option mcode_equal stga stgb
767 conjunct_many_bindings
768 [check_mcode eq1 eq; check_mcode sc1 sc;
769 match_option check_mcode stga stgb;
770 match_typeC tya tyb; match_ident ida idb;
771 match_init inia inib]
773 | (Ast0.UnInit(stga,tya,ida,sc1),Ast0.UnInit(stgb,tyb,idb,sc)) ->
774 if bool_match_option mcode_equal stga stgb
776 conjunct_many_bindings
777 [check_mcode sc1 sc; match_option check_mcode stga stgb;
778 match_typeC tya tyb; match_ident ida idb]
780 | (Ast0.MacroDecl(namea,lp1,argsa,rp1,sc1),
781 Ast0.MacroDecl(nameb,lp,argsb,rp,sc)) ->
782 conjunct_many_bindings
783 [match_ident namea nameb;
784 check_mcode lp1 lp; check_mcode rp1 rp;
786 match_dots match_expr is_elist_matcher do_elist_match
788 | (Ast0.TyDecl(tya,sc1),Ast0.TyDecl(tyb,sc)) ->
789 conjunct_bindings (check_mcode sc1 sc) (match_typeC tya tyb)
790 | (Ast0.Typedef(stga,tya,ida,sc1),Ast0.Typedef(stgb,tyb,idb,sc)) ->
791 conjunct_bindings (check_mcode sc1 sc)
792 (conjunct_bindings (match_typeC tya tyb) (match_typeC ida idb))
793 | (Ast0.DisjDecl(_,declsa,_,_),Ast0.DisjDecl(_,declsb,_,_)) ->
794 failwith "not allowed in the pattern of an isomorphism"
795 | (Ast0.Ddots(d1,None),Ast0.Ddots(d,None)) -> check_mcode d1 d
796 | (Ast0.Ddots(dd,None),Ast0.Ddots(d,Some wc)) ->
797 conjunct_bindings (check_mcode dd d)
798 (* hope that mcode of ddots is unique somehow *)
799 (let (ddots_whencode_allowed,_,_) = whencode_allowed in
800 if ddots_whencode_allowed
801 then add_dot_binding dd (Ast0.DeclTag wc)
803 (Printf.printf "warning: not applying iso because of whencode";
805 | (Ast0.Ddots(_,Some _),_) ->
806 failwith "whencode not allowed in a pattern1"
808 | (Ast0.OptDecl(decla),Ast0.OptDecl(declb))
809 | (Ast0.UniqueDecl(decla),Ast0.UniqueDecl(declb)) ->
810 match_decl decla declb
811 | (_,Ast0.OptDecl(declb))
812 | (_,Ast0.UniqueDecl(declb)) ->
813 match_decl pattern declb
815 else return_false (ContextRequired (Ast0.DeclTag d))
817 and match_init pattern i =
818 if not(checks_needed) or not(context_required) or is_context i
820 match (Ast0.unwrap pattern,Ast0.unwrap i) with
821 (Ast0.InitExpr(expa),Ast0.InitExpr(expb)) ->
823 | (Ast0.InitList(lb1,initlista,rb1),Ast0.InitList(lb,initlistb,rb)) ->
824 conjunct_many_bindings
825 [check_mcode lb1 lb; check_mcode rb1 rb;
826 match_dots match_init no_list do_nolist_match
828 | (Ast0.InitGccDotName(d1,namea,e1,inia),
829 Ast0.InitGccDotName(d,nameb,e,inib)) ->
830 conjunct_many_bindings
831 [check_mcode d1 d; check_mcode e1 e;
832 match_ident namea nameb; match_init inia inib]
833 | (Ast0.InitGccName(namea,c1,inia),Ast0.InitGccName(nameb,c,inib)) ->
834 conjunct_many_bindings
835 [check_mcode c1 c; match_ident namea nameb;
836 match_init inia inib]
837 | (Ast0.InitGccIndex(lb1,expa,rb1,e1,inia),
838 Ast0.InitGccIndex(lb2,expb,rb2,e2,inib)) ->
839 conjunct_many_bindings
840 [check_mcode lb1 lb2; check_mcode rb1 rb2; check_mcode e1 e2;
841 match_expr expa expb; match_init inia inib]
842 | (Ast0.InitGccRange(lb1,exp1a,d1,exp2a,rb1,e1,inia),
843 Ast0.InitGccRange(lb2,exp1b,d2,exp2b,rb2,e2,inib)) ->
844 conjunct_many_bindings
845 [check_mcode lb1 lb2; check_mcode d1 d2;
846 check_mcode rb1 rb2; check_mcode e1 e2;
847 match_expr exp1a exp1b; match_expr exp2a exp2b;
848 match_init inia inib]
849 | (Ast0.IComma(c1),Ast0.IComma(c)) -> check_mcode c1 c
850 | (Ast0.Idots(d1,None),Ast0.Idots(d,None)) -> check_mcode d1 d
851 | (Ast0.Idots(id,None),Ast0.Idots(d,Some wc)) ->
852 conjunct_bindings (check_mcode id d)
853 (* hope that mcode of edots is unique somehow *)
854 (let (_,idots_whencode_allowed,_) = whencode_allowed in
855 if idots_whencode_allowed
856 then add_dot_binding id (Ast0.InitTag wc)
858 (Printf.printf "warning: not applying iso because of whencode";
860 | (Ast0.Idots(_,Some _),_) ->
861 failwith "whencode not allowed in a pattern2"
862 | (Ast0.OptIni(ia),Ast0.OptIni(ib))
863 | (Ast0.UniqueIni(ia),Ast0.UniqueIni(ib)) -> match_init ia ib
864 | (_,Ast0.OptIni(ib))
865 | (_,Ast0.UniqueIni(ib)) -> match_init pattern ib
867 else return_false (ContextRequired (Ast0.InitTag i))
869 and match_param pattern p =
870 match Ast0.unwrap pattern with
871 Ast0.MetaParam(name,pure) ->
872 add_pure_binding name pure pure_sp_code.V0.combiner_parameter
873 (function p -> Ast0.ParamTag p)
875 | Ast0.MetaParamList(name,_,pure) -> failwith "metaparamlist not supported"
877 if not(checks_needed) or not(context_required) or is_context p
879 match (up,Ast0.unwrap p) with
880 (Ast0.VoidParam(tya),Ast0.VoidParam(tyb)) -> match_typeC tya tyb
881 | (Ast0.Param(tya,ida),Ast0.Param(tyb,idb)) ->
882 conjunct_bindings (match_typeC tya tyb)
883 (match_option match_ident ida idb)
884 | (Ast0.PComma(c1),Ast0.PComma(c)) -> check_mcode c1 c
885 | (Ast0.Pdots(d1),Ast0.Pdots(d))
886 | (Ast0.Pcircles(d1),Ast0.Pcircles(d)) -> check_mcode d1 d
887 | (Ast0.OptParam(parama),Ast0.OptParam(paramb))
888 | (Ast0.UniqueParam(parama),Ast0.UniqueParam(paramb)) ->
889 match_param parama paramb
890 | (_,Ast0.OptParam(paramb))
891 | (_,Ast0.UniqueParam(paramb)) -> match_param pattern paramb
893 else return_false (ContextRequired (Ast0.ParamTag p))
895 and match_statement pattern s =
896 match Ast0.unwrap pattern with
897 Ast0.MetaStmt(name,pure) ->
898 (match Ast0.unwrap s with
899 Ast0.Dots(_,_) | Ast0.Circles(_,_) | Ast0.Stars(_,_) ->
900 return false (* ... is not a single statement *)
902 add_pure_binding name pure pure_sp_code.V0.combiner_statement
903 (function ty -> Ast0.StmtTag ty)
905 | Ast0.MetaStmtList(name,pure) -> failwith "metastmtlist not supported"
907 if not(checks_needed) or not(context_required) or is_context s
909 match (up,Ast0.unwrap s) with
910 (Ast0.FunDecl(_,fninfoa,namea,lp1,paramsa,rp1,lb1,bodya,rb1),
911 Ast0.FunDecl(_,fninfob,nameb,lp,paramsb,rp,lb,bodyb,rb)) ->
912 conjunct_many_bindings
913 [check_mcode lp1 lp; check_mcode rp1 rp;
914 check_mcode lb1 lb; check_mcode rb1 rb;
915 match_fninfo fninfoa fninfob; match_ident namea nameb;
916 match_dots match_param is_plist_matcher do_plist_match
918 match_dots match_statement is_slist_matcher do_slist_match
920 | (Ast0.Decl(_,decla),Ast0.Decl(_,declb)) ->
921 match_decl decla declb
922 | (Ast0.Seq(lb1,bodya,rb1),Ast0.Seq(lb,bodyb,rb)) ->
923 (* seqs can only match if they are all minus (plus code
924 allowed) or all context (plus code not allowed in the body).
925 we could be more permissive if the expansions of the isos are
926 also all seqs, but this would be hard to check except at top
927 level, and perhaps not worth checking even in that case.
928 Overall, the issue is that braces are used where single
929 statements are required, and something not satisfying these
930 conditions can cause a single statement to become a
931 non-single statement after the transformation.
933 example: if { ... -foo(); ... }
934 if we let the sequence convert to just -foo();
935 then we produce invalid code. For some reason,
936 single_statement can't deal with this case, perhaps because
937 it starts introducing too many braces? don't remember the
940 conjunct_bindings (check_mcode lb1 lb)
941 (conjunct_bindings (check_mcode rb1 rb)
942 (if not(checks_needed) or is_minus s or
944 List.for_all is_pure_context (Ast0.undots bodyb))
946 match_dots match_statement is_slist_matcher do_slist_match
948 else return_false (Braces(s))))
949 | (Ast0.ExprStatement(expa,sc1),Ast0.ExprStatement(expb,sc)) ->
950 conjunct_bindings (check_mcode sc1 sc) (match_expr expa expb)
951 | (Ast0.IfThen(if1,lp1,expa,rp1,branch1a,_),
952 Ast0.IfThen(if2,lp2,expb,rp2,branch1b,_)) ->
953 conjunct_many_bindings
954 [check_mcode if1 if2; check_mcode lp1 lp2;
956 match_expr expa expb;
957 match_statement branch1a branch1b]
958 | (Ast0.IfThenElse(if1,lp1,expa,rp1,branch1a,e1,branch2a,_),
959 Ast0.IfThenElse(if2,lp2,expb,rp2,branch1b,e2,branch2b,_)) ->
960 conjunct_many_bindings
961 [check_mcode if1 if2; check_mcode lp1 lp2;
962 check_mcode rp1 rp2; check_mcode e1 e2;
963 match_expr expa expb;
964 match_statement branch1a branch1b;
965 match_statement branch2a branch2b]
966 | (Ast0.While(w1,lp1,expa,rp1,bodya,_),
967 Ast0.While(w,lp,expb,rp,bodyb,_)) ->
968 conjunct_many_bindings
969 [check_mcode w1 w; check_mcode lp1 lp;
970 check_mcode rp1 rp; match_expr expa expb;
971 match_statement bodya bodyb]
972 | (Ast0.Do(d1,bodya,w1,lp1,expa,rp1,_),
973 Ast0.Do(d,bodyb,w,lp,expb,rp,_)) ->
974 conjunct_many_bindings
975 [check_mcode d1 d; check_mcode w1 w; check_mcode lp1 lp;
976 check_mcode rp1 rp; match_statement bodya bodyb;
977 match_expr expa expb]
978 | (Ast0.For(f1,lp1,e1a,sc1a,e2a,sc2a,e3a,rp1,bodya,_),
979 Ast0.For(f,lp,e1b,sc1b,e2b,sc2b,e3b,rp,bodyb,_)) ->
980 conjunct_many_bindings
981 [check_mcode f1 f; check_mcode lp1 lp; check_mcode sc1a sc1b;
982 check_mcode sc2a sc2b; check_mcode rp1 rp;
983 match_option match_expr e1a e1b;
984 match_option match_expr e2a e2b;
985 match_option match_expr e3a e3b;
986 match_statement bodya bodyb]
987 | (Ast0.Iterator(nma,lp1,argsa,rp1,bodya,_),
988 Ast0.Iterator(nmb,lp,argsb,rp,bodyb,_)) ->
989 conjunct_many_bindings
990 [match_ident nma nmb;
991 check_mcode lp1 lp; check_mcode rp1 rp;
992 match_dots match_expr is_elist_matcher do_elist_match
994 match_statement bodya bodyb]
995 | (Ast0.Switch(s1,lp1,expa,rp1,lb1,casesa,rb1),
996 Ast0.Switch(s,lp,expb,rp,lb,casesb,rb)) ->
997 conjunct_many_bindings
998 [check_mcode s1 s; check_mcode lp1 lp; check_mcode rp1 rp;
999 check_mcode lb1 lb; check_mcode rb1 rb;
1000 match_expr expa expb;
1001 match_dots match_case_line no_list do_nolist_match
1003 | (Ast0.Break(b1,sc1),Ast0.Break(b,sc))
1004 | (Ast0.Continue(b1,sc1),Ast0.Continue(b,sc)) ->
1005 conjunct_bindings (check_mcode b1 b) (check_mcode sc1 sc)
1006 | (Ast0.Label(l1,c1),Ast0.Label(l2,c)) ->
1007 conjunct_bindings (match_ident l1 l2) (check_mcode c1 c)
1008 | (Ast0.Goto(g1,l1,sc1),Ast0.Goto(g,l2,sc)) ->
1009 conjunct_many_bindings
1010 [check_mcode g1 g; check_mcode sc1 sc; match_ident l1 l2]
1011 | (Ast0.Return(r1,sc1),Ast0.Return(r,sc)) ->
1012 conjunct_bindings (check_mcode r1 r) (check_mcode sc1 sc)
1013 | (Ast0.ReturnExpr(r1,expa,sc1),Ast0.ReturnExpr(r,expb,sc)) ->
1014 conjunct_many_bindings
1015 [check_mcode r1 r; check_mcode sc1 sc; match_expr expa expb]
1016 | (Ast0.Disj(_,statement_dots_lista,_,_),_) ->
1017 failwith "disj not supported in patterns"
1018 | (Ast0.Nest(_,stmt_dotsa,_,_,_),_) ->
1019 failwith "nest not supported in patterns"
1020 | (Ast0.Exp(expa),Ast0.Exp(expb)) -> match_expr expa expb
1021 | (Ast0.TopExp(expa),Ast0.TopExp(expb)) -> match_expr expa expb
1022 | (Ast0.Exp(expa),Ast0.TopExp(expb)) -> match_expr expa expb
1023 | (Ast0.Ty(tya),Ast0.Ty(tyb)) -> match_typeC tya tyb
1024 | (Ast0.Dots(d,[]),Ast0.Dots(d1,wc))
1025 | (Ast0.Circles(d,[]),Ast0.Circles(d1,wc))
1026 | (Ast0.Stars(d,[]),Ast0.Stars(d1,wc)) ->
1028 [] -> check_mcode d d1
1030 let (_,_,dots_whencode_allowed) = whencode_allowed in
1031 if dots_whencode_allowed
1033 conjunct_bindings (check_mcode d d1)
1037 | Ast0.WhenNot wc ->
1038 conjunct_bindings prev
1039 (add_multi_dot_binding d
1040 (Ast0.DotsStmtTag wc))
1041 | Ast0.WhenAlways wc ->
1042 conjunct_bindings prev
1043 (add_multi_dot_binding d (Ast0.StmtTag wc))
1044 | Ast0.WhenModifier(x) ->
1045 conjunct_bindings prev
1046 (add_multi_dot_binding d
1047 (Ast0.IsoWhenTag x)))
1051 "warning: not applying iso because of whencode";
1053 | (Ast0.Dots(_,_::_),_) | (Ast0.Circles(_,_::_),_)
1054 | (Ast0.Stars(_,_::_),_) ->
1055 failwith "whencode not allowed in a pattern3"
1056 | (Ast0.OptStm(rea),Ast0.OptStm(reb))
1057 | (Ast0.UniqueStm(rea),Ast0.UniqueStm(reb)) ->
1058 match_statement rea reb
1059 | (_,Ast0.OptStm(reb))
1060 | (_,Ast0.UniqueStm(reb)) -> match_statement pattern reb
1062 else return_false (ContextRequired (Ast0.StmtTag s))
1064 (* first should provide a subset of the information in the second *)
1065 and match_fninfo patterninfo cinfo =
1066 let patterninfo = List.sort compare patterninfo in
1067 let cinfo = List.sort compare cinfo in
1068 let rec loop = function
1069 (Ast0.FStorage(sta)::resta,Ast0.FStorage(stb)::restb) ->
1070 if mcode_equal sta stb
1071 then conjunct_bindings (check_mcode sta stb) (loop (resta,restb))
1073 | (Ast0.FType(tya)::resta,Ast0.FType(tyb)::restb) ->
1074 conjunct_bindings (match_typeC tya tyb) (loop (resta,restb))
1075 | (Ast0.FInline(ia)::resta,Ast0.FInline(ib)::restb) ->
1076 if mcode_equal ia ib
1077 then conjunct_bindings (check_mcode ia ib) (loop (resta,restb))
1079 | (Ast0.FAttr(ia)::resta,Ast0.FAttr(ib)::restb) ->
1080 if mcode_equal ia ib
1081 then conjunct_bindings (check_mcode ia ib) (loop (resta,restb))
1083 | (x::resta,((y::_) as restb)) ->
1084 (match compare x y with
1086 | 1 -> loop (resta,restb)
1087 | _ -> failwith "not possible")
1088 | _ -> return false in
1089 loop (patterninfo,cinfo)
1091 and match_case_line pattern c =
1092 if not(checks_needed) or not(context_required) or is_context c
1094 match (Ast0.unwrap pattern,Ast0.unwrap c) with
1095 (Ast0.Default(d1,c1,codea),Ast0.Default(d,c,codeb)) ->
1096 conjunct_many_bindings
1097 [check_mcode d1 d; check_mcode c1 c;
1098 match_dots match_statement is_slist_matcher do_slist_match
1100 | (Ast0.Case(ca1,expa,c1,codea),Ast0.Case(ca,expb,c,codeb)) ->
1101 conjunct_many_bindings
1102 [check_mcode ca1 ca; check_mcode c1 c; match_expr expa expb;
1103 match_dots match_statement is_slist_matcher do_slist_match
1105 | (Ast0.OptCase(ca),Ast0.OptCase(cb)) -> match_case_line ca cb
1106 | (_,Ast0.OptCase(cb)) -> match_case_line pattern cb
1108 else return_false (ContextRequired (Ast0.CaseLineTag c)) in
1110 let match_statement_dots x y =
1111 match_dots match_statement is_slist_matcher do_slist_match x y in
1113 (match_expr, match_decl, match_statement, match_typeC,
1114 match_statement_dots)
1116 let match_expr dochecks context_required whencode_allowed =
1117 let (fn,_,_,_,_) = match_maker dochecks context_required whencode_allowed in
1120 let match_decl dochecks context_required whencode_allowed =
1121 let (_,fn,_,_,_) = match_maker dochecks context_required whencode_allowed in
1124 let match_statement dochecks context_required whencode_allowed =
1125 let (_,_,fn,_,_) = match_maker dochecks context_required whencode_allowed in
1128 let match_typeC dochecks context_required whencode_allowed =
1129 let (_,_,_,fn,_) = match_maker dochecks context_required whencode_allowed in
1132 let match_statement_dots dochecks context_required whencode_allowed =
1133 let (_,_,_,_,fn) = match_maker dochecks context_required whencode_allowed in
1136 (* --------------------------------------------------------------------- *)
1137 (* make an entire tree MINUS *)
1140 let mcode (term,arity,info,mcodekind,pos) =
1142 match mcodekind with
1145 (Ast.NOTHING,_,_) -> Ast0.MINUS(ref([],Ast0.default_token_info))
1146 | _ -> failwith "make_minus: unexpected befaft")
1147 | Ast0.MINUS(mc) -> mcodekind (* in the part copied from the src term *)
1148 | _ -> failwith "make_minus mcode: unexpected mcodekind" in
1149 (term,arity,info,new_mcodekind,pos) in
1151 let update_mc mcodekind e =
1152 match !mcodekind with
1155 (Ast.NOTHING,_,_) ->
1156 mcodekind := Ast0.MINUS(ref([],Ast0.default_token_info))
1157 | _ -> failwith "make_minus: unexpected befaft")
1158 | Ast0.MINUS(_mc) -> () (* in the part copied from the src term *)
1159 | Ast0.PLUS -> failwith "make_minus donothing: unexpected plus mcodekind"
1160 | _ -> failwith "make_minus donothing: unexpected mcodekind" in
1162 let donothing r k e =
1163 let mcodekind = Ast0.get_mcodekind_ref e in
1164 let e = k e in update_mc mcodekind e; e in
1166 (* special case for whencode, because it isn't processed by contextneg,
1167 since it doesn't appear in the + code *)
1168 (* cases for dots and nests *)
1169 let expression r k e =
1170 let mcodekind = Ast0.get_mcodekind_ref e in
1171 match Ast0.unwrap e with
1172 Ast0.Edots(d,whencode) ->
1173 (*don't recurse because whencode hasn't been processed by context_neg*)
1174 update_mc mcodekind e; Ast0.rewrap e (Ast0.Edots(mcode d,whencode))
1175 | Ast0.Ecircles(d,whencode) ->
1176 (*don't recurse because whencode hasn't been processed by context_neg*)
1177 update_mc mcodekind e; Ast0.rewrap e (Ast0.Ecircles(mcode d,whencode))
1178 | Ast0.Estars(d,whencode) ->
1179 (*don't recurse because whencode hasn't been processed by context_neg*)
1180 update_mc mcodekind e; Ast0.rewrap e (Ast0.Estars(mcode d,whencode))
1181 | Ast0.NestExpr(starter,expr_dots,ender,whencode,multi) ->
1182 update_mc mcodekind e;
1184 (Ast0.NestExpr(mcode starter,
1185 r.V0.rebuilder_expression_dots expr_dots,
1186 mcode ender,whencode,multi))
1187 | _ -> donothing r k e in
1189 let declaration r k e =
1190 let mcodekind = Ast0.get_mcodekind_ref e in
1191 match Ast0.unwrap e with
1192 Ast0.Ddots(d,whencode) ->
1193 (*don't recurse because whencode hasn't been processed by context_neg*)
1194 update_mc mcodekind e; Ast0.rewrap e (Ast0.Ddots(mcode d,whencode))
1195 | _ -> donothing r k e in
1197 let statement r k e =
1198 let mcodekind = Ast0.get_mcodekind_ref e in
1199 match Ast0.unwrap e with
1200 Ast0.Dots(d,whencode) ->
1201 (*don't recurse because whencode hasn't been processed by context_neg*)
1202 update_mc mcodekind e; Ast0.rewrap e (Ast0.Dots(mcode d,whencode))
1203 | Ast0.Circles(d,whencode) ->
1204 update_mc mcodekind e; Ast0.rewrap e (Ast0.Circles(mcode d,whencode))
1205 | Ast0.Stars(d,whencode) ->
1206 update_mc mcodekind e; Ast0.rewrap e (Ast0.Stars(mcode d,whencode))
1207 | Ast0.Nest(starter,stmt_dots,ender,whencode,multi) ->
1208 update_mc mcodekind e;
1210 (Ast0.Nest(mcode starter,r.V0.rebuilder_statement_dots stmt_dots,
1211 mcode ender,whencode,multi))
1212 | _ -> donothing r k e in
1214 let initialiser r k e =
1215 let mcodekind = Ast0.get_mcodekind_ref e in
1216 match Ast0.unwrap e with
1217 Ast0.Idots(d,whencode) ->
1218 (*don't recurse because whencode hasn't been processed by context_neg*)
1219 update_mc mcodekind e; Ast0.rewrap e (Ast0.Idots(mcode d,whencode))
1220 | _ -> donothing r k e in
1223 let info = Ast0.get_info e in
1224 let mcodekind = Ast0.get_mcodekind_ref e in
1225 match Ast0.unwrap e with
1227 (* if context is - this should be - as well. There are no tokens
1228 here though, so the bottom-up minusifier in context_neg leaves it
1229 as mixed. It would be better to fix context_neg, but that would
1230 require a special case for each term with a dots subterm. *)
1231 (match !mcodekind with
1234 (Ast.NOTHING,_,_) ->
1235 mcodekind := Ast0.MINUS(ref([],Ast0.default_token_info));
1237 | _ -> failwith "make_minus: unexpected befaft")
1238 (* code already processed by an enclosing iso *)
1239 | Ast0.MINUS(mc) -> e
1243 "%d: make_minus donothingxxx: unexpected mcodekind"
1244 info.Ast0.line_start))
1245 | _ -> donothing r k e in
1248 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
1250 dots dots dots dots dots dots
1251 donothing expression donothing initialiser donothing declaration
1252 statement donothing donothing
1254 (* --------------------------------------------------------------------- *)
1255 (* rebuild mcode cells in an instantiated alt *)
1257 (* mcodes will be side effected later with plus code, so we have to copy
1258 them on instantiating an isomorphism. One could wonder whether it would
1259 be better not to use side-effects, but they are convenient for insert_plus
1260 where is it useful to manipulate a list of the mcodes but side-effect a
1262 (* hmm... Insert_plus is called before Iso_pattern... *)
1263 let rebuild_mcode start_line =
1264 let copy_mcodekind = function
1265 Ast0.CONTEXT(mc) -> Ast0.CONTEXT(ref (!mc))
1266 | Ast0.MINUS(mc) -> Ast0.MINUS(ref (!mc))
1267 | Ast0.MIXED(mc) -> Ast0.MIXED(ref (!mc))
1269 (* this function is used elsewhere where we need to rebuild the
1270 indices, and so we allow PLUS code as well *)
1273 let mcode (term,arity,info,mcodekind,pos) =
1275 match start_line with
1276 Some x -> {info with Ast0.line_start = x; Ast0.line_end = x}
1278 (term,arity,info,copy_mcodekind mcodekind,pos) in
1281 let old_info = Ast0.get_info x in
1283 match start_line with
1284 Some x -> {old_info with Ast0.line_start = x; Ast0.line_end = x}
1285 | None -> old_info in
1286 {x with Ast0.info = info; Ast0.index = ref(Ast0.get_index x);
1287 Ast0.mcodekind = ref (copy_mcodekind (Ast0.get_mcodekind x))} in
1289 let donothing r k e = copy_one (k e) in
1291 (* case for control operators (if, etc) *)
1292 let statement r k e =
1297 (match Ast0.unwrap s with
1298 Ast0.Decl((info,mc),decl) ->
1299 Ast0.Decl((info,copy_mcodekind mc),decl)
1300 | Ast0.IfThen(iff,lp,tst,rp,branch,(info,mc)) ->
1301 Ast0.IfThen(iff,lp,tst,rp,branch,(info,copy_mcodekind mc))
1302 | Ast0.IfThenElse(iff,lp,tst,rp,branch1,els,branch2,(info,mc)) ->
1303 Ast0.IfThenElse(iff,lp,tst,rp,branch1,els,branch2,
1304 (info,copy_mcodekind mc))
1305 | Ast0.While(whl,lp,exp,rp,body,(info,mc)) ->
1306 Ast0.While(whl,lp,exp,rp,body,(info,copy_mcodekind mc))
1307 | Ast0.For(fr,lp,e1,sem1,e2,sem2,e3,rp,body,(info,mc)) ->
1308 Ast0.For(fr,lp,e1,sem1,e2,sem2,e3,rp,body,
1309 (info,copy_mcodekind mc))
1310 | Ast0.Iterator(nm,lp,args,rp,body,(info,mc)) ->
1311 Ast0.Iterator(nm,lp,args,rp,body,(info,copy_mcodekind mc))
1313 ((info,mc),fninfo,name,lp,params,rp,lbrace,body,rbrace) ->
1315 ((info,copy_mcodekind mc),
1316 fninfo,name,lp,params,rp,lbrace,body,rbrace)
1318 Ast0.set_dots_bef_aft res
1319 (match Ast0.get_dots_bef_aft res with
1320 Ast0.NoDots -> Ast0.NoDots
1321 | Ast0.AddingBetweenDots s ->
1322 Ast0.AddingBetweenDots(r.V0.rebuilder_statement s)
1323 | Ast0.DroppingBetweenDots s ->
1324 Ast0.DroppingBetweenDots(r.V0.rebuilder_statement s)) in
1327 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
1329 donothing donothing donothing donothing donothing donothing
1330 donothing donothing donothing donothing donothing
1331 donothing statement donothing donothing
1333 (* --------------------------------------------------------------------- *)
1334 (* The problem of whencode. If an isomorphism contains dots in multiple
1335 rules, then the code that is matched cannot contain whencode, because we
1336 won't know which dots it goes with. Should worry about nests, but they
1337 aren't allowed in isomorphisms for the moment. *)
1341 let option_default = 0 in
1342 let bind x y = x + y in
1343 let donothing r k e = k e in
1345 match Ast0.unwrap e with
1346 Ast0.Edots(_,_) | Ast0.Ecircles(_,_) | Ast0.Estars(_,_) -> 1
1349 V0.combiner bind option_default
1350 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
1352 donothing donothing donothing donothing donothing donothing
1353 donothing exprfn donothing donothing donothing donothing donothing
1358 let option_default = 0 in
1359 let bind x y = x + y in
1360 let donothing r k e = k e in
1362 match Ast0.unwrap e with Ast0.Idots(_,_) -> 1 | _ -> 0 in
1364 V0.combiner bind option_default
1365 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
1367 donothing donothing donothing donothing donothing donothing
1368 donothing donothing donothing initfn donothing donothing donothing
1373 let option_default = 0 in
1374 let bind x y = x + y in
1375 let donothing r k e = k e in
1377 match Ast0.unwrap e with
1378 Ast0.Dots(_,_) | Ast0.Circles(_,_) | Ast0.Stars(_,_) -> 1
1381 V0.combiner bind option_default
1382 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
1384 donothing donothing donothing donothing donothing donothing
1385 donothing donothing donothing donothing donothing donothing stmtfn
1388 (* --------------------------------------------------------------------- *)
1390 let lookup name bindings mv_bindings =
1391 try Common.Left (List.assoc (term name) bindings)
1394 (* failure is not possible anymore *)
1395 Common.Right (List.assoc (term name) mv_bindings)
1397 (* mv_bindings is for the fresh metavariables that are introduced by the
1399 let instantiate bindings mv_bindings =
1401 match Ast0.get_pos x with
1402 Ast0.MetaPos(name,_,_) ->
1404 match lookup name bindings mv_bindings with
1405 Common.Left(Ast0.MetaPosTag(id)) -> Ast0.set_pos id x
1406 | _ -> failwith "not possible"
1407 with Not_found -> Ast0.set_pos Ast0.NoMetaPos x)
1409 let donothing r k e = k e in
1411 (* cases where metavariables can occur *)
1414 match Ast0.unwrap e with
1415 Ast0.MetaId(name,constraints,pure) ->
1416 (rebuild_mcode None).V0.rebuilder_ident
1417 (match lookup name bindings mv_bindings with
1418 Common.Left(Ast0.IdentTag(id)) -> id
1419 | Common.Left(_) -> failwith "not possible 1"
1420 | Common.Right(new_mv) ->
1423 (Ast0.set_mcode_data new_mv name,constraints,pure)))
1424 | Ast0.MetaFunc(name,_,pure) -> failwith "metafunc not supported"
1425 | Ast0.MetaLocalFunc(name,_,pure) -> failwith "metalocalfunc not supported"
1428 (* case for list metavariables *)
1429 let rec elist r same_dots = function
1432 (match Ast0.unwrap x with
1433 Ast0.MetaExprList(name,lenname,pure) ->
1434 failwith "meta_expr_list in iso not supported"
1435 (*match lookup name bindings mv_bindings with
1436 Common.Left(Ast0.DotsExprTag(exp)) ->
1437 (match same_dots exp with
1439 | None -> failwith "dots put in incompatible context")
1440 | Common.Left(Ast0.ExprTag(exp)) -> [exp]
1441 | Common.Left(_) -> failwith "not possible 1"
1442 | Common.Right(new_mv) ->
1443 failwith "MetaExprList in SP not supported"*)
1444 | _ -> [r.V0.rebuilder_expression x])
1445 | x::xs -> (r.V0.rebuilder_expression x)::(elist r same_dots xs) in
1447 let rec plist r same_dots = function
1450 (match Ast0.unwrap x with
1451 Ast0.MetaParamList(name,lenname,pure) ->
1452 failwith "meta_param_list in iso not supported"
1453 (*match lookup name bindings mv_bindings with
1454 Common.Left(Ast0.DotsParamTag(param)) ->
1455 (match same_dots param with
1457 | None -> failwith "dots put in incompatible context")
1458 | Common.Left(Ast0.ParamTag(param)) -> [param]
1459 | Common.Left(_) -> failwith "not possible 1"
1460 | Common.Right(new_mv) ->
1461 failwith "MetaExprList in SP not supported"*)
1462 | _ -> [r.V0.rebuilder_parameter x])
1463 | x::xs -> (r.V0.rebuilder_parameter x)::(plist r same_dots xs) in
1465 let rec slist r same_dots = function
1468 (match Ast0.unwrap x with
1469 Ast0.MetaStmtList(name,pure) ->
1470 (match lookup name bindings mv_bindings with
1471 Common.Left(Ast0.DotsStmtTag(stm)) ->
1472 (match same_dots stm with
1474 | None -> failwith "dots put in incompatible context")
1475 | Common.Left(Ast0.StmtTag(stm)) -> [stm]
1476 | Common.Left(_) -> failwith "not possible 1"
1477 | Common.Right(new_mv) ->
1478 failwith "MetaExprList in SP not supported")
1479 | _ -> [r.V0.rebuilder_statement x])
1480 | x::xs -> (r.V0.rebuilder_statement x)::(slist r same_dots xs) in
1483 match Ast0.unwrap d with Ast0.DOTS(l) -> Some l |_ -> None in
1484 let same_circles d =
1485 match Ast0.unwrap d with Ast0.CIRCLES(l) -> Some l |_ -> None in
1487 match Ast0.unwrap d with Ast0.STARS(l) -> Some l |_ -> None in
1489 let dots list_fn r k d =
1491 (match Ast0.unwrap d with
1492 Ast0.DOTS(l) -> Ast0.DOTS(list_fn r same_dots l)
1493 | Ast0.CIRCLES(l) -> Ast0.CIRCLES(list_fn r same_circles l)
1494 | Ast0.STARS(l) -> Ast0.STARS(list_fn r same_stars l)) in
1496 let exprfn r k old_e = (* need to keep the original code for ! optim *)
1499 match Ast0.unwrap e with
1500 Ast0.MetaExpr(name,constraints,x,form,pure) ->
1501 (rebuild_mcode None).V0.rebuilder_expression
1502 (match lookup name bindings mv_bindings with
1503 Common.Left(Ast0.ExprTag(exp)) -> exp
1504 | Common.Left(_) -> failwith "not possible 1"
1505 | Common.Right(new_mv) ->
1510 let rec renamer = function
1511 Type_cocci.MetaType(name,keep,inherited) ->
1513 lookup (name,(),(),(),None) bindings mv_bindings
1515 Common.Left(Ast0.TypeCTag(t)) ->
1516 Ast0.ast0_type_to_type t
1518 failwith "iso pattern: unexpected type"
1519 | Common.Right(new_mv) ->
1520 Type_cocci.MetaType(new_mv,keep,inherited))
1521 | Type_cocci.ConstVol(cv,ty) ->
1522 Type_cocci.ConstVol(cv,renamer ty)
1523 | Type_cocci.Pointer(ty) ->
1524 Type_cocci.Pointer(renamer ty)
1525 | Type_cocci.FunctionPointer(ty) ->
1526 Type_cocci.FunctionPointer(renamer ty)
1527 | Type_cocci.Array(ty) ->
1528 Type_cocci.Array(renamer ty)
1530 Some(List.map renamer types) in
1533 (Ast0.set_mcode_data new_mv name,constraints,
1534 new_types,form,pure)))
1535 | Ast0.MetaErr(namea,_,pure) -> failwith "metaerr not supported"
1536 | Ast0.MetaExprList(namea,lenname,pure) ->
1537 failwith "metaexprlist not supported"
1538 | Ast0.Unary(exp,unop) ->
1539 (match Ast0.unwrap_mcode unop with
1542 (* k e doesn't change the outer structure of the term,
1543 only the metavars *)
1544 match Ast0.unwrap old_e with
1545 Ast0.Unary(exp,_) ->
1546 (match Ast0.unwrap exp with
1547 Ast0.MetaExpr(name,constraints,x,form,pure) -> true
1549 | _ -> failwith "not possible" in
1551 let mc = Ast0.get_mcodekind exp in
1557 | Ast0.CONTEXT(x) | Ast0.MIXED(x) ->
1559 (Ast.NOTHING,_,_) -> true
1561 | _ -> failwith "plus not possible" in
1562 if was_meta && nomodif exp && nomodif e
1564 let rec negate e (*for rewrapping*) res (*code to process*) =
1565 match Ast0.unwrap res with
1566 Ast0.Unary(e1,op) when Ast0.unwrap_mcode op = Ast.Not ->
1567 Ast0.rewrap e (Ast0.unwrap e1)
1568 | Ast0.Edots(_,_) -> Ast0.rewrap e (Ast0.unwrap res)
1569 | Ast0.Paren(lp,e,rp) ->
1570 Ast0.rewrap res (Ast0.Paren(lp,negate e e,rp))
1571 | Ast0.Binary(e1,op,e2) ->
1572 let reb nop = Ast0.rewrap_mcode op (Ast.Logical(nop)) in
1574 match Ast0.unwrap_mcode op with
1575 Ast.Logical(Ast.Inf) ->
1576 Ast0.Binary(e1,reb Ast.SupEq,e2)
1577 | Ast.Logical(Ast.Sup) ->
1578 Ast0.Binary(e1,reb Ast.InfEq,e2)
1579 | Ast.Logical(Ast.InfEq) ->
1580 Ast0.Binary(e1,reb Ast.Sup,e2)
1581 | Ast.Logical(Ast.SupEq) ->
1582 Ast0.Binary(e1,reb Ast.Inf,e2)
1583 | Ast.Logical(Ast.Eq) ->
1584 Ast0.Binary(e1,reb Ast.NotEq,e2)
1585 | Ast.Logical(Ast.NotEq) ->
1586 Ast0.Binary(e1,reb Ast.Eq,e2)
1587 | Ast.Logical(Ast.AndLog) ->
1588 Ast0.Binary(negate e1 e1,reb Ast.OrLog,
1590 | Ast.Logical(Ast.OrLog) ->
1591 Ast0.Binary(negate e1 e1,reb Ast.AndLog,
1593 | _ -> Ast0.Unary(res,Ast0.rewrap_mcode op Ast.Not) in
1595 | Ast0.DisjExpr(lp,exps,mids,rp) ->
1596 (* use res because it is the transformed argument *)
1597 let exps = List.map (function e -> negate e e) exps in
1598 Ast0.rewrap res (Ast0.DisjExpr(lp,exps,mids,rp))
1600 (*use e, because this might be the toplevel expression*)
1602 (Ast0.Unary(res,Ast0.rewrap_mcode unop Ast.Not)) in
1606 | Ast0.Edots(d,_) ->
1608 (match List.assoc (dot_term d) bindings with
1609 Ast0.ExprTag(exp) -> Ast0.rewrap e (Ast0.Edots(d,Some exp))
1610 | _ -> failwith "unexpected binding")
1611 with Not_found -> e)
1612 | Ast0.Ecircles(d,_) ->
1614 (match List.assoc (dot_term d) bindings with
1615 Ast0.ExprTag(exp) -> Ast0.rewrap e (Ast0.Ecircles(d,Some exp))
1616 | _ -> failwith "unexpected binding")
1617 with Not_found -> e)
1618 | Ast0.Estars(d,_) ->
1620 (match List.assoc (dot_term d) bindings with
1621 Ast0.ExprTag(exp) -> Ast0.rewrap e (Ast0.Estars(d,Some exp))
1622 | _ -> failwith "unexpected binding")
1623 with Not_found -> e)
1625 if Ast0.get_test_exp old_e then Ast0.set_test_exp e1 else e1 in
1629 match Ast0.unwrap e with
1630 Ast0.MetaType(name,pure) ->
1631 (rebuild_mcode None).V0.rebuilder_typeC
1632 (match lookup name bindings mv_bindings with
1633 Common.Left(Ast0.TypeCTag(ty)) -> ty
1634 | Common.Left(_) -> failwith "not possible 1"
1635 | Common.Right(new_mv) ->
1637 (Ast0.MetaType(Ast0.set_mcode_data new_mv name,pure)))
1642 match Ast0.unwrap e with
1645 (match List.assoc (dot_term d) bindings with
1646 Ast0.DeclTag(exp) -> Ast0.rewrap e (Ast0.Ddots(d,Some exp))
1647 | _ -> failwith "unexpected binding")
1648 with Not_found -> e)
1653 match Ast0.unwrap e with
1654 Ast0.MetaParam(name,pure) ->
1655 (rebuild_mcode None).V0.rebuilder_parameter
1656 (match lookup name bindings mv_bindings with
1657 Common.Left(Ast0.ParamTag(param)) -> param
1658 | Common.Left(_) -> failwith "not possible 1"
1659 | Common.Right(new_mv) ->
1661 (Ast0.MetaParam(Ast0.set_mcode_data new_mv name, pure)))
1662 | Ast0.MetaParamList(name,lenname,pure) ->
1663 failwith "metaparamlist not supported"
1668 match Ast0.unwrap e with
1669 Ast0.MetaStmt(name,pure) ->
1670 (rebuild_mcode None).V0.rebuilder_statement
1671 (match lookup name bindings mv_bindings with
1672 Common.Left(Ast0.StmtTag(stm)) -> stm
1673 | Common.Left(_) -> failwith "not possible 1"
1674 | Common.Right(new_mv) ->
1676 (Ast0.MetaStmt(Ast0.set_mcode_data new_mv name,pure)))
1677 | Ast0.MetaStmtList(name,pure) -> failwith "metastmtlist not supported"
1685 Ast0.DotsStmtTag(stms) -> Ast0.WhenNot stms
1686 | Ast0.StmtTag(stm) -> Ast0.WhenAlways stm
1687 | Ast0.IsoWhenTag(x) -> Ast0.WhenModifier(x)
1688 | _ -> failwith "unexpected binding")
1689 (List.filter (function (x,v) -> x = (dot_term d)) bindings)))
1690 | Ast0.Circles(d,_) ->
1697 Ast0.DotsStmtTag(stms) -> Ast0.WhenNot stms
1698 | Ast0.StmtTag(stm) -> Ast0.WhenAlways stm
1699 | Ast0.IsoWhenTag(x) -> Ast0.WhenModifier(x)
1700 | _ -> failwith "unexpected binding")
1701 (List.filter (function (x,v) -> x = (dot_term d)) bindings)))
1702 | Ast0.Stars(d,_) ->
1709 Ast0.DotsStmtTag(stms) -> Ast0.WhenNot stms
1710 | Ast0.StmtTag(stm) -> Ast0.WhenAlways stm
1711 | Ast0.IsoWhenTag(x) -> Ast0.WhenModifier(x)
1712 | _ -> failwith "unexpected binding")
1713 (List.filter (function (x,v) -> x = (dot_term d)) bindings)))
1717 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
1719 (dots elist) donothing (dots plist) (dots slist) donothing donothing
1720 identfn exprfn tyfn donothing paramfn declfn stmtfn donothing donothing
1722 (* --------------------------------------------------------------------- *)
1725 match Ast0.get_mcodekind e with Ast0.MINUS(cell) -> true | _ -> false
1727 let context_required e = not(is_minus e) && not !Flag.sgrep_mode2
1729 let disj_fail bindings e =
1731 Some x -> Printf.fprintf stderr "no disj available at this type"; e
1734 (* isomorphism code is by default CONTEXT *)
1735 let merge_plus model_mcode e_mcode =
1736 match model_mcode with
1738 (* add the replacement information at the root *)
1742 (match (!mc,!emc) with
1743 (([],_),(x,t)) | ((x,_),([],t)) -> (x,t)
1744 | _ -> failwith "how can we combine minuses?")
1745 | _ -> failwith "not possible 6")
1746 | Ast0.CONTEXT(mc) ->
1748 Ast0.CONTEXT(emc) ->
1749 (* keep the logical line info as in the model *)
1750 let (mba,tb,ta) = !mc in
1751 let (eba,_,_) = !emc in
1752 (* merging may be required when a term is replaced by a subterm *)
1754 match (mba,eba) with
1755 (x,Ast.NOTHING) | (Ast.NOTHING,x) -> x
1756 | (Ast.BEFORE(b1),Ast.BEFORE(b2)) -> Ast.BEFORE(b1@b2)
1757 | (Ast.BEFORE(b),Ast.AFTER(a)) -> Ast.BEFOREAFTER(b,a)
1758 | (Ast.BEFORE(b1),Ast.BEFOREAFTER(b2,a)) ->
1759 Ast.BEFOREAFTER(b1@b2,a)
1760 | (Ast.AFTER(a),Ast.BEFORE(b)) -> Ast.BEFOREAFTER(b,a)
1761 | (Ast.AFTER(a1),Ast.AFTER(a2)) ->Ast.AFTER(a2@a1)
1762 | (Ast.AFTER(a1),Ast.BEFOREAFTER(b,a2)) -> Ast.BEFOREAFTER(b,a2@a1)
1763 | (Ast.BEFOREAFTER(b1,a),Ast.BEFORE(b2)) ->
1764 Ast.BEFOREAFTER(b1@b2,a)
1765 | (Ast.BEFOREAFTER(b,a1),Ast.AFTER(a2)) ->
1766 Ast.BEFOREAFTER(b,a2@a1)
1767 | (Ast.BEFOREAFTER(b1,a1),Ast.BEFOREAFTER(b2,a2)) ->
1768 Ast.BEFOREAFTER(b1@b2,a2@a1) in
1769 emc := (merged,tb,ta)
1770 | Ast0.MINUS(emc) ->
1771 let (anything_bef_aft,_,_) = !mc in
1772 let (anythings,t) = !emc in
1774 (match anything_bef_aft with
1775 Ast.BEFORE(b) -> (b@anythings,t)
1776 | Ast.AFTER(a) -> (anythings@a,t)
1777 | Ast.BEFOREAFTER(b,a) -> (b@anythings@a,t)
1778 | Ast.NOTHING -> (anythings,t))
1779 | _ -> failwith "not possible 7")
1780 | Ast0.MIXED(_) -> failwith "not possible 8"
1781 | Ast0.PLUS -> failwith "not possible 9"
1783 let copy_plus printer minusify model e =
1784 if !Flag.sgrep_mode2
1785 then e (* no plus code, can cause a "not possible" error, so just avoid it *)
1788 match Ast0.get_mcodekind model with
1789 Ast0.MINUS(mc) -> minusify e
1790 | Ast0.CONTEXT(mc) -> e
1791 | _ -> failwith "not possible: copy_plus\n" in
1792 merge_plus (Ast0.get_mcodekind model) (Ast0.get_mcodekind e);
1795 let copy_minus printer minusify model e =
1796 match Ast0.get_mcodekind model with
1797 Ast0.MINUS(mc) -> minusify e
1798 | Ast0.CONTEXT(mc) -> e
1800 if !Flag.sgrep_mode2
1802 else failwith "not possible 8"
1803 | Ast0.PLUS -> failwith "not possible 9"
1805 let whencode_allowed prev_ecount prev_icount prev_dcount
1806 ecount icount dcount rest =
1807 (* actually, if ecount or dcount is 0, the flag doesn't matter, because it
1809 let other_ecount = (* number of edots *)
1810 List.fold_left (function rest -> function (_,ec,ic,dc) -> ec + rest)
1812 let other_icount = (* number of dots *)
1813 List.fold_left (function rest -> function (_,ec,ic,dc) -> ic + rest)
1815 let other_dcount = (* number of dots *)
1816 List.fold_left (function rest -> function (_,ec,ic,dc) -> dc + rest)
1818 (ecount = 0 or other_ecount = 0, icount = 0 or other_icount = 0,
1819 dcount = 0 or other_dcount = 0)
1821 (* copy the befores and afters to the instantiated code *)
1822 let extra_copy_stmt_plus model e =
1823 (if not !Flag.sgrep_mode2 (* sgrep has no plus code, so nothing to do *)
1825 (match Ast0.unwrap model with
1826 Ast0.FunDecl((info,bef),_,_,_,_,_,_,_,_)
1827 | Ast0.Decl((info,bef),_) ->
1828 (match Ast0.unwrap e with
1829 Ast0.FunDecl((info,bef1),_,_,_,_,_,_,_,_)
1830 | Ast0.Decl((info,bef1),_) ->
1832 | _ -> merge_plus bef (Ast0.get_mcodekind e))
1833 | Ast0.IfThen(_,_,_,_,_,(info,aft))
1834 | Ast0.IfThenElse(_,_,_,_,_,_,_,(info,aft))
1835 | Ast0.While(_,_,_,_,_,(info,aft))
1836 | Ast0.For(_,_,_,_,_,_,_,_,_,(info,aft))
1837 | Ast0.Iterator(_,_,_,_,_,(info,aft)) ->
1838 (match Ast0.unwrap e with
1839 Ast0.IfThen(_,_,_,_,_,(info,aft1))
1840 | Ast0.IfThenElse(_,_,_,_,_,_,_,(info,aft1))
1841 | Ast0.While(_,_,_,_,_,(info,aft1))
1842 | Ast0.For(_,_,_,_,_,_,_,_,_,(info,aft1))
1843 | Ast0.Iterator(_,_,_,_,_,(info,aft1)) ->
1845 | _ -> merge_plus aft (Ast0.get_mcodekind e))
1849 let extra_copy_other_plus model e = e
1851 (* --------------------------------------------------------------------- *)
1853 let mv_count = ref 0
1855 let ct = !mv_count in
1856 mv_count := !mv_count + 1;
1857 "_"^s^"_"^(string_of_int ct)
1859 let get_name = function
1860 Ast.MetaIdDecl(ar,nm) ->
1861 (nm,function nm -> Ast.MetaIdDecl(ar,nm))
1862 | Ast.MetaFreshIdDecl(ar,nm) ->
1863 (nm,function nm -> Ast.MetaFreshIdDecl(ar,nm))
1864 | Ast.MetaTypeDecl(ar,nm) ->
1865 (nm,function nm -> Ast.MetaTypeDecl(ar,nm))
1866 | Ast.MetaListlenDecl(nm) ->
1867 failwith "should not be rebuilt"
1868 | Ast.MetaParamDecl(ar,nm) ->
1869 (nm,function nm -> Ast.MetaParamDecl(ar,nm))
1870 | Ast.MetaParamListDecl(ar,nm,nm1) ->
1871 (nm,function nm -> Ast.MetaParamListDecl(ar,nm,nm1))
1872 | Ast.MetaConstDecl(ar,nm,ty) ->
1873 (nm,function nm -> Ast.MetaConstDecl(ar,nm,ty))
1874 | Ast.MetaErrDecl(ar,nm) ->
1875 (nm,function nm -> Ast.MetaErrDecl(ar,nm))
1876 | Ast.MetaExpDecl(ar,nm,ty) ->
1877 (nm,function nm -> Ast.MetaExpDecl(ar,nm,ty))
1878 | Ast.MetaIdExpDecl(ar,nm,ty) ->
1879 (nm,function nm -> Ast.MetaIdExpDecl(ar,nm,ty))
1880 | Ast.MetaLocalIdExpDecl(ar,nm,ty) ->
1881 (nm,function nm -> Ast.MetaLocalIdExpDecl(ar,nm,ty))
1882 | Ast.MetaExpListDecl(ar,nm,nm1) ->
1883 (nm,function nm -> Ast.MetaExpListDecl(ar,nm,nm1))
1884 | Ast.MetaStmDecl(ar,nm) ->
1885 (nm,function nm -> Ast.MetaStmDecl(ar,nm))
1886 | Ast.MetaStmListDecl(ar,nm) ->
1887 (nm,function nm -> Ast.MetaStmListDecl(ar,nm))
1888 | Ast.MetaFuncDecl(ar,nm) ->
1889 (nm,function nm -> Ast.MetaFuncDecl(ar,nm))
1890 | Ast.MetaLocalFuncDecl(ar,nm) ->
1891 (nm,function nm -> Ast.MetaLocalFuncDecl(ar,nm))
1892 | Ast.MetaPosDecl(ar,nm) ->
1893 (nm,function nm -> Ast.MetaPosDecl(ar,nm))
1894 | Ast.MetaDeclarerDecl(ar,nm) ->
1895 (nm,function nm -> Ast.MetaDeclarerDecl(ar,nm))
1896 | Ast.MetaIteratorDecl(ar,nm) ->
1897 (nm,function nm -> Ast.MetaIteratorDecl(ar,nm))
1899 let make_new_metavars metavars bindings =
1903 let (s,_) = get_name mv in
1904 try let _ = List.assoc s bindings in false with Not_found -> true)
1909 let (s,rebuild) = get_name mv in
1910 let new_s = (!current_rule,new_mv s) in
1911 (rebuild new_s, (s,new_s)))
1914 (* --------------------------------------------------------------------- *)
1916 let do_nothing x = x
1918 let mkdisj matcher metavars alts e instantiater mkiso disj_maker minusify
1919 rebuild_mcodes name printer extra_plus update_others =
1920 let call_instantiate bindings mv_bindings alts =
1923 (function (a,_,_,_) ->
1925 (* no need to create duplicates when the bindings have no effect *)
1927 (function bindings ->
1929 (copy_plus printer minusify e
1931 (instantiater bindings mv_bindings
1932 (rebuild_mcodes a))))
1933 (Common.union_set [(name,mkiso a)] (Ast0.get_iso e)))
1936 let rec inner_loop all_alts prev_ecount prev_icount prev_dcount = function
1937 [] -> Common.Left (prev_ecount, prev_icount, prev_dcount)
1938 | ((pattern,ecount,icount,dcount)::rest) ->
1940 whencode_allowed prev_ecount prev_icount prev_dcount
1941 ecount dcount icount rest in
1942 (match matcher true (context_required e) wc pattern e init_env with
1944 if reason = NonMatch || not !Flag_parsing_cocci.show_iso_failures
1947 (match matcher false false wc pattern e init_env with
1949 interpret_reason name (Ast0.get_line e) reason
1950 (function () -> printer e)
1952 inner_loop all_alts (prev_ecount + ecount) (prev_icount + icount)
1953 (prev_dcount + dcount) rest
1954 | OK (bindings : (((string * string) * 'a) list list)) ->
1956 (* apply update_others to all patterns other than the matched
1957 one. This is used to desigate the others as test
1958 expressions in the TestExpression case *)
1960 (function (x,e,i,d) as all ->
1963 else (update_others x,e,i,d))
1964 (List.hd all_alts)) ::
1966 (List.map (function (x,e,i,d) -> (update_others x,e,i,d)))
1967 (List.tl all_alts)) in
1968 (match List.concat all_alts with
1969 [x] -> Common.Left (prev_ecount, prev_icount, prev_dcount)
1971 let (new_metavars,mv_bindings) =
1972 make_new_metavars metavars (nub(List.concat bindings)) in
1975 call_instantiate bindings mv_bindings all_alts))) in
1976 let rec outer_loop prev_ecount prev_icount prev_dcount = function
1977 [] | [[_]] (*only one alternative*) -> ([],e) (* nothing matched *)
1978 | (alts::rest) as all_alts ->
1979 match inner_loop all_alts prev_ecount prev_icount prev_dcount alts with
1980 Common.Left(prev_ecount, prev_icount, prev_dcount) ->
1981 outer_loop prev_ecount prev_icount prev_dcount rest
1982 | Common.Right (new_metavars,res) ->
1984 copy_minus printer minusify e (disj_maker res)) in
1985 outer_loop 0 0 0 alts
1987 (* no one should ever look at the information stored in these mcodes *)
1988 let disj_starter lst =
1989 let old_info = Ast0.get_info(List.hd lst) in
1992 Ast0.line_end = old_info.Ast0.line_start;
1993 Ast0.logical_end = old_info.Ast0.logical_start;
1994 Ast0.attachable_start = false; Ast0.attachable_end = false;
1995 Ast0.mcode_start = []; Ast0.mcode_end = [];
1996 Ast0.strings_before = []; Ast0.strings_after = [] } in
1997 Ast0.make_mcode_info "(" info
1999 let disj_ender lst =
2000 let old_info = Ast0.get_info(List.hd lst) in
2003 Ast0.line_start = old_info.Ast0.line_end;
2004 Ast0.logical_start = old_info.Ast0.logical_end;
2005 Ast0.attachable_start = false; Ast0.attachable_end = false;
2006 Ast0.mcode_start = []; Ast0.mcode_end = [];
2007 Ast0.strings_before = []; Ast0.strings_after = [] } in
2008 Ast0.make_mcode_info ")" info
2010 let disj_mid _ = Ast0.make_mcode "|"
2012 let make_disj_type tl =
2015 [] -> failwith "bad disjunction"
2016 | x::xs -> List.map disj_mid xs in
2017 Ast0.context_wrap (Ast0.DisjType(disj_starter tl,tl,mids,disj_ender tl))
2018 let make_disj_stmt_list tl =
2021 [] -> failwith "bad disjunction"
2022 | x::xs -> List.map disj_mid xs in
2023 Ast0.context_wrap (Ast0.Disj(disj_starter tl,tl,mids,disj_ender tl))
2024 let make_disj_expr model el =
2027 [] -> failwith "bad disjunction"
2028 | x::xs -> List.map disj_mid xs in
2030 if Ast0.get_arg_exp model then Ast0.set_arg_exp x else x in
2032 let x = if Ast0.get_test_pos model then Ast0.set_test_pos x else x in
2033 if Ast0.get_test_exp model then Ast0.set_test_exp x else x in
2034 let el = List.map update_arg (List.map update_test el) in
2035 Ast0.context_wrap (Ast0.DisjExpr(disj_starter el,el,mids,disj_ender el))
2036 let make_disj_decl dl =
2039 [] -> failwith "bad disjunction"
2040 | x::xs -> List.map disj_mid xs in
2041 Ast0.context_wrap (Ast0.DisjDecl(disj_starter dl,dl,mids,disj_ender dl))
2042 let make_disj_stmt sl =
2043 let dotify x = Ast0.context_wrap (Ast0.DOTS[x]) in
2046 [] -> failwith "bad disjunction"
2047 | x::xs -> List.map disj_mid xs in
2049 (Ast0.Disj(disj_starter sl,List.map dotify sl,mids,disj_ender sl))
2051 let transform_type (metavars,alts,name) e =
2053 (Ast0.TypeCTag(_)::_)::_ ->
2054 (* start line is given to any leaves in the iso code *)
2055 let start_line = Some ((Ast0.get_info e).Ast0.line_start) in
2061 (p,count_edots.V0.combiner_typeC p,
2062 count_idots.V0.combiner_typeC p,
2063 count_dots.V0.combiner_typeC p)
2064 | _ -> failwith "invalid alt"))
2066 mkdisj match_typeC metavars alts e
2067 (function b -> function mv_b ->
2068 (instantiate b mv_b).V0.rebuilder_typeC)
2069 (function t -> Ast0.TypeCTag t)
2070 make_disj_type make_minus.V0.rebuilder_typeC
2071 (rebuild_mcode start_line).V0.rebuilder_typeC
2072 name Unparse_ast0.typeC extra_copy_other_plus do_nothing
2076 let transform_expr (metavars,alts,name) e =
2077 let process update_others =
2078 (* start line is given to any leaves in the iso code *)
2079 let start_line = Some ((Ast0.get_info e).Ast0.line_start) in
2084 Ast0.ExprTag(p) | Ast0.ArgExprTag(p) | Ast0.TestExprTag(p) ->
2085 (p,count_edots.V0.combiner_expression p,
2086 count_idots.V0.combiner_expression p,
2087 count_dots.V0.combiner_expression p)
2088 | _ -> failwith "invalid alt"))
2090 mkdisj match_expr metavars alts e
2091 (function b -> function mv_b ->
2092 (instantiate b mv_b).V0.rebuilder_expression)
2093 (function e -> Ast0.ExprTag e)
2094 (make_disj_expr e) make_minus.V0.rebuilder_expression
2095 (rebuild_mcode start_line).V0.rebuilder_expression
2096 name Unparse_ast0.expression extra_copy_other_plus update_others in
2098 (Ast0.ExprTag(_)::_)::_ -> process do_nothing
2099 | (Ast0.ArgExprTag(_)::_)::_ when Ast0.get_arg_exp e -> process do_nothing
2100 | (Ast0.TestExprTag(_)::_)::_ when Ast0.get_test_pos e ->
2101 process Ast0.set_test_exp
2104 let transform_decl (metavars,alts,name) e =
2106 (Ast0.DeclTag(_)::_)::_ ->
2107 (* start line is given to any leaves in the iso code *)
2108 let start_line = Some (Ast0.get_info e).Ast0.line_start in
2114 (p,count_edots.V0.combiner_declaration p,
2115 count_idots.V0.combiner_declaration p,
2116 count_dots.V0.combiner_declaration p)
2117 | _ -> failwith "invalid alt"))
2119 mkdisj match_decl metavars alts e
2120 (function b -> function mv_b ->
2121 (instantiate b mv_b).V0.rebuilder_declaration)
2122 (function d -> Ast0.DeclTag d)
2124 make_minus.V0.rebuilder_declaration
2125 (rebuild_mcode start_line).V0.rebuilder_declaration
2126 name Unparse_ast0.declaration extra_copy_other_plus do_nothing
2129 let transform_stmt (metavars,alts,name) e =
2131 (Ast0.StmtTag(_)::_)::_ ->
2132 (* start line is given to any leaves in the iso code *)
2133 let start_line = Some (Ast0.get_info e).Ast0.line_start in
2139 (p,count_edots.V0.combiner_statement p,
2140 count_idots.V0.combiner_statement p,
2141 count_dots.V0.combiner_statement p)
2142 | _ -> failwith "invalid alt"))
2144 mkdisj match_statement metavars alts e
2145 (function b -> function mv_b ->
2146 (instantiate b mv_b).V0.rebuilder_statement)
2147 (function s -> Ast0.StmtTag s)
2148 make_disj_stmt make_minus.V0.rebuilder_statement
2149 (rebuild_mcode start_line).V0.rebuilder_statement
2150 name (Unparse_ast0.statement "") extra_copy_stmt_plus do_nothing
2153 (* sort of a hack, because there is no disj at top level *)
2154 let transform_top (metavars,alts,name) e =
2155 match Ast0.unwrap e with
2156 Ast0.DECL(declstm) ->
2162 Ast0.DotsStmtTag(d) ->
2163 (match Ast0.unwrap d with
2164 Ast0.DOTS([s]) -> Ast0.StmtTag(s)
2165 | _ -> raise (Failure ""))
2166 | _ -> raise (Failure "")))
2168 let (mv,s) = transform_stmt (metavars,strip alts,name) declstm in
2169 (mv,Ast0.rewrap e (Ast0.DECL(s)))
2170 with Failure _ -> ([],e))
2171 | Ast0.CODE(stmts) ->
2174 (Ast0.DotsStmtTag(_)::_)::_ ->
2175 (* start line is given to any leaves in the iso code *)
2176 let start_line = Some ((Ast0.get_info e).Ast0.line_start) in
2181 Ast0.DotsStmtTag(p) ->
2182 (p,count_edots.V0.combiner_statement_dots p,
2183 count_idots.V0.combiner_statement_dots p,
2184 count_dots.V0.combiner_statement_dots p)
2185 | _ -> failwith "invalid alt"))
2187 mkdisj match_statement_dots metavars alts stmts
2188 (function b -> function mv_b ->
2189 (instantiate b mv_b).V0.rebuilder_statement_dots)
2190 (function s -> Ast0.DotsStmtTag s)
2192 Ast0.rewrap e (Ast0.DOTS([make_disj_stmt_list x])))
2193 make_minus.V0.rebuilder_statement_dots
2194 (rebuild_mcode start_line).V0.rebuilder_statement_dots
2195 name Unparse_ast0.statement_dots extra_copy_other_plus do_nothing
2196 | _ -> ([],stmts) in
2197 (mv,Ast0.rewrap e (Ast0.CODE res))
2200 (* --------------------------------------------------------------------- *)
2202 let transform (alts : isomorphism) t =
2203 (* the following ugliness is because rebuilder only returns a new term *)
2204 let extra_meta_decls = ref ([] : Ast_cocci.metavar list) in
2206 let donothing r k e = k e in
2208 let (extra_meta,exp) = transform_expr alts (k e) in
2209 extra_meta_decls := extra_meta @ !extra_meta_decls;
2213 let (extra_meta,dec) = transform_decl alts (k e) in
2214 extra_meta_decls := extra_meta @ !extra_meta_decls;
2218 let (extra_meta,stm) = transform_stmt alts (k e) in
2219 extra_meta_decls := extra_meta @ !extra_meta_decls;
2223 let (extra_meta,ty) = transform_type alts (k e) in
2224 extra_meta_decls := extra_meta @ !extra_meta_decls;
2228 let (extra_meta,ty) = transform_top alts (k e) in
2229 extra_meta_decls := extra_meta @ !extra_meta_decls;
2234 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
2236 donothing donothing donothing donothing donothing donothing
2237 donothing exprfn typefn donothing donothing declfn stmtfn
2239 let res = res.V0.rebuilder_top_level t in
2240 (!extra_meta_decls,res)
2242 (* --------------------------------------------------------------------- *)
2244 (* should be done by functorizing the parser to use wrap or context_wrap *)
2246 let mcode (x,a,i,mc,pos) = (x,a,i,Ast0.context_befaft(),pos) in
2247 let donothing r k e = Ast0.context_wrap(Ast0.unwrap(k e)) in
2249 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
2251 donothing donothing donothing donothing donothing donothing
2252 donothing donothing donothing donothing donothing donothing donothing
2255 let rewrap_anything = function
2256 Ast0.DotsExprTag(d) ->
2257 Ast0.DotsExprTag(rewrap.V0.rebuilder_expression_dots d)
2258 | Ast0.DotsInitTag(d) ->
2259 Ast0.DotsInitTag(rewrap.V0.rebuilder_initialiser_list d)
2260 | Ast0.DotsParamTag(d) ->
2261 Ast0.DotsParamTag(rewrap.V0.rebuilder_parameter_list d)
2262 | Ast0.DotsStmtTag(d) ->
2263 Ast0.DotsStmtTag(rewrap.V0.rebuilder_statement_dots d)
2264 | Ast0.DotsDeclTag(d) ->
2265 Ast0.DotsDeclTag(rewrap.V0.rebuilder_declaration_dots d)
2266 | Ast0.DotsCaseTag(d) ->
2267 Ast0.DotsCaseTag(rewrap.V0.rebuilder_case_line_dots d)
2268 | Ast0.IdentTag(d) -> Ast0.IdentTag(rewrap.V0.rebuilder_ident d)
2269 | Ast0.ExprTag(d) -> Ast0.ExprTag(rewrap.V0.rebuilder_expression d)
2270 | Ast0.ArgExprTag(d) -> Ast0.ArgExprTag(rewrap.V0.rebuilder_expression d)
2271 | Ast0.TestExprTag(d) -> Ast0.TestExprTag(rewrap.V0.rebuilder_expression d)
2272 | Ast0.TypeCTag(d) -> Ast0.TypeCTag(rewrap.V0.rebuilder_typeC d)
2273 | Ast0.InitTag(d) -> Ast0.InitTag(rewrap.V0.rebuilder_initialiser d)
2274 | Ast0.ParamTag(d) -> Ast0.ParamTag(rewrap.V0.rebuilder_parameter d)
2275 | Ast0.DeclTag(d) -> Ast0.DeclTag(rewrap.V0.rebuilder_declaration d)
2276 | Ast0.StmtTag(d) -> Ast0.StmtTag(rewrap.V0.rebuilder_statement d)
2277 | Ast0.CaseLineTag(d) -> Ast0.CaseLineTag(rewrap.V0.rebuilder_case_line d)
2278 | Ast0.TopTag(d) -> Ast0.TopTag(rewrap.V0.rebuilder_top_level d)
2279 | Ast0.IsoWhenTag(_) -> failwith "only for isos within iso phase"
2280 | Ast0.MetaPosTag(p) -> Ast0.MetaPosTag(p)
2282 (* --------------------------------------------------------------------- *)
2284 let apply_isos isos rule rule_name =
2289 current_rule := rule_name;
2292 (function (metavars,iso,name) ->
2293 (metavars,List.map (List.map rewrap_anything) iso,name))
2295 let (extra_meta,rule) =
2300 (function (extra_meta,t) -> function iso ->
2301 let (new_extra_meta,t) = transform iso t in
2302 (new_extra_meta@extra_meta,t))
2305 (List.concat extra_meta, Compute_lines.compute_lines rule)