| 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, Nicolas Palix |
| 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 | module Ast0 = Ast0_cocci |
| 24 | module Ast = Ast_cocci |
| 25 | module V0 = Visitor_ast0 |
| 26 | module VT0 = Visitor_ast0_types |
| 27 | |
| 28 | type id = Id of string | Meta of (string * string) |
| 29 | |
| 30 | let rec get_name name = |
| 31 | match Ast0.unwrap name with |
| 32 | Ast0.Id(nm) -> Id(Ast0.unwrap_mcode nm) |
| 33 | | Ast0.MetaId(nm,_,_) | Ast0.MetaFunc(nm,_,_) |
| 34 | | Ast0.MetaLocalFunc(nm,_,_) -> Meta(Ast0.unwrap_mcode nm) |
| 35 | | Ast0.OptIdent(id) | Ast0.UniqueIdent(id) -> |
| 36 | get_name id |
| 37 | |
| 38 | (* --------------------------------------------------------------------- *) |
| 39 | (* collect all of the functions *) |
| 40 | |
| 41 | let brace_to_semi (_,arity,info,mcodekind,pos,adj) = |
| 42 | let info = |
| 43 | (* drop column information, so that with -smpl_spacing the semicolon |
| 44 | will come out right after the close parenthesis *) |
| 45 | {info with Ast0.pos_info = {info.Ast0.pos_info with Ast0.column = -1}} in |
| 46 | (";",Ast0.NONE,info,mcodekind,pos,adj) |
| 47 | |
| 48 | let collect_function (stm : Ast0.statement) = |
| 49 | match Ast0.unwrap stm with |
| 50 | Ast0.FunDecl(_,fninfo,name,lp,params,rp,lbrace,body,rbrace) -> |
| 51 | let stg = |
| 52 | match |
| 53 | List.filter (function Ast0.FStorage(_) -> true | _ -> false) |
| 54 | fninfo with [Ast0.FStorage(s)] -> Some s | _ -> None in |
| 55 | let ty = |
| 56 | match |
| 57 | List.filter (function Ast0.FType(_) -> true | _ -> false) |
| 58 | fninfo with [Ast0.FType(t)] -> Some t | _ -> None in |
| 59 | [(get_name name,stm, |
| 60 | Ast0.copywrap stm |
| 61 | (Ast0.Decl((Ast0.default_info(),Ast0.context_befaft()), |
| 62 | Ast0.copywrap stm |
| 63 | (Ast0.UnInit |
| 64 | (stg, |
| 65 | Ast0.copywrap stm |
| 66 | (Ast0.FunctionType(ty,lp,params,rp)), |
| 67 | name,brace_to_semi lbrace)))))] |
| 68 | | _ -> [] |
| 69 | |
| 70 | let collect_functions stmt_dots = |
| 71 | List.concat (List.map collect_function (Ast0.undots stmt_dots)) |
| 72 | |
| 73 | let get_all_functions rule = |
| 74 | let res = |
| 75 | match Ast0.unwrap rule with |
| 76 | Ast0.DECL(stmt) -> collect_function stmt |
| 77 | | Ast0.CODE(rule_elem_dots) -> collect_functions rule_elem_dots |
| 78 | | _ -> [] in |
| 79 | List.map |
| 80 | (function (nm,def,vl) -> |
| 81 | (nm, |
| 82 | (def,(Iso_pattern.rebuild_mcode None).VT0.rebuilder_rec_statement vl))) |
| 83 | res |
| 84 | |
| 85 | (* --------------------------------------------------------------------- *) |
| 86 | (* try to match up the functions *) |
| 87 | |
| 88 | (* pass through the - and + functions in lockstep, until one runs out. |
| 89 | Then process the remaining minuses, if any. If we can find another |
| 90 | function of the same name for either the current - or + function, take that |
| 91 | one. Otherwise, align the two current ones. *) |
| 92 | |
| 93 | let rec align all_minus all_plus = |
| 94 | let rec loop = function |
| 95 | ([],_) -> [] |
| 96 | | ((mname,(mdef,mproto))::minus,[]) -> |
| 97 | (try |
| 98 | let (_,pproto) = List.assoc mname all_plus in |
| 99 | (mname,mdef,mproto,Some pproto)::(loop (minus,[])) |
| 100 | with Not_found -> (mname,mdef,mproto,None)::(loop (minus, []))) |
| 101 | | ((mname,(mdef,mproto))::minus,(pname,(pdef,pproto))::plus) -> |
| 102 | if mname = pname |
| 103 | then (mname,mdef,mproto,Some pproto)::(loop (minus, [])) |
| 104 | else |
| 105 | (try |
| 106 | let (_,pproto_for_minus) = List.assoc mname all_plus in |
| 107 | (try |
| 108 | let _ = List.assoc mname all_plus in |
| 109 | (* protos that match both *) |
| 110 | (mname,mdef,mproto,Some pproto_for_minus)::(loop (minus, plus)) |
| 111 | with Not_found -> |
| 112 | (* proto that matches only minus *) |
| 113 | (mname,mdef,mproto,Some pproto_for_minus):: |
| 114 | (loop (minus, ((pname,(pdef,pproto))::plus)))) |
| 115 | with Not_found -> |
| 116 | (try |
| 117 | let _ = List.assoc mname all_plus in |
| 118 | (* proto only for plus *) |
| 119 | (mname,mdef,mproto,None)::(loop (minus, plus)) |
| 120 | with Not_found -> |
| 121 | (* protos for no one *) |
| 122 | (mname,mdef,mproto,Some pproto)::(loop (minus, plus)))) in |
| 123 | List.filter changed_proto (loop (all_minus, all_plus)) |
| 124 | |
| 125 | (* --------------------------------------------------------------------- *) |
| 126 | |
| 127 | and strip = |
| 128 | let donothing r k e = |
| 129 | {(Ast0.wrap (Ast0.unwrap (k e))) with |
| 130 | Ast0.mcodekind = ref (Ast0.PLUS Ast.ONE)} in |
| 131 | let mcode (mc,_,_,_,_,_) = |
| 132 | (mc,Ast0.NONE,Ast0.default_info(),Ast0.PLUS Ast.ONE, |
| 133 | ref Ast0.NoMetaPos,-1) in |
| 134 | |
| 135 | (* need a case for everything that has an unvisited component and can be in |
| 136 | a function prototype *) |
| 137 | |
| 138 | let ident r k e = |
| 139 | donothing r k |
| 140 | (Ast0.rewrap e |
| 141 | (match Ast0.unwrap e with |
| 142 | Ast0.MetaId(nm,constraints,pure) -> |
| 143 | Ast0.MetaId(nm,constraints,Ast0.Pure) |
| 144 | | Ast0.MetaFunc(nm,constraints,pure) -> |
| 145 | Ast0.MetaFunc(nm,constraints,Ast0.Pure) |
| 146 | | Ast0.MetaLocalFunc(nm,constraints,pure) -> |
| 147 | Ast0.MetaLocalFunc(nm,constraints,Ast0.Pure) |
| 148 | | e -> e)) in |
| 149 | |
| 150 | let typeC r k e = |
| 151 | donothing r k |
| 152 | (Ast0.rewrap e |
| 153 | (match Ast0.unwrap e with |
| 154 | Ast0.MetaType(nm,pure) -> Ast0.MetaType(nm,Ast0.Pure) |
| 155 | | e -> e)) in |
| 156 | |
| 157 | let param r k e = |
| 158 | donothing r k |
| 159 | (Ast0.rewrap e |
| 160 | (match Ast0.unwrap e with |
| 161 | Ast0.MetaParam(nm,pure) -> |
| 162 | Ast0.MetaParam(nm,Ast0.Pure) |
| 163 | | Ast0.MetaParamList(nm,lenname,pure) -> |
| 164 | Ast0.MetaParamList(nm,lenname,Ast0.Pure) |
| 165 | | e -> e)) in |
| 166 | |
| 167 | V0.flat_rebuilder |
| 168 | mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode |
| 169 | donothing donothing donothing donothing donothing donothing |
| 170 | ident donothing typeC donothing param donothing donothing |
| 171 | donothing donothing |
| 172 | |
| 173 | and changed_proto = function |
| 174 | (mname,mdef,mproto,None) -> true |
| 175 | | (mname,mdef,mproto,Some pproto) -> |
| 176 | not ((strip.VT0.rebuilder_rec_statement mproto) = |
| 177 | (strip.VT0.rebuilder_rec_statement pproto)) |
| 178 | |
| 179 | (* --------------------------------------------------------------------- *) |
| 180 | (* make rules *) |
| 181 | |
| 182 | let rec drop_param_name p = |
| 183 | Ast0.rewrap p |
| 184 | (match Ast0.unwrap p with |
| 185 | Ast0.Param(p,_) -> Ast0.Param(p,None) |
| 186 | | Ast0.OptParam(p) -> Ast0.OptParam(drop_param_name p) |
| 187 | | Ast0.UniqueParam(p) -> Ast0.UniqueParam(p) |
| 188 | | p -> p) |
| 189 | |
| 190 | let drop_names dec = |
| 191 | let dec = (Iso_pattern.rebuild_mcode None).VT0.rebuilder_rec_statement dec in |
| 192 | match Ast0.unwrap dec with |
| 193 | Ast0.Decl(info,uninit) -> |
| 194 | (match Ast0.unwrap uninit with |
| 195 | Ast0.UnInit(stg,typ,name,sem) -> |
| 196 | (match Ast0.unwrap typ with |
| 197 | Ast0.FunctionType(ty,lp,params,rp) -> |
| 198 | let params = |
| 199 | match Ast0.unwrap params with |
| 200 | Ast0.DOTS(l) -> |
| 201 | Ast0.rewrap params (Ast0.DOTS(List.map drop_param_name l)) |
| 202 | | Ast0.CIRCLES(l) -> |
| 203 | Ast0.rewrap params |
| 204 | (Ast0.CIRCLES(List.map drop_param_name l)) |
| 205 | | Ast0.STARS(l) -> failwith "unexpected stars" in |
| 206 | Ast0.rewrap dec |
| 207 | (Ast0.Decl |
| 208 | (info, |
| 209 | Ast0.rewrap uninit |
| 210 | (Ast0.UnInit |
| 211 | (stg, |
| 212 | Ast0.rewrap typ |
| 213 | (Ast0.FunctionType(ty,lp,params,rp)), |
| 214 | name,sem)))) |
| 215 | | _ -> failwith "function prototypes: unexpected type") |
| 216 | | _ -> failwith "unexpected declaration") |
| 217 | | _ -> failwith "unexpected term" |
| 218 | |
| 219 | let ct = ref 0 |
| 220 | |
| 221 | let new_name name = |
| 222 | let n = !ct in |
| 223 | ct := !ct + 1; |
| 224 | name^"__"^(string_of_int n) |
| 225 | |
| 226 | let rec rename_param old_name all param = |
| 227 | match Ast0.unwrap param with |
| 228 | Ast0.Param(ty,Some id) when all -> |
| 229 | (match Ast0.unwrap id with |
| 230 | Ast0.MetaId |
| 231 | (((_,name),arity,info,mcodekind,pos,adj),constraints,pure) -> |
| 232 | let nm = ("__no_name__",new_name name) in |
| 233 | let new_id = |
| 234 | Ast0.rewrap id |
| 235 | (Ast0.MetaId |
| 236 | ((nm,arity,info,mcodekind,pos,adj),constraints,Ast0.Pure)) in |
| 237 | ([Ast.MetaIdDecl(Ast.NONE,nm)], |
| 238 | Ast0.rewrap param (Ast0.Param(ty,Some new_id))) |
| 239 | | _ -> ([],param)) |
| 240 | | Ast0.Pdots(d) -> |
| 241 | let nm = (old_name,new_name "__P") in |
| 242 | let nml = (old_name,new_name "__n") in |
| 243 | let new_id = |
| 244 | Ast0.rewrap param |
| 245 | (Ast0.MetaParamList(Ast0.rewrap_mcode d nm, |
| 246 | Some (Ast0.rewrap_mcode d nml), |
| 247 | Ast0.Pure)) in |
| 248 | ([Ast.MetaParamListDecl(Ast.NONE,nm,Some nml);Ast.MetaListlenDecl(nml)], |
| 249 | new_id) |
| 250 | | Ast0.OptParam(p) -> |
| 251 | let (metavars,p) = rename_param old_name all p in |
| 252 | (metavars,Ast0.rewrap param (Ast0.OptParam(p))) |
| 253 | | Ast0.UniqueParam(p) -> |
| 254 | let (metavars,p) = rename_param old_name all p in |
| 255 | (metavars,Ast0.rewrap param (Ast0.UniqueParam(p))) |
| 256 | | _ -> ([],param) |
| 257 | |
| 258 | (* try to convert names in the - parameter list to new metavariables, to |
| 259 | account for spelling mistakes on the part of the programmer *) |
| 260 | let fresh_names old_name mdef dec = |
| 261 | let res = ([],[],dec,mdef) in |
| 262 | match Ast0.unwrap dec with |
| 263 | Ast0.Decl(info,uninit) -> |
| 264 | (match Ast0.unwrap uninit with |
| 265 | Ast0.UnInit(stg,typ,name,sem) -> |
| 266 | (match Ast0.unwrap typ with |
| 267 | Ast0.FunctionType(ty,lp,params,rp) -> |
| 268 | let (metavars,newdec) = |
| 269 | let (metavars,l) = |
| 270 | List.split |
| 271 | (List.map (rename_param old_name true) |
| 272 | (Ast0.undots params)) in |
| 273 | (List.concat metavars, |
| 274 | Ast0.rewrap dec |
| 275 | (Ast0.Decl |
| 276 | (info, |
| 277 | Ast0.rewrap uninit |
| 278 | (Ast0.UnInit |
| 279 | (stg, |
| 280 | Ast0.rewrap typ |
| 281 | (Ast0.FunctionType |
| 282 | (ty,lp,Ast0.rewrap params (Ast0.DOTS(l)), |
| 283 | rp)), |
| 284 | name,sem))))) in |
| 285 | let (def_metavars,newdef) = |
| 286 | match Ast0.unwrap mdef with |
| 287 | Ast0.FunDecl(x,fninfo,name,lp,params,rp,lb,body,rb) -> |
| 288 | let (def_metavars,def_l) = |
| 289 | List.split |
| 290 | (List.map (rename_param old_name false) |
| 291 | (Ast0.undots params)) in |
| 292 | (List.concat def_metavars, |
| 293 | Ast0.rewrap mdef |
| 294 | (Ast0.FunDecl(x,fninfo,name,lp, |
| 295 | Ast0.rewrap params (Ast0.DOTS(def_l)), |
| 296 | rp,lb,body,rb))) |
| 297 | | _ -> failwith "unexpected function definition" in |
| 298 | (metavars,def_metavars,newdec,newdef) |
| 299 | | _ -> res) |
| 300 | | _ -> res) |
| 301 | | _ -> res |
| 302 | |
| 303 | (* since there is no + counterpart, the function must be completely deleted *) |
| 304 | let no_names dec = |
| 305 | match Ast0.unwrap dec with |
| 306 | Ast0.Decl(info,uninit) -> |
| 307 | (match Ast0.unwrap uninit with |
| 308 | Ast0.UnInit(stg,typ,name,sem) -> |
| 309 | (match Ast0.unwrap typ with |
| 310 | Ast0.FunctionType(ty,lp,params,rp) -> |
| 311 | Ast0.rewrap dec |
| 312 | (Ast0.Decl |
| 313 | (info, |
| 314 | Ast0.rewrap uninit |
| 315 | (Ast0.UnInit |
| 316 | (stg, |
| 317 | Ast0.rewrap typ |
| 318 | (Ast0.FunctionType |
| 319 | (ty,lp, |
| 320 | Ast0.rewrap params |
| 321 | (let info = Ast0.get_info params in |
| 322 | let mcodekind = |
| 323 | (* use the mcodekind of an atomic minused |
| 324 | thing *) |
| 325 | Ast0.get_mcode_mcodekind lp in |
| 326 | let pdots = |
| 327 | ("...",Ast0.NONE,info,mcodekind, |
| 328 | ref Ast0.NoMetaPos,-1) in |
| 329 | Ast0.DOTS |
| 330 | ([Ast0.rewrap params |
| 331 | (Ast0.Pdots(pdots))])), |
| 332 | rp)), |
| 333 | name,sem)))) |
| 334 | | _ -> dec) |
| 335 | | _ -> dec) |
| 336 | | _ -> dec |
| 337 | |
| 338 | let merge mproto pproto = |
| 339 | let mproto = |
| 340 | Compute_lines.compute_lines true |
| 341 | [Ast0.copywrap mproto (Ast0.DECL mproto)] in |
| 342 | let pproto = |
| 343 | Compute_lines.compute_lines true |
| 344 | [Ast0.copywrap pproto (Ast0.DECL pproto)] in |
| 345 | let (m,p) = List.split(Context_neg.context_neg mproto pproto) in |
| 346 | Insert_plus.insert_plus m p true (* no isos for protos *); |
| 347 | (* convert to ast so that the + code will fall down to the tokens |
| 348 | and off the artificially added Ast0.DECL *) |
| 349 | let mproto = Ast0toast.ast0toast_toplevel (List.hd mproto) in |
| 350 | (* clean up the wrapping added above *) |
| 351 | match Ast.unwrap mproto with |
| 352 | Ast.DECL mproto -> mproto |
| 353 | | _ -> failwith "not possible" |
| 354 | |
| 355 | let make_rule rule_name = function |
| 356 | (mname,mdef,mproto,Some pproto) -> |
| 357 | let (metavars,mdef_metavars,mproto,mdef) = |
| 358 | fresh_names rule_name mdef mproto in |
| 359 | let no_name_mproto = drop_names mproto in |
| 360 | let no_name_pproto = drop_names pproto in |
| 361 | (metavars,mdef_metavars, |
| 362 | [merge mproto pproto; merge no_name_mproto no_name_pproto],mdef) |
| 363 | | (mname,mdef,mproto,None) -> |
| 364 | ([],[],[Ast0toast.statement(no_names mproto)],mdef) |
| 365 | |
| 366 | (* --------------------------------------------------------------------- *) |
| 367 | |
| 368 | let reinsert mdefs minus = |
| 369 | let table = |
| 370 | List.map |
| 371 | (function x -> |
| 372 | match Ast0.unwrap x with |
| 373 | Ast0.FunDecl(_,fninfo,name,lp,params,rp,lbrace,body,rbrace) -> |
| 374 | (name,x) |
| 375 | | _ -> failwith "bad mdef") |
| 376 | mdefs in |
| 377 | List.map |
| 378 | (function x -> |
| 379 | match Ast0.unwrap x with |
| 380 | Ast0.DECL(stmt) -> |
| 381 | (match Ast0.unwrap stmt with |
| 382 | Ast0.FunDecl(_,fninfo,name,lp,params,rp,lbrace,body,rbrace) -> |
| 383 | (try Ast0.rewrap x (Ast0.DECL(List.assoc name table)) |
| 384 | with Not_found -> x) |
| 385 | | _ -> x) |
| 386 | | Ast0.CODE(rule_elem_dots) -> |
| 387 | (* let's hope there are no functions in here... *) |
| 388 | x |
| 389 | | _ -> x) |
| 390 | minus |
| 391 | |
| 392 | (* --------------------------------------------------------------------- *) |
| 393 | (* entry point *) |
| 394 | |
| 395 | let rec split4 = function |
| 396 | [] -> ([],[],[],[]) |
| 397 | | (a,b,c,d)::rest -> |
| 398 | let (ax,bx,cx,dx) = split4 rest in (a::ax,b::bx,c::cx,d::dx) |
| 399 | |
| 400 | let process rule_name rule_metavars dropped_isos minus plus ruletype = |
| 401 | let minus_functions = List.concat (List.map get_all_functions minus) in |
| 402 | match minus_functions with |
| 403 | [] -> ((rule_metavars,minus),None) |
| 404 | | _ -> |
| 405 | let plus_functions = |
| 406 | List.concat (List.map get_all_functions plus) in |
| 407 | let protos = align minus_functions plus_functions in |
| 408 | let (metavars,mdef_metavars,rules,mdefs) = |
| 409 | split4(List.map (make_rule rule_name) protos) in |
| 410 | let metavars = List.concat metavars in |
| 411 | let mdef_metavars = (List.concat mdef_metavars) @ rule_metavars in |
| 412 | let rules = List.concat rules in |
| 413 | let minus = reinsert mdefs minus in |
| 414 | match rules with |
| 415 | [] -> ((rule_metavars,minus),None) |
| 416 | | [x] -> |
| 417 | (* probably not possible, since there is always the version with |
| 418 | variables and the version without *) |
| 419 | ((mdef_metavars,minus), |
| 420 | Some |
| 421 | (metavars, |
| 422 | Ast.CocciRule |
| 423 | ("proto for "^rule_name, |
| 424 | (Ast.Dep rule_name,dropped_isos,Ast.Forall), |
| 425 | [Ast.rewrap x (Ast.DECL x)], |
| 426 | [false],ruletype))) |
| 427 | | x::_ -> |
| 428 | let drules = |
| 429 | List.map (function x -> Ast.rewrap x (Ast.DOTS [x])) rules in |
| 430 | let res = |
| 431 | Ast.CocciRule |
| 432 | ("proto for "^rule_name, |
| 433 | (Ast.Dep rule_name,dropped_isos,Ast.Forall), |
| 434 | [Ast.rewrap x (Ast.DECL (Ast.rewrap x (Ast.Disj drules)))], |
| 435 | [false],ruletype) in |
| 436 | ((mdef_metavars,minus),Some(metavars,res)) |