parsing_cocci/adjust_pragmas.ml

   1 (*
   2  * Copyright 2012, INRIA
   3  * Julia Lawall, Gilles Muller
   4  * Copyright 2010-2011, INRIA, University of Copenhagen
   5  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
   6  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
   7  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
   8  * This file is part of Coccinelle.
   9  *
  10  * Coccinelle is free software: you can redistribute it and/or modify
  11  * it under the terms of the GNU General Public License as published by
  12  * the Free Software Foundation, according to version 2 of the License.
  13  *
  14  * Coccinelle is distributed in the hope that it will be useful,
  15  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  16  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17  * GNU General Public License for more details.
  18  *
  19  * You should have received a copy of the GNU General Public License
  20  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  21  *
  22  * The authors reserve the right to distribute this or future versions of
  23  * Coccinelle under other licenses.
  24  *)
  25
  26
  27 # 0 "./adjust_pragmas.ml"
  28 (*
  29  * Copyright 2012, INRIA
  30  * Julia Lawall, Gilles Muller
  31  * Copyright 2010-2011, INRIA, University of Copenhagen
  32  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
  33  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
  34  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
  35  * This file is part of Coccinelle.
  36  *
  37  * Coccinelle is free software: you can redistribute it and/or modify
  38  * it under the terms of the GNU General Public License as published by
  39  * the Free Software Foundation, according to version 2 of the License.
  40  *
  41  * Coccinelle is distributed in the hope that it will be useful,
  42  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  43  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  44  * GNU General Public License for more details.
  45  *
  46  * You should have received a copy of the GNU General Public License
  47  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  48  *
  49  * The authors reserve the right to distribute this or future versions of
  50  * Coccinelle under other licenses.
  51  *)
  52
  53
  54 # 0 "./adjust_pragmas.ml"
  55 (* Find a directive or comment at the end of a statement.  Things with aft
  56 given None, because they can accomodate their own directives or comments *)
  57
  58 module Ast0 = Ast0_cocci
  59 module Ast = Ast_cocci
  60 module V0 = Visitor_ast0
  61 module VT0 = Visitor_ast0_types
  62
  63 let call_right processor data s cont =
  64   match processor data with
  65     None -> None
  66   | Some(pragmas,data) -> Some (pragmas,Ast0.rewrap s (cont data))
  67
  68 let left_mcode (a,b,info,mcodekind,d,e) =
  69   match (info.Ast0.strings_before,mcodekind) with
  70     ([],_) | (_,Ast0.PLUS _) -> None
  71   | (l,_) -> Some(l,(a,b,{info with Ast0.strings_before = []},mcodekind,d,e))
  72
  73 let right_mcode (a,b,info,mcodekind,d,e) =
  74   match (info.Ast0.strings_after,mcodekind) with
  75     ([],_) | (_,Ast0.PLUS _) -> None
  76   | (l,_) -> Some(l,(a,b,{info with Ast0.strings_after = []},mcodekind,d,e))
  77
  78 let update_before pragmas (info,x) =
  79   ({info with Ast0.strings_before = pragmas @ info.Ast0.strings_before},
  80    Ast0.PLUS Ast.ONE) (* not sure what the arg should be... one seems safe *)
  81
  82 let update_after pragmas (info,x) =
  83   ({info with Ast0.strings_after = info.Ast0.strings_after @ pragmas},
  84    Ast0.PLUS Ast.ONE) (* not sure what the arg should be... one seems safe *)
  85
  86 let rec right_decl d =
  87   match Ast0.unwrap d with
  88     Ast0.MetaDecl(name,pure) ->
  89       call_right right_mcode name d
  90         (function name -> Ast0.MetaDecl(name,pure))
  91   | Ast0.MetaField(name,pure) ->
  92       call_right right_mcode name d
  93         (function name -> Ast0.MetaField(name,pure))
  94   | Ast0.MetaFieldList(name,lenname,pure) ->
  95       call_right right_mcode name d
  96         (function name -> Ast0.MetaFieldList(name,lenname,pure))
  97   | Ast0.AsDecl(decl,asdecl) -> failwith "not possible"
  98   | Ast0.Init(Some stg,ty,id,eq,ini,sem) ->
  99       call_right right_mcode sem d
 100         (function sem -> Ast0.Init(Some stg,ty,id,eq,ini,sem))
 101   | Ast0.Init(None,ty,id,eq,ini,sem) ->
 102       call_right right_mcode sem d
 103         (function sem -> Ast0.Init(None,ty,id,eq,ini,sem))
 104   | Ast0.UnInit(Some stg,ty,id,sem) ->
 105       call_right right_mcode sem d
 106         (function sem -> Ast0.UnInit(Some stg,ty,id,sem))
 107   | Ast0.UnInit(None,ty,id,sem) ->
 108       call_right right_mcode sem d
 109         (function sem -> Ast0.UnInit(None,ty,id,sem))
 110   | Ast0.MacroDecl(name,lp,args,rp,sem) ->
 111       call_right right_mcode sem d
 112         (function sem -> Ast0.MacroDecl(name,lp,args,rp,sem))
 113   | Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem) ->
 114       call_right right_mcode sem d
 115         (function sem -> Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem))
 116   | Ast0.TyDecl(ty,sem) ->
 117       call_right right_mcode sem d
 118         (function sem -> Ast0.TyDecl(ty,sem))
 119   | Ast0.Typedef(stg,ty,id,sem) ->
 120       call_right right_mcode sem d
 121         (function sem -> Ast0.Typedef(stg,ty,id,sem))
 122   | Ast0.DisjDecl(starter,decls,mids,ender) -> None
 123   | Ast0.Ddots(dots,whencode) -> None
 124   | Ast0.OptDecl(decl) ->
 125       call_right right_decl decl d (function decl -> Ast0.OptDecl(decl))
 126   | Ast0.UniqueDecl(decl) ->
 127       call_right right_decl decl d (function decl -> Ast0.UniqueDecl(decl))
 128
 129 let rec right_statement s =
 130   match Ast0.unwrap s with
 131     Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace) -> None
 132   | Ast0.Decl(bef,decl) ->
 133       call_right right_decl decl s
 134         (function decl -> Ast0.Decl(bef,decl))
 135   | Ast0.Seq(lbrace,body,rbrace) ->
 136       call_right right_mcode rbrace s
 137         (function rbrace -> Ast0.Seq(lbrace,body,rbrace))
 138   | Ast0.ExprStatement(exp,sem) ->
 139       call_right right_mcode sem s
 140         (function sem -> Ast0.ExprStatement(exp,sem))
 141   | Ast0.IfThen(iff,lp,exp,rp,branch1,aft) -> None
 142   | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft) -> None
 143   | Ast0.While(whl,lp,exp,rp,body,aft) -> None
 144   | Ast0.Do(d,body,whl,lp,exp,rp,sem) ->
 145       call_right right_mcode sem s
 146         (function sem -> Ast0.Do(d,body,whl,lp,exp,rp,sem))
 147   | Ast0.For(fr,lp,e1,sem1,e2,sem2,e3,rp,body,aft) -> None
 148   | Ast0.Iterator(nm,lp,args,rp,body,aft) -> None
 149   | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) ->
 150       call_right right_mcode rb s
 151         (function rb -> Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb))
 152   | Ast0.Break(br,sem) ->
 153       call_right right_mcode sem s
 154         (function sem -> Ast0.Break(br,sem))
 155   | Ast0.Continue(cont,sem) ->
 156       call_right right_mcode sem s
 157         (function sem -> Ast0.Continue(cont,sem))
 158   | Ast0.Label(l,dd) ->
 159       call_right right_mcode dd s
 160         (function dd -> Ast0.Label(l,dd))
 161   | Ast0.Goto(goto,l,sem) ->
 162       call_right right_mcode sem s
 163         (function sem -> Ast0.Goto(goto,l,sem))
 164   | Ast0.Return(ret,sem) ->
 165       call_right right_mcode sem s
 166         (function sem -> Ast0.Return(ret,sem))
 167   | Ast0.ReturnExpr(ret,exp,sem) ->
 168       call_right right_mcode sem s
 169         (function sem -> Ast0.ReturnExpr(ret,exp,sem))
 170   | Ast0.MetaStmt(name,pure) ->
 171       call_right right_mcode name s
 172         (function name -> Ast0.MetaStmt(name,pure))
 173   | Ast0.MetaStmtList(name,pure) ->
 174       call_right right_mcode name s
 175         (function name -> Ast0.MetaStmtList(name,pure))
 176   | Ast0.AsStmt(stm,asstm) -> failwith "not possible"
 177   | Ast0.Disj(starter,statement_dots_list,mids,ender) -> None
 178   | Ast0.Nest(starter,stmt_dots,ender,whn,multi) -> None
 179   (* the following are None, because they can't be adjacent to an aft node *)
 180   | Ast0.Exp(exp) -> None
 181   | Ast0.TopExp(exp) -> None
 182   | Ast0.Ty(ty) -> None
 183   | Ast0.TopInit(init) -> None
 184   | Ast0.Dots(d,whn) -> None
 185   | Ast0.Circles(d,whn) -> None
 186   | Ast0.Stars(d,whn) -> None
 187   | Ast0.Include(inc,name) ->
 188       call_right right_mcode name s
 189         (function name -> Ast0.Include(inc,name))
 190   | Ast0.Undef(def,id) ->
 191       (* nothing available for ident, and not sure code can appear
 192          here anyway *)
 193       None
 194   | Ast0.Define(def,id,params,body) ->
 195       call_right right_statement_dots body s
 196         (function body -> Ast0.Define(def,id,params,body))
 197   | Ast0.OptStm(re) ->
 198       call_right right_statement re s (function re -> Ast0.OptStm(re))
 199   | Ast0.UniqueStm(re) ->
 200       call_right right_statement re s (function re -> Ast0.UniqueStm(re))
 201
 202 and right_statement_dots sd =
 203   match Ast0.unwrap sd with
 204     Ast0.DOTS([]) -> failwith "empty statement dots"
 205   | Ast0.DOTS(s::r) ->
 206       call_right right_statement s sd
 207         (function s -> Ast0.DOTS(List.rev(s::r)))
 208   | _ -> failwith "circles and stars not supported"
 209
 210 let rec left_ty t =
 211   match Ast0.unwrap t with
 212     Ast0.ConstVol(cv,ty) ->
 213       call_right left_mcode cv t (function cv -> Ast0.ConstVol(cv,ty))
 214   | Ast0.BaseType(ty,strings) ->
 215       (match strings with
 216         [] -> failwith "empty strings in type"
 217       | s::r ->
 218           call_right left_mcode s t (function s -> Ast0.BaseType(ty,s::r)))
 219   | Ast0.Signed(sign,ty) ->
 220       call_right left_mcode sign t (function sign -> Ast0.Signed(sign,ty))
 221   | Ast0.Pointer(ty,star) ->
 222       call_right left_ty ty t (function ty -> Ast0.Pointer(ty,star))
 223   | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
 224       call_right left_ty ty t
 225         (function ty -> Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2))
 226   | Ast0.FunctionType(Some ty,lp1,params,rp1) ->
 227       call_right left_ty ty t
 228         (function ty -> Ast0.FunctionType(Some ty,lp1,params,rp1))
 229   | Ast0.FunctionType(None,lp1,params,rp1) ->
 230       call_right left_mcode lp1 t
 231         (function lp1 -> Ast0.FunctionType(None,lp1,params,rp1))
 232   | Ast0.Array(ty,lb,size,rb) ->
 233       call_right left_ty ty t (function ty -> Ast0.Array(ty,lb,size,rb))
 234   | Ast0.EnumName(kind,name) ->
 235       call_right left_mcode kind t (function kind -> Ast0.EnumName(kind,name))
 236   | Ast0.EnumDef(ty,lb,ids,rb) ->
 237       call_right left_ty ty t
 238         (function ty -> Ast0.EnumDef(ty,lb,ids,rb))
 239   | Ast0.StructUnionName(kind,name) ->
 240       call_right left_mcode kind t
 241         (function kind -> Ast0.StructUnionName(kind,name))
 242   | Ast0.StructUnionDef(ty,lb,decls,rb) ->
 243       call_right left_ty ty t
 244         (function ty -> Ast0.StructUnionDef(ty,lb,decls,rb))
 245   | Ast0.TypeName(name) ->
 246       call_right left_mcode name t (function name -> Ast0.TypeName(name))
 247   | Ast0.MetaType(name,x) ->
 248       call_right left_mcode name t (function name -> Ast0.MetaType(name,x))
 249   | Ast0.AsType(ty,asty) -> failwith "not possible"
 250   | Ast0.DisjType(starter,types,mids,ender) -> None
 251   | Ast0.OptType(ty) ->
 252       call_right left_ty ty t (function ty -> Ast0.OptType(ty))
 253   | Ast0.UniqueType(ty) ->
 254       call_right left_ty ty t (function ty -> Ast0.UniqueType(ty))
 255
 256 let rec left_ident i =
 257   match Ast0.unwrap i with
 258     Ast0.Id(name) ->
 259       call_right left_mcode name i (function name -> Ast0.Id(name))
 260   | Ast0.MetaId(name,a,b,c) ->
 261       call_right left_mcode name i (function name -> Ast0.MetaId(name,a,b,c))
 262   | Ast0.MetaFunc(name,a,b) ->
 263       call_right left_mcode name i (function name -> Ast0.MetaFunc(name,a,b))
 264   | Ast0.MetaLocalFunc(name,a,b) ->
 265       call_right left_mcode name i
 266         (function name -> Ast0.MetaLocalFunc(name,a,b))
 267   | Ast0.DisjId(starter,ids,mids,ender) -> None
 268   | Ast0.OptIdent(id) ->
 269       call_right left_ident id i (function id -> Ast0.OptIdent(id))
 270   | Ast0.UniqueIdent(id) ->
 271       call_right left_ident id i (function id -> Ast0.UniqueIdent(id))
 272   | Ast0.AsIdent(id,asid) -> failwith "not possible"
 273
 274 let left_fundecl name fninfo =
 275   let fncall_right processor data cont =
 276     match processor data with
 277       None -> None
 278     | Some(pragmas,data) -> Some (pragmas,cont data,name) in
 279   match fninfo with
 280     [] ->
 281       (match left_ident name with
 282         None -> None
 283       | Some(pragmas,name) -> Some(pragmas,fninfo,name))
 284   | (Ast0.FStorage sto)::x ->
 285       fncall_right left_mcode sto (function sto -> (Ast0.FStorage sto)::x)
 286   | (Ast0.FType ty)::x ->
 287       fncall_right left_ty ty (function ty -> (Ast0.FType ty)::x)
 288   | (Ast0.FInline inl)::x ->
 289       fncall_right left_mcode inl (function inl -> (Ast0.FInline inl)::x)
 290   | (Ast0.FAttr atr)::x ->
 291       fncall_right left_mcode atr (function atr -> (Ast0.FAttr atr)::x)
 292
 293 let rec left_decl decl =
 294   match Ast0.unwrap decl with
 295     Ast0.MetaDecl(name,pure) ->
 296       call_right right_mcode name decl
 297         (function name -> Ast0.MetaDecl(name,pure))
 298   | Ast0.MetaField(name,pure) ->
 299       call_right right_mcode name decl
 300         (function name -> Ast0.MetaField(name,pure))
 301   | Ast0.MetaFieldList(name,lenname,pure) ->
 302       call_right right_mcode name decl
 303         (function name -> Ast0.MetaFieldList(name,lenname,pure))
 304   | Ast0.AsDecl(decl,asdecl) -> failwith "not possible"
 305   | Ast0.Init(Some stg,ty,id,eq,ini,sem) ->
 306       call_right left_mcode stg decl
 307         (function stg -> Ast0.Init(Some stg,ty,id,eq,ini,sem))
 308   | Ast0.Init(None,ty,id,eq,ini,sem) ->
 309       call_right left_ty ty decl
 310         (function ty -> Ast0.Init(None,ty,id,eq,ini,sem))
 311   | Ast0.UnInit(Some stg,ty,id,sem) ->
 312       call_right left_mcode stg decl
 313         (function stg -> Ast0.UnInit(Some stg,ty,id,sem))
 314   | Ast0.UnInit(None,ty,id,sem) ->
 315       call_right left_ty ty decl
 316         (function ty -> Ast0.UnInit(None,ty,id,sem))
 317   | Ast0.MacroDecl(name,lp,args,rp,sem) ->
 318       call_right left_ident name decl
 319         (function name -> Ast0.MacroDecl(name,lp,args,rp,sem))
 320   | Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem) ->
 321       call_right left_ident name decl
 322         (function name -> Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem))
 323   | Ast0.TyDecl(ty,sem) ->
 324       call_right left_ty ty decl (function ty -> Ast0.TyDecl(ty,sem))
 325   | Ast0.Typedef(stg,ty,id,sem) ->
 326       call_right left_mcode stg decl
 327         (function stg -> Ast0.Typedef(stg,ty,id,sem))
 328   | Ast0.DisjDecl(starter,decls,mids,ender) -> None
 329   | Ast0.Ddots(dots,whencode) -> None
 330   | Ast0.OptDecl(d) ->
 331       call_right left_decl d decl (function decl -> Ast0.OptDecl(decl))
 332   | Ast0.UniqueDecl(d) ->
 333       call_right left_decl d decl (function decl -> Ast0.UniqueDecl(decl))
 334
 335 let process =
 336   let statement r k s =
 337     let s = k s in
 338     Ast0.rewrap s
 339       (match Ast0.unwrap s with
 340         Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace) ->
 341           (match left_fundecl name fi with
 342             None -> Ast0.unwrap s
 343           | Some (pragmas,fi,name) ->
 344               Ast0.FunDecl
 345                 (update_after pragmas bef,
 346                  fi,name,lp,params,rp,lbrace,body,rbrace))
 347       | Ast0.Decl(bef,decl) ->
 348           (match left_decl decl with
 349             None -> Ast0.unwrap s
 350           | Some (pragmas,decl) ->
 351               Ast0.Decl(update_after pragmas bef,decl))
 352       | Ast0.IfThen(iff,lp,exp,rp,branch1,aft) ->
 353           (match right_statement branch1 with
 354             None -> Ast0.unwrap s
 355           | Some (pragmas,branch1) ->
 356               Ast0.IfThen
 357                 (iff,lp,exp,rp,branch1,update_before pragmas aft))
 358       | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft) ->
 359           (match right_statement branch2 with
 360             None -> Ast0.unwrap s
 361           | Some (pragmas,branch2) ->
 362               Ast0.IfThenElse
 363                 (iff,lp,exp,rp,branch1,els,branch2,
 364                   update_before pragmas aft))
 365       | Ast0.While(whl,lp,exp,rp,body,aft) ->
 366           (match right_statement body with
 367             None -> Ast0.unwrap s
 368           | Some (pragmas,body) ->
 369               Ast0.While(whl,lp,exp,rp,body,update_before pragmas aft))
 370       | Ast0.For(fr,lp,e1,sem1,e2,sem2,e3,rp,body,aft) ->
 371           (match right_statement body with
 372             None -> Ast0.unwrap s
 373           | Some (pragmas,body) ->
 374               Ast0.For
 375                 (fr,lp,e1,sem1,e2,sem2,e3,rp,body,
 376                  update_before pragmas aft))
 377       | Ast0.Iterator(nm,lp,args,rp,body,aft) ->
 378           (match right_statement body with
 379             None -> Ast0.unwrap s
 380           | Some (pragmas,body) ->
 381               Ast0.Iterator(nm,lp,args,rp,body,update_before pragmas aft))
 382       | _ -> Ast0.unwrap s) in
 383
 384   let res = V0.rebuilder
 385       {V0.rebuilder_functions with VT0.rebuilder_stmtfn = statement} in
 386
 387   List.map res.VT0.rebuilder_rec_top_level