parsing_cocci/ast0toast.ml

   1 (*
   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.
   5 *
   6 * Coccinelle is free software: you can redistribute it and/or modify
   7 * it under the terms of the GNU General Public License as published by
   8 * the Free Software Foundation, according to version 2 of the License.
   9 *
  10 * Coccinelle is distributed in the hope that it will be useful,
  11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 * GNU General Public License for more details.
  14 *
  15 * You should have received a copy of the GNU General Public License
  16 * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  17 *
  18 * The authors reserve the right to distribute this or future versions of
  19 * Coccinelle under other licenses.
  20 *)
  21
  22
  23 (* Arities matter for the minus slice, but not for the plus slice. *)
  24
  25 (* + only allowed on code in a nest (in_nest = true).  ? only allowed on
  26 rule_elems, and on subterms if the context is ? also. *)
  27
  28 module Ast0 = Ast0_cocci
  29 module Ast = Ast_cocci
  30 module V0 = Visitor_ast0
  31 module VT0 = Visitor_ast0_types
  32 module V = Visitor_ast
  33
  34 let unitary = Type_cocci.Unitary
  35
  36 let ctr = ref 0
  37 let get_ctr _ =
  38   let c = !ctr in
  39   ctr := !ctr + 1;
  40   c
  41
  42 (* --------------------------------------------------------------------- *)
  43 (* Move plus tokens from the MINUS and CONTEXT structured nodes to the
  44 corresponding leftmost and rightmost mcodes *)
  45
  46 let inline_mcodes =
  47   let bind x y = () in
  48   let option_default = () in
  49   let mcode _ = () in
  50   let do_nothing r k e =
  51     k e;
  52     let einfo = Ast0.get_info e in
  53     match (Ast0.get_mcodekind e) with
  54       Ast0.MINUS(replacements) ->
  55         (match !replacements with
  56           ([],_) -> ()
  57         | replacements ->
  58             let minus_try = function
  59                 (true,mc) ->
  60                   if List.for_all
  61                       (function
  62                           Ast0.MINUS(mreplacements) -> true | _ -> false)
  63                       mc
  64                   then
  65                     (List.iter
  66                        (function
  67                            Ast0.MINUS(mreplacements) ->
  68                              mreplacements := replacements
  69                          | _ -> ())
  70                        mc;
  71                      true)
  72                   else false
  73               | _ -> false in
  74             if not (minus_try(einfo.Ast0.attachable_start,
  75                               einfo.Ast0.mcode_start)
  76                       or
  77                     minus_try(einfo.Ast0.attachable_end,
  78                               einfo.Ast0.mcode_end))
  79             then
  80               failwith "minus tree should not have bad code on both sides")
  81     | Ast0.CONTEXT(befaft)
  82     | Ast0.MIXED(befaft) ->
  83         let concat starter startinfo ender endinfo =
  84           let lst =
  85             match (starter,ender) with
  86               ([],_) -> ender
  87             | (_,[]) -> starter
  88             | _ ->
  89                 if startinfo.Ast0.tline_end = endinfo.Ast0.tline_start
  90                 then (* put them in the same inner list *)
  91                   let last = List.hd (List.rev starter) in
  92                   let butlast = List.rev(List.tl(List.rev starter)) in
  93                   butlast @ (last@(List.hd ender)) :: (List.tl ender)
  94                 else starter @ ender in
  95           (lst,
  96            {endinfo with Ast0.tline_start = startinfo.Ast0.tline_start}) in
  97         let attach_bef bef beforeinfo = function
  98             (true,mcl) ->
  99               List.iter
 100                 (function
 101                     Ast0.MINUS(mreplacements) ->
 102                       let (mrepl,tokeninfo) = !mreplacements in
 103                       mreplacements := concat bef beforeinfo mrepl tokeninfo
 104                   | Ast0.CONTEXT(mbefaft) ->
 105                       (match !mbefaft with
 106                         (Ast.BEFORE(mbef),mbeforeinfo,a) ->
 107                           let (newbef,newinfo) =
 108                             concat bef beforeinfo mbef mbeforeinfo in
 109                           mbefaft := (Ast.BEFORE(newbef),newinfo,a)
 110                       | (Ast.AFTER(maft),_,a) ->
 111                           mbefaft :=
 112                             (Ast.BEFOREAFTER(bef,maft),beforeinfo,a)
 113                       | (Ast.BEFOREAFTER(mbef,maft),mbeforeinfo,a) ->
 114                           let (newbef,newinfo) =
 115                             concat bef beforeinfo mbef mbeforeinfo in
 116                           mbefaft :=
 117                             (Ast.BEFOREAFTER(newbef,maft),newinfo,a)
 118                       | (Ast.NOTHING,_,a) ->
 119                           mbefaft := (Ast.BEFORE(bef),beforeinfo,a))
 120                   |     _ -> failwith "unexpected annotation")
 121                 mcl
 122           | _ ->
 123               Printf.printf "before %s\n" (Dumper.dump bef);
 124               failwith
 125                 "context tree should not have bad code before" in
 126         let attach_aft aft afterinfo = function
 127             (true,mcl) ->
 128               List.iter
 129                 (function
 130                     Ast0.MINUS(mreplacements) ->
 131                       let (mrepl,tokeninfo) = !mreplacements in
 132                       mreplacements := concat mrepl tokeninfo aft afterinfo
 133                   | Ast0.CONTEXT(mbefaft) ->
 134                       (match !mbefaft with
 135                         (Ast.BEFORE(mbef),b,_) ->
 136                           mbefaft :=
 137                             (Ast.BEFOREAFTER(mbef,aft),b,afterinfo)
 138                       | (Ast.AFTER(maft),b,mafterinfo) ->
 139                           let (newaft,newinfo) =
 140                             concat maft mafterinfo aft afterinfo in
 141                           mbefaft := (Ast.AFTER(newaft),b,newinfo)
 142                       | (Ast.BEFOREAFTER(mbef,maft),b,mafterinfo) ->
 143                           let (newaft,newinfo) =
 144                             concat maft mafterinfo aft afterinfo in
 145                           mbefaft :=
 146                             (Ast.BEFOREAFTER(mbef,newaft),b,newinfo)
 147                       | (Ast.NOTHING,b,_) ->
 148                           mbefaft := (Ast.AFTER(aft),b,afterinfo))
 149                   |     _ -> failwith "unexpected annotation")
 150                 mcl
 151           | _ ->
 152               failwith
 153                 "context tree should not have bad code after" in
 154         (match !befaft with
 155           (Ast.BEFORE(bef),beforeinfo,_) ->
 156             attach_bef bef beforeinfo
 157               (einfo.Ast0.attachable_start,einfo.Ast0.mcode_start)
 158         | (Ast.AFTER(aft),_,afterinfo) ->
 159             attach_aft aft afterinfo
 160               (einfo.Ast0.attachable_end,einfo.Ast0.mcode_end)
 161         | (Ast.BEFOREAFTER(bef,aft),beforeinfo,afterinfo) ->
 162             attach_bef bef beforeinfo
 163               (einfo.Ast0.attachable_start,einfo.Ast0.mcode_start);
 164             attach_aft aft afterinfo
 165               (einfo.Ast0.attachable_end,einfo.Ast0.mcode_end)
 166         | (Ast.NOTHING,_,_) -> ())
 167     | Ast0.PLUS -> () in
 168   V0.flat_combiner bind option_default
 169     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 170     mcode mcode
 171     do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
 172     do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
 173     do_nothing do_nothing do_nothing
 174
 175 (* --------------------------------------------------------------------- *)
 176 (* For function declarations.  Can't use the mcode at the root, because that
 177 might be mixed when the function contains ()s, where agglomeration of -s is
 178 not possible. *)
 179
 180 let check_allminus =
 181   let donothing r k e = k e in
 182   let bind x y = x && y in
 183   let option_default = true in
 184   let mcode (_,_,_,mc,_,_) =
 185     match mc with
 186       Ast0.MINUS(r) -> let (plusses,_) = !r in plusses = []
 187     | _ -> false in
 188
 189   (* special case for disj *)
 190   let expression r k e =
 191     match Ast0.unwrap e with
 192       Ast0.DisjExpr(starter,expr_list,mids,ender) ->
 193         List.for_all r.VT0.combiner_rec_expression expr_list
 194     | _ -> k e in
 195
 196   let declaration r k e =
 197     match Ast0.unwrap e with
 198       Ast0.DisjDecl(starter,decls,mids,ender) ->
 199         List.for_all r.VT0.combiner_rec_declaration decls
 200     | _ -> k e in
 201
 202   let typeC r k e =
 203     match Ast0.unwrap e with
 204       Ast0.DisjType(starter,decls,mids,ender) ->
 205         List.for_all r.VT0.combiner_rec_typeC decls
 206     | _ -> k e in
 207
 208   let statement r k e =
 209     match Ast0.unwrap e with
 210       Ast0.Disj(starter,statement_dots_list,mids,ender) ->
 211         List.for_all r.VT0.combiner_rec_statement_dots statement_dots_list
 212     | _ -> k e in
 213
 214   V0.flat_combiner bind option_default
 215     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 216     mcode mcode
 217     donothing donothing donothing donothing donothing donothing
 218     donothing expression typeC donothing donothing declaration
 219     statement donothing donothing
 220
 221 (* --------------------------------------------------------------------- *)
 222 (* --------------------------------------------------------------------- *)
 223
 224 let get_option fn = function
 225     None -> None
 226   | Some x -> Some (fn x)
 227
 228 (* --------------------------------------------------------------------- *)
 229 (* --------------------------------------------------------------------- *)
 230 (* Mcode *)
 231
 232 let convert_info info =
 233   let strings_to_s l =
 234     List.map
 235       (function (s,info) -> (s,info.Ast0.line_start,info.Ast0.column))
 236       l in
 237   { Ast.line = info.Ast0.pos_info.Ast0.line_start;
 238     Ast.column = info.Ast0.pos_info.Ast0.column;
 239     Ast.strbef = strings_to_s info.Ast0.strings_before;
 240     Ast.straft = strings_to_s info.Ast0.strings_after;}
 241
 242 let convert_mcodekind adj = function
 243     Ast0.MINUS(replacements) ->
 244       let (replacements,_) = !replacements in
 245       Ast.MINUS(Ast.NoPos,[],adj,replacements)
 246   | Ast0.PLUS -> Ast.PLUS
 247   | Ast0.CONTEXT(befaft) ->
 248       let (befaft,_,_) = !befaft in Ast.CONTEXT(Ast.NoPos,befaft)
 249   | Ast0.MIXED(_) -> failwith "not possible for mcode"
 250
 251 let pos_mcode(term,_,info,mcodekind,pos,adj) =
 252   (* avoids a recursion problem *)
 253   (term,convert_info info,convert_mcodekind adj mcodekind,Ast.NoMetaPos)
 254
 255 let mcode (term,_,info,mcodekind,pos,adj) =
 256   let pos =
 257     match !pos with
 258       Ast0.MetaPos(pos,constraints,per) ->
 259         Ast.MetaPos(pos_mcode pos,constraints,per,unitary,false)
 260     | _ -> Ast.NoMetaPos in
 261   (term,convert_info info,convert_mcodekind adj mcodekind,pos)
 262
 263 (* --------------------------------------------------------------------- *)
 264 (* Dots *)
 265 let wrap ast line isos =
 266   {(Ast.make_term ast) with Ast.node_line = line;
 267     Ast.iso_info = isos}
 268
 269 let rewrap ast0 isos ast =
 270   wrap ast ((Ast0.get_info ast0).Ast0.pos_info.Ast0.line_start) isos
 271
 272 let no_isos = []
 273
 274 (* no isos on tokens *)
 275 let tokenwrap (_,info,_,_) s ast = wrap ast info.Ast.line no_isos
 276 let iso_tokenwrap (_,info,_,_) s ast iso = wrap ast info.Ast.line iso
 277
 278 let dots fn d =
 279   rewrap d no_isos
 280     (match Ast0.unwrap d with
 281       Ast0.DOTS(x) -> Ast.DOTS(List.map fn x)
 282     | Ast0.CIRCLES(x) -> Ast.CIRCLES(List.map fn x)
 283     | Ast0.STARS(x) -> Ast.STARS(List.map fn x))
 284
 285 (* --------------------------------------------------------------------- *)
 286 (* Identifier *)
 287
 288 let rec do_isos l = List.map (function (nm,x) -> (nm,anything x)) l
 289
 290 and ident i =
 291   rewrap i (do_isos (Ast0.get_iso i))
 292     (match Ast0.unwrap i with
 293       Ast0.Id(name) -> Ast.Id(mcode name)
 294     | Ast0.MetaId(name,constraints,_) ->
 295         let constraints = List.map ident constraints in
 296         Ast.MetaId(mcode name,constraints,unitary,false)
 297     | Ast0.MetaFunc(name,constraints,_) ->
 298         let constraints = List.map ident constraints in
 299         Ast.MetaFunc(mcode name,constraints,unitary,false)
 300     | Ast0.MetaLocalFunc(name,constraints,_) ->
 301         let constraints = List.map ident constraints in
 302         Ast.MetaLocalFunc(mcode name,constraints,unitary,false)
 303     | Ast0.OptIdent(id) -> Ast.OptIdent(ident id)
 304     | Ast0.UniqueIdent(id) -> Ast.UniqueIdent(ident id))
 305
 306 (* --------------------------------------------------------------------- *)
 307 (* Expression *)
 308
 309 and expression e =
 310   let e1 =
 311   rewrap e (do_isos (Ast0.get_iso e))
 312     (match Ast0.unwrap e with
 313       Ast0.Ident(id) -> Ast.Ident(ident id)
 314     | Ast0.Constant(const) ->
 315         Ast.Constant(mcode const)
 316     | Ast0.FunCall(fn,lp,args,rp) ->
 317         let fn = expression fn in
 318         let lp = mcode lp in
 319         let args = dots expression args in
 320         let rp = mcode rp in
 321         Ast.FunCall(fn,lp,args,rp)
 322     | Ast0.Assignment(left,op,right,simple) ->
 323         Ast.Assignment(expression left,mcode op,expression right,simple)
 324     | Ast0.CondExpr(exp1,why,exp2,colon,exp3) ->
 325         let exp1 = expression exp1 in
 326         let why = mcode why in
 327         let exp2 = get_option expression exp2 in
 328         let colon = mcode colon in
 329         let exp3 = expression exp3 in
 330         Ast.CondExpr(exp1,why,exp2,colon,exp3)
 331     | Ast0.Postfix(exp,op) ->
 332         Ast.Postfix(expression exp,mcode op)
 333     | Ast0.Infix(exp,op) ->
 334         Ast.Infix(expression exp,mcode op)
 335     | Ast0.Unary(exp,op) ->
 336         Ast.Unary(expression exp,mcode op)
 337     | Ast0.Binary(left,op,right) ->
 338         Ast.Binary(expression left,mcode op,expression right)
 339     | Ast0.Nested(left,op,right) ->
 340         Ast.Nested(expression left,mcode op,expression right)
 341     | Ast0.Paren(lp,exp,rp) ->
 342         Ast.Paren(mcode lp,expression exp,mcode rp)
 343     | Ast0.ArrayAccess(exp1,lb,exp2,rb) ->
 344         Ast.ArrayAccess(expression exp1,mcode lb,expression exp2,mcode rb)
 345     | Ast0.RecordAccess(exp,pt,field) ->
 346         Ast.RecordAccess(expression exp,mcode pt,ident field)
 347     | Ast0.RecordPtAccess(exp,ar,field) ->
 348         Ast.RecordPtAccess(expression exp,mcode ar,ident field)
 349     | Ast0.Cast(lp,ty,rp,exp) ->
 350         Ast.Cast(mcode lp,typeC ty,mcode rp,expression exp)
 351     | Ast0.SizeOfExpr(szf,exp) ->
 352         Ast.SizeOfExpr(mcode szf,expression exp)
 353     | Ast0.SizeOfType(szf,lp,ty,rp) ->
 354         Ast.SizeOfType(mcode szf, mcode lp,typeC ty,mcode rp)
 355     | Ast0.TypeExp(ty) -> Ast.TypeExp(typeC ty)
 356     | Ast0.MetaErr(name,constraints,_)  ->
 357         let constraints = List.map expression constraints in
 358         Ast.MetaErr(mcode name,constraints,unitary,false)
 359     | Ast0.MetaExpr(name,constraints,ty,form,_)  ->
 360         let constraints = List.map expression constraints in
 361         Ast.MetaExpr(mcode name,constraints,unitary,ty,form,false)
 362     | Ast0.MetaExprList(name,Some lenname,_) ->
 363         Ast.MetaExprList(mcode name,Some (mcode lenname,unitary,false),
 364                          unitary,false)
 365     | Ast0.MetaExprList(name,None,_) ->
 366         Ast.MetaExprList(mcode name,None,unitary,false)
 367     | Ast0.EComma(cm)         -> Ast.EComma(mcode cm)
 368     | Ast0.DisjExpr(_,exps,_,_)     ->
 369         Ast.DisjExpr(List.map expression exps)
 370     | Ast0.NestExpr(_,exp_dots,_,whencode,multi) ->
 371         let whencode = get_option expression whencode in
 372         Ast.NestExpr(dots expression exp_dots,whencode,multi)
 373     | Ast0.Edots(dots,whencode) ->
 374         let dots = mcode dots in
 375         let whencode = get_option expression whencode in
 376         Ast.Edots(dots,whencode)
 377     | Ast0.Ecircles(dots,whencode) ->
 378         let dots = mcode dots in
 379         let whencode = get_option expression whencode in
 380         Ast.Ecircles(dots,whencode)
 381     | Ast0.Estars(dots,whencode) ->
 382         let dots = mcode dots in
 383         let whencode = get_option expression whencode in
 384         Ast.Estars(dots,whencode)
 385     | Ast0.OptExp(exp) -> Ast.OptExp(expression exp)
 386     | Ast0.UniqueExp(exp) -> Ast.UniqueExp(expression exp)) in
 387   if Ast0.get_test_exp e then Ast.set_test_exp e1 else e1
 388
 389 and expression_dots ed = dots expression ed
 390
 391 (* --------------------------------------------------------------------- *)
 392 (* Types *)
 393
 394 and rewrap_iso t t1 = rewrap t (do_isos (Ast0.get_iso t)) t1
 395
 396 and typeC t =
 397   rewrap t (do_isos (Ast0.get_iso t))
 398     (match Ast0.unwrap t with
 399       Ast0.ConstVol(cv,ty) ->
 400         let rec collect_disjs t =
 401           match Ast0.unwrap t with
 402             Ast0.DisjType(_,types,_,_) ->
 403               if Ast0.get_iso t = []
 404               then List.concat (List.map collect_disjs types)
 405               else failwith "unexpected iso on a disjtype"
 406           | _ -> [t] in
 407         let res =
 408           List.map
 409             (function ty ->
 410               Ast.Type
 411                 (Some (mcode cv),rewrap_iso ty (base_typeC ty)))
 412             (collect_disjs ty) in
 413         (* one could worry that isos are lost because we flatten the
 414            disjunctions.  but there should not be isos on the disjunctions
 415            themselves. *)
 416         (match res with
 417           [ty] -> ty
 418         | types -> Ast.DisjType(List.map (rewrap t no_isos) types))
 419     | Ast0.BaseType(_) | Ast0.Signed(_,_) | Ast0.Pointer(_,_)
 420     | Ast0.FunctionPointer(_,_,_,_,_,_,_) | Ast0.FunctionType(_,_,_,_)
 421     | Ast0.Array(_,_,_,_) | Ast0.EnumName(_,_) | Ast0.StructUnionName(_,_)
 422     | Ast0.StructUnionDef(_,_,_,_) | Ast0.TypeName(_) | Ast0.MetaType(_,_) ->
 423         Ast.Type(None,rewrap t no_isos (base_typeC t))
 424     | Ast0.DisjType(_,types,_,_) -> Ast.DisjType(List.map typeC types)
 425     | Ast0.OptType(ty) -> Ast.OptType(typeC ty)
 426     | Ast0.UniqueType(ty) -> Ast.UniqueType(typeC ty))
 427
 428 and base_typeC t =
 429   match Ast0.unwrap t with
 430     Ast0.BaseType(ty,strings) -> Ast.BaseType(ty,List.map mcode strings)
 431   | Ast0.Signed(sgn,ty) ->
 432       Ast.SignedT(mcode sgn,
 433                   get_option (function x -> rewrap_iso x (base_typeC x)) ty)
 434   | Ast0.Pointer(ty,star) -> Ast.Pointer(typeC ty,mcode star)
 435   | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
 436       Ast.FunctionPointer
 437         (typeC ty,mcode lp1,mcode star,mcode rp1,
 438          mcode lp2,parameter_list params,mcode rp2)
 439   | Ast0.FunctionType(ret,lp,params,rp) ->
 440       let allminus = check_allminus.VT0.combiner_rec_typeC t in
 441       Ast.FunctionType
 442         (allminus,get_option typeC ret,mcode lp,
 443          parameter_list params,mcode rp)
 444   | Ast0.Array(ty,lb,size,rb) ->
 445       Ast.Array(typeC ty,mcode lb,get_option expression size,mcode rb)
 446   | Ast0.EnumName(kind,name) ->
 447       Ast.EnumName(mcode kind,ident name)
 448   | Ast0.StructUnionName(kind,name) ->
 449       Ast.StructUnionName(mcode kind,get_option ident name)
 450   | Ast0.StructUnionDef(ty,lb,decls,rb) ->
 451       Ast.StructUnionDef(typeC ty,mcode lb,
 452                          dots declaration decls,
 453                          mcode rb)
 454   | Ast0.TypeName(name) -> Ast.TypeName(mcode name)
 455   | Ast0.MetaType(name,_) ->
 456       Ast.MetaType(mcode name,unitary,false)
 457   | _ -> failwith "ast0toast: unexpected type"
 458
 459 (* --------------------------------------------------------------------- *)
 460 (* Variable declaration *)
 461 (* Even if the Cocci program specifies a list of declarations, they are
 462    split out into multiple declarations of a single variable each. *)
 463
 464 and declaration d =
 465   rewrap d (do_isos (Ast0.get_iso d))
 466     (match Ast0.unwrap d with
 467       Ast0.Init(stg,ty,id,eq,ini,sem) ->
 468         let stg = get_option mcode stg in
 469         let ty = typeC ty in
 470         let id = ident id in
 471         let eq = mcode eq in
 472         let ini = initialiser ini in
 473         let sem = mcode sem in
 474         Ast.Init(stg,ty,id,eq,ini,sem)
 475     | Ast0.UnInit(stg,ty,id,sem) ->
 476         (match Ast0.unwrap ty with
 477           Ast0.FunctionType(tyx,lp1,params,rp1) ->
 478             let allminus = check_allminus.VT0.combiner_rec_declaration d in
 479             Ast.UnInit(get_option mcode stg,
 480                        rewrap ty (do_isos (Ast0.get_iso ty))
 481                          (Ast.Type
 482                             (None,
 483                              rewrap ty no_isos
 484                                (Ast.FunctionType
 485                                   (allminus,get_option typeC tyx,mcode lp1,
 486                                    parameter_list params,mcode rp1)))),
 487                        ident id,mcode sem)
 488         | _ -> Ast.UnInit(get_option mcode stg,typeC ty,ident id,mcode sem))
 489     | Ast0.MacroDecl(name,lp,args,rp,sem) ->
 490         let name = ident name in
 491         let lp = mcode lp in
 492         let args = dots expression args in
 493         let rp = mcode rp in
 494         let sem = mcode sem in
 495         Ast.MacroDecl(name,lp,args,rp,sem)
 496     | Ast0.TyDecl(ty,sem) -> Ast.TyDecl(typeC ty,mcode sem)
 497     | Ast0.Typedef(stg,ty,id,sem) ->
 498         let id = typeC id in
 499         (match Ast.unwrap id with
 500           Ast.Type(None,id) -> (* only MetaType or Id *)
 501             Ast.Typedef(mcode stg,typeC ty,id,mcode sem)
 502         | _ -> failwith "bad typedef")
 503     | Ast0.DisjDecl(_,decls,_,_) -> Ast.DisjDecl(List.map declaration decls)
 504     | Ast0.Ddots(dots,whencode) ->
 505         let dots = mcode dots in
 506         let whencode = get_option declaration whencode in
 507         Ast.Ddots(dots,whencode)
 508     | Ast0.OptDecl(decl) -> Ast.OptDecl(declaration decl)
 509     | Ast0.UniqueDecl(decl) -> Ast.UniqueDecl(declaration decl))
 510
 511 and declaration_dots l = dots declaration l
 512
 513 (* --------------------------------------------------------------------- *)
 514 (* Initialiser *)
 515
 516 and strip_idots initlist =
 517   match Ast0.unwrap initlist with
 518     Ast0.DOTS(x) ->
 519       let (whencode,init) =
 520         List.fold_left
 521           (function (prevwhen,previnit) ->
 522             function cur ->
 523               match Ast0.unwrap cur with
 524                 Ast0.Idots(dots,Some whencode) ->
 525                   (whencode :: prevwhen, previnit)
 526               | Ast0.Idots(dots,None) -> (prevwhen,previnit)
 527               | _ -> (prevwhen, cur :: previnit))
 528           ([],[]) x in
 529       (List.rev whencode, List.rev init)
 530   | Ast0.CIRCLES(x) | Ast0.STARS(x) -> failwith "not possible for an initlist"
 531
 532 and initialiser i =
 533   rewrap i no_isos
 534     (match Ast0.unwrap i with
 535       Ast0.MetaInit(name,_) -> Ast.MetaInit(mcode name,unitary,false)
 536     | Ast0.InitExpr(exp) -> Ast.InitExpr(expression exp)
 537     | Ast0.InitList(lb,initlist,rb) ->
 538         let (whencode,initlist) =  strip_idots initlist in
 539         Ast.InitList(mcode lb,List.map initialiser initlist,mcode rb,
 540                      List.map initialiser whencode)
 541     | Ast0.InitGccExt(designators,eq,ini) ->
 542         Ast.InitGccExt(List.map designator designators,mcode eq,
 543                        initialiser ini)
 544     | Ast0.InitGccName(name,eq,ini) ->
 545         Ast.InitGccName(ident name,mcode eq,initialiser ini)
 546     | Ast0.IComma(comma) -> Ast.IComma(mcode comma)
 547     | Ast0.Idots(_,_) -> failwith "Idots should have been removed"
 548     | Ast0.OptIni(ini) -> Ast.OptIni(initialiser ini)
 549     | Ast0.UniqueIni(ini) -> Ast.UniqueIni(initialiser ini))
 550
 551 and designator = function
 552     Ast0.DesignatorField(dot,id) -> Ast.DesignatorField(mcode dot,ident id)
 553   | Ast0.DesignatorIndex(lb,exp,rb) ->
 554       Ast.DesignatorIndex(mcode lb, expression exp, mcode rb)
 555   | Ast0.DesignatorRange(lb,min,dots,max,rb) ->
 556       Ast.DesignatorRange(mcode lb,expression min,mcode dots,expression max,
 557                           mcode rb)
 558
 559 (* --------------------------------------------------------------------- *)
 560 (* Parameter *)
 561
 562 and parameterTypeDef p =
 563   rewrap p no_isos
 564     (match Ast0.unwrap p with
 565       Ast0.VoidParam(ty) -> Ast.VoidParam(typeC ty)
 566     | Ast0.Param(ty,id) -> Ast.Param(typeC ty,get_option ident id)
 567     | Ast0.MetaParam(name,_) ->
 568         Ast.MetaParam(mcode name,unitary,false)
 569     | Ast0.MetaParamList(name,Some lenname,_) ->
 570         Ast.MetaParamList(mcode name,Some(mcode lenname,unitary,false),
 571                           unitary,false)
 572     | Ast0.MetaParamList(name,None,_) ->
 573         Ast.MetaParamList(mcode name,None,unitary,false)
 574     | Ast0.PComma(cm) -> Ast.PComma(mcode cm)
 575     | Ast0.Pdots(dots) -> Ast.Pdots(mcode dots)
 576     | Ast0.Pcircles(dots) -> Ast.Pcircles(mcode dots)
 577     | Ast0.OptParam(param) -> Ast.OptParam(parameterTypeDef param)
 578     | Ast0.UniqueParam(param) -> Ast.UniqueParam(parameterTypeDef param))
 579
 580 and parameter_list l = dots parameterTypeDef l
 581
 582 (* --------------------------------------------------------------------- *)
 583 (* Top-level code *)
 584
 585 and statement s =
 586   let rec statement seqible s =
 587     let rewrap_stmt ast0 ast =
 588       let befaft =
 589         match Ast0.get_dots_bef_aft s with
 590           Ast0.NoDots -> Ast.NoDots
 591         | Ast0.DroppingBetweenDots s ->
 592             Ast.DroppingBetweenDots (statement seqible s,get_ctr())
 593         | Ast0.AddingBetweenDots s ->
 594             Ast.AddingBetweenDots (statement seqible s,get_ctr()) in
 595       Ast.set_dots_bef_aft befaft (rewrap ast0 no_isos ast) in
 596     let rewrap_rule_elem ast0 ast =
 597       rewrap ast0 (do_isos (Ast0.get_iso ast0)) ast in
 598     rewrap_stmt s
 599       (match Ast0.unwrap s with
 600         Ast0.Decl((_,bef),decl) ->
 601           Ast.Atomic(rewrap_rule_elem s
 602                        (Ast.Decl(convert_mcodekind (-1) bef,
 603                                  check_allminus.VT0.combiner_rec_statement s,
 604                                  declaration decl)))
 605       | Ast0.Seq(lbrace,body,rbrace) ->
 606           let lbrace = mcode lbrace in
 607           let body = dots (statement seqible) body in
 608           let rbrace = mcode rbrace in
 609           Ast.Seq(iso_tokenwrap lbrace s (Ast.SeqStart(lbrace))
 610                     (do_isos (Ast0.get_iso s)),
 611                   body,
 612                   tokenwrap rbrace s (Ast.SeqEnd(rbrace)))
 613       | Ast0.ExprStatement(exp,sem) ->
 614           Ast.Atomic(rewrap_rule_elem s
 615                        (Ast.ExprStatement(expression exp,mcode sem)))
 616       | Ast0.IfThen(iff,lp,exp,rp,branch,(_,aft)) ->
 617           Ast.IfThen
 618             (rewrap_rule_elem s
 619                (Ast.IfHeader(mcode iff,mcode lp,expression exp,mcode rp)),
 620              statement Ast.NotSequencible branch,
 621              ([],[],[],convert_mcodekind (-1) aft))
 622       | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(_,aft)) ->
 623           let els = mcode els in
 624           Ast.IfThenElse
 625             (rewrap_rule_elem s
 626                (Ast.IfHeader(mcode iff,mcode lp,expression exp,mcode rp)),
 627              statement Ast.NotSequencible branch1,
 628              tokenwrap els s (Ast.Else(els)),
 629              statement Ast.NotSequencible branch2,
 630              ([],[],[],convert_mcodekind (-1) aft))
 631       | Ast0.While(wh,lp,exp,rp,body,(_,aft)) ->
 632           Ast.While(rewrap_rule_elem s
 633                       (Ast.WhileHeader
 634                          (mcode wh,mcode lp,expression exp,mcode rp)),
 635                     statement Ast.NotSequencible body,
 636                     ([],[],[],convert_mcodekind (-1) aft))
 637       | Ast0.Do(d,body,wh,lp,exp,rp,sem) ->
 638           let wh = mcode wh in
 639           Ast.Do(rewrap_rule_elem s (Ast.DoHeader(mcode d)),
 640                  statement Ast.NotSequencible body,
 641                  tokenwrap wh s
 642                    (Ast.WhileTail(wh,mcode lp,expression exp,mcode rp,
 643                                   mcode sem)))
 644       | Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,(_,aft)) ->
 645           let fr = mcode fr in
 646           let lp = mcode lp in
 647           let exp1 = get_option expression exp1 in
 648           let sem1 = mcode sem1 in
 649           let exp2 = get_option expression exp2 in
 650           let sem2= mcode sem2 in
 651           let exp3 = get_option expression exp3 in
 652           let rp = mcode rp in
 653           let body = statement Ast.NotSequencible body in
 654           Ast.For(rewrap_rule_elem s
 655                     (Ast.ForHeader(fr,lp,exp1,sem1,exp2,sem2,exp3,rp)),
 656                   body,([],[],[],convert_mcodekind (-1) aft))
 657       | Ast0.Iterator(nm,lp,args,rp,body,(_,aft)) ->
 658           Ast.Iterator(rewrap_rule_elem s
 659                       (Ast.IteratorHeader
 660                          (ident nm,mcode lp,
 661                           dots expression args,
 662                           mcode rp)),
 663                     statement Ast.NotSequencible body,
 664                     ([],[],[],convert_mcodekind (-1) aft))
 665       | Ast0.Switch(switch,lp,exp,rp,lb,cases,rb) ->
 666           let switch = mcode switch in
 667           let lp = mcode lp in
 668           let exp = expression exp in
 669           let rp = mcode rp in
 670           let lb = mcode lb in
 671           let cases = List.map case_line (Ast0.undots cases) in
 672           let rb = mcode rb in
 673           Ast.Switch(rewrap_rule_elem s (Ast.SwitchHeader(switch,lp,exp,rp)),
 674                      tokenwrap lb s (Ast.SeqStart(lb)),
 675                      cases,
 676                      tokenwrap rb s (Ast.SeqEnd(rb)))
 677       | Ast0.Break(br,sem) ->
 678           Ast.Atomic(rewrap_rule_elem s (Ast.Break(mcode br,mcode sem)))
 679       | Ast0.Continue(cont,sem) ->
 680           Ast.Atomic(rewrap_rule_elem s (Ast.Continue(mcode cont,mcode sem)))
 681       | Ast0.Label(l,dd) ->
 682           Ast.Atomic(rewrap_rule_elem s (Ast.Label(ident l,mcode dd)))
 683       | Ast0.Goto(goto,l,sem) ->
 684           Ast.Atomic
 685             (rewrap_rule_elem s (Ast.Goto(mcode goto,ident l,mcode sem)))
 686       | Ast0.Return(ret,sem) ->
 687           Ast.Atomic(rewrap_rule_elem s (Ast.Return(mcode ret,mcode sem)))
 688       | Ast0.ReturnExpr(ret,exp,sem) ->
 689           Ast.Atomic
 690             (rewrap_rule_elem s
 691                (Ast.ReturnExpr(mcode ret,expression exp,mcode sem)))
 692       | Ast0.MetaStmt(name,_) ->
 693           Ast.Atomic(rewrap_rule_elem s
 694                        (Ast.MetaStmt(mcode name,unitary,seqible,false)))
 695       | Ast0.MetaStmtList(name,_) ->
 696           Ast.Atomic(rewrap_rule_elem s
 697                        (Ast.MetaStmtList(mcode name,unitary,false)))
 698       | Ast0.TopExp(exp) ->
 699           Ast.Atomic(rewrap_rule_elem s (Ast.TopExp(expression exp)))
 700       | Ast0.Exp(exp) ->
 701           Ast.Atomic(rewrap_rule_elem s (Ast.Exp(expression exp)))
 702       | Ast0.TopInit(init) ->
 703           Ast.Atomic(rewrap_rule_elem s (Ast.TopInit(initialiser init)))
 704       | Ast0.Ty(ty) ->
 705           Ast.Atomic(rewrap_rule_elem s (Ast.Ty(typeC ty)))
 706       | Ast0.Disj(_,rule_elem_dots_list,_,_) ->
 707           Ast.Disj(List.map (function x -> statement_dots seqible x)
 708                      rule_elem_dots_list)
 709       | Ast0.Nest(_,rule_elem_dots,_,whn,multi) ->
 710           Ast.Nest
 711             (statement_dots Ast.Sequencible rule_elem_dots,
 712              List.map
 713                (whencode (statement_dots Ast.Sequencible)
 714                  (statement Ast.NotSequencible))
 715                whn,
 716              multi,[],[])
 717       | Ast0.Dots(d,whn) ->
 718           let d = mcode d in
 719           let whn =
 720             List.map
 721               (whencode (statement_dots Ast.Sequencible)
 722                  (statement Ast.NotSequencible))
 723               whn in
 724           Ast.Dots(d,whn,[],[])
 725       | Ast0.Circles(d,whn) ->
 726           let d = mcode d in
 727           let whn =
 728             List.map
 729               (whencode (statement_dots Ast.Sequencible)
 730                  (statement Ast.NotSequencible))
 731               whn in
 732           Ast.Circles(d,whn,[],[])
 733       | Ast0.Stars(d,whn) ->
 734           let d = mcode d in
 735           let whn =
 736             List.map
 737               (whencode (statement_dots Ast.Sequencible)
 738                  (statement Ast.NotSequencible))
 739               whn in
 740           Ast.Stars(d,whn,[],[])
 741       | Ast0.FunDecl((_,bef),fi,name,lp,params,rp,lbrace,body,rbrace) ->
 742           let fi = List.map fninfo fi in
 743           let name = ident name in
 744           let lp = mcode lp in
 745           let params = parameter_list params in
 746           let rp = mcode rp in
 747           let lbrace = mcode lbrace in
 748           let body = dots (statement seqible) body in
 749           let rbrace = mcode rbrace in
 750           let allminus = check_allminus.VT0.combiner_rec_statement s in
 751           Ast.FunDecl(rewrap_rule_elem s
 752                         (Ast.FunHeader(convert_mcodekind (-1) bef,
 753                                        allminus,fi,name,lp,params,rp)),
 754                       tokenwrap lbrace s (Ast.SeqStart(lbrace)),
 755                       body,
 756                       tokenwrap rbrace s (Ast.SeqEnd(rbrace)))
 757       | Ast0.Include(inc,str) ->
 758           Ast.Atomic(rewrap_rule_elem s (Ast.Include(mcode inc,mcode str)))
 759       | Ast0.Define(def,id,params,body) ->
 760           Ast.Define
 761             (rewrap_rule_elem s
 762                (Ast.DefineHeader
 763                   (mcode def,ident id, define_parameters params)),
 764              statement_dots Ast.NotSequencible (*not sure*) body)
 765       | Ast0.OptStm(stm) -> Ast.OptStm(statement seqible stm)
 766       | Ast0.UniqueStm(stm) -> Ast.UniqueStm(statement seqible stm))
 767
 768   and define_parameters p =
 769     rewrap p no_isos
 770       (match Ast0.unwrap p with
 771         Ast0.NoParams -> Ast.NoParams
 772       | Ast0.DParams(lp,params,rp) ->
 773           Ast.DParams(mcode lp,
 774                       dots define_param params,
 775                       mcode rp))
 776
 777   and define_param p =
 778     rewrap p no_isos
 779       (match Ast0.unwrap p with
 780         Ast0.DParam(id) -> Ast.DParam(ident id)
 781       | Ast0.DPComma(comma) -> Ast.DPComma(mcode comma)
 782       | Ast0.DPdots(d) -> Ast.DPdots(mcode d)
 783       | Ast0.DPcircles(c) -> Ast.DPcircles(mcode c)
 784       | Ast0.OptDParam(dp) -> Ast.OptDParam(define_param dp)
 785       | Ast0.UniqueDParam(dp) -> Ast.UniqueDParam(define_param dp))
 786
 787   and whencode notfn alwaysfn = function
 788       Ast0.WhenNot a -> Ast.WhenNot (notfn a)
 789     | Ast0.WhenAlways a -> Ast.WhenAlways (alwaysfn a)
 790     | Ast0.WhenModifier(x) -> Ast.WhenModifier(x)
 791     | x ->
 792         let rewrap_rule_elem ast0 ast =
 793           rewrap ast0 (do_isos (Ast0.get_iso ast0)) ast in
 794         match x with
 795           Ast0.WhenNotTrue(e) ->
 796             Ast.WhenNotTrue(rewrap_rule_elem e (Ast.Exp(expression e)))
 797         | Ast0.WhenNotFalse(e) ->
 798             Ast.WhenNotFalse(rewrap_rule_elem e (Ast.Exp(expression e)))
 799         | _ -> failwith "not possible"
 800
 801   and process_list seqible isos = function
 802       [] -> []
 803     | x::rest ->
 804         let first = statement seqible x in
 805         let first =
 806           if !Flag.track_iso_usage
 807           then Ast.set_isos first (isos@(Ast.get_isos first))
 808           else first in
 809         (match Ast0.unwrap x with
 810           Ast0.Dots(_,_) | Ast0.Nest(_) ->
 811             first::(process_list (Ast.SequencibleAfterDots []) no_isos rest)
 812         | _ ->
 813             first::(process_list Ast.Sequencible no_isos rest))
 814
 815   and statement_dots seqible d =
 816     let isos = do_isos (Ast0.get_iso d) in
 817     rewrap d no_isos
 818       (match Ast0.unwrap d with
 819         Ast0.DOTS(x) -> Ast.DOTS(process_list seqible isos x)
 820       | Ast0.CIRCLES(x) -> Ast.CIRCLES(process_list seqible isos x)
 821       | Ast0.STARS(x) -> Ast.STARS(process_list seqible isos x))
 822
 823   (* the following is no longer used.
 824    the goal was to let one put a statement at the very beginning of a function
 825    pattern and have it skip over the declarations in the C code.
 826    that feature was removed a long time ago, however, in favor of
 827    ... when != S, which also causes whatever comes after it to match the
 828    first real statement.
 829    the separation of declarations from the rest of the body means that the
 830    quantifier of any variable shared between them comes out too high, posing
 831    problems when there is ... decl ... stmt, as the quantifier of any shared
 832    variable will be around the whole thing, making variables not free enough
 833    in the first ..., and thus not implementing the expected shortest path
 834    condition.  example: f() { ... int A; ... foo(A); }.
 835    the quantifier for A should start just before int A, not at the top of the
 836    function.
 837   and separate_decls seqible d =
 838     let rec collect_decls = function
 839         [] -> ([],[])
 840       | (x::xs) as l ->
 841           (match Ast0.unwrap x with
 842             Ast0.Decl(_) ->
 843               let (decls,other) = collect_decls xs in
 844               (x :: decls,other)
 845           | Ast0.Dots(_,_) | Ast0.Nest(_,_,_,_,_) ->
 846               let (decls,other) = collect_decls xs in
 847               (match decls with
 848                 [] -> ([],x::other)
 849               | _ -> (x :: decls,other))
 850           | Ast0.Disj(starter,stmt_dots_list,mids,ender) ->
 851               let disjs = List.map collect_dot_decls stmt_dots_list in
 852               let all_decls = List.for_all (function (_,s) -> s=[]) disjs in
 853               if all_decls
 854               then
 855                 let (decls,other) = collect_decls xs in
 856                 (x :: decls,other)
 857               else ([],l)
 858           | _ -> ([],l))
 859
 860     and collect_dot_decls d =
 861       match Ast0.unwrap d with
 862         Ast0.DOTS(x) -> collect_decls x
 863       | Ast0.CIRCLES(x) -> collect_decls x
 864       | Ast0.STARS(x) -> collect_decls x in
 865
 866     let process l d fn =
 867       let (decls,other) = collect_decls l in
 868       (rewrap d no_isos (fn (List.map (statement seqible) decls)),
 869        rewrap d no_isos
 870          (fn (process_list seqible (do_isos (Ast0.get_iso d)) other))) in
 871     match Ast0.unwrap d with
 872       Ast0.DOTS(x) -> process x d (function x -> Ast.DOTS x)
 873     | Ast0.CIRCLES(x) -> process x d (function x -> Ast.CIRCLES x)
 874     | Ast0.STARS(x) -> process x d (function x -> Ast.STARS x) *) in
 875
 876   statement Ast.Sequencible s
 877
 878 and fninfo = function
 879     Ast0.FStorage(stg) -> Ast.FStorage(mcode stg)
 880   | Ast0.FType(ty) -> Ast.FType(typeC ty)
 881   | Ast0.FInline(inline) -> Ast.FInline(mcode inline)
 882   | Ast0.FAttr(attr) -> Ast.FAttr(mcode attr)
 883
 884 and option_to_list = function
 885     Some x -> [x]
 886   | None -> []
 887
 888 and case_line c =
 889   rewrap c no_isos
 890     (match Ast0.unwrap c with
 891       Ast0.Default(def,colon,code) ->
 892         let def = mcode def in
 893         let colon = mcode colon in
 894         let code = dots statement code in
 895         Ast.CaseLine(rewrap c no_isos (Ast.Default(def,colon)),code)
 896     | Ast0.Case(case,exp,colon,code) ->
 897         let case = mcode case in
 898         let exp = expression exp in
 899         let colon = mcode colon in
 900         let code = dots statement code in
 901         Ast.CaseLine(rewrap c no_isos (Ast.Case(case,exp,colon)),code)
 902     | Ast0.OptCase(case) -> Ast.OptCase(case_line case))
 903
 904 and statement_dots l = dots statement l
 905
 906 (* --------------------------------------------------------------------- *)
 907
 908 (* what is possible is only what is at the top level in an iso *)
 909 and anything = function
 910     Ast0.DotsExprTag(d) -> Ast.ExprDotsTag(expression_dots d)
 911   | Ast0.DotsParamTag(d) -> Ast.ParamDotsTag(parameter_list d)
 912   | Ast0.DotsInitTag(d) -> failwith "not possible"
 913   | Ast0.DotsStmtTag(d) -> Ast.StmtDotsTag(statement_dots d)
 914   | Ast0.DotsDeclTag(d) -> Ast.DeclDotsTag(declaration_dots d)
 915   | Ast0.DotsCaseTag(d) -> failwith "not possible"
 916   | Ast0.IdentTag(d) -> Ast.IdentTag(ident d)
 917   | Ast0.ExprTag(d) -> Ast.ExpressionTag(expression d)
 918   | Ast0.ArgExprTag(d) | Ast0.TestExprTag(d) ->
 919      failwith "only in isos, not converted to ast"
 920   | Ast0.TypeCTag(d) -> Ast.FullTypeTag(typeC d)
 921   | Ast0.ParamTag(d) -> Ast.ParamTag(parameterTypeDef d)
 922   | Ast0.InitTag(d) -> Ast.InitTag(initialiser d)
 923   | Ast0.DeclTag(d) -> Ast.DeclarationTag(declaration d)
 924   | Ast0.StmtTag(d) -> Ast.StatementTag(statement d)
 925   | Ast0.CaseLineTag(d) -> Ast.CaseLineTag(case_line d)
 926   | Ast0.TopTag(d) -> Ast.Code(top_level d)
 927   | Ast0.IsoWhenTag(_) -> failwith "not possible"
 928   | Ast0.IsoWhenTTag(_) -> failwith "not possible"
 929   | Ast0.IsoWhenFTag(_) -> failwith "not possible"
 930   | Ast0.MetaPosTag _ -> failwith "not possible"
 931
 932 (* --------------------------------------------------------------------- *)
 933 (* Function declaration *)
 934 (* top level isos are probably lost to tracking *)
 935
 936 and top_level t =
 937   rewrap t no_isos
 938     (match Ast0.unwrap t with
 939       Ast0.FILEINFO(old_file,new_file) ->
 940         Ast.FILEINFO(mcode old_file,mcode new_file)
 941     | Ast0.DECL(stmt) -> Ast.DECL(statement stmt)
 942     | Ast0.CODE(rule_elem_dots) ->
 943         Ast.CODE(statement_dots rule_elem_dots)
 944     | Ast0.ERRORWORDS(exps) -> Ast.ERRORWORDS(List.map expression exps)
 945     | Ast0.OTHER(_) -> failwith "eliminated by top_level")
 946
 947 (* --------------------------------------------------------------------- *)
 948 (* Entry point for minus code *)
 949
 950 (* Inline_mcodes is very important - sends + code attached to the - code
 951 down to the mcodes.  The functions above can only be used when there is no
 952 attached + code, eg in + code itself. *)
 953 let ast0toast_toplevel x =
 954   inline_mcodes.VT0.combiner_rec_top_level x;
 955   top_level x
 956
 957 let ast0toast name deps dropped exists x is_exp ruletype =
 958   List.iter inline_mcodes.VT0.combiner_rec_top_level x;
 959   Ast.CocciRule
 960     (name,(deps,dropped,exists),List.map top_level x,is_exp,ruletype)