parsing_cocci/.#ast0toast.ml.1.140

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