2 * Copyright 2005-2009, 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.
28 module F = Control_flow_c
30 module Flag = Flag_matcher
32 (*****************************************************************************)
34 (*****************************************************************************)
36 (*****************************************************************************)
38 (*****************************************************************************)
40 type sequence = Ordered | Unordered
43 match A.unwrap eas with
45 | A.CIRCLES _ -> Unordered
46 | A.STARS _ -> failwith "not handling stars"
48 let (redots : 'a A.dots -> 'a list -> 'a A.dots)=fun eas easundots ->
50 match A.unwrap eas with
51 | A.DOTS _ -> A.DOTS easundots
52 | A.CIRCLES _ -> A.CIRCLES easundots
53 | A.STARS _ -> A.STARS easundots
57 let (need_unordered_initialisers : B.initialiser B.wrap2 list -> bool) =
59 ibs +> List.exists (fun (ib, icomma) ->
60 match B.unwrap ib with
70 (* For the #include <linux/...> in the .cocci, need to find where is
71 * the '+' attached to this element, to later find the first concrete
72 * #include <linux/xxx.h> or last one in the serie of #includes in the
75 type include_requirement =
82 (* todo? put in semantic_c.ml *)
85 | LocalFunction (* entails Function *)
89 let term mc = A.unwrap_mcode mc
90 let mcodekind mc = A.get_mcodekind mc
93 let mcode_contain_plus = function
94 | A.CONTEXT (_,A.NOTHING) -> false
96 | A.MINUS (_,[]) -> false
97 | A.MINUS (_,x::xs) -> true
98 | A.PLUS -> raise Impossible
100 let mcode_simple_minus = function
101 | A.MINUS (_,[]) -> true
105 (* In transformation.ml sometime I build some mcodekind myself and
106 * julia has put None for the pos. But there is no possible raise
107 * NoMatch in those cases because it is for the minusall trick or for
108 * the distribute, so either have to build those pos, in fact a range,
109 * because for the distribute have to erase a fullType with one
110 * mcodekind, or add an argument to tag_with_mck such as "safe" that
111 * don't do the check_pos. Hence this DontCarePos constructor. *)
115 {A.line = 0; column =0; A.strbef=[]; A.straft=[];},
116 (A.MINUS(A.DontCarePos, [])),
119 let generalize_mcode ia =
120 let (s1, i, mck, pos) = ia in
123 | A.PLUS -> raise Impossible
124 | A.CONTEXT (A.NoPos,x) ->
125 A.CONTEXT (A.DontCarePos,x)
126 | A.MINUS (A.NoPos,x) ->
127 A.MINUS (A.DontCarePos,x)
129 | A.CONTEXT ((A.FixPos _|A.DontCarePos), _)
130 | A.MINUS ((A.FixPos _|A.DontCarePos), _)
134 (s1, i, new_mck, pos)
138 (*---------------------------------------------------------------------------*)
140 (* 0x0 is equivalent to 0, value format isomorphism *)
141 let equal_c_int s1 s2 =
143 int_of_string s1 = int_of_string s2
144 with Failure("int_of_string") ->
149 (*---------------------------------------------------------------------------*)
150 (* Normally A should reuse some types of Ast_c, so those
151 * functions should not exist.
153 * update: but now Ast_c depends on A, so can't make too
154 * A depends on Ast_c, so have to stay with those equal_xxx
158 let equal_unaryOp a b =
160 | A.GetRef , B.GetRef -> true
161 | A.DeRef , B.DeRef -> true
162 | A.UnPlus , B.UnPlus -> true
163 | A.UnMinus , B.UnMinus -> true
164 | A.Tilde , B.Tilde -> true
165 | A.Not , B.Not -> true
166 | _, B.GetRefLabel -> false (* todo cocci? *)
167 | _, (B.Not|B.Tilde|B.UnMinus|B.UnPlus|B.DeRef|B.GetRef) -> false
171 let equal_arithOp a b =
173 | A.Plus , B.Plus -> true
174 | A.Minus , B.Minus -> true
175 | A.Mul , B.Mul -> true
176 | A.Div , B.Div -> true
177 | A.Mod , B.Mod -> true
178 | A.DecLeft , B.DecLeft -> true
179 | A.DecRight , B.DecRight -> true
180 | A.And , B.And -> true
181 | A.Or , B.Or -> true
182 | A.Xor , B.Xor -> true
183 | _, (B.Xor|B.Or|B.And|B.DecRight|B.DecLeft|B.Mod|B.Div|B.Mul|B.Minus|B.Plus)
186 let equal_logicalOp a b =
188 | A.Inf , B.Inf -> true
189 | A.Sup , B.Sup -> true
190 | A.InfEq , B.InfEq -> true
191 | A.SupEq , B.SupEq -> true
192 | A.Eq , B.Eq -> true
193 | A.NotEq , B.NotEq -> true
194 | A.AndLog , B.AndLog -> true
195 | A.OrLog , B.OrLog -> true
196 | _, (B.OrLog|B.AndLog|B.NotEq|B.Eq|B.SupEq|B.InfEq|B.Sup|B.Inf)
199 let equal_assignOp a b =
201 | A.SimpleAssign, B.SimpleAssign -> true
202 | A.OpAssign a, B.OpAssign b -> equal_arithOp a b
203 | _, (B.OpAssign _|B.SimpleAssign) -> false
205 let equal_fixOp a b =
207 | A.Dec, B.Dec -> true
208 | A.Inc, B.Inc -> true
209 | _, (B.Inc|B.Dec) -> false
211 let equal_binaryOp a b =
213 | A.Arith a, B.Arith b -> equal_arithOp a b
214 | A.Logical a, B.Logical b -> equal_logicalOp a b
215 | _, (B.Logical _ | B.Arith _) -> false
217 let equal_structUnion a b =
219 | A.Struct, B.Struct -> true
220 | A.Union, B.Union -> true
221 | _, (B.Struct|B.Union) -> false
225 | A.Signed, B.Signed -> true
226 | A.Unsigned, B.UnSigned -> true
227 | _, (B.UnSigned|B.Signed) -> false
229 let equal_storage a b =
231 | A.Static , B.Sto B.Static
232 | A.Auto , B.Sto B.Auto
233 | A.Register , B.Sto B.Register
234 | A.Extern , B.Sto B.Extern
236 | _, (B.NoSto | B.StoTypedef) -> false
237 | _, (B.Sto (B.Register|B.Static|B.Auto|B.Extern)) -> false
240 (*---------------------------------------------------------------------------*)
242 let equal_metavarval valu valu' =
243 match valu, valu' with
244 | Ast_c.MetaIdVal a, Ast_c.MetaIdVal b -> a =$= b
245 | Ast_c.MetaFuncVal a, Ast_c.MetaFuncVal b -> a =$= b
246 | Ast_c.MetaLocalFuncVal a, Ast_c.MetaLocalFuncVal b ->
247 (* do something more ? *)
250 (* al_expr before comparing !!! and accept when they match.
251 * Note that here we have Astc._expression, so it is a match
252 * modulo isomorphism (there is no metavariable involved here,
253 * just isomorphisms). => TODO call isomorphism_c_c instead of
254 * =*=. Maybe would be easier to transform ast_c in ast_cocci
255 * and call the iso engine of julia. *)
256 | Ast_c.MetaExprVal a, Ast_c.MetaExprVal b ->
257 Lib_parsing_c.al_expr a =*= Lib_parsing_c.al_expr b
258 | Ast_c.MetaExprListVal a, Ast_c.MetaExprListVal b ->
259 Lib_parsing_c.al_arguments a =*= Lib_parsing_c.al_arguments b
261 | Ast_c.MetaStmtVal a, Ast_c.MetaStmtVal b ->
262 Lib_parsing_c.al_statement a =*= Lib_parsing_c.al_statement b
263 | Ast_c.MetaTypeVal a, Ast_c.MetaTypeVal b ->
264 (* old: Lib_parsing_c.al_type a =*= Lib_parsing_c.al_type b *)
267 | Ast_c.MetaListlenVal a, Ast_c.MetaListlenVal b -> a =|= b
269 | Ast_c.MetaParamVal a, Ast_c.MetaParamVal b ->
270 Lib_parsing_c.al_param a =*= Lib_parsing_c.al_param b
271 | Ast_c.MetaParamListVal a, Ast_c.MetaParamListVal b ->
272 Lib_parsing_c.al_params a =*= Lib_parsing_c.al_params b
274 | Ast_c.MetaPosVal (posa1,posa2), Ast_c.MetaPosVal (posb1,posb2) ->
275 Ast_cocci.equal_pos posa1 posb1 && Ast_cocci.equal_pos posa2 posb2
277 | Ast_c.MetaPosValList l1, Ast_c.MetaPosValList l2 ->
279 (function (fla,cea,posa1,posa2) ->
281 (function (flb,ceb,posb1,posb2) ->
282 fla = flb && cea = ceb &&
283 Ast_c.equal_posl posa1 posb1 && Ast_c.equal_posl posa2 posb2)
287 | (B.MetaPosValList _|B.MetaListlenVal _|B.MetaPosVal _|B.MetaStmtVal _
289 |B.MetaParamListVal _|B.MetaParamVal _|B.MetaExprListVal _
290 |B.MetaExprVal _|B.MetaLocalFuncVal _|B.MetaFuncVal _|B.MetaIdVal _
295 (*---------------------------------------------------------------------------*)
296 (* could put in ast_c.ml, next to the split/unsplit_comma *)
297 let split_signb_baseb_ii (baseb, ii) =
298 let iis = ii +> List.map (fun info -> (B.str_of_info info), info) in
299 match baseb, iis with
301 | B.Void, ["void",i1] -> None, [i1]
303 | B.FloatType (B.CFloat),["float",i1] -> None, [i1]
304 | B.FloatType (B.CDouble),["double",i1] -> None, [i1]
305 | B.FloatType (B.CLongDouble),["long",i1;"double",i2] -> None,[i1;i2]
307 | B.IntType (B.CChar), ["char",i1] -> None, [i1]
310 | B.IntType (B.Si (sign, base)), xs ->
311 (match sign, base, xs with
312 | B.Signed, B.CChar2, ["signed",i1;"char",i2] ->
313 Some (B.Signed, i1), [i2]
314 | B.UnSigned, B.CChar2, ["unsigned",i1;"char",i2] ->
315 Some (B.UnSigned, i1), [i2]
317 | B.Signed, B.CShort, ["short",i1] ->
319 | B.Signed, B.CShort, ["signed",i1;"short",i2] ->
320 Some (B.Signed, i1), [i2]
321 | B.UnSigned, B.CShort, ["unsigned",i1;"short",i2] ->
322 Some (B.UnSigned, i1), [i2]
323 | B.Signed, B.CShort, ["short",i1;"int",i2] ->
326 | B.Signed, B.CInt, ["int",i1] ->
328 | B.Signed, B.CInt, ["signed",i1;"int",i2] ->
329 Some (B.Signed, i1), [i2]
330 | B.UnSigned, B.CInt, ["unsigned",i1;"int",i2] ->
331 Some (B.UnSigned, i1), [i2]
333 | B.Signed, B.CInt, ["signed",i1;] ->
334 Some (B.Signed, i1), []
335 | B.UnSigned, B.CInt, ["unsigned",i1;] ->
336 Some (B.UnSigned, i1), []
338 | B.Signed, B.CLong, ["long",i1] ->
340 | B.Signed, B.CLong, ["long",i1;"int",i2] ->
342 | B.Signed, B.CLong, ["signed",i1;"long",i2] ->
343 Some (B.Signed, i1), [i2]
344 | B.UnSigned, B.CLong, ["unsigned",i1;"long",i2] ->
345 Some (B.UnSigned, i1), [i2]
347 | B.Signed, B.CLongLong, ["long",i1;"long",i2] -> None, [i1;i2]
348 | B.Signed, B.CLongLong, ["signed",i1;"long",i2;"long",i3] ->
349 Some (B.Signed, i1), [i2;i3]
350 | B.UnSigned, B.CLongLong, ["unsigned",i1;"long",i2;"long",i3] ->
351 Some (B.UnSigned, i1), [i2;i3]
354 | B.UnSigned, B.CShort, ["unsigned",i1;"short",i2; "int", i3] ->
355 Some (B.UnSigned, i1), [i2;i3]
359 | _ -> failwith "strange type1, maybe because of weird order"
361 | _ -> failwith "strange type2, maybe because of weird order"
363 (*---------------------------------------------------------------------------*)
365 let rec unsplit_icomma xs =
369 (match A.unwrap y with
371 (x, y)::unsplit_icomma xs
372 | _ -> failwith "wrong ast_cocci in initializer"
375 failwith ("wrong ast_cocci in initializer, should have pair " ^
380 let resplit_initialiser ibs iicomma =
381 match iicomma, ibs with
384 failwith "should have a iicomma, do you generate fakeInfo in parser?"
386 failwith "shouldn't have a iicomma"
387 | [iicomma], x::xs ->
388 let elems = List.map fst (x::xs) in
389 let commas = List.map snd (x::xs) +> List.flatten in
390 let commas = commas @ [iicomma] in
392 | _ -> raise Impossible
396 let rec split_icomma xs =
399 | (x,y)::xs -> x::y::split_icomma xs
401 let rec unsplit_initialiser ibs_unsplit =
402 match ibs_unsplit with
403 | [] -> [], [] (* empty iicomma *)
405 let (xs, lastcomma) = unsplit_initialiser_bis commax xs in
406 (x, [])::xs, lastcomma
408 and unsplit_initialiser_bis comma_before = function
409 | [] -> [], [comma_before]
411 let (xs, lastcomma) = unsplit_initialiser_bis commax xs in
412 (x, [comma_before])::xs, lastcomma
417 (*---------------------------------------------------------------------------*)
418 (* coupling: same in type_annotater_c.ml *)
419 let structdef_to_struct_name ty =
421 | qu, (B.StructUnion (su, sopt, fields), iis) ->
423 | Some s , [i1;i2;i3;i4] ->
424 qu, (B.StructUnionName (su, s), [i1;i2])
428 | x -> raise Impossible
430 | _ -> raise Impossible
432 (*---------------------------------------------------------------------------*)
433 let initialisation_to_affectation decl =
435 | B.MacroDecl _ -> F.Decl decl
436 | B.DeclList (xs, iis) ->
438 (* todo?: should not do that if the variable is an array cos
439 * will have x[] = , mais de toute facon ca sera pas un InitExp
442 | [] -> raise Impossible
444 let ({B.v_namei = var;
445 B.v_type = returnType;
446 B.v_storage = storage;
451 | Some ((s, ini), iis::iini) ->
453 | Some (B.InitExpr e, ii_empty2) ->
456 Ast_c.NotLocalDecl -> Ast_c.NotLocalVar
457 | Ast_c.LocalDecl -> Ast_c.LocalVar (iis.Ast_c.pinfo) in
460 ref (Some ((Lib_parsing_c.al_type returnType),local),
462 let id = (B.Ident s, typ),[iis] in
464 ((B.Assignment (id, B.SimpleAssign, e),
465 Ast_c.noType()), iini)
471 pr2_once "TODO: initialisation_to_affectation for multi vars";
472 (* todo? do a fold_left and generate 'x = a, y = b' etc, use
473 * the Sequence expression operator of C and make an
474 * ExprStatement from that.
483 (*****************************************************************************)
484 (* Functor parameter combinators *)
485 (*****************************************************************************)
487 * src: papers on parser combinators in haskell (cf a pearl by meijer in ICFP)
489 * version0: was not tagging the SP, so just tag the C
491 * (tin -> 'c tout) -> ('c -> (tin -> 'b tout)) -> (tin -> 'b tout)
492 * val return : 'b -> tin -> 'b tout
493 * val fail : tin -> 'b tout
495 * version1: now also tag the SP so return a ('a * 'b)
498 type mode = PatternMode | TransformMode
506 type ('a, 'b) matcher = 'a -> 'b -> tin -> ('a * 'b) tout
511 (tin -> ('a * 'b) tout) ->
512 ('a -> 'b -> (tin -> ('c * 'd) tout)) ->
513 (tin -> ('c * 'd) tout)
515 val return : ('a * 'b) -> tin -> ('a *'b) tout
516 val fail : tin -> ('a * 'b) tout
528 val (>&&>) : (tin -> bool) -> (tin -> 'x tout) -> (tin -> 'x tout)
530 val tokenf : ('a A.mcode, B.info) matcher
531 val tokenf_mck : (A.mcodekind, B.info) matcher
534 (A.meta_name A.mcode, B.expression) matcher
536 (A.meta_name A.mcode, (Ast_c.argument, Ast_c.il) either list) matcher
538 (A.meta_name A.mcode, Ast_c.fullType) matcher
540 (A.meta_name A.mcode,
541 (Ast_c.parameterType, Ast_c.il) either list) matcher
543 (A.meta_name A.mcode, Ast_c.parameterType) matcher
545 (A.meta_name A.mcode, Ast_c.initialiser) matcher
547 (A.meta_name A.mcode, Control_flow_c.node) matcher
549 val distrf_define_params :
550 (A.meta_name A.mcode, (string Ast_c.wrap, Ast_c.il) either list)
553 val distrf_struct_fields :
554 (A.meta_name A.mcode, B.field list) matcher
557 (A.meta_name A.mcode, (B.constant, string) either B.wrap) matcher
560 (A.expression, B.expression) matcher -> (A.expression, F.node) matcher
563 (A.expression, B.expression) matcher ->
564 (A.expression, B.expression) matcher
567 (A.fullType, B.fullType) matcher -> (A.fullType, F.node) matcher
570 (A.initialiser, B.initialiser) matcher -> (A.initialiser, F.node) matcher
573 A.keep_binding -> A.inherited ->
574 A.meta_name A.mcode * Ast_c.metavar_binding_kind *
575 (unit -> Common.filename * string * Ast_c.posl * Ast_c.posl) ->
576 (unit -> tin -> 'x tout) -> (tin -> 'x tout)
578 val check_constraints :
579 ('a, 'b) matcher -> 'a list -> 'b ->
580 (unit -> tin -> 'x tout) -> (tin -> 'x tout)
582 val all_bound : A.meta_name list -> (tin -> bool)
584 val optional_storage_flag : (bool -> tin -> 'x tout) -> (tin -> 'x tout)
585 val optional_qualifier_flag : (bool -> tin -> 'x tout) -> (tin -> 'x tout)
586 val value_format_flag: (bool -> tin -> 'x tout) -> (tin -> 'x tout)
591 (*****************************************************************************)
592 (* Functor code, "Cocci vs C" *)
593 (*****************************************************************************)
596 functor (X : PARAM) ->
599 type ('a, 'b) matcher = 'a -> 'b -> X.tin -> ('a * 'b) X.tout
602 let return = X.return
605 let (>||>) = X.(>||>)
606 let (>|+|>) = X.(>|+|>)
607 let (>&&>) = X.(>&&>)
609 let tokenf = X.tokenf
611 (* should be raise Impossible when called from transformation.ml *)
614 | PatternMode -> fail
615 | TransformMode -> raise Impossible
618 let (option: ('a,'b) matcher -> ('a option,'b option) matcher)= fun f t1 t2 ->
620 | (Some t1, Some t2) ->
621 f t1 t2 >>= (fun t1 t2 ->
622 return (Some t1, Some t2)
624 | (None, None) -> return (None, None)
627 (* Dots are sometimes used as metavariables, since like metavariables they
628 can match other things. But they no longer have the same type. Perhaps these
629 functions could be avoided by introducing an appropriate level of polymorphism,
630 but I don't know how to declare polymorphism across functors *)
631 let dots2metavar (_,info,mcodekind,pos) = (("","..."),info,mcodekind,pos)
632 let metavar2dots (_,info,mcodekind,pos) = ("...",info,mcodekind,pos)
634 (*---------------------------------------------------------------------------*)
646 (*---------------------------------------------------------------------------*)
647 let rec (expression: (A.expression, Ast_c.expression) matcher) =
649 X.all_bound (A.get_inherited ea) >&&>
650 let wa x = A.rewrap ea x in
651 match A.unwrap ea, eb with
653 (* general case: a MetaExpr can match everything *)
654 | A.MetaExpr (ida,constraints,keep,opttypa,form,inherited),
655 (((expr, opttypb), ii) as expb) ->
657 (* old: before have a MetaConst. Now we factorize and use 'form' to
658 * differentiate between different cases *)
659 let rec matches_id = function
661 | B.Cast(ty,e) -> matches_id (B.unwrap_expr e)
664 match (form,expr) with
667 let rec matches = function
668 B.Constant(c) -> true
669 | B.Ident idb when idb =~ "^[A-Z_][A-Z_0-9]*$" ->
670 pr2_once ("warning: I consider " ^ idb ^ " as a constant");
672 | B.Cast(ty,e) -> matches (B.unwrap_expr e)
673 | B.Unary(e,B.UnMinus) -> matches (B.unwrap_expr e)
674 | B.SizeOfExpr(exp) -> true
675 | B.SizeOfType(ty) -> true
681 (Some (_,Ast_c.LocalVar _),_) -> true
683 | (A.ID,e) -> matches_id e in
687 (let (opttypb,_testb) = !opttypb in
688 match opttypa, opttypb with
689 | None, _ -> return ((),())
691 pr2_once ("Missing type information. Certainly a pb in " ^
692 "annotate_typer.ml");
695 | Some tas, Some tb ->
696 tas +> List.fold_left (fun acc ta ->
697 acc >|+|> compatible_type ta tb) fail
700 X.check_constraints expression constraints eb
703 Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_expr expb) in
704 X.envf keep inherited (ida, Ast_c.MetaExprVal expb, max_min)
706 X.distrf_e ida expb >>= (fun ida expb ->
708 A.MetaExpr (ida,constraints,keep,opttypa,form,inherited)+>
716 * | A.MetaExpr(ida,false,opttypa,_inherited), expb ->
717 * D.distribute_mck (mcodekind ida) D.distribute_mck_e expb binding
719 * but bug! because if have not tagged SP, then transform without doing
720 * any checks. Hopefully now have tagged SP technique.
725 * | A.Edots _, _ -> raise Impossible.
727 * In fact now can also have the Edots inside normal expression, not
728 * just in arg lists. in 'x[...];' less: in if(<... x ... y ...>)
730 | A.Edots (mcode, None), expb ->
731 X.distrf_e (dots2metavar mcode) expb >>= (fun mcode expb ->
733 A.Edots (metavar2dots mcode, None) +> A.rewrap ea ,
738 | A.Edots (_, Some expr), _ -> failwith "not handling when on Edots"
741 | A.Ident ida, ((B.Ident idb, typ),ii) ->
742 let ib1 = tuple_of_list1 ii in
743 ident DontKnow ida (idb, ib1) >>= (fun ida (idb, ib1) ->
745 ((A.Ident ida)) +> wa,
746 ((B.Ident idb, typ),[ib1])
752 | A.MetaErr _, _ -> failwith "not handling MetaErr"
754 (* todo?: handle some isomorphisms in int/float ? can have different
755 * format : 1l can match a 1.
757 * todo: normally string can contain some metavar too, so should
758 * recurse on the string
760 | A.Constant (ia1), ((B.Constant (ib) , typ),ii) ->
761 (* for everything except the String case where can have multi elems *)
763 let ib1 = tuple_of_list1 ii in
764 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
766 ((A.Constant ia1)) +> wa,
767 ((B.Constant (ib), typ),[ib1])
770 (match term ia1, ib with
771 | A.Int x, B.Int y ->
772 X.value_format_flag (fun use_value_equivalence ->
773 if use_value_equivalence
783 | A.Char x, B.Char (y,_) when x =$= y (* todo: use kind ? *)
785 | A.Float x, B.Float (y,_) when x =$= y (* todo: use floatType ? *)
788 | A.String sa, B.String (sb,_kind) when sa =$= sb ->
791 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
793 ((A.Constant ia1)) +> wa,
794 ((B.Constant (ib), typ),[ib1])
796 | _ -> fail (* multi string, not handled *)
799 | _, B.MultiString -> (* todo cocci? *) fail
800 | _, (B.String _ | B.Float _ | B.Char _ | B.Int _) -> fail
804 | A.FunCall (ea, ia1, eas, ia2), ((B.FunCall (eb, ebs), typ),ii) ->
805 (* todo: do special case to allow IdMetaFunc, cos doing the
806 * recursive call will be too late, match_ident will not have the
807 * info whether it was a function. todo: but how detect when do
808 * x.field = f; how know that f is a Func ? By having computed
809 * some information before the matching!
811 * Allow match with FunCall containing types. Now ast_cocci allow
812 * type in parameter, and morover ast_cocci allow f(...) and those
813 * ... could match type.
815 let (ib1, ib2) = tuple_of_list2 ii in
816 expression ea eb >>= (fun ea eb ->
817 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
818 tokenf ia2 ib2 >>= (fun ia2 ib2 ->
819 arguments (seqstyle eas) (A.undots eas) ebs >>= (fun easundots ebs ->
820 let eas = redots eas easundots in
822 ((A.FunCall (ea, ia1, eas, ia2)) +> wa,
823 ((B.FunCall (eb, ebs),typ), [ib1;ib2])
829 | A.Assignment (ea1, opa, ea2, simple),
830 ((B.Assignment (eb1, opb, eb2), typ),ii) ->
831 let (opbi) = tuple_of_list1 ii in
832 if equal_assignOp (term opa) opb
834 expression ea1 eb1 >>= (fun ea1 eb1 ->
835 expression ea2 eb2 >>= (fun ea2 eb2 ->
836 tokenf opa opbi >>= (fun opa opbi ->
838 ((A.Assignment (ea1, opa, ea2, simple))) +> wa,
839 ((B.Assignment (eb1, opb, eb2), typ), [opbi])
843 | A.CondExpr(ea1,ia1,ea2opt,ia2,ea3),((B.CondExpr(eb1,eb2opt,eb3),typ),ii) ->
844 let (ib1, ib2) = tuple_of_list2 ii in
845 expression ea1 eb1 >>= (fun ea1 eb1 ->
846 option expression ea2opt eb2opt >>= (fun ea2opt eb2opt ->
847 expression ea3 eb3 >>= (fun ea3 eb3 ->
848 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
849 tokenf ia2 ib2 >>= (fun ia2 ib2 ->
851 ((A.CondExpr(ea1,ia1,ea2opt,ia2,ea3))) +> wa,
852 ((B.CondExpr (eb1, eb2opt, eb3),typ), [ib1;ib2])
855 (* todo?: handle some isomorphisms here ? *)
856 | A.Postfix (ea, opa), ((B.Postfix (eb, opb), typ),ii) ->
857 let opbi = tuple_of_list1 ii in
858 if equal_fixOp (term opa) opb
860 expression ea eb >>= (fun ea eb ->
861 tokenf opa opbi >>= (fun opa opbi ->
863 ((A.Postfix (ea, opa))) +> wa,
864 ((B.Postfix (eb, opb), typ),[opbi])
869 | A.Infix (ea, opa), ((B.Infix (eb, opb), typ),ii) ->
870 let opbi = tuple_of_list1 ii in
871 if equal_fixOp (term opa) opb
873 expression ea eb >>= (fun ea eb ->
874 tokenf opa opbi >>= (fun opa opbi ->
876 ((A.Infix (ea, opa))) +> wa,
877 ((B.Infix (eb, opb), typ),[opbi])
881 | A.Unary (ea, opa), ((B.Unary (eb, opb), typ),ii) ->
882 let opbi = tuple_of_list1 ii in
883 if equal_unaryOp (term opa) opb
885 expression ea eb >>= (fun ea eb ->
886 tokenf opa opbi >>= (fun opa opbi ->
888 ((A.Unary (ea, opa))) +> wa,
889 ((B.Unary (eb, opb), typ),[opbi])
893 | A.Binary (ea1, opa, ea2), ((B.Binary (eb1, opb, eb2), typ),ii) ->
894 let opbi = tuple_of_list1 ii in
895 if equal_binaryOp (term opa) opb
897 expression ea1 eb1 >>= (fun ea1 eb1 ->
898 expression ea2 eb2 >>= (fun ea2 eb2 ->
899 tokenf opa opbi >>= (fun opa opbi ->
901 ((A.Binary (ea1, opa, ea2))) +> wa,
902 ((B.Binary (eb1, opb, eb2), typ),[opbi]
906 | A.Nested (ea1, opa, ea2), eb ->
908 (if A.get_test_exp ea1 && not (Ast_c.is_test eb) then fail
909 else expression ea1 eb) >|+|>
911 ((B.Binary (eb1, opb, eb2), typ),ii)
912 when equal_binaryOp (term opa) opb ->
913 let opbi = tuple_of_list1 ii in
915 (expression ea1 eb1 >>= (fun ea1 eb1 ->
916 expression ea2 eb2 >>= (fun ea2 eb2 ->
917 tokenf opa opbi >>= (fun opa opbi ->
919 ((A.Nested (ea1, opa, ea2))) +> wa,
920 ((B.Binary (eb1, opb, eb2), typ),[opbi]
923 (expression ea2 eb1 >>= (fun ea2 eb1 ->
924 expression ea1 eb2 >>= (fun ea1 eb2 ->
925 tokenf opa opbi >>= (fun opa opbi ->
927 ((A.Nested (ea1, opa, ea2))) +> wa,
928 ((B.Binary (eb1, opb, eb2), typ),[opbi]
931 (loop eb1 >>= (fun ea1 eb1 ->
932 expression ea2 eb2 >>= (fun ea2 eb2 ->
933 tokenf opa opbi >>= (fun opa opbi ->
935 ((A.Nested (ea1, opa, ea2))) +> wa,
936 ((B.Binary (eb1, opb, eb2), typ),[opbi]
939 (expression ea2 eb1 >>= (fun ea2 eb1 ->
940 loop eb2 >>= (fun ea1 eb2 ->
941 tokenf opa opbi >>= (fun opa opbi ->
943 ((A.Nested (ea1, opa, ea2))) +> wa,
944 ((B.Binary (eb1, opb, eb2), typ),[opbi]
946 left_to_right >|+|> right_to_left >|+|> in_left >|+|> in_right
950 (* todo?: handle some isomorphisms here ? (with pointers = Unary Deref) *)
951 | A.ArrayAccess (ea1, ia1, ea2, ia2),((B.ArrayAccess (eb1, eb2), typ),ii) ->
952 let (ib1, ib2) = tuple_of_list2 ii in
953 expression ea1 eb1 >>= (fun ea1 eb1 ->
954 expression ea2 eb2 >>= (fun ea2 eb2 ->
955 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
956 tokenf ia2 ib2 >>= (fun ia2 ib2 ->
958 ((A.ArrayAccess (ea1, ia1, ea2, ia2))) +> wa,
959 ((B.ArrayAccess (eb1, eb2),typ), [ib1;ib2])
962 (* todo?: handle some isomorphisms here ? *)
963 | A.RecordAccess (ea, ia1, ida), ((B.RecordAccess (eb, idb), typ),ii) ->
964 let (ib1, ib2) = tuple_of_list2 ii in
965 ident DontKnow ida (idb, ib2) >>= (fun ida (idb, ib2) ->
966 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
967 expression ea eb >>= (fun ea eb ->
969 ((A.RecordAccess (ea, ia1, ida))) +> wa,
970 ((B.RecordAccess (eb, idb), typ), [ib1;ib2])
975 | A.RecordPtAccess (ea,ia1,ida),((B.RecordPtAccess (eb, idb), typ), ii) ->
976 let (ib1, ib2) = tuple_of_list2 ii in
977 ident DontKnow ida (idb, ib2) >>= (fun ida (idb, ib2) ->
978 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
979 expression ea eb >>= (fun ea eb ->
981 ((A.RecordPtAccess (ea, ia1, ida))) +> wa,
982 ((B.RecordPtAccess (eb, idb), typ), [ib1;ib2])
986 (* todo?: handle some isomorphisms here ?
987 * todo?: do some iso-by-absence on cast ?
988 * by trying | ea, B.Case (typb, eb) -> match_e_e ea eb ?
991 | A.Cast (ia1, typa, ia2, ea), ((B.Cast (typb, eb), typ),ii) ->
992 let (ib1, ib2) = tuple_of_list2 ii in
993 fullType typa typb >>= (fun typa typb ->
994 expression ea eb >>= (fun ea eb ->
995 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
996 tokenf ia2 ib2 >>= (fun ia2 ib2 ->
998 ((A.Cast (ia1, typa, ia2, ea))) +> wa,
999 ((B.Cast (typb, eb),typ),[ib1;ib2])
1002 | A.SizeOfExpr (ia1, ea), ((B.SizeOfExpr (eb), typ),ii) ->
1003 let ib1 = tuple_of_list1 ii in
1004 expression ea eb >>= (fun ea eb ->
1005 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
1007 ((A.SizeOfExpr (ia1, ea))) +> wa,
1008 ((B.SizeOfExpr (eb), typ),[ib1])
1011 | A.SizeOfType (ia1, ia2, typa, ia3), ((B.SizeOfType typb, typ),ii) ->
1012 let (ib1,ib2,ib3) = tuple_of_list3 ii in
1013 fullType typa typb >>= (fun typa typb ->
1014 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
1015 tokenf ia2 ib2 >>= (fun ia2 ib2 ->
1016 tokenf ia3 ib3 >>= (fun ia3 ib3 ->
1018 ((A.SizeOfType (ia1, ia2, typa, ia3))) +> wa,
1019 ((B.SizeOfType (typb),typ),[ib1;ib2;ib3])
1023 (* todo? iso ? allow all the combinations ? *)
1024 | A.Paren (ia1, ea, ia2), ((B.ParenExpr (eb), typ),ii) ->
1025 let (ib1, ib2) = tuple_of_list2 ii in
1026 expression ea eb >>= (fun ea eb ->
1027 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
1028 tokenf ia2 ib2 >>= (fun ia2 ib2 ->
1030 ((A.Paren (ia1, ea, ia2))) +> wa,
1031 ((B.ParenExpr (eb), typ), [ib1;ib2])
1034 | A.NestExpr(exps,None,true), eb ->
1035 (match A.unwrap exps with
1037 X.cocciExpExp expression exp eb >>= (fun exp eb ->
1039 (A.NestExpr(A.rewrap exps (A.DOTS [exp]),None,true)) +> wa,
1045 "for nestexpr, only handling the case with dots and only one exp")
1047 | A.NestExpr _, _ ->
1048 failwith "only handling multi and no when code in a nest expr"
1050 (* only in arg lists or in define body *)
1051 | A.TypeExp _, _ -> fail
1053 (* only in arg lists *)
1054 | A.MetaExprList _, _
1061 | A.DisjExpr eas, eb ->
1062 eas +> List.fold_left (fun acc ea -> acc >|+|> (expression ea eb)) fail
1064 | A.UniqueExp _,_ | A.OptExp _,_ ->
1065 failwith "not handling Opt/Unique/Multi on expr"
1067 (* Because of Exp cant put a raise Impossible; have to put a fail *)
1069 (* have not a counter part in coccinelle, for the moment *)
1070 | _, ((B.Sequence _,_),_)
1071 | _, ((B.StatementExpr _,_),_)
1072 | _, ((B.Constructor _,_),_)
1077 (((B.Cast (_, _)|B.ParenExpr _|B.SizeOfType _|B.SizeOfExpr _|
1078 B.RecordPtAccess (_, _)|
1079 B.RecordAccess (_, _)|B.ArrayAccess (_, _)|
1080 B.Binary (_, _, _)|B.Unary (_, _)|
1081 B.Infix (_, _)|B.Postfix (_, _)|
1082 B.Assignment (_, _, _)|B.CondExpr (_, _, _)|
1083 B.FunCall (_, _)|B.Constant _|B.Ident _),
1092 (* ------------------------------------------------------------------------- *)
1093 and (ident: info_ident -> (A.ident, string * Ast_c.info) matcher) =
1094 fun infoidb ida ((idb, iib) as ib) ->
1095 X.all_bound (A.get_inherited ida) >&&>
1096 match A.unwrap ida with
1098 if (term sa) =$= idb then
1099 tokenf sa iib >>= (fun sa iib ->
1101 ((A.Id sa)) +> A.rewrap ida,
1107 | A.MetaId(mida,constraints,keep,inherited) ->
1108 X.check_constraints (ident infoidb) constraints ib
1110 let max_min _ = Lib_parsing_c.lin_col_by_pos [iib] in
1111 (* use drop_pos for ids so that the pos is not added a second time in
1112 the call to tokenf *)
1113 X.envf keep inherited (A.drop_pos mida, Ast_c.MetaIdVal (idb), max_min)
1115 tokenf mida iib >>= (fun mida iib ->
1117 ((A.MetaId (mida, constraints, keep, inherited)) +> A.rewrap ida,
1122 | A.MetaFunc(mida,constraints,keep,inherited) ->
1124 X.check_constraints (ident infoidb) constraints ib
1126 let max_min _ = Lib_parsing_c.lin_col_by_pos [iib] in
1127 X.envf keep inherited (A.drop_pos mida,Ast_c.MetaFuncVal idb,max_min)
1129 tokenf mida iib >>= (fun mida iib ->
1131 ((A.MetaFunc(mida,constraints,keep,inherited)))+>A.rewrap ida,
1136 | LocalFunction | Function -> is_function()
1138 failwith "MetaFunc, need more semantic info about id"
1139 (* the following implementation could possibly be useful, if one
1140 follows the convention that a macro is always in capital letters
1141 and that a macro is not a function.
1142 (if idb =~ "^[A-Z_][A-Z_0-9]*$" then fail else is_function())*)
1145 | A.MetaLocalFunc(mida,constraints,keep,inherited) ->
1148 X.check_constraints (ident infoidb) constraints ib
1150 let max_min _ = Lib_parsing_c.lin_col_by_pos [iib] in
1151 X.envf keep inherited
1152 (A.drop_pos mida,Ast_c.MetaLocalFuncVal idb, max_min)
1154 tokenf mida iib >>= (fun mida iib ->
1156 ((A.MetaLocalFunc(mida,constraints,keep,inherited)))
1162 | DontKnow -> failwith "MetaLocalFunc, need more semantic info about id"
1165 | A.OptIdent _ | A.UniqueIdent _ ->
1166 failwith "not handling Opt/Unique for ident"
1170 (* ------------------------------------------------------------------------- *)
1171 and (arguments: sequence ->
1172 (A.expression list, Ast_c.argument Ast_c.wrap2 list) matcher) =
1173 fun seqstyle eas ebs ->
1175 | Unordered -> failwith "not handling ooo"
1177 arguments_bis eas (Ast_c.split_comma ebs) >>= (fun eas ebs_splitted ->
1178 return (eas, (Ast_c.unsplit_comma ebs_splitted))
1180 (* because '...' can match nothing, need to take care when have
1181 * ', ...' or '...,' as in f(..., X, Y, ...). It must match
1182 * f(1,2) for instance.
1183 * So I have added special cases such as (if startxs = []) and code
1184 * in the Ecomma matching rule.
1186 * old: Must do some try, for instance when f(...,X,Y,...) have to
1187 * test the transfo for all the combinaitions and if multiple transfo
1188 * possible ? pb ? => the type is to return a expression option ? use
1189 * some combinators to help ?
1190 * update: with the tag-SP approach, no more a problem.
1193 and arguments_bis = fun eas ebs ->
1195 | [], [] -> return ([], [])
1196 | [], eb::ebs -> fail
1198 X.all_bound (A.get_inherited ea) >&&>
1199 (match A.unwrap ea, ebs with
1200 | A.Edots (mcode, optexpr), ys ->
1201 (* todo: if optexpr, then a WHEN and so may have to filter yys *)
1202 if optexpr <> None then failwith "not handling when in argument";
1204 (* '...' can take more or less the beginnings of the arguments *)
1205 let startendxs = Common.zip (Common.inits ys) (Common.tails ys) in
1206 startendxs +> List.fold_left (fun acc (startxs, endxs) ->
1209 (* allow '...', and maybe its associated ',' to match nothing.
1210 * for the associated ',' see below how we handle the EComma
1215 if mcode_contain_plus (mcodekind mcode)
1217 (* failwith "I have no token that I could accroche myself on" *)
1218 else return (dots2metavar mcode, [])
1220 (* subtil: we dont want the '...' to match until the
1221 * comma. cf -test pb_params_iso. We would get at
1222 * "already tagged" error.
1223 * this is because both f (... x, ...) and f (..., x, ...)
1224 * would match a f(x,3) with our "optional-comma" strategy.
1226 (match Common.last startxs with
1229 X.distrf_args (dots2metavar mcode) startxs
1232 >>= (fun mcode startxs ->
1233 let mcode = metavar2dots mcode in
1234 arguments_bis eas endxs >>= (fun eas endxs ->
1236 (A.Edots (mcode, optexpr) +> A.rewrap ea) ::eas,
1242 | A.EComma ia1, Right ii::ebs ->
1243 let ib1 = tuple_of_list1 ii in
1244 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
1245 arguments_bis eas ebs >>= (fun eas ebs ->
1247 (A.EComma ia1 +> A.rewrap ea)::eas,
1251 | A.EComma ia1, ebs ->
1252 (* allow ',' to maching nothing. optional comma trick *)
1253 if mcode_contain_plus (mcodekind ia1)
1255 else arguments_bis eas ebs
1257 | A.MetaExprList(ida,leninfo,keep,inherited),ys ->
1258 let startendxs = Common.zip (Common.inits ys) (Common.tails ys) in
1259 startendxs +> List.fold_left (fun acc (startxs, endxs) ->
1264 if mcode_contain_plus (mcodekind ida)
1266 (* failwith "no token that I could accroche myself on" *)
1269 (match Common.last startxs with
1277 let startxs' = Ast_c.unsplit_comma startxs in
1278 let len = List.length startxs' in
1281 | Some (lenname,lenkeep,leninherited) ->
1282 let max_min _ = failwith "no pos" in
1283 X.envf lenkeep leninherited
1284 (lenname, Ast_c.MetaListlenVal (len), max_min)
1285 | None -> function f -> f()
1289 Lib_parsing_c.lin_col_by_pos
1290 (Lib_parsing_c.ii_of_args startxs) in
1291 X.envf keep inherited
1292 (ida, Ast_c.MetaExprListVal startxs', max_min)
1295 then return (ida, [])
1296 else X.distrf_args ida (Ast_c.split_comma startxs')
1298 >>= (fun ida startxs ->
1299 arguments_bis eas endxs >>= (fun eas endxs ->
1301 (A.MetaExprList(ida,leninfo,keep,inherited))
1302 +> A.rewrap ea::eas,
1310 | _unwrapx, (Left eb)::ebs ->
1311 argument ea eb >>= (fun ea eb ->
1312 arguments_bis eas ebs >>= (fun eas ebs ->
1313 return (ea::eas, Left eb::ebs)
1315 | _unwrapx, (Right y)::ys -> raise Impossible
1316 | _unwrapx, [] -> fail
1320 and argument arga argb =
1321 X.all_bound (A.get_inherited arga) >&&>
1322 match A.unwrap arga, argb with
1323 | A.TypeExp tya, Right (B.ArgType (((b, sopt, tyb), ii_b_s))) ->
1325 if b || sopt <> None
1327 (* failwith "the argument have a storage and ast_cocci does not have"*)
1330 fullType tya tyb >>= (fun tya tyb ->
1332 (A.TypeExp tya) +> A.rewrap arga,
1333 (Right (B.ArgType (((b, sopt, tyb), ii_b_s))))
1336 | A.TypeExp tya, _ -> fail
1337 | _, Right (B.ArgType (tyb, sto_iisto)) -> fail
1339 expression arga argb >>= (fun arga argb ->
1340 return (arga, Left argb)
1342 | _, Right (B.ArgAction y) -> fail
1345 (* ------------------------------------------------------------------------- *)
1346 (* todo? facto code with argument ? *)
1347 and (parameters: sequence ->
1348 (A.parameterTypeDef list, Ast_c.parameterType Ast_c.wrap2 list)
1350 fun seqstyle eas ebs ->
1352 | Unordered -> failwith "not handling ooo"
1354 parameters_bis eas (Ast_c.split_comma ebs) >>= (fun eas ebs_splitted ->
1355 return (eas, (Ast_c.unsplit_comma ebs_splitted))
1359 and parameters_bis eas ebs =
1361 | [], [] -> return ([], [])
1362 | [], eb::ebs -> fail
1364 (* the management of positions is inlined into each case, because
1365 sometimes there is a Param and sometimes a ParamList *)
1366 X.all_bound (A.get_inherited ea) >&&>
1367 (match A.unwrap ea, ebs with
1368 | A.Pdots (mcode), ys ->
1370 (* '...' can take more or less the beginnings of the arguments *)
1371 let startendxs = Common.zip (Common.inits ys) (Common.tails ys) in
1372 startendxs +> List.fold_left (fun acc (startxs, endxs) ->
1377 if mcode_contain_plus (mcodekind mcode)
1379 (* failwith "I have no token that I could accroche myself on"*)
1380 else return (dots2metavar mcode, [])
1382 (match Common.last startxs with
1385 X.distrf_params (dots2metavar mcode) startxs
1387 ) >>= (fun mcode startxs ->
1388 let mcode = metavar2dots mcode in
1389 parameters_bis eas endxs >>= (fun eas endxs ->
1391 (A.Pdots (mcode) +> A.rewrap ea) ::eas,
1397 | A.PComma ia1, Right ii::ebs ->
1398 let ib1 = tuple_of_list1 ii in
1399 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
1400 parameters_bis eas ebs >>= (fun eas ebs ->
1402 (A.PComma ia1 +> A.rewrap ea)::eas,
1407 | A.PComma ia1, ebs ->
1408 (* try optional comma trick *)
1409 if mcode_contain_plus (mcodekind ia1)
1411 else parameters_bis eas ebs
1414 | A.MetaParamList(ida,leninfo,keep,inherited),ys->
1415 let startendxs = Common.zip (Common.inits ys) (Common.tails ys) in
1416 startendxs +> List.fold_left (fun acc (startxs, endxs) ->
1421 if mcode_contain_plus (mcodekind ida)
1423 (* failwith "I have no token that I could accroche myself on" *)
1426 (match Common.last startxs with
1434 let startxs' = Ast_c.unsplit_comma startxs in
1435 let len = List.length startxs' in
1438 Some (lenname,lenkeep,leninherited) ->
1439 let max_min _ = failwith "no pos" in
1440 X.envf lenkeep leninherited
1441 (lenname, Ast_c.MetaListlenVal (len), max_min)
1442 | None -> function f -> f()
1446 Lib_parsing_c.lin_col_by_pos
1447 (Lib_parsing_c.ii_of_params startxs) in
1448 X.envf keep inherited
1449 (ida, Ast_c.MetaParamListVal startxs', max_min)
1452 then return (ida, [])
1453 else X.distrf_params ida (Ast_c.split_comma startxs')
1454 ) >>= (fun ida startxs ->
1455 parameters_bis eas endxs >>= (fun eas endxs ->
1457 (A.MetaParamList(ida,leninfo,keep,inherited))
1458 +> A.rewrap ea::eas,
1466 | A.VoidParam ta, ys ->
1467 (match eas, ebs with
1469 let ((hasreg, idbopt, tb), ii_b_s) = eb in
1470 if idbopt = None && null ii_b_s
1473 | (qub, (B.BaseType B.Void,_)) ->
1474 fullType ta tb >>= (fun ta tb ->
1476 [(A.VoidParam ta) +> A.rewrap ea],
1477 [Left ((hasreg, idbopt, tb), ii_b_s)]
1484 | (A.OptParam _ | A.UniqueParam _), _ ->
1485 failwith "handling Opt/Unique for Param"
1487 | A.Pcircles (_), ys -> raise Impossible (* in Ordered mode *)
1490 | A.MetaParam (ida,keep,inherited), (Left eb)::ebs ->
1491 (* todo: use quaopt, hasreg ? *)
1493 Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_param eb) in
1494 X.envf keep inherited (ida,Ast_c.MetaParamVal eb,max_min) (fun () ->
1495 X.distrf_param ida eb
1496 ) >>= (fun ida eb ->
1497 parameters_bis eas ebs >>= (fun eas ebs ->
1499 (A.MetaParam(ida,keep,inherited))+> A.rewrap ea::eas,
1504 | A.Param (typa, idaopt), (Left eb)::ebs ->
1505 (*this should succeed if the C code has a name, and fail otherwise*)
1506 parameter (idaopt, typa) eb >>= (fun (idaopt, typa) eb ->
1507 parameters_bis eas ebs >>= (fun eas ebs ->
1509 (A.Param (typa, idaopt))+> A.rewrap ea :: eas,
1513 | _unwrapx, (Right y)::ys -> raise Impossible
1514 | _unwrapx, [] -> fail
1521 and parameter = fun (idaopt, typa) ((hasreg, idbopt, typb), ii_b_s) ->
1522 fullType typa typb >>= (fun typa typb ->
1523 match idaopt, Ast_c.split_register_param (hasreg, idbopt, ii_b_s) with
1524 | Some ida, Left (idb, iihasreg, iidb) ->
1525 (* todo: if minus on ida, should also minus the iihasreg ? *)
1526 ident DontKnow ida (idb,iidb) >>= (fun ida (idb,iidb) ->
1529 ((hasreg, Some idb, typb), iihasreg++[iidb])
1532 | None, Right iihasreg ->
1535 ((hasreg, None, typb), iihasreg)
1539 (* why handle this case ? because of transform_proto ? we may not
1540 * have an ident in the proto.
1541 * If have some plus on ida ? do nothing about ida ?
1543 (* not anymore !!! now that julia is handling the proto.
1544 | _, Right iihasreg ->
1547 ((hasreg, None, typb), iihasreg)
1551 | Some _, Right _ -> fail
1552 | None, Left _ -> fail
1558 (* ------------------------------------------------------------------------- *)
1559 and (declaration: (A.mcodekind * bool * A.declaration,B.declaration) matcher) =
1560 fun (mckstart, allminus, decla) declb ->
1561 X.all_bound (A.get_inherited decla) >&&>
1562 match A.unwrap decla, declb with
1564 (* Un MetaDecl est introduit dans l'asttoctl pour sauter au dessus
1565 * de toutes les declarations qui sont au debut d'un fonction et
1566 * commencer le reste du match au premier statement. Alors, ca matche
1567 * n'importe quelle declaration. On n'a pas besoin d'ajouter
1568 * quoi que ce soit dans l'environnement. C'est une sorte de DDots.
1570 * When the SP want to remove the whole function, the minus is not
1571 * on the MetaDecl but on the MetaRuleElem. So there should
1572 * be no transform of MetaDecl, just matching are allowed.
1575 | A.MetaDecl(ida,_keep,_inherited), _ -> (* keep ? inherited ? *)
1576 (* todo: should not happen in transform mode *)
1577 return ((mckstart, allminus, decla), declb)
1581 | _, (B.DeclList ([var], iiptvirgb::iifakestart::iisto)) ->
1582 onedecl allminus decla (var,iiptvirgb,iisto) >>=
1583 (fun decla (var,iiptvirgb,iisto)->
1584 X.tokenf_mck mckstart iifakestart >>= (fun mckstart iifakestart ->
1586 (mckstart, allminus, decla),
1587 (B.DeclList ([var], iiptvirgb::iifakestart::iisto))
1590 | _, (B.DeclList (xs, iiptvirgb::iifakestart::iisto)) ->
1591 if X.mode = PatternMode
1593 xs +> List.fold_left (fun acc var ->
1595 X.tokenf_mck mckstart iifakestart >>= (fun mckstart iifakestart ->
1596 onedecl allminus decla (var, iiptvirgb, iisto) >>=
1597 (fun decla (var, iiptvirgb, iisto) ->
1599 (mckstart, allminus, decla),
1600 (B.DeclList ([var], iiptvirgb::iifakestart::iisto))
1604 failwith "More that one variable in decl. Have to split to transform."
1606 | A.MacroDecl (sa,lpa,eas,rpa,enda), B.MacroDecl ((sb,ebs),ii) ->
1607 let (iisb, lpb, rpb, iiendb, iifakestart, iistob) =
1609 | iisb::lpb::rpb::iiendb::iifakestart::iisto ->
1610 (iisb,lpb,rpb,iiendb, iifakestart,iisto)
1611 | _ -> raise Impossible
1614 then minusize_list iistob
1615 else return ((), iistob)
1616 ) >>= (fun () iistob ->
1618 X.tokenf_mck mckstart iifakestart >>= (fun mckstart iifakestart ->
1619 ident DontKnow sa (sb, iisb) >>= (fun sa (sb, iisb) ->
1620 tokenf lpa lpb >>= (fun lpa lpb ->
1621 tokenf rpa rpb >>= (fun rpa rpb ->
1622 tokenf enda iiendb >>= (fun enda iiendb ->
1623 arguments (seqstyle eas) (A.undots eas) ebs >>= (fun easundots ebs ->
1624 let eas = redots eas easundots in
1627 (mckstart, allminus,
1628 (A.MacroDecl (sa,lpa,eas,rpa,enda)) +> A.rewrap decla),
1629 (B.MacroDecl ((sb,ebs),
1630 [iisb;lpb;rpb;iiendb;iifakestart] ++ iistob))
1633 | _, (B.MacroDecl _ |B.DeclList _) -> fail
1637 and onedecl = fun allminus decla (declb, iiptvirgb, iistob) ->
1638 X.all_bound (A.get_inherited decla) >&&>
1639 match A.unwrap decla, declb with
1641 (* kind of typedef iso, we must unfold, it's for the case
1642 * T { }; that we want to match against typedef struct { } xx_t;
1644 | A.TyDecl (tya0, ptvirga),
1645 ({B.v_namei = Some ((idb, None),[iidb]);
1647 B.v_storage = (B.StoTypedef, inl);
1652 (match A.unwrap tya0, typb0 with
1653 | A.Type(cv1,tya1), ((qu,il),typb1) ->
1655 (match A.unwrap tya1, typb1 with
1656 | A.StructUnionDef(tya2, lba, declsa, rba),
1657 (B.StructUnion (sub, sbopt, declsb), ii) ->
1659 let (iisub, iisbopt, lbb, rbb) =
1662 let (iisub, lbb, rbb) = tuple_of_list3 ii in
1663 (iisub, [], lbb, rbb)
1666 "warning: both a typedef (%s) and struct name introduction (%s)"
1669 pr2 "warning: I will consider only the typedef";
1670 let (iisub, iisb, lbb, rbb) = tuple_of_list4 ii in
1671 (iisub, [iisb], lbb, rbb)
1674 structdef_to_struct_name
1675 (Ast_c.nQ, (B.StructUnion (sub, sbopt, declsb), ii))
1678 Ast_c.nQ,((B.TypeName (idb, Some
1679 (Lib_parsing_c.al_type structnameb))), [iidb])
1682 tokenf ptvirga iiptvirgb >>= (fun ptvirga iiptvirgb ->
1683 tokenf lba lbb >>= (fun lba lbb ->
1684 tokenf rba rbb >>= (fun rba rbb ->
1685 struct_fields (A.undots declsa) declsb >>=(fun undeclsa declsb ->
1686 let declsa = redots declsa undeclsa in
1688 (match A.unwrap tya2 with
1689 | A.Type(cv3, tya3) ->
1690 (match A.unwrap tya3 with
1691 | A.MetaType(ida,keep, inherited) ->
1693 fullType tya2 fake_typeb >>= (fun tya2 fake_typeb ->
1695 A.StructUnionDef(tya2,lba,declsa,rba)+> A.rewrap tya1 in
1696 let tya0 = A.Type(cv1, tya1) +> A.rewrap tya0 in
1699 let typb1 = B.StructUnion (sub,sbopt, declsb),
1700 [iisub] @ iisbopt @ [lbb;rbb] in
1701 let typb0 = ((qu, il), typb1) in
1703 match fake_typeb with
1704 | _nQ, ((B.TypeName (idb,_typ)), [iidb]) ->
1707 (A.TyDecl (tya0, ptvirga)) +> A.rewrap decla,
1708 (({B.v_namei = Some ((idb, None),[iidb]);
1710 B.v_storage = (B.StoTypedef, inl);
1714 iivirg),iiptvirgb,iistob)
1716 | _ -> raise Impossible
1719 | A.StructUnionName(sua, sa) ->
1721 fullType tya2 structnameb >>= (fun tya2 structnameb ->
1723 let tya1 = A.StructUnionDef(tya2,lba,declsa,rba)+> A.rewrap tya1
1725 let tya0 = A.Type(cv1, tya1) +> A.rewrap tya0 in
1727 match structnameb with
1728 | _nQ, (B.StructUnionName (sub, s), [iisub;iisbopt]) ->
1730 let typb1 = B.StructUnion (sub,sbopt, declsb),
1731 [iisub;iisbopt;lbb;rbb] in
1732 let typb0 = ((qu, il), typb1) in
1735 (A.TyDecl (tya0, ptvirga)) +> A.rewrap decla,
1736 (({B.v_namei = Some ((idb, None),[iidb]);
1738 B.v_storage = (B.StoTypedef, inl);
1742 iivirg),iiptvirgb,iistob)
1744 | _ -> raise Impossible
1746 | _ -> raise Impossible
1755 | A.UnInit (stoa, typa, ida, ptvirga),
1756 ({B.v_namei = Some ((idb, _),[iidb]);
1757 B.v_storage = (B.StoTypedef,_);
1761 | A.Init (stoa, typa, ida, eqa, inia, ptvirga),
1762 ({B.v_namei = Some ((idb, _),[iidb]);
1763 B.v_storage = (B.StoTypedef,_);
1769 (* could handle iso here but handled in standard.iso *)
1770 | A.UnInit (stoa, typa, ida, ptvirga),
1771 ({B.v_namei = Some ((idb, None),[iidb]);
1778 tokenf ptvirga iiptvirgb >>= (fun ptvirga iiptvirgb ->
1779 fullType typa typb >>= (fun typa typb ->
1780 ident DontKnow ida (idb, iidb) >>= (fun ida (idb, iidb) ->
1781 storage_optional_allminus allminus stoa (stob, iistob) >>=
1782 (fun stoa (stob, iistob) ->
1784 (A.UnInit (stoa, typa, ida, ptvirga)) +> A.rewrap decla,
1785 (({B.v_namei = Some ((idb,None),[iidb]);
1794 | A.Init (stoa, typa, ida, eqa, inia, ptvirga),
1795 ({B.v_namei = Some((idb,Some inib),[iidb;iieqb]);
1802 tokenf ptvirga iiptvirgb >>= (fun ptvirga iiptvirgb ->
1803 tokenf eqa iieqb >>= (fun eqa iieqb ->
1804 fullType typa typb >>= (fun typa typb ->
1805 ident DontKnow ida (idb, iidb) >>= (fun ida (idb, iidb) ->
1806 storage_optional_allminus allminus stoa (stob, iistob) >>=
1807 (fun stoa (stob, iistob) ->
1808 initialiser inia inib >>= (fun inia inib ->
1810 (A.Init (stoa, typa, ida, eqa, inia, ptvirga)) +> A.rewrap decla,
1811 (({B.v_namei = Some((idb,Some inib),[iidb;iieqb]);
1820 (* do iso-by-absence here ? allow typedecl and var ? *)
1821 | A.TyDecl (typa, ptvirga),
1822 ({B.v_namei = None; B.v_type = typb;
1828 if stob = (B.NoSto, false)
1830 tokenf ptvirga iiptvirgb >>= (fun ptvirga iiptvirgb ->
1831 fullType typa typb >>= (fun typa typb ->
1833 (A.TyDecl (typa, ptvirga)) +> A.rewrap decla,
1834 (({B.v_namei = None;
1839 }, iivirg), iiptvirgb, iistob)
1844 | A.Typedef (stoa, typa, ida, ptvirga),
1845 ({B.v_namei = Some ((idb, None),[iidb]);
1847 B.v_storage = (B.StoTypedef,inline);
1852 tokenf ptvirga iiptvirgb >>= (fun ptvirga iiptvirgb ->
1853 fullType typa typb >>= (fun typa typb ->
1856 tokenf stoa iitypedef >>= (fun stoa iitypedef ->
1857 return (stoa, [iitypedef])
1859 | _ -> failwith "wierd, have both typedef and inline or nothing";
1860 ) >>= (fun stoa iistob ->
1861 (match A.unwrap ida with
1862 | A.MetaType(_,_,_) ->
1865 Ast_c.nQ, ((B.TypeName (idb, Ast_c.noTypedefDef())), [iidb])
1867 fullTypebis ida fake_typeb >>= (fun ida fake_typeb ->
1868 match fake_typeb with
1869 | _nQ, ((B.TypeName (idb,_typ)), [iidb]) ->
1870 return (ida, (idb, iidb))
1871 | _ -> raise Impossible
1875 if (term sa) =$= idb
1877 tokenf sa iidb >>= (fun sa iidb ->
1879 (A.TypeName sa) +> A.rewrap ida,
1883 | _ -> raise Impossible
1885 ) >>= (fun ida (idb, iidb) ->
1887 (A.Typedef (stoa, typa, ida, ptvirga)) +> A.rewrap decla,
1888 (({B.v_namei = Some ((idb, None),[iidb]);
1890 B.v_storage = (B.StoTypedef,inline);
1900 | _, ({B.v_namei = None;}, _) ->
1901 (* old: failwith "no variable in this declaration, wierd" *)
1906 | A.DisjDecl declas, declb ->
1907 declas +> List.fold_left (fun acc decla ->
1909 (* (declaration (mckstart, allminus, decla) declb) *)
1910 (onedecl allminus decla (declb,iiptvirgb, iistob))
1915 (* only in struct type decls *)
1916 | A.Ddots(dots,whencode), _ ->
1919 | A.OptDecl _, _ | A.UniqueDecl _, _ ->
1920 failwith "not handling Opt/Unique Decl"
1922 | _, ({B.v_namei=Some _}, _)
1928 (* ------------------------------------------------------------------------- *)
1930 and (initialiser: (A.initialiser, Ast_c.initialiser) matcher) = fun ia ib ->
1931 X.all_bound (A.get_inherited ia) >&&>
1932 match (A.unwrap ia,ib) with
1934 | (A.InitExpr expa, ib) ->
1935 (match A.unwrap expa, ib with
1936 | A.Edots (mcode, None), ib ->
1937 X.distrf_ini (dots2metavar mcode) ib >>= (fun mcode ib ->
1940 (A.Edots (metavar2dots mcode, None) +> A.rewrap expa)
1945 | A.Edots (_, Some expr), _ -> failwith "not handling when on Edots"
1947 | _, (B.InitExpr expb, ii) ->
1949 expression expa expb >>= (fun expa expb ->
1951 (A.InitExpr expa) +> A.rewrap ia,
1952 (B.InitExpr expb, ii)
1957 | (A.InitList (ia1, ias, ia2, []), (B.InitList ibs, ii)) ->
1959 | ib1::ib2::iicommaopt ->
1960 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
1961 tokenf ia2 ib2 >>= (fun ia2 ib2 ->
1962 initialisers ias (ibs, iicommaopt) >>= (fun ias (ibs,iicommaopt) ->
1964 (A.InitList (ia1, ias, ia2, [])) +> A.rewrap ia,
1965 (B.InitList ibs, ib1::ib2::iicommaopt)
1968 | _ -> raise Impossible
1971 | (A.InitList (i1, ias, i2, whencode),(B.InitList ibs, _ii)) ->
1972 failwith "TODO: not handling whencode in initialisers"
1975 | (A.InitGccDotName (ia1, ida, ia2, inia),
1976 (B.InitDesignators ([B.DesignatorField idb,ii1], inib), ii2))->
1978 let (iidot, iidb) = tuple_of_list2 ii1 in
1979 let iieq = tuple_of_list1 ii2 in
1981 tokenf ia1 iidot >>= (fun ia1 iidot ->
1982 tokenf ia2 iieq >>= (fun ia2 iieq ->
1983 ident DontKnow ida (idb, iidb) >>= (fun ida (idb, iidb) ->
1984 initialiser inia inib >>= (fun inia inib ->
1986 (A.InitGccDotName (ia1, ida, ia2, inia)) +> A.rewrap ia,
1988 ([B.DesignatorField idb, [iidot;iidb]], inib), [iieq])
1992 | (A.InitGccIndex (ia1,ea,ia2,ia3,inia),
1993 (B.InitDesignators ([B.DesignatorIndex eb, ii1], inib), ii2)) ->
1995 let (ib1, ib2) = tuple_of_list2 ii1 in
1996 let ib3 = tuple_of_list1 ii2 in
1997 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
1998 tokenf ia2 ib2 >>= (fun ia2 ib2 ->
1999 tokenf ia3 ib3 >>= (fun ia3 ib3 ->
2000 expression ea eb >>= (fun ea eb ->
2001 initialiser inia inib >>= (fun inia inib ->
2003 (A.InitGccIndex (ia1,ea,ia2,ia3,inia)) +> A.rewrap ia,
2005 ([B.DesignatorIndex eb, [ib1;ib2]], inib), [ib3])
2009 | (A.InitGccRange (ia1,e1a,ia2,e2a,ia3,ia4,inia),
2010 (B.InitDesignators ([B.DesignatorRange (e1b, e2b), ii1], inib), ii2)) ->
2012 let (ib1, ib2, ib3) = tuple_of_list3 ii1 in
2013 let (ib4) = tuple_of_list1 ii2 in
2014 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
2015 tokenf ia2 ib2 >>= (fun ia2 ib2 ->
2016 tokenf ia3 ib3 >>= (fun ia3 ib3 ->
2017 tokenf ia4 ib4 >>= (fun ia4 ib4 ->
2018 expression e1a e1b >>= (fun e1a e1b ->
2019 expression e2a e2b >>= (fun e2a e2b ->
2020 initialiser inia inib >>= (fun inia inib ->
2022 (A.InitGccRange (ia1,e1a,ia2,e2a,ia3,ia4,inia)) +> A.rewrap ia,
2024 ([B.DesignatorRange (e1b, e2b),[ib1;ib2;ib3]], inib), [ib4])
2030 | (A.InitGccName (ida, ia1, inia), (B.InitFieldOld (idb, inib), ii)) ->
2033 ident DontKnow ida (idb, iidb) >>= (fun ida (idb, iidb) ->
2034 initialiser inia inib >>= (fun inia inib ->
2035 tokenf ia1 iicolon >>= (fun ia1 iicolon ->
2037 (A.InitGccName (ida, ia1, inia)) +> A.rewrap ia,
2038 (B.InitFieldOld (idb, inib), [iidb;iicolon])
2045 | A.IComma(comma), _ ->
2048 | A.UniqueIni _,_ | A.OptIni _,_ ->
2049 failwith "not handling Opt/Unique on initialisers"
2051 | _, (B.InitIndexOld (_, _), _) -> fail
2052 | _, (B.InitFieldOld (_, _), _) -> fail
2054 | _, ((B.InitDesignators (_, _)|B.InitList _|B.InitExpr _), _)
2062 and initialisers = fun ias (ibs, iicomma) ->
2063 let ias_unsplit = unsplit_icomma ias in
2064 let ibs_split = resplit_initialiser ibs iicomma in
2067 if need_unordered_initialisers ibs
2068 then initialisers_unordered2
2069 else initialisers_ordered2
2071 f ias_unsplit ibs_split >>=
2072 (fun ias_unsplit ibs_split ->
2074 split_icomma ias_unsplit,
2075 unsplit_initialiser ibs_split
2079 (* todo: one day julia will reput a IDots *)
2080 and initialisers_ordered2 = fun ias ibs ->
2082 | [], [] -> return ([], [])
2083 | (x, xcomma)::xs, (y, commay)::ys ->
2084 (match A.unwrap xcomma with
2085 | A.IComma commax ->
2086 tokenf commax commay >>= (fun commax commay ->
2087 initialiser x y >>= (fun x y ->
2088 initialisers_ordered2 xs ys >>= (fun xs ys ->
2090 (x, (A.IComma commax) +> A.rewrap xcomma)::xs,
2094 | _ -> raise Impossible (* unsplit_iicomma wrong *)
2100 and initialisers_unordered2 = fun ias ibs ->
2103 | [], ys -> return ([], ys)
2104 | (x,xcomma)::xs, ys ->
2106 let permut = Common.uncons_permut_lazy ys in
2107 permut +> List.fold_left (fun acc ((e, pos), rest) ->
2110 (match A.unwrap xcomma, e with
2111 | A.IComma commax, (y, commay) ->
2112 tokenf commax commay >>= (fun commax commay ->
2113 initialiser x y >>= (fun x y ->
2115 (x, (A.IComma commax) +> A.rewrap xcomma),
2119 | _ -> raise Impossible (* unsplit_iicomma wrong *)
2122 let rest = Lazy.force rest in
2123 initialisers_unordered2 xs rest >>= (fun xs rest ->
2126 Common.insert_elem_pos (e, pos) rest
2131 (* ------------------------------------------------------------------------- *)
2132 and (struct_fields: (A.declaration list, B.field list) matcher) =
2135 | [], [] -> return ([], [])
2136 | [], eb::ebs -> fail
2138 X.all_bound (A.get_inherited ea) >&&>
2139 (match A.unwrap ea, ebs with
2140 | A.Ddots (mcode, optwhen), ys ->
2141 if optwhen <> None then failwith "not handling when in argument";
2143 (* '...' can take more or less the beginnings of the arguments *)
2144 let startendxs = Common.zip (Common.inits ys) (Common.tails ys) in
2145 startendxs +> List.fold_left (fun acc (startxs, endxs) ->
2150 if mcode_contain_plus (mcodekind mcode)
2152 (* failwith "I have no token that I could accroche myself on" *)
2153 else return (dots2metavar mcode, [])
2156 X.distrf_struct_fields (dots2metavar mcode) startxs
2157 ) >>= (fun mcode startxs ->
2158 let mcode = metavar2dots mcode in
2159 struct_fields eas endxs >>= (fun eas endxs ->
2161 (A.Ddots (mcode, optwhen) +> A.rewrap ea) ::eas,
2166 | _unwrapx, eb::ebs ->
2167 struct_field ea eb >>= (fun ea eb ->
2168 struct_fields eas ebs >>= (fun eas ebs ->
2169 return (ea::eas, eb::ebs)
2172 | _unwrapx, [] -> fail
2175 and (struct_field: (A.declaration, B.field) matcher) = fun fa fb ->
2176 let (xfield, iifield) = fb in
2179 | B.DeclarationField (B.FieldDeclList (onefield_multivars,iiptvirg)) ->
2181 let iiptvirgb = tuple_of_list1 iiptvirg in
2183 (match onefield_multivars with
2184 | [] -> raise Impossible
2185 | [onevar,iivirg] ->
2186 assert (null iivirg);
2188 | B.BitField (sopt, typb, expr), ii ->
2189 pr2_once "warning: bitfield not handled by ast_cocci";
2191 | B.Simple (None, typb), ii ->
2192 pr2_once "warning: unamed struct field not handled by ast_cocci";
2194 | B.Simple (Some idb, typb), ii ->
2195 let (iidb) = tuple_of_list1 ii in
2197 (* build a declaration from a struct field *)
2198 let allminus = false in
2200 let stob = B.NoSto, false in
2202 ({B.v_namei = Some ((idb, None),[iidb]);
2205 B.v_local = Ast_c.NotLocalDecl;
2206 B.v_attr = Ast_c.noattr;
2210 onedecl allminus fa (fake_var,iiptvirgb,iisto) >>=
2211 (fun fa (var,iiptvirgb,iisto) ->
2214 | ({B.v_namei = Some ((idb, None),[iidb]);
2218 let onevar = B.Simple (Some idb, typb), [iidb] in
2222 ((B.DeclarationField
2223 (B.FieldDeclList ([onevar, iivirg], [iiptvirgb]))),
2226 | _ -> raise Impossible
2231 pr2_once "PB: More that one variable in decl. Have to split";
2235 let _iiptvirgb = tuple_of_list1 iifield in
2238 | B.MacroStructDeclTodo -> fail
2239 | B.CppDirectiveStruct directive -> fail
2240 | B.IfdefStruct directive -> fail
2244 (* ------------------------------------------------------------------------- *)
2245 and (fullType: (A.fullType, Ast_c.fullType) matcher) =
2247 X.optional_qualifier_flag (fun optional_qualifier ->
2248 X.all_bound (A.get_inherited typa) >&&>
2249 match A.unwrap typa, typb with
2250 | A.Type(cv,ty1), ((qu,il),ty2) ->
2252 if qu.B.const && qu.B.volatile
2255 ("warning: the type is both const & volatile but cocci " ^
2256 "does not handle that");
2258 (* Drop out the const/volatile part that has been matched.
2259 * This is because a SP can contain const T v; in which case
2260 * later in match_t_t when we encounter a T, we must not add in
2261 * the environment the whole type.
2266 (* "iso-by-absence" *)
2269 fullTypebis ty1 ((qu,il), ty2) >>= (fun ty1 fullty2 ->
2271 (A.Type(None, ty1)) +> A.rewrap typa,
2275 (match optional_qualifier, qu.B.const || qu.B.volatile with
2276 | false, false -> do_stuff ()
2277 | false, true -> fail
2278 | true, false -> do_stuff ()
2281 then pr2_once "USING optional_qualifier builtin isomorphism";
2287 (* todo: can be __const__ ? can be const & volatile so
2288 * should filter instead ?
2290 (match term x, il with
2291 | A.Const, [i1] when qu.B.const ->
2293 tokenf x i1 >>= (fun x i1 ->
2294 fullTypebis ty1 (Ast_c.nQ,ty2) >>= (fun ty1 (_, ty2) ->
2296 (A.Type(Some x, ty1)) +> A.rewrap typa,
2300 | A.Volatile, [i1] when qu.B.volatile ->
2301 tokenf x i1 >>= (fun x i1 ->
2302 fullTypebis ty1 (Ast_c.nQ,ty2) >>= (fun ty1 (_, ty2) ->
2304 (A.Type(Some x, ty1)) +> A.rewrap typa,
2312 | A.DisjType typas, typb ->
2314 List.fold_left (fun acc typa -> acc >|+|> (fullType typa typb)) fail
2316 | A.OptType(_), _ | A.UniqueType(_), _
2317 -> failwith "not handling Opt/Unique on type"
2322 * Why not (A.typeC, Ast_c.typeC) matcher ?
2323 * because when there is MetaType, we want that T record the whole type,
2324 * including the qualifier, and so this type (and the new_il function in
2325 * preceding function).
2328 and (fullTypebis: (A.typeC, Ast_c.fullType) matcher) =
2330 X.all_bound (A.get_inherited ta) >&&>
2331 match A.unwrap ta, tb with
2334 | A.MetaType(ida,keep, inherited), typb ->
2336 Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_type typb) in
2337 X.envf keep inherited (ida, B.MetaTypeVal typb, max_min) (fun () ->
2338 X.distrf_type ida typb >>= (fun ida typb ->
2340 A.MetaType(ida,keep, inherited) +> A.rewrap ta,
2344 | unwrap, (qub, typb) ->
2345 typeC ta typb >>= (fun ta typb ->
2346 return (ta, (qub, typb))
2349 and simulate_signed ta basea stringsa signaopt tb baseb ii rebuilda =
2350 (* In ii there is a list, sometimes of length 1 or 2 or 3.
2351 * And even if in baseb we have a Signed Int, that does not mean
2352 * that ii is of length 2, cos Signed is the default, so if in signa
2353 * we have Signed explicitely ? we cant "accrocher" this mcode to
2354 * something :( So for the moment when there is signed in cocci,
2355 * we force that there is a signed in c too (done in pattern.ml).
2357 let signbopt, iibaseb = split_signb_baseb_ii (baseb, ii) in
2360 (* handle some iso on type ? (cf complex C rule for possible implicit
2362 match basea, baseb with
2363 | A.VoidType, B.Void
2364 | A.FloatType, B.FloatType (B.CFloat)
2365 | A.DoubleType, B.FloatType (B.CDouble) ->
2366 assert (signaopt = None);
2367 let stringa = tuple_of_list1 stringsa in
2368 let (ibaseb) = tuple_of_list1 ii in
2369 tokenf stringa ibaseb >>= (fun stringa ibaseb ->
2371 (rebuilda ([stringa], signaopt)) +> A.rewrap ta,
2372 (B.BaseType baseb, [ibaseb])
2375 | A.CharType, B.IntType B.CChar when signaopt = None ->
2376 let stringa = tuple_of_list1 stringsa in
2377 let ibaseb = tuple_of_list1 ii in
2378 tokenf stringa ibaseb >>= (fun stringa ibaseb ->
2380 (rebuilda ([stringa], signaopt)) +> A.rewrap ta,
2381 (B.BaseType (B.IntType B.CChar), [ibaseb])
2384 | A.CharType,B.IntType (B.Si (_sign, B.CChar2)) when signaopt <> None ->
2385 let stringa = tuple_of_list1 stringsa in
2386 let ibaseb = tuple_of_list1 iibaseb in
2387 sign signaopt signbopt >>= (fun signaopt iisignbopt ->
2388 tokenf stringa ibaseb >>= (fun stringa ibaseb ->
2390 (rebuilda ([stringa], signaopt)) +> A.rewrap ta,
2391 (B.BaseType (baseb), iisignbopt ++ [ibaseb])
2394 | A.ShortType, B.IntType (B.Si (_, B.CShort))
2395 | A.IntType, B.IntType (B.Si (_, B.CInt))
2396 | A.LongType, B.IntType (B.Si (_, B.CLong)) ->
2397 let stringa = tuple_of_list1 stringsa in
2400 (* iso-by-presence ? *)
2401 (* when unsigned int in SP, allow have just unsigned in C ? *)
2402 if mcode_contain_plus (mcodekind stringa)
2406 sign signaopt signbopt >>= (fun signaopt iisignbopt ->
2408 (rebuilda ([stringa], signaopt)) +> A.rewrap ta,
2409 (B.BaseType (baseb), iisignbopt ++ [])
2415 "warning: long int or short int not handled by ast_cocci";
2419 sign signaopt signbopt >>= (fun signaopt iisignbopt ->
2420 tokenf stringa ibaseb >>= (fun stringa ibaseb ->
2422 (rebuilda ([stringa], signaopt)) +> A.rewrap ta,
2423 (B.BaseType (baseb), iisignbopt ++ [ibaseb])
2425 | _ -> raise Impossible
2430 | A.LongLongType, B.IntType (B.Si (_, B.CLongLong)) ->
2431 let (string1a,string2a) = tuple_of_list2 stringsa in
2433 [ibase1b;ibase2b] ->
2434 sign signaopt signbopt >>= (fun signaopt iisignbopt ->
2435 tokenf string1a ibase1b >>= (fun base1a ibase1b ->
2436 tokenf string2a ibase2b >>= (fun base2a ibase2b ->
2438 (rebuilda ([base1a;base2a], signaopt)) +> A.rewrap ta,
2439 (B.BaseType (baseb), iisignbopt ++ [ibase1b;ibase2b])
2441 | [] -> fail (* should something be done in this case? *)
2442 | _ -> raise Impossible)
2445 | _, B.FloatType B.CLongDouble
2448 "warning: long double not handled by ast_cocci";
2451 | _, (B.Void|B.FloatType _|B.IntType _) -> fail
2453 and simulate_signed_meta ta basea signaopt tb baseb ii rebuilda =
2454 (* In ii there is a list, sometimes of length 1 or 2 or 3.
2455 * And even if in baseb we have a Signed Int, that does not mean
2456 * that ii is of length 2, cos Signed is the default, so if in signa
2457 * we have Signed explicitely ? we cant "accrocher" this mcode to
2458 * something :( So for the moment when there is signed in cocci,
2459 * we force that there is a signed in c too (done in pattern.ml).
2461 let signbopt, iibaseb = split_signb_baseb_ii (baseb, ii) in
2463 let match_to_type rebaseb =
2464 sign signaopt signbopt >>= (fun signaopt iisignbopt ->
2465 let ibaseb = tuple_of_list1 iibaseb in
2466 let fta = A.rewrap basea (A.Type(None,basea)) in
2467 let ftb = Ast_c.nQ,(B.BaseType (rebaseb), [ibaseb]) in
2468 fullType fta ftb >>= (fun fta (_,tb) ->
2469 (match A.unwrap fta,tb with
2470 A.Type(_,basea), (B.BaseType baseb, ii) ->
2471 let ibaseb = tuple_of_list1 ii in
2473 (rebuilda (basea, signaopt)) +> A.rewrap ta,
2474 (B.BaseType (baseb), iisignbopt ++ [ibaseb])
2476 | _ -> failwith "not possible"))) in
2478 (* handle some iso on type ? (cf complex C rule for possible implicit
2481 | B.IntType (B.Si (_sign, B.CChar2)) ->
2482 match_to_type (B.IntType B.CChar)
2484 | B.IntType (B.Si (_, ty)) ->
2486 | [] -> fail (* metavariable has to match something *)
2490 "warning: long int or short int not handled by ast_cocci";
2493 | [ibaseb] -> match_to_type (B.IntType (B.Si (B.Signed, ty)))
2494 | _ -> raise Impossible
2498 | (B.Void|B.FloatType _|B.IntType _) -> fail
2500 and (typeC: (A.typeC, Ast_c.typeC) matcher) =
2502 match A.unwrap ta, tb with
2503 | A.BaseType (basea,stringsa), (B.BaseType baseb, ii) ->
2504 simulate_signed ta basea stringsa None tb baseb ii
2505 (function (stringsa, signaopt) -> A.BaseType (basea,stringsa))
2506 | A.SignedT (signaopt, Some basea), (B.BaseType baseb, ii) ->
2507 (match A.unwrap basea with
2508 A.BaseType (basea1,strings1) ->
2509 simulate_signed ta basea1 strings1 (Some signaopt) tb baseb ii
2510 (function (strings1, Some signaopt) ->
2513 Some (A.rewrap basea (A.BaseType (basea1,strings1))))
2514 | _ -> failwith "not possible")
2515 | A.MetaType(ida,keep,inherited) ->
2516 simulate_signed_meta ta basea (Some signaopt) tb baseb ii
2517 (function (basea, Some signaopt) ->
2518 A.SignedT(signaopt,Some basea)
2519 | _ -> failwith "not possible")
2520 | _ -> failwith "not possible")
2521 | A.SignedT (signa,None), (B.BaseType baseb, ii) ->
2522 let signbopt, iibaseb = split_signb_baseb_ii (baseb, ii) in
2523 (match iibaseb, baseb with
2524 | [], B.IntType (B.Si (_sign, B.CInt)) ->
2525 sign (Some signa) signbopt >>= (fun signaopt iisignbopt ->
2527 | None -> raise Impossible
2530 (A.SignedT (signa,None)) +> A.rewrap ta,
2531 (B.BaseType baseb, iisignbopt)
2539 (* todo? iso with array *)
2540 | A.Pointer (typa, iamult), (B.Pointer typb, ii) ->
2541 let (ibmult) = tuple_of_list1 ii in
2542 fullType typa typb >>= (fun typa typb ->
2543 tokenf iamult ibmult >>= (fun iamult ibmult ->
2545 (A.Pointer (typa, iamult)) +> A.rewrap ta,
2546 (B.Pointer typb, [ibmult])
2549 | A.FunctionType(allminus,tyaopt,lpa,paramsa,rpa),
2550 (B.FunctionType(tyb, (paramsb, (isvaargs, iidotsb))), ii) ->
2552 let (lpb, rpb) = tuple_of_list2 ii in
2556 ("Not handling well variable length arguments func. "^
2557 "You have been warned");
2558 tokenf lpa lpb >>= (fun lpa lpb ->
2559 tokenf rpa rpb >>= (fun rpa rpb ->
2560 fullType_optional_allminus allminus tyaopt tyb >>= (fun tyaopt tyb ->
2561 parameters (seqstyle paramsa) (A.undots paramsa) paramsb >>=
2562 (fun paramsaundots paramsb ->
2563 let paramsa = redots paramsa paramsaundots in
2565 (A.FunctionType(allminus,tyaopt,lpa,paramsa,rpa) +> A.rewrap ta,
2566 (B.FunctionType(tyb, (paramsb, (isvaargs, iidotsb))), [lpb;rpb])
2574 | A.FunctionPointer(tya,lp1a,stara,rp1a,lp2a,paramsa,rp2a),
2575 (B.ParenType t1, ii) ->
2576 let (lp1b, rp1b) = tuple_of_list2 ii in
2577 let (qu1b, t1b) = t1 in
2579 | B.Pointer t2, ii ->
2580 let (starb) = tuple_of_list1 ii in
2581 let (qu2b, t2b) = t2 in
2583 | B.FunctionType (tyb, (paramsb, (isvaargs, iidotsb))), ii ->
2584 let (lp2b, rp2b) = tuple_of_list2 ii in
2589 ("Not handling well variable length arguments func. "^
2590 "You have been warned");
2592 fullType tya tyb >>= (fun tya tyb ->
2593 tokenf lp1a lp1b >>= (fun lp1a lp1b ->
2594 tokenf rp1a rp1b >>= (fun rp1a rp1b ->
2595 tokenf lp2a lp2b >>= (fun lp2a lp2b ->
2596 tokenf rp2a rp2b >>= (fun rp2a rp2b ->
2597 tokenf stara starb >>= (fun stara starb ->
2598 parameters (seqstyle paramsa) (A.undots paramsa) paramsb >>=
2599 (fun paramsaundots paramsb ->
2600 let paramsa = redots paramsa paramsaundots in
2604 (B.FunctionType (tyb, (paramsb, (isvaargs, iidotsb))),
2609 (B.Pointer t2, [starb]))
2613 (A.FunctionPointer(tya,lp1a,stara,rp1a,lp2a,paramsa,rp2a))
2615 (B.ParenType t1, [lp1b;rp1b])
2628 (* todo: handle the iso on optionnal size specifification ? *)
2629 | A.Array (typa, ia1, eaopt, ia2), (B.Array (ebopt, typb), ii) ->
2630 let (ib1, ib2) = tuple_of_list2 ii in
2631 fullType typa typb >>= (fun typa typb ->
2632 option expression eaopt ebopt >>= (fun eaopt ebopt ->
2633 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
2634 tokenf ia2 ib2 >>= (fun ia2 ib2 ->
2636 (A.Array (typa, ia1, eaopt, ia2)) +> A.rewrap ta,
2637 (B.Array (ebopt, typb), [ib1;ib2])
2641 (* todo: could also match a Struct that has provided a name *)
2642 (* This is for the case where the SmPL code contains "struct x", without
2643 a definition. In this case, the name field is always present.
2644 This case is also called from the case for A.StructUnionDef when
2645 a name is present in the C code. *)
2646 | A.StructUnionName(sua, Some sa), (B.StructUnionName (sub, sb), ii) ->
2647 (* sa is now an ident, not an mcode, old: ... && (term sa) =$= sb *)
2648 let (ib1, ib2) = tuple_of_list2 ii in
2649 if equal_structUnion (term sua) sub
2651 ident DontKnow sa (sb, ib2) >>= (fun sa (sb, ib2) ->
2652 tokenf sua ib1 >>= (fun sua ib1 ->
2654 (A.StructUnionName (sua, Some sa)) +> A.rewrap ta,
2655 (B.StructUnionName (sub, sb), [ib1;ib2])
2660 | A.StructUnionDef(ty, lba, declsa, rba),
2661 (B.StructUnion (sub, sbopt, declsb), ii) ->
2663 let (ii_sub_sb, lbb, rbb) =
2665 [iisub; lbb; rbb] -> (Common.Left iisub,lbb,rbb)
2666 | [iisub; iisb; lbb; rbb] -> (Common.Right (iisub,iisb),lbb,rbb)
2667 | _ -> failwith "list of length 3 or 4 expected" in
2670 match (sbopt,ii_sub_sb) with
2671 (None,Common.Left iisub) ->
2672 (* the following doesn't reconstruct the complete SP code, just
2673 the part that matched *)
2675 match A.unwrap s with
2677 (match A.unwrap ty with
2678 A.StructUnionName(sua, None) ->
2679 tokenf sua iisub >>= (fun sua iisub ->
2682 A.StructUnionName(sua, None) +> A.rewrap ty)
2684 return (ty,[iisub]))
2686 | A.DisjType(disjs) ->
2688 List.fold_left (fun acc disj -> acc >|+|> (loop disj)) fail
2692 | (Some sb,Common.Right (iisub,iisb)) ->
2694 (* build a StructUnionName from a StructUnion *)
2695 let fake_su = B.nQ, (B.StructUnionName (sub, sb), [iisub;iisb]) in
2697 fullType ty fake_su >>= (fun ty fake_su ->
2699 | _nQ, (B.StructUnionName (sub, sb), [iisub;iisb]) ->
2700 return (ty, [iisub; iisb])
2701 | _ -> raise Impossible)
2705 >>= (fun ty ii_sub_sb ->
2707 tokenf lba lbb >>= (fun lba lbb ->
2708 tokenf rba rbb >>= (fun rba rbb ->
2709 struct_fields (A.undots declsa) declsb >>=(fun undeclsa declsb ->
2710 let declsa = redots declsa undeclsa in
2713 (A.StructUnionDef(ty, lba, declsa, rba)) +> A.rewrap ta,
2714 (B.StructUnion (sub, sbopt, declsb),ii_sub_sb@[lbb;rbb])
2718 (* todo? handle isomorphisms ? because Unsigned Int can be match on a
2719 * uint in the C code. But some CEs consists in renaming some types,
2720 * so we don't want apply isomorphisms every time.
2722 | A.TypeName sa, (B.TypeName (sb,typb), ii) ->
2723 let (isb) = tuple_of_list1 ii in
2726 tokenf sa isb >>= (fun sa isb ->
2728 (A.TypeName sa) +> A.rewrap ta,
2729 (B.TypeName (sb,typb), [isb])
2733 | _, (B.TypeOfExpr e, ii) -> fail
2734 | _, (B.TypeOfType e, ii) -> fail
2736 | _, (B.ParenType e, ii) -> fail (* todo ?*)
2737 | A.EnumName(en,namea), (B.EnumName nameb, ii) ->
2738 let (ib1,ib2) = tuple_of_list2 ii in
2739 ident DontKnow namea (nameb, ib2) >>= (fun namea (nameb, ib2) ->
2740 tokenf en ib1 >>= (fun en ib1 ->
2742 (A.EnumName (en, namea)) +> A.rewrap ta,
2743 (B.EnumName nameb, [ib1;ib2])
2746 | _, (B.Enum _, _) -> fail (* todo cocci ?*)
2749 ((B.TypeName (_, _) | B.StructUnionName (_, _) | B.EnumName _ |
2750 B.StructUnion (_, _, _) |
2751 B.FunctionType _ | B.Array (_, _) | B.Pointer _ |
2757 (* todo: iso on sign, if not mentioned then free. tochange?
2758 * but that require to know if signed int because explicit
2759 * signed int, or because implicit signed int.
2762 and sign signa signb =
2763 match signa, signb with
2764 | None, None -> return (None, [])
2765 | Some signa, Some (signb, ib) ->
2766 if equal_sign (term signa) signb
2767 then tokenf signa ib >>= (fun signa ib ->
2768 return (Some signa, [ib])
2774 and minusize_list iixs =
2775 iixs +> List.fold_left (fun acc ii ->
2776 acc >>= (fun xs ys ->
2777 tokenf minusizer ii >>= (fun minus ii ->
2778 return (minus::xs, ii::ys)
2779 ))) (return ([],[]))
2780 >>= (fun _xsminys ys ->
2781 return ((), List.rev ys)
2784 and storage_optional_allminus allminus stoa (stob, iistob) =
2785 (* "iso-by-absence" for storage, and return type. *)
2786 X.optional_storage_flag (fun optional_storage ->
2787 match stoa, stob with
2788 | None, (stobis, inline) ->
2792 minusize_list iistob >>= (fun () iistob ->
2793 return (None, (stob, iistob))
2795 else return (None, (stob, iistob))
2798 (match optional_storage, stobis with
2799 | false, B.NoSto -> do_minus ()
2801 | true, B.NoSto -> do_minus ()
2804 then pr2_once "USING optional_storage builtin isomorphism";
2808 | Some x, ((stobis, inline)) ->
2809 if equal_storage (term x) stobis
2813 tokenf x i1 >>= (fun x i1 ->
2814 return (Some x, ((stobis, inline), [i1]))
2816 (* or if have inline ? have to do a split_storage_inline a la
2817 * split_signb_baseb_ii *)
2818 | _ -> raise Impossible
2826 and fullType_optional_allminus allminus tya retb =
2831 X.distrf_type minusizer retb >>= (fun _x retb ->
2835 else return (None, retb)
2837 fullType tya retb >>= (fun tya retb ->
2838 return (Some tya, retb)
2843 (*---------------------------------------------------------------------------*)
2845 and compatible_base_type a signa b =
2846 let ok = return ((),()) in
2849 | Type_cocci.VoidType, B.Void ->
2850 assert (signa = None);
2852 | Type_cocci.CharType, B.IntType B.CChar when signa = None ->
2854 | Type_cocci.CharType, B.IntType (B.Si (signb, B.CChar2)) ->
2855 compatible_sign signa signb
2856 | Type_cocci.ShortType, B.IntType (B.Si (signb, B.CShort)) ->
2857 compatible_sign signa signb
2858 | Type_cocci.IntType, B.IntType (B.Si (signb, B.CInt)) ->
2859 compatible_sign signa signb
2860 | Type_cocci.LongType, B.IntType (B.Si (signb, B.CLong)) ->
2861 compatible_sign signa signb
2862 | _, B.IntType (B.Si (signb, B.CLongLong)) ->
2863 pr2_once "no longlong in cocci";
2865 | Type_cocci.FloatType, B.FloatType B.CFloat ->
2866 assert (signa = None);
2868 | Type_cocci.DoubleType, B.FloatType B.CDouble ->
2869 assert (signa = None);
2871 | _, B.FloatType B.CLongDouble ->
2872 pr2_once "no longdouble in cocci";
2874 | Type_cocci.BoolType, _ -> failwith "no booltype in C"
2876 | _, (B.Void|B.FloatType _|B.IntType _) -> fail
2878 and compatible_base_type_meta a signa qua b ii local =
2880 | Type_cocci.MetaType(ida,keep,inherited),
2881 B.IntType (B.Si (signb, B.CChar2)) ->
2882 compatible_sign signa signb >>= fun _ _ ->
2883 let newb = ((qua, (B.BaseType (B.IntType B.CChar),ii)),local) in
2884 compatible_type a newb
2885 | Type_cocci.MetaType(ida,keep,inherited), B.IntType (B.Si (signb, ty)) ->
2886 compatible_sign signa signb >>= fun _ _ ->
2888 ((qua, (B.BaseType (B.IntType (B.Si (B.Signed, ty))),ii)),local) in
2889 compatible_type a newb
2890 | _, B.FloatType B.CLongDouble ->
2891 pr2_once "no longdouble in cocci";
2894 | _, (B.Void|B.FloatType _|B.IntType _) -> fail
2897 and compatible_type a (b,local) =
2898 let ok = return ((),()) in
2900 let rec loop = function
2901 | Type_cocci.BaseType a, (qua, (B.BaseType b,ii)) ->
2902 compatible_base_type a None b
2904 | Type_cocci.SignedT (signa,None), (qua, (B.BaseType b,ii)) ->
2905 compatible_base_type Type_cocci.IntType (Some signa) b
2907 | Type_cocci.SignedT (signa,Some ty), (qua, (B.BaseType b,ii)) ->
2909 Type_cocci.BaseType ty ->
2910 compatible_base_type ty (Some signa) b
2911 | Type_cocci.MetaType(ida,keep,inherited) ->
2912 compatible_base_type_meta ty (Some signa) qua b ii local
2913 | _ -> failwith "not possible")
2915 | Type_cocci.Pointer a, (qub, (B.Pointer b, ii)) ->
2917 | Type_cocci.FunctionPointer a, _ ->
2919 "TODO: function pointer type doesn't store enough information to determine compatability"
2920 | Type_cocci.Array a, (qub, (B.Array (eopt, b),ii)) ->
2921 (* no size info for cocci *)
2923 | Type_cocci.StructUnionName (sua, _, sa),
2924 (qub, (B.StructUnionName (sub, sb),ii)) ->
2925 if equal_structUnion_type_cocci sua sub && sa = sb
2928 | Type_cocci.EnumName (_, sa),
2929 (qub, (B.EnumName (sb),ii)) ->
2933 | Type_cocci.TypeName sa, (qub, (B.TypeName (sb,_typb), ii)) ->
2938 | Type_cocci.ConstVol (qua, a), (qub, b) ->
2939 if (fst qub).B.const && (fst qub).B.volatile
2942 pr2_once ("warning: the type is both const & volatile but cocci " ^
2943 "does not handle that");
2949 | Type_cocci.Const -> (fst qub).B.const
2950 | Type_cocci.Volatile -> (fst qub).B.volatile
2952 then loop (a,(Ast_c.nQ, b))
2955 | Type_cocci.MetaType (ida,keep,inherited), typb ->
2957 Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_type typb) in
2958 X.envf keep inherited (A.make_mcode ida, B.MetaTypeVal typb, max_min)
2962 (* subtil: must be after the MetaType case *)
2963 | a, (qub, (B.TypeName (sb,Some b), ii)) ->
2964 (* kind of typedef iso *)
2971 (* for metavariables of type expression *^* *)
2972 | Type_cocci.Unknown , _ -> ok
2977 B.TypeOfType _|B.TypeOfExpr _|B.ParenType _|
2978 B.EnumName _|B.StructUnion (_, _, _)|B.Enum (_, _)
2985 B.StructUnionName (_, _)|
2987 B.Array (_, _)|B.Pointer _|B.TypeName _|
2996 and compatible_sign signa signb =
2997 let ok = return ((),()) in
2998 match signa, signb with
3000 | Some Type_cocci.Signed, B.Signed
3001 | Some Type_cocci.Unsigned, B.UnSigned
3006 and equal_structUnion_type_cocci a b =
3008 | Type_cocci.Struct, B.Struct -> true
3009 | Type_cocci.Union, B.Union -> true
3010 | _, (B.Struct | B.Union) -> false
3014 (*---------------------------------------------------------------------------*)
3015 and inc_file (a, before_after) (b, h_rel_pos) =
3017 let rec aux_inc (ass, bss) passed =
3021 let passed = List.rev passed in
3023 (match before_after, !h_rel_pos with
3024 | IncludeNothing, _ -> true
3025 | IncludeMcodeBefore, Some x ->
3026 List.mem passed (x.Ast_c.first_of)
3028 | IncludeMcodeAfter, Some x ->
3029 List.mem passed (x.Ast_c.last_of)
3031 (* no info, maybe cos of a #include <xx.h> that was already in a .h *)
3035 | (A.IncPath x)::xs, y::ys -> x = y && aux_inc (xs, ys) (x::passed)
3036 | _ -> failwith "IncDots not in last place or other pb"
3041 | A.Local ass, B.Local bss ->
3042 aux_inc (ass, bss) []
3043 | A.NonLocal ass, B.NonLocal bss ->
3044 aux_inc (ass, bss) []
3049 (*---------------------------------------------------------------------------*)
3051 and (define_params: sequence ->
3052 (A.define_param list, (string B.wrap) B.wrap2 list) matcher) =
3053 fun seqstyle eas ebs ->
3055 | Unordered -> failwith "not handling ooo"
3057 define_paramsbis eas (Ast_c.split_comma ebs) >>= (fun eas ebs_splitted ->
3058 return (eas, (Ast_c.unsplit_comma ebs_splitted))
3061 (* todo? facto code with argument and parameters ? *)
3062 and define_paramsbis = fun eas ebs ->
3064 | [], [] -> return ([], [])
3065 | [], eb::ebs -> fail
3067 X.all_bound (A.get_inherited ea) >&&>
3068 (match A.unwrap ea, ebs with
3069 | A.DPdots (mcode), ys ->
3071 (* '...' can take more or less the beginnings of the arguments *)
3072 let startendxs = Common.zip (Common.inits ys) (Common.tails ys) in
3073 startendxs +> List.fold_left (fun acc (startxs, endxs) ->
3078 if mcode_contain_plus (mcodekind mcode)
3080 (* failwith "I have no token that I could accroche myself on" *)
3081 else return (dots2metavar mcode, [])
3083 (match Common.last startxs with
3086 X.distrf_define_params (dots2metavar mcode) startxs
3088 ) >>= (fun mcode startxs ->
3089 let mcode = metavar2dots mcode in
3090 define_paramsbis eas endxs >>= (fun eas endxs ->
3092 (A.DPdots (mcode) +> A.rewrap ea) ::eas,
3098 | A.DPComma ia1, Right ii::ebs ->
3099 let ib1 = tuple_of_list1 ii in
3100 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
3101 define_paramsbis eas ebs >>= (fun eas ebs ->
3103 (A.DPComma ia1 +> A.rewrap ea)::eas,
3108 | A.DPComma ia1, ebs ->
3109 if mcode_contain_plus (mcodekind ia1)
3112 (define_paramsbis eas ebs) (* try optional comma trick *)
3114 | (A.OptDParam _ | A.UniqueDParam _), _ ->
3115 failwith "handling Opt/Unique for define parameters"
3117 | A.DPcircles (_), ys -> raise Impossible (* in Ordered mode *)
3119 | A.DParam ida, (Left (idb, ii))::ebs ->
3120 let ib1 = tuple_of_list1 ii in
3121 ident DontKnow ida (idb, ib1) >>= (fun ida (idb, ib1) ->
3122 define_paramsbis eas ebs >>= (fun eas ebs ->
3124 (A.DParam ida)+> A.rewrap ea :: eas,
3125 (Left (idb, [ib1]))::ebs
3128 | _unwrapx, (Right y)::ys -> raise Impossible
3129 | _unwrapx, [] -> fail
3134 (*****************************************************************************)
3136 (*****************************************************************************)
3138 (* no global solution for positions here, because for a statement metavariable
3139 we want a MetaStmtVal, and for the others, it's not clear what we want *)
3141 let rec (rule_elem_node: (A.rule_elem, Control_flow_c.node) matcher) =
3144 x >>= (fun a b -> return (A.rewrap re a, F.rewrap node b))
3146 X.all_bound (A.get_inherited re) >&&>
3149 match A.unwrap re, F.unwrap node with
3151 (* note: the order of the clauses is important. *)
3153 | _, F.Enter | _, F.Exit | _, F.ErrorExit -> fail2()
3155 (* the metaRuleElem contains just '-' information. We dont need to add
3156 * stuff in the environment. If we need stuff in environment, because
3157 * there is a + S somewhere, then this will be done via MetaStmt, not
3159 * Can match TrueNode/FalseNode/... so must be placed before those cases.
3162 | A.MetaRuleElem(mcode,keep,inherited), unwrap_node ->
3163 let default = A.MetaRuleElem(mcode,keep,inherited), unwrap_node in
3164 (match unwrap_node with
3166 | F.TrueNode | F.FalseNode | F.AfterNode | F.FallThroughNode
3168 if X.mode = PatternMode
3171 if mcode_contain_plus (mcodekind mcode)
3172 then failwith "try add stuff on fake node"
3173 (* minusize or contextize a fake node is ok *)
3176 | F.EndStatement None ->
3177 if X.mode = PatternMode then return default
3179 (* DEAD CODE NOW ? only useful in -no_cocci_vs_c_3 ?
3180 if mcode_contain_plus (mcodekind mcode)
3182 let fake_info = Ast_c.fakeInfo() in
3183 distrf distrf_node (mcodekind mcode)
3184 (F.EndStatement (Some fake_info))
3185 else return unwrap_node
3189 | F.EndStatement (Some i1) ->
3190 tokenf mcode i1 >>= (fun mcode i1 ->
3192 A.MetaRuleElem (mcode,keep, inherited),
3193 F.EndStatement (Some i1)
3197 if X.mode = PatternMode then return default
3198 else failwith "a MetaRuleElem can't transform a headfunc"
3200 if X.mode = PatternMode then return default
3202 X.distrf_node (generalize_mcode mcode) node >>= (fun mcode node ->
3204 A.MetaRuleElem(mcode,keep, inherited),
3210 (* rene cant have found that a state containing a fake/exit/... should be
3212 * TODO: and F.Fake ?
3214 | _, F.EndStatement _ | _, F.CaseNode _
3215 | _, F.TrueNode | _, F.FalseNode | _, F.AfterNode | _, F.FallThroughNode
3219 (* really ? diff between pattern.ml and transformation.ml *)
3220 | _, F.Fake -> fail2()
3223 (* cas general: a Meta can match everything. It matches only
3224 * "header"-statement. We transform only MetaRuleElem, not MetaStmt.
3225 * So can't have been called in transform.
3227 | A.MetaStmt (ida,keep,metainfoMaybeTodo,inherited), F.Decl(_) -> fail
3229 | A.MetaStmt (ida,keep,metainfoMaybeTodo,inherited), unwrap_node ->
3230 (* todo: should not happen in transform mode *)
3232 (match Control_flow_c.extract_fullstatement node with
3235 Lib_parsing_c.lin_col_by_pos (Lib_parsing_c.ii_of_stmt stb) in
3236 X.envf keep inherited (ida, Ast_c.MetaStmtVal stb, max_min)
3238 (* no need tag ida, we can't be called in transform-mode *)
3240 A.MetaStmt (ida, keep, metainfoMaybeTodo, inherited),
3248 | A.MetaStmtList _, _ ->
3249 failwith "not handling MetaStmtList"
3251 | A.TopExp ea, F.DefineExpr eb ->
3252 expression ea eb >>= (fun ea eb ->
3258 | A.TopExp ea, F.DefineType eb ->
3259 (match A.unwrap ea with
3261 fullType ft eb >>= (fun ft eb ->
3263 A.TopExp (A.rewrap ea (A.TypeExp(ft))),
3270 (* It is important to put this case before the one that fails because
3271 * of the lack of the counter part of a C construct in SmPL (for instance
3272 * there is not yet a CaseRange in SmPL). Even if SmPL don't handle
3273 * yet certain constructs, those constructs may contain expression
3274 * that we still want and can transform.
3277 | A.Exp exp, nodeb ->
3279 (* kind of iso, initialisation vs affectation *)
3281 match A.unwrap exp, nodeb with
3282 | A.Assignment (ea, op, eb, true), F.Decl decl ->
3283 initialisation_to_affectation decl +> F.rewrap node
3288 (* Now keep fullstatement inside the control flow node,
3289 * so that can then get in a MetaStmtVar the fullstatement to later
3290 * pp back when the S is in a +. But that means that
3291 * Exp will match an Ifnode even if there is no such exp
3292 * inside the condition of the Ifnode (because the exp may
3293 * be deeper, in the then branch). So have to not visit
3294 * all inside a node anymore.
3296 * update: j'ai choisi d'accrocher au noeud du CFG Ã la
3297 * fois le fullstatement et le partialstatement et appeler le
3298 * visiteur que sur le partialstatement.
3301 match Ast_cocci.get_pos re with
3302 | None -> expression
3306 Lib_parsing_c.max_min_by_pos (Lib_parsing_c.ii_of_expr eb) in
3307 let keep = Type_cocci.Unitary in
3308 let inherited = false in
3309 let max_min _ = failwith "no pos" in
3310 X.envf keep inherited (pos, B.MetaPosVal (min,max), max_min)
3316 X.cocciExp expfn exp node >>= (fun exp node ->
3324 X.cocciTy fullType ty node >>= (fun ty node ->
3331 | A.TopInit init, nodeb ->
3332 X.cocciInit initialiser init node >>= (fun init node ->
3340 | A.FunHeader (mckstart, allminus, fninfoa, ida, oparen, paramsa, cparen),
3341 F.FunHeader ({B.f_name = idb;
3342 f_type = (retb, (paramsb, (isvaargs, iidotsb)));
3346 f_old_c_style = oldstyle;
3351 then pr2 "OLD STYLE DECL NOT WELL SUPPORTED";
3354 (* fninfoa records the order in which the SP specified the various
3355 information, but this isn't taken into account in the matching.
3356 Could this be a problem for transformation? *)
3359 List.filter (function A.FStorage(s) -> true | _ -> false) fninfoa
3360 with [A.FStorage(s)] -> Some s | _ -> None in
3362 match List.filter (function A.FType(s) -> true | _ -> false) fninfoa
3363 with [A.FType(t)] -> Some t | _ -> None in
3365 (match List.filter (function A.FInline(i) -> true | _ -> false) fninfoa
3366 with [A.FInline(i)] -> failwith "not checking inline" | _ -> ());
3368 (match List.filter (function A.FAttr(a) -> true | _ -> false) fninfoa
3369 with [A.FAttr(a)] -> failwith "not checking attributes" | _ -> ());
3372 | iidb::ioparenb::icparenb::iifakestart::iistob ->
3374 (* maybe important to put ident as the first tokens to transform.
3375 * It's related to transform_proto. So don't change order
3378 ident LocalFunction ida (idb, iidb) >>= (fun ida (idb, iidb) ->
3379 X.tokenf_mck mckstart iifakestart >>= (fun mckstart iifakestart ->
3380 tokenf oparen ioparenb >>= (fun oparen ioparenb ->
3381 tokenf cparen icparenb >>= (fun cparen icparenb ->
3382 parameters (seqstyle paramsa)
3383 (A.undots paramsa) paramsb >>=
3384 (fun paramsaundots paramsb ->
3385 let paramsa = redots paramsa paramsaundots in
3386 storage_optional_allminus allminus
3387 stoa (stob, iistob) >>= (fun stoa (stob, iistob) ->
3392 ("Not handling well variable length arguments func. "^
3393 "You have been warned");
3395 then minusize_list iidotsb
3396 else return ((),iidotsb)
3397 ) >>= (fun () iidotsb ->
3399 fullType_optional_allminus allminus tya retb >>= (fun tya retb ->
3402 (match stoa with Some st -> [A.FStorage st] | None -> []) ++
3403 (match tya with Some t -> [A.FType t] | None -> [])
3408 A.FunHeader(mckstart,allminus,fninfoa,ida,oparen,
3410 F.FunHeader ({B.f_name = idb;
3411 f_type = (retb, (paramsb, (isvaargs, iidotsb)));
3415 f_old_c_style = oldstyle; (* TODO *)
3417 iidb::ioparenb::icparenb::iifakestart::iistob)
3420 | _ -> raise Impossible
3428 | A.Decl (mckstart,allminus,decla), F.Decl declb ->
3429 declaration (mckstart,allminus,decla) declb >>=
3430 (fun (mckstart,allminus,decla) declb ->
3432 A.Decl (mckstart,allminus,decla),
3437 | A.SeqStart mcode, F.SeqStart (st, level, i1) ->
3438 tokenf mcode i1 >>= (fun mcode i1 ->
3441 F.SeqStart (st, level, i1)
3444 | A.SeqEnd mcode, F.SeqEnd (level, i1) ->
3445 tokenf mcode i1 >>= (fun mcode i1 ->
3448 F.SeqEnd (level, i1)
3451 | A.ExprStatement (ea, ia1), F.ExprStatement (st, (Some eb, ii)) ->
3452 let ib1 = tuple_of_list1 ii in
3453 expression ea eb >>= (fun ea eb ->
3454 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
3456 A.ExprStatement (ea, ia1),
3457 F.ExprStatement (st, (Some eb, [ib1]))
3462 | A.IfHeader (ia1,ia2, ea, ia3), F.IfHeader (st, (eb,ii)) ->
3463 let (ib1, ib2, ib3) = tuple_of_list3 ii in
3464 expression ea eb >>= (fun ea eb ->
3465 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
3466 tokenf ia2 ib2 >>= (fun ia2 ib2 ->
3467 tokenf ia3 ib3 >>= (fun ia3 ib3 ->
3469 A.IfHeader (ia1, ia2, ea, ia3),
3470 F.IfHeader (st, (eb,[ib1;ib2;ib3]))
3473 | A.Else ia, F.Else ib ->
3474 tokenf ia ib >>= (fun ia ib ->
3475 return (A.Else ia, F.Else ib)
3478 | A.WhileHeader (ia1, ia2, ea, ia3), F.WhileHeader (st, (eb, ii)) ->
3479 let (ib1, ib2, ib3) = tuple_of_list3 ii in
3480 expression ea eb >>= (fun ea eb ->
3481 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
3482 tokenf ia2 ib2 >>= (fun ia2 ib2 ->
3483 tokenf ia3 ib3 >>= (fun ia3 ib3 ->
3485 A.WhileHeader (ia1, ia2, ea, ia3),
3486 F.WhileHeader (st, (eb, [ib1;ib2;ib3]))
3489 | A.DoHeader ia, F.DoHeader (st, ib) ->
3490 tokenf ia ib >>= (fun ia ib ->
3495 | A.WhileTail (ia1,ia2,ea,ia3,ia4), F.DoWhileTail (eb, ii) ->
3496 let (ib1, ib2, ib3, ib4) = tuple_of_list4 ii in
3497 expression ea eb >>= (fun ea eb ->
3498 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
3499 tokenf ia2 ib2 >>= (fun ia2 ib2 ->
3500 tokenf ia3 ib3 >>= (fun ia3 ib3 ->
3501 tokenf ia4 ib4 >>= (fun ia4 ib4 ->
3503 A.WhileTail (ia1,ia2,ea,ia3,ia4),
3504 F.DoWhileTail (eb, [ib1;ib2;ib3;ib4])
3506 | A.IteratorHeader (ia1, ia2, eas, ia3), F.MacroIterHeader (st, ((s,ebs),ii))
3508 let (ib1, ib2, ib3) = tuple_of_list3 ii in
3510 ident DontKnow ia1 (s, ib1) >>= (fun ia1 (s, ib1) ->
3511 tokenf ia2 ib2 >>= (fun ia2 ib2 ->
3512 tokenf ia3 ib3 >>= (fun ia3 ib3 ->
3513 arguments (seqstyle eas) (A.undots eas) ebs >>= (fun easundots ebs ->
3514 let eas = redots eas easundots in
3516 A.IteratorHeader (ia1, ia2, eas, ia3),
3517 F.MacroIterHeader (st, ((s,ebs), [ib1;ib2;ib3]))
3522 | A.ForHeader (ia1, ia2, ea1opt, ia3, ea2opt, ia4, ea3opt, ia5),
3523 F.ForHeader (st, (((eb1opt,ib3s), (eb2opt,ib4s), (eb3opt,ib4vide)), ii))
3525 assert (null ib4vide);
3526 let (ib1, ib2, ib5) = tuple_of_list3 ii in
3527 let ib3 = tuple_of_list1 ib3s in
3528 let ib4 = tuple_of_list1 ib4s in
3530 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
3531 tokenf ia2 ib2 >>= (fun ia2 ib2 ->
3532 tokenf ia3 ib3 >>= (fun ia3 ib3 ->
3533 tokenf ia4 ib4 >>= (fun ia4 ib4 ->
3534 tokenf ia5 ib5 >>= (fun ia5 ib5 ->
3535 option expression ea1opt eb1opt >>= (fun ea1opt eb1opt ->
3536 option expression ea2opt eb2opt >>= (fun ea2opt eb2opt ->
3537 option expression ea3opt eb3opt >>= (fun ea3opt eb3opt ->
3539 A.ForHeader (ia1, ia2, ea1opt, ia3, ea2opt, ia4, ea3opt, ia5),
3540 F.ForHeader (st, (((eb1opt,[ib3]), (eb2opt,[ib4]), (eb3opt,[])),
3546 | A.SwitchHeader(ia1,ia2,ea,ia3), F.SwitchHeader (st, (eb,ii)) ->
3547 let (ib1, ib2, ib3) = tuple_of_list3 ii in
3548 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
3549 tokenf ia2 ib2 >>= (fun ia2 ib2 ->
3550 tokenf ia3 ib3 >>= (fun ia3 ib3 ->
3551 expression ea eb >>= (fun ea eb ->
3553 A.SwitchHeader(ia1,ia2,ea,ia3),
3554 F.SwitchHeader (st, (eb,[ib1;ib2;ib3]))
3557 | A.Break (ia1, ia2), F.Break (st, ((),ii)) ->
3558 let (ib1, ib2) = tuple_of_list2 ii in
3559 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
3560 tokenf ia2 ib2 >>= (fun ia2 ib2 ->
3563 F.Break (st, ((),[ib1;ib2]))
3566 | A.Continue (ia1, ia2), F.Continue (st, ((),ii)) ->
3567 let (ib1, ib2) = tuple_of_list2 ii in
3568 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
3569 tokenf ia2 ib2 >>= (fun ia2 ib2 ->
3571 A.Continue (ia1, ia2),
3572 F.Continue (st, ((),[ib1;ib2]))
3575 | A.Return (ia1, ia2), F.Return (st, ((),ii)) ->
3576 let (ib1, ib2) = tuple_of_list2 ii in
3577 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
3578 tokenf ia2 ib2 >>= (fun ia2 ib2 ->
3580 A.Return (ia1, ia2),
3581 F.Return (st, ((),[ib1;ib2]))
3584 | A.ReturnExpr (ia1, ea, ia2), F.ReturnExpr (st, (eb, ii)) ->
3585 let (ib1, ib2) = tuple_of_list2 ii in
3586 tokenf ia1 ib1 >>= (fun ia1 ib1 ->
3587 tokenf ia2 ib2 >>= (fun ia2 ib2 ->
3588 expression ea eb >>= (fun ea eb ->
3590 A.ReturnExpr (ia1, ea, ia2),
3591 F.ReturnExpr (st, (eb, [ib1;ib2]))
3596 | A.Include(incla,filea),
3597 F.Include {B.i_include = (fileb, ii);
3598 B.i_rel_pos = h_rel_pos;
3599 B.i_is_in_ifdef = inifdef;
3602 assert (copt = None);
3604 let include_requirment =
3605 match mcodekind incla, mcodekind filea with
3606 | A.CONTEXT (_, A.BEFORE _), _ ->
3608 | _, A.CONTEXT (_, A.AFTER _) ->
3614 let (inclb, iifileb) = tuple_of_list2 ii in
3615 if inc_file (term filea, include_requirment) (fileb, h_rel_pos)
3617 tokenf incla inclb >>= (fun incla inclb ->
3618 tokenf filea iifileb >>= (fun filea iifileb ->
3620 A.Include(incla, filea),
3621 F.Include {B.i_include = (fileb, [inclb;iifileb]);
3622 B.i_rel_pos = h_rel_pos;
3623 B.i_is_in_ifdef = inifdef;
3631 | A.DefineHeader(definea,ida,params), F.DefineHeader ((idb, ii), defkind) ->
3632 let (defineb, iidb, ieol) = tuple_of_list3 ii in
3633 ident DontKnow ida (idb, iidb) >>= (fun ida (idb, iidb) ->
3634 tokenf definea defineb >>= (fun definea defineb ->
3635 (match A.unwrap params, defkind with
3636 | A.NoParams, B.DefineVar ->
3638 A.NoParams +> A.rewrap params,
3641 | A.DParams(lpa,eas,rpa), (B.DefineFunc (ebs, ii)) ->
3642 let (lpb, rpb) = tuple_of_list2 ii in
3643 tokenf lpa lpb >>= (fun lpa lpb ->
3644 tokenf rpa rpb >>= (fun rpa rpb ->
3646 define_params (seqstyle eas) (A.undots eas) ebs >>=
3647 (fun easundots ebs ->
3648 let eas = redots eas easundots in
3650 A.DParams (lpa,eas,rpa) +> A.rewrap params,
3651 B.DefineFunc (ebs,[lpb;rpb])
3655 ) >>= (fun params defkind ->
3657 A.DefineHeader (definea, ida, params),
3658 F.DefineHeader ((idb,[defineb;iidb;ieol]),defkind)
3663 | A.Default(def,colon), F.Default (st, ((),ii)) ->
3664 let (ib1, ib2) = tuple_of_list2 ii in
3665 tokenf def ib1 >>= (fun def ib1 ->
3666 tokenf colon ib2 >>= (fun colon ib2 ->
3668 A.Default(def,colon),
3669 F.Default (st, ((),[ib1;ib2]))
3674 | A.Case(case,ea,colon), F.Case (st, (eb,ii)) ->
3675 let (ib1, ib2) = tuple_of_list2 ii in
3676 tokenf case ib1 >>= (fun case ib1 ->
3677 expression ea eb >>= (fun ea eb ->
3678 tokenf colon ib2 >>= (fun colon ib2 ->
3680 A.Case(case,ea,colon),
3681 F.Case (st, (eb,[ib1;ib2]))
3684 (* only occurs in the predicates generated by asttomember *)
3685 | A.DisjRuleElem eas, _ ->
3687 List.fold_left (fun acc ea -> acc >|+|> (rule_elem_node ea node)) fail)
3688 >>= (fun ea eb -> return (A.unwrap ea,F.unwrap eb))
3690 | _, F.ExprStatement (_, (None, ii)) -> fail (* happen ? *)
3692 | A.Label(id,dd), F.Label (st,(s,ii)) ->
3693 let (ib1,ib2) = tuple_of_list2 ii in
3694 let (string_of_id,rebuild) =
3695 match A.unwrap id with
3696 A.Id(s) -> (s,function s -> A.rewrap id (A.Id(s)))
3697 | _ -> failwith "labels with metavariables not supported" in
3698 if (term string_of_id) =$= s
3700 tokenf string_of_id ib1 >>= (fun string_of_id ib1 ->
3701 tokenf dd ib2 >>= (fun dd ib2 ->
3703 A.Label(rebuild string_of_id,dd),
3704 F.Label (st,(s,[ib1;ib2]))
3708 | A.Goto(goto,id,sem), F.Goto (st,(s,ii)) ->
3709 let (ib1,ib2,ib3) = tuple_of_list3 ii in
3710 tokenf goto ib1 >>= (fun goto ib1 ->
3711 ident DontKnow id (s, ib2) >>= (fun id (s, ib2) ->
3712 tokenf sem ib3 >>= (fun sem ib3 ->
3714 A.Goto(goto,id,sem),
3715 F.Goto (st,(s,[ib1;ib2;ib3]))
3718 (* have not a counter part in coccinelle, for the moment *)
3719 (* todo?: print a warning at least ? *)
3725 | _, (F.IfdefEndif _|F.IfdefElse _|F.IfdefHeader _)
3729 (F.MacroStmt (_, _)| F.DefineDoWhileZeroHeader _| F.EndNode|F.TopNode)
3732 (F.Label (_, _)|F.Break (_, _)|F.Continue (_, _)|F.Default (_, _)|
3733 F.Case (_, _)|F.Include _|F.Goto _|F.ExprStatement _|
3734 F.DefineType _|F.DefineExpr _|F.DefineTodo|
3735 F.DefineHeader (_, _)|F.ReturnExpr (_, _)|F.Return (_, _)|F.MacroIterHeader (_, _)|
3736 F.SwitchHeader (_, _)|F.ForHeader (_, _)|F.DoWhileTail _|F.DoHeader (_, _)|
3737 F.WhileHeader (_, _)|F.Else _|F.IfHeader (_, _)|
3738 F.SeqEnd (_, _)|F.SeqStart (_, _, _)|
3739 F.Decl _|F.FunHeader _)