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