parsing_cocci/ast0toast.ml

   1 (* Arities matter for the minus slice, but not for the plus slice. *)
   2
   3 (* + only allowed on code in a nest (in_nest = true).  ? only allowed on
   4 rule_elems, and on subterms if the context is ? also. *)
   5
   6 module Ast0 = Ast0_cocci
   7 module Ast = Ast_cocci
   8 module V0 = Visitor_ast0
   9 module VT0 = Visitor_ast0_types
  10 module V = Visitor_ast
  11
  12 let unitary = Type_cocci.Unitary
  13
  14 let ctr = ref 0
  15 let get_ctr _ =
  16   let c = !ctr in
  17   ctr := !ctr + 1;
  18   c
  19
  20 (* --------------------------------------------------------------------- *)
  21 (* Move plus tokens from the MINUS and CONTEXT structured nodes to the
  22 corresponding leftmost and rightmost mcodes *)
  23
  24 let inline_mcodes =
  25   let bind x y = () in
  26   let option_default = () in
  27   let mcode _ = () in
  28   let do_nothing r k e =
  29     k e;
  30     let einfo = Ast0.get_info e in
  31     match (Ast0.get_mcodekind e) with
  32       Ast0.MINUS(replacements) ->
  33         (match !replacements with
  34           ([],_) -> ()
  35         | replacements ->
  36             let minus_try = function
  37                 (true,mc) ->
  38                   if List.for_all
  39                       (function
  40                           Ast0.MINUS(mreplacements) -> true | _ -> false)
  41                       mc
  42                   then
  43                     (List.iter
  44                        (function
  45                            Ast0.MINUS(mreplacements) ->
  46                              mreplacements := replacements
  47                          | _ -> ())
  48                        mc;
  49                      true)
  50                   else false
  51               | _ -> false in
  52             if not (minus_try(einfo.Ast0.attachable_start,
  53                               einfo.Ast0.mcode_start)
  54                       or
  55                     minus_try(einfo.Ast0.attachable_end,
  56                               einfo.Ast0.mcode_end))
  57             then
  58               failwith "minus tree should not have bad code on both sides")
  59     | Ast0.CONTEXT(befaft)
  60     | Ast0.MIXED(befaft) ->
  61         let concat starter startinfo ender endinfo =
  62           let lst =
  63             match (starter,ender) with
  64               ([],_) -> ender
  65             | (_,[]) -> starter
  66             | _ ->
  67                 if startinfo.Ast0.tline_end = endinfo.Ast0.tline_start
  68                 then (* put them in the same inner list *)
  69                   let last = List.hd (List.rev starter) in
  70                   let butlast = List.rev(List.tl(List.rev starter)) in
  71                   butlast @ (last@(List.hd ender)) :: (List.tl ender)
  72                 else starter @ ender in
  73           (lst,
  74            {endinfo with Ast0.tline_start = startinfo.Ast0.tline_start}) in
  75         let attach_bef bef beforeinfo befit = function
  76             (true,mcl) ->
  77               List.iter
  78                 (function
  79                     Ast0.MINUS(mreplacements) ->
  80                       let (mrepl,tokeninfo) = !mreplacements in
  81                       mreplacements := concat bef beforeinfo mrepl tokeninfo
  82                   | Ast0.CONTEXT(mbefaft) ->
  83                       (match !mbefaft with
  84                         (Ast.BEFORE(mbef,it),mbeforeinfo,a) ->
  85                           let (newbef,newinfo) =
  86                             concat bef beforeinfo mbef mbeforeinfo in
  87                           let it = Ast.lub_count befit it in
  88                           mbefaft := (Ast.BEFORE(newbef,it),newinfo,a)
  89                       | (Ast.AFTER(maft,it),_,a) ->
  90                           let it = Ast.lub_count befit it in
  91                           mbefaft :=
  92                             (Ast.BEFOREAFTER(bef,maft,it),beforeinfo,a)
  93                       | (Ast.BEFOREAFTER(mbef,maft,it),mbeforeinfo,a) ->
  94                           let (newbef,newinfo) =
  95                             concat bef beforeinfo mbef mbeforeinfo in
  96                           let it = Ast.lub_count befit it in
  97                           mbefaft :=
  98                             (Ast.BEFOREAFTER(newbef,maft,it),newinfo,a)
  99                       | (Ast.NOTHING,_,a) ->
 100                           mbefaft :=
 101                             (Ast.BEFORE(bef,befit),beforeinfo,a))
 102                   |     _ -> failwith "unexpected annotation")
 103                 mcl
 104           | _ ->
 105               Printf.printf "before %s\n" (Dumper.dump bef);
 106               failwith
 107                 "context tree should not have bad code before" in
 108         let attach_aft aft afterinfo aftit = function
 109             (true,mcl) ->
 110               List.iter
 111                 (function
 112                     Ast0.MINUS(mreplacements) ->
 113                       let (mrepl,tokeninfo) = !mreplacements in
 114                       mreplacements := concat mrepl tokeninfo aft afterinfo
 115                   | Ast0.CONTEXT(mbefaft) ->
 116                       (match !mbefaft with
 117                         (Ast.BEFORE(mbef,it),b,_) ->
 118                           let it = Ast.lub_count aftit it in
 119                           mbefaft :=
 120                             (Ast.BEFOREAFTER(mbef,aft,it),b,afterinfo)
 121                       | (Ast.AFTER(maft,it),b,mafterinfo) ->
 122                           let (newaft,newinfo) =
 123                             concat maft mafterinfo aft afterinfo in
 124                           let it = Ast.lub_count aftit it in
 125                           mbefaft := (Ast.AFTER(newaft,it),b,newinfo)
 126                       | (Ast.BEFOREAFTER(mbef,maft,it),b,mafterinfo) ->
 127                           let (newaft,newinfo) =
 128                             concat maft mafterinfo aft afterinfo in
 129                           let it = Ast.lub_count aftit it in
 130                           mbefaft :=
 131                             (Ast.BEFOREAFTER(mbef,newaft,it),b,newinfo)
 132                       | (Ast.NOTHING,b,_) ->
 133                           mbefaft := (Ast.AFTER(aft,aftit),b,afterinfo))
 134                   |     _ -> failwith "unexpected annotation")
 135                 mcl
 136           | _ ->
 137               failwith
 138                 "context tree should not have bad code after" in
 139         (match !befaft with
 140           (Ast.BEFORE(bef,it),beforeinfo,_) ->
 141             attach_bef bef beforeinfo it
 142               (einfo.Ast0.attachable_start,einfo.Ast0.mcode_start)
 143         | (Ast.AFTER(aft,it),_,afterinfo) ->
 144             attach_aft aft afterinfo it
 145               (einfo.Ast0.attachable_end,einfo.Ast0.mcode_end)
 146         | (Ast.BEFOREAFTER(bef,aft,it),beforeinfo,afterinfo) ->
 147             attach_bef bef beforeinfo it
 148               (einfo.Ast0.attachable_start,einfo.Ast0.mcode_start);
 149             attach_aft aft afterinfo it
 150               (einfo.Ast0.attachable_end,einfo.Ast0.mcode_end)
 151         | (Ast.NOTHING,_,_) -> ())
 152     | Ast0.PLUS _ -> () in
 153   V0.flat_combiner bind option_default
 154     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 155     mcode mcode
 156     do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
 157     do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
 158     do_nothing do_nothing do_nothing
 159
 160 (* --------------------------------------------------------------------- *)
 161 (* For function declarations.  Can't use the mcode at the root, because that
 162 might be mixed when the function contains ()s, where agglomeration of -s is
 163 not possible. *)
 164
 165 let check_allminus =
 166   let donothing r k e = k e in
 167   let bind x y = x && y in
 168   let option_default = true in
 169   let mcode (_,_,_,mc,_,_) =
 170     match mc with
 171       Ast0.MINUS(r) -> let (plusses,_) = !r in plusses = []
 172     | _ -> false in
 173
 174   (* special case for disj *)
 175   let expression r k e =
 176     match Ast0.unwrap e with
 177       Ast0.DisjExpr(starter,expr_list,mids,ender) ->
 178         List.for_all r.VT0.combiner_rec_expression expr_list
 179     | _ -> k e in
 180
 181   let declaration r k e =
 182     match Ast0.unwrap e with
 183       Ast0.DisjDecl(starter,decls,mids,ender) ->
 184         List.for_all r.VT0.combiner_rec_declaration decls
 185     | _ -> k e in
 186
 187   let typeC r k e =
 188     match Ast0.unwrap e with
 189       Ast0.DisjType(starter,decls,mids,ender) ->
 190         List.for_all r.VT0.combiner_rec_typeC decls
 191     | _ -> k e in
 192
 193   let statement r k e =
 194     match Ast0.unwrap e with
 195       Ast0.Disj(starter,statement_dots_list,mids,ender) ->
 196         List.for_all r.VT0.combiner_rec_statement_dots statement_dots_list
 197     | _ -> k e in
 198
 199   let case_line r k e =
 200     match Ast0.unwrap e with
 201       Ast0.DisjCase(starter,case_lines,mids,ender) ->
 202         List.for_all r.VT0.combiner_rec_case_line case_lines
 203     | _ -> k e in
 204
 205   V0.flat_combiner bind option_default
 206     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 207     mcode mcode
 208     donothing donothing donothing donothing donothing donothing
 209     donothing expression typeC donothing donothing declaration
 210     statement case_line donothing
 211
 212 (* --------------------------------------------------------------------- *)
 213 (* --------------------------------------------------------------------- *)
 214
 215 let get_option fn = function
 216     None -> None
 217   | Some x -> Some (fn x)
 218
 219 (* --------------------------------------------------------------------- *)
 220 (* --------------------------------------------------------------------- *)
 221 (* Mcode *)
 222
 223 let convert_info info =
 224   let strings_to_s l =
 225     List.map
 226       (function (s,info) -> (s,info.Ast0.line_start,info.Ast0.column))
 227       l in
 228   { Ast.line = info.Ast0.pos_info.Ast0.line_start;
 229     Ast.column = info.Ast0.pos_info.Ast0.column;
 230     Ast.strbef = strings_to_s info.Ast0.strings_before;
 231     Ast.straft = strings_to_s info.Ast0.strings_after;}
 232
 233 let convert_mcodekind adj = function
 234     Ast0.MINUS(replacements) ->
 235       let (replacements,_) = !replacements in
 236       Ast.MINUS(Ast.NoPos,[],adj,replacements)
 237   | Ast0.PLUS count -> Ast.PLUS count
 238   | Ast0.CONTEXT(befaft) ->
 239       let (befaft,_,_) = !befaft in Ast.CONTEXT(Ast.NoPos,befaft)
 240   | Ast0.MIXED(_) -> failwith "not possible for mcode"
 241
 242 let pos_mcode(term,_,info,mcodekind,pos,adj) =
 243   (* avoids a recursion problem *)
 244   (term,convert_info info,convert_mcodekind adj mcodekind,Ast.NoMetaPos)
 245
 246 let mcode (term,_,info,mcodekind,pos,adj) =
 247   let pos =
 248     match !pos with
 249       Ast0.MetaPos(pos,constraints,per) ->
 250         Ast.MetaPos(pos_mcode pos,constraints,per,unitary,false)
 251     | _ -> Ast.NoMetaPos in
 252   (term,convert_info info,convert_mcodekind adj mcodekind,pos)
 253
 254 (* --------------------------------------------------------------------- *)
 255 (* Dots *)
 256 let wrap ast line isos =
 257   {(Ast.make_term ast) with Ast.node_line = line;
 258     Ast.iso_info = isos}
 259
 260 let rewrap ast0 isos ast =
 261   wrap ast ((Ast0.get_info ast0).Ast0.pos_info.Ast0.line_start) isos
 262
 263 let no_isos = []
 264
 265 (* no isos on tokens *)
 266 let tokenwrap (_,info,_,_) s ast = wrap ast info.Ast.line no_isos
 267 let iso_tokenwrap (_,info,_,_) s ast iso = wrap ast info.Ast.line iso
 268
 269 let dots fn d =
 270   rewrap d no_isos
 271     (match Ast0.unwrap d with
 272       Ast0.DOTS(x) -> Ast.DOTS(List.map fn x)
 273     | Ast0.CIRCLES(x) -> Ast.CIRCLES(List.map fn x)
 274     | Ast0.STARS(x) -> Ast.STARS(List.map fn x))
 275
 276 (* --------------------------------------------------------------------- *)
 277 (* Identifier *)
 278
 279 let rec do_isos l = List.map (function (nm,x) -> (nm,anything x)) l
 280
 281 and ident i =
 282   rewrap i (do_isos (Ast0.get_iso i))
 283     (match Ast0.unwrap i with
 284          Ast0.Id(name) -> Ast.Id(mcode name)
 285        | Ast0.MetaId(name,constraints,_) ->
 286              Ast.MetaId(mcode name,constraints,unitary,false)
 287        | Ast0.MetaFunc(name,constraints,_) ->
 288              Ast.MetaFunc(mcode name,constraints,unitary,false)
 289        | Ast0.MetaLocalFunc(name,constraints,_) ->
 290              Ast.MetaLocalFunc(mcode name,constraints,unitary,false)
 291        | Ast0.OptIdent(id) -> Ast.OptIdent(ident id)
 292        | Ast0.UniqueIdent(id) -> Ast.UniqueIdent(ident id))
 293
 294 (* --------------------------------------------------------------------- *)
 295 (* Expression *)
 296
 297 and expression e =
 298   let e1 =
 299   rewrap e (do_isos (Ast0.get_iso e))
 300     (match Ast0.unwrap e with
 301       Ast0.Ident(id) -> Ast.Ident(ident id)
 302     | Ast0.Constant(const) ->
 303         Ast.Constant(mcode const)
 304     | Ast0.FunCall(fn,lp,args,rp) ->
 305         let fn = expression fn in
 306         let lp = mcode lp in
 307         let args = dots expression args in
 308         let rp = mcode rp in
 309         Ast.FunCall(fn,lp,args,rp)
 310     | Ast0.Assignment(left,op,right,simple) ->
 311         Ast.Assignment(expression left,mcode op,expression right,simple)
 312     | Ast0.CondExpr(exp1,why,exp2,colon,exp3) ->
 313         let exp1 = expression exp1 in
 314         let why = mcode why in
 315         let exp2 = get_option expression exp2 in
 316         let colon = mcode colon in
 317         let exp3 = expression exp3 in
 318         Ast.CondExpr(exp1,why,exp2,colon,exp3)
 319     | Ast0.Postfix(exp,op) ->
 320         Ast.Postfix(expression exp,mcode op)
 321     | Ast0.Infix(exp,op) ->
 322         Ast.Infix(expression exp,mcode op)
 323     | Ast0.Unary(exp,op) ->
 324         Ast.Unary(expression exp,mcode op)
 325     | Ast0.Binary(left,op,right) ->
 326         Ast.Binary(expression left,mcode op,expression right)
 327     | Ast0.Nested(left,op,right) ->
 328         Ast.Nested(expression left,mcode op,expression right)
 329     | Ast0.Paren(lp,exp,rp) ->
 330         Ast.Paren(mcode lp,expression exp,mcode rp)
 331     | Ast0.ArrayAccess(exp1,lb,exp2,rb) ->
 332         Ast.ArrayAccess(expression exp1,mcode lb,expression exp2,mcode rb)
 333     | Ast0.RecordAccess(exp,pt,field) ->
 334         Ast.RecordAccess(expression exp,mcode pt,ident field)
 335     | Ast0.RecordPtAccess(exp,ar,field) ->
 336         Ast.RecordPtAccess(expression exp,mcode ar,ident field)
 337     | Ast0.Cast(lp,ty,rp,exp) ->
 338         Ast.Cast(mcode lp,typeC ty,mcode rp,expression exp)
 339     | Ast0.SizeOfExpr(szf,exp) ->
 340         Ast.SizeOfExpr(mcode szf,expression exp)
 341     | Ast0.SizeOfType(szf,lp,ty,rp) ->
 342         Ast.SizeOfType(mcode szf, mcode lp,typeC ty,mcode rp)
 343     | Ast0.TypeExp(ty) -> Ast.TypeExp(typeC ty)
 344     | Ast0.MetaErr(name,cstrts,_)  ->
 345           Ast.MetaErr(mcode name,constraints cstrts,unitary,false)
 346     | Ast0.MetaExpr(name,cstrts,ty,form,_)  ->
 347           Ast.MetaExpr(mcode name,constraints cstrts,unitary,ty,form,false)
 348     | Ast0.MetaExprList(name,Some lenname,_) ->
 349         Ast.MetaExprList(mcode name,Some (mcode lenname,unitary,false),
 350                          unitary,false)
 351     | Ast0.MetaExprList(name,None,_) ->
 352         Ast.MetaExprList(mcode name,None,unitary,false)
 353     | Ast0.EComma(cm)         -> Ast.EComma(mcode cm)
 354     | Ast0.DisjExpr(_,exps,_,_)     ->
 355         Ast.DisjExpr(List.map expression exps)
 356     | Ast0.NestExpr(_,exp_dots,_,whencode,multi) ->
 357         let whencode = get_option expression whencode in
 358         Ast.NestExpr(dots expression exp_dots,whencode,multi)
 359     | Ast0.Edots(dots,whencode) ->
 360         let dots = mcode dots in
 361         let whencode = get_option expression whencode in
 362         Ast.Edots(dots,whencode)
 363     | Ast0.Ecircles(dots,whencode) ->
 364         let dots = mcode dots in
 365         let whencode = get_option expression whencode in
 366         Ast.Ecircles(dots,whencode)
 367     | Ast0.Estars(dots,whencode) ->
 368         let dots = mcode dots in
 369         let whencode = get_option expression whencode in
 370         Ast.Estars(dots,whencode)
 371     | Ast0.OptExp(exp) -> Ast.OptExp(expression exp)
 372     | Ast0.UniqueExp(exp) -> Ast.UniqueExp(expression exp)) in
 373   if Ast0.get_test_exp e then Ast.set_test_exp e1 else e1
 374
 375 and expression_dots ed = dots expression ed
 376
 377 and constraints c =
 378   match c with
 379       Ast0.NoConstraint        -> Ast.NoConstraint
 380     | Ast0.NotIdCstrt   idctrt -> Ast.NotIdCstrt idctrt
 381     | Ast0.NotExpCstrt  exps   -> Ast.NotExpCstrt (List.map expression exps)
 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.VT0.combiner_rec_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.VT0.combiner_rec_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 (-1) bef,
 595                                  check_allminus.VT0.combiner_rec_statement s,
 596                                  declaration decl)))
 597       | Ast0.Seq(lbrace,body,rbrace) ->
 598           let lbrace = mcode lbrace in
 599           let body = dots (statement 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                   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 (-1) 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 (-1) 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 (-1) 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 (-1) 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 (-1) aft))
 657       | Ast0.Switch(switch,lp,exp,rp,lb,decls,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 decls = dots (statement seqible) decls in
 664           let cases = List.map case_line (Ast0.undots cases) in
 665           let rb = mcode rb in
 666           Ast.Switch(rewrap_rule_elem s (Ast.SwitchHeader(switch,lp,exp,rp)),
 667                      tokenwrap lb s (Ast.SeqStart(lb)),
 668                      decls,cases,
 669                      tokenwrap rb s (Ast.SeqEnd(rb)))
 670       | Ast0.Break(br,sem) ->
 671           Ast.Atomic(rewrap_rule_elem s (Ast.Break(mcode br,mcode sem)))
 672       | Ast0.Continue(cont,sem) ->
 673           Ast.Atomic(rewrap_rule_elem s (Ast.Continue(mcode cont,mcode sem)))
 674       | Ast0.Label(l,dd) ->
 675           Ast.Atomic(rewrap_rule_elem s (Ast.Label(ident l,mcode dd)))
 676       | Ast0.Goto(goto,l,sem) ->
 677           Ast.Atomic
 678             (rewrap_rule_elem s (Ast.Goto(mcode goto,ident l,mcode sem)))
 679       | Ast0.Return(ret,sem) ->
 680           Ast.Atomic(rewrap_rule_elem s (Ast.Return(mcode ret,mcode sem)))
 681       | Ast0.ReturnExpr(ret,exp,sem) ->
 682           Ast.Atomic
 683             (rewrap_rule_elem s
 684                (Ast.ReturnExpr(mcode ret,expression exp,mcode sem)))
 685       | Ast0.MetaStmt(name,_) ->
 686           Ast.Atomic(rewrap_rule_elem s
 687                        (Ast.MetaStmt(mcode name,unitary,seqible,false)))
 688       | Ast0.MetaStmtList(name,_) ->
 689           Ast.Atomic(rewrap_rule_elem s
 690                        (Ast.MetaStmtList(mcode name,unitary,false)))
 691       | Ast0.TopExp(exp) ->
 692           Ast.Atomic(rewrap_rule_elem s (Ast.TopExp(expression exp)))
 693       | Ast0.Exp(exp) ->
 694           Ast.Atomic(rewrap_rule_elem s (Ast.Exp(expression exp)))
 695       | Ast0.TopInit(init) ->
 696           Ast.Atomic(rewrap_rule_elem s (Ast.TopInit(initialiser init)))
 697       | Ast0.Ty(ty) ->
 698           Ast.Atomic(rewrap_rule_elem s (Ast.Ty(typeC ty)))
 699       | Ast0.Disj(_,rule_elem_dots_list,_,_) ->
 700           Ast.Disj(List.map (function x -> statement_dots seqible x)
 701                      rule_elem_dots_list)
 702       | Ast0.Nest(_,rule_elem_dots,_,whn,multi) ->
 703           Ast.Nest
 704             (statement_dots Ast.Sequencible rule_elem_dots,
 705              List.map
 706                (whencode (statement_dots Ast.Sequencible)
 707                  (statement Ast.NotSequencible))
 708                whn,
 709              multi,[],[])
 710       | Ast0.Dots(d,whn) ->
 711           let d = mcode d in
 712           let whn =
 713             List.map
 714               (whencode (statement_dots Ast.Sequencible)
 715                  (statement Ast.NotSequencible))
 716               whn in
 717           Ast.Dots(d,whn,[],[])
 718       | Ast0.Circles(d,whn) ->
 719           let d = mcode d in
 720           let whn =
 721             List.map
 722               (whencode (statement_dots Ast.Sequencible)
 723                  (statement Ast.NotSequencible))
 724               whn in
 725           Ast.Circles(d,whn,[],[])
 726       | Ast0.Stars(d,whn) ->
 727           let d = mcode d in
 728           let whn =
 729             List.map
 730               (whencode (statement_dots Ast.Sequencible)
 731                  (statement Ast.NotSequencible))
 732               whn in
 733           Ast.Stars(d,whn,[],[])
 734       | Ast0.FunDecl((_,bef),fi,name,lp,params,rp,lbrace,body,rbrace) ->
 735           let fi = List.map fninfo fi in
 736           let name = ident name in
 737           let lp = mcode lp in
 738           let params = parameter_list params in
 739           let rp = mcode rp in
 740           let lbrace = mcode lbrace in
 741           let body = dots (statement seqible) body in
 742           let rbrace = mcode rbrace in
 743           let allminus = check_allminus.VT0.combiner_rec_statement s in
 744           Ast.FunDecl(rewrap_rule_elem s
 745                         (Ast.FunHeader(convert_mcodekind (-1) bef,
 746                                        allminus,fi,name,lp,params,rp)),
 747                       tokenwrap lbrace s (Ast.SeqStart(lbrace)),
 748                       body,
 749                       tokenwrap rbrace s (Ast.SeqEnd(rbrace)))
 750       | Ast0.Include(inc,str) ->
 751           Ast.Atomic(rewrap_rule_elem s (Ast.Include(mcode inc,mcode str)))
 752       | Ast0.Define(def,id,params,body) ->
 753           Ast.Define
 754             (rewrap_rule_elem s
 755                (Ast.DefineHeader
 756                   (mcode def,ident id, define_parameters params)),
 757              statement_dots Ast.NotSequencible (*not sure*) body)
 758       | Ast0.OptStm(stm) -> Ast.OptStm(statement seqible stm)
 759       | Ast0.UniqueStm(stm) -> Ast.UniqueStm(statement seqible stm))
 760
 761   and define_parameters p =
 762     rewrap p no_isos
 763       (match Ast0.unwrap p with
 764         Ast0.NoParams -> Ast.NoParams
 765       | Ast0.DParams(lp,params,rp) ->
 766           Ast.DParams(mcode lp,
 767                       dots define_param params,
 768                       mcode rp))
 769
 770   and define_param p =
 771     rewrap p no_isos
 772       (match Ast0.unwrap p with
 773         Ast0.DParam(id) -> Ast.DParam(ident id)
 774       | Ast0.DPComma(comma) -> Ast.DPComma(mcode comma)
 775       | Ast0.DPdots(d) -> Ast.DPdots(mcode d)
 776       | Ast0.DPcircles(c) -> Ast.DPcircles(mcode c)
 777       | Ast0.OptDParam(dp) -> Ast.OptDParam(define_param dp)
 778       | Ast0.UniqueDParam(dp) -> Ast.UniqueDParam(define_param dp))
 779
 780   and whencode notfn alwaysfn = function
 781       Ast0.WhenNot a -> Ast.WhenNot (notfn a)
 782     | Ast0.WhenAlways a -> Ast.WhenAlways (alwaysfn a)
 783     | Ast0.WhenModifier(x) -> Ast.WhenModifier(x)
 784     | x ->
 785         let rewrap_rule_elem ast0 ast =
 786           rewrap ast0 (do_isos (Ast0.get_iso ast0)) ast in
 787         match x with
 788           Ast0.WhenNotTrue(e) ->
 789             Ast.WhenNotTrue(rewrap_rule_elem e (Ast.Exp(expression e)))
 790         | Ast0.WhenNotFalse(e) ->
 791             Ast.WhenNotFalse(rewrap_rule_elem e (Ast.Exp(expression e)))
 792         | _ -> failwith "not possible"
 793
 794   and process_list seqible isos = function
 795       [] -> []
 796     | x::rest ->
 797         let first = statement seqible x in
 798         let first =
 799           if !Flag.track_iso_usage
 800           then Ast.set_isos first (isos@(Ast.get_isos first))
 801           else first in
 802         (match Ast0.unwrap x with
 803           Ast0.Dots(_,_) | Ast0.Nest(_) ->
 804             first::(process_list (Ast.SequencibleAfterDots []) no_isos rest)
 805         | _ ->
 806             first::(process_list Ast.Sequencible no_isos rest))
 807
 808   and statement_dots seqible d =
 809     let isos = do_isos (Ast0.get_iso d) in
 810     rewrap d no_isos
 811       (match Ast0.unwrap d with
 812         Ast0.DOTS(x) -> Ast.DOTS(process_list seqible isos x)
 813       | Ast0.CIRCLES(x) -> Ast.CIRCLES(process_list seqible isos x)
 814       | Ast0.STARS(x) -> Ast.STARS(process_list seqible isos x))
 815
 816   (* the following is no longer used.
 817    the goal was to let one put a statement at the very beginning of a function
 818    pattern and have it skip over the declarations in the C code.
 819    that feature was removed a long time ago, however, in favor of
 820    ... when != S, which also causes whatever comes after it to match the
 821    first real statement.
 822    the separation of declarations from the rest of the body means that the
 823    quantifier of any variable shared between them comes out too high, posing
 824    problems when there is ... decl ... stmt, as the quantifier of any shared
 825    variable will be around the whole thing, making variables not free enough
 826    in the first ..., and thus not implementing the expected shortest path
 827    condition.  example: f() { ... int A; ... foo(A); }.
 828    the quantifier for A should start just before int A, not at the top of the
 829    function.
 830   and separate_decls seqible d =
 831     let rec collect_decls = function
 832         [] -> ([],[])
 833       | (x::xs) as l ->
 834           (match Ast0.unwrap x with
 835             Ast0.Decl(_) ->
 836               let (decls,other) = collect_decls xs in
 837               (x :: decls,other)
 838           | Ast0.Dots(_,_) | Ast0.Nest(_,_,_,_,_) ->
 839               let (decls,other) = collect_decls xs in
 840               (match decls with
 841                 [] -> ([],x::other)
 842               | _ -> (x :: decls,other))
 843           | Ast0.Disj(starter,stmt_dots_list,mids,ender) ->
 844               let disjs = List.map collect_dot_decls stmt_dots_list in
 845               let all_decls = List.for_all (function (_,s) -> s=[]) disjs in
 846               if all_decls
 847               then
 848                 let (decls,other) = collect_decls xs in
 849                 (x :: decls,other)
 850               else ([],l)
 851           | _ -> ([],l))
 852
 853     and collect_dot_decls d =
 854       match Ast0.unwrap d with
 855         Ast0.DOTS(x) -> collect_decls x
 856       | Ast0.CIRCLES(x) -> collect_decls x
 857       | Ast0.STARS(x) -> collect_decls x in
 858
 859     let process l d fn =
 860       let (decls,other) = collect_decls l in
 861       (rewrap d no_isos (fn (List.map (statement seqible) decls)),
 862        rewrap d no_isos
 863          (fn (process_list seqible (do_isos (Ast0.get_iso d)) other))) in
 864     match Ast0.unwrap d with
 865       Ast0.DOTS(x) -> process x d (function x -> Ast.DOTS x)
 866     | Ast0.CIRCLES(x) -> process x d (function x -> Ast.CIRCLES x)
 867     | Ast0.STARS(x) -> process x d (function x -> Ast.STARS x) *) in
 868
 869   statement Ast.Sequencible s
 870
 871 and fninfo = function
 872     Ast0.FStorage(stg) -> Ast.FStorage(mcode stg)
 873   | Ast0.FType(ty) -> Ast.FType(typeC ty)
 874   | Ast0.FInline(inline) -> Ast.FInline(mcode inline)
 875   | Ast0.FAttr(attr) -> Ast.FAttr(mcode attr)
 876
 877 and option_to_list = function
 878     Some x -> [x]
 879   | None -> []
 880
 881 and case_line c =
 882   rewrap c no_isos
 883     (match Ast0.unwrap c with
 884       Ast0.Default(def,colon,code) ->
 885         let def = mcode def in
 886         let colon = mcode colon in
 887         let code = dots statement code in
 888         Ast.CaseLine(rewrap c no_isos (Ast.Default(def,colon)),code)
 889     | Ast0.Case(case,exp,colon,code) ->
 890         let case = mcode case in
 891         let exp = expression exp in
 892         let colon = mcode colon in
 893         let code = dots statement code in
 894         Ast.CaseLine(rewrap c no_isos (Ast.Case(case,exp,colon)),code)
 895     | Ast0.DisjCase(_,case_lines,_,_) ->
 896         failwith "not supported"
 897         (*Ast.CaseLine(Ast.DisjRuleElem(List.map case_line case_lines))*)
 898
 899     | Ast0.OptCase(case) -> Ast.OptCase(case_line case))
 900
 901 and statement_dots l = dots statement l
 902
 903 (* --------------------------------------------------------------------- *)
 904
 905 (* what is possible is only what is at the top level in an iso *)
 906 and anything = function
 907     Ast0.DotsExprTag(d) -> Ast.ExprDotsTag(expression_dots d)
 908   | Ast0.DotsParamTag(d) -> Ast.ParamDotsTag(parameter_list d)
 909   | Ast0.DotsInitTag(d) -> failwith "not possible"
 910   | Ast0.DotsStmtTag(d) -> Ast.StmtDotsTag(statement_dots d)
 911   | Ast0.DotsDeclTag(d) -> Ast.DeclDotsTag(declaration_dots d)
 912   | Ast0.DotsCaseTag(d) -> failwith "not possible"
 913   | Ast0.IdentTag(d) -> Ast.IdentTag(ident d)
 914   | Ast0.ExprTag(d) -> Ast.ExpressionTag(expression d)
 915   | Ast0.ArgExprTag(d) | Ast0.TestExprTag(d) ->
 916      failwith "only in isos, not converted to ast"
 917   | Ast0.TypeCTag(d) -> Ast.FullTypeTag(typeC d)
 918   | Ast0.ParamTag(d) -> Ast.ParamTag(parameterTypeDef d)
 919   | Ast0.InitTag(d) -> Ast.InitTag(initialiser d)
 920   | Ast0.DeclTag(d) -> Ast.DeclarationTag(declaration d)
 921   | Ast0.StmtTag(d) -> Ast.StatementTag(statement d)
 922   | Ast0.CaseLineTag(d) -> Ast.CaseLineTag(case_line d)
 923   | Ast0.TopTag(d) -> Ast.Code(top_level d)
 924   | Ast0.IsoWhenTag(_) -> failwith "not possible"
 925   | Ast0.IsoWhenTTag(_) -> failwith "not possible"
 926   | Ast0.IsoWhenFTag(_) -> failwith "not possible"
 927   | Ast0.MetaPosTag _ -> failwith "not possible"
 928
 929 (* --------------------------------------------------------------------- *)
 930 (* Function declaration *)
 931 (* top level isos are probably lost to tracking *)
 932
 933 and top_level t =
 934   rewrap t no_isos
 935     (match Ast0.unwrap t with
 936       Ast0.FILEINFO(old_file,new_file) ->
 937         Ast.FILEINFO(mcode old_file,mcode new_file)
 938     | Ast0.DECL(stmt) -> Ast.DECL(statement stmt)
 939     | Ast0.CODE(rule_elem_dots) ->
 940         Ast.CODE(statement_dots rule_elem_dots)
 941     | Ast0.ERRORWORDS(exps) -> Ast.ERRORWORDS(List.map expression exps)
 942     | Ast0.OTHER(_) -> failwith "eliminated by top_level")
 943
 944 (* --------------------------------------------------------------------- *)
 945 (* Entry point for minus code *)
 946
 947 (* Inline_mcodes is very important - sends + code attached to the - code
 948 down to the mcodes.  The functions above can only be used when there is no
 949 attached + code, eg in + code itself. *)
 950 let ast0toast_toplevel x =
 951   inline_mcodes.VT0.combiner_rec_top_level x;
 952   top_level x
 953
 954 let ast0toast name deps dropped exists x is_exp ruletype =
 955   List.iter inline_mcodes.VT0.combiner_rec_top_level x;
 956   Ast.CocciRule
 957     (name,(deps,dropped,exists),List.map top_level x,is_exp,ruletype)