parsing_cocci/compute_lines.ml

   1 (*
   2  * Copyright 2010, INRIA, University of Copenhagen
   3  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
   4  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
   5  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
   6  * This file is part of Coccinelle.
   7  *
   8  * Coccinelle is free software: you can redistribute it and/or modify
   9  * it under the terms of the GNU General Public License as published by
  10  * the Free Software Foundation, according to version 2 of the License.
  11  *
  12  * Coccinelle is distributed in the hope that it will be useful,
  13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15  * GNU General Public License for more details.
  16  *
  17  * You should have received a copy of the GNU General Public License
  18  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  19  *
  20  * The authors reserve the right to distribute this or future versions of
  21  * Coccinelle under other licenses.
  22  *)
  23
  24
  25 (* Computes starting and ending logical lines for statements and
  26 expressions.  every node gets an index as well. *)
  27
  28 module Ast0 = Ast0_cocci
  29 module Ast = Ast_cocci
  30
  31 (* --------------------------------------------------------------------- *)
  32 (* Result *)
  33
  34 (* This is a horrible hack.  We need to have a special treatment for the code
  35 inside a nest, and this is to avoid threading that information around
  36 everywhere *)
  37 let in_nest_count = ref 0
  38 let check_attachable v = if !in_nest_count > 0 then false else v
  39
  40 let mkres x e left right =
  41   let lstart = Ast0.get_info left in
  42   let lend = Ast0.get_info right in
  43   let pos_info =
  44     { Ast0.line_start = lstart.Ast0.pos_info.Ast0.line_start;
  45       Ast0.line_end = lend.Ast0.pos_info.Ast0.line_end;
  46       Ast0.logical_start = lstart.Ast0.pos_info.Ast0.logical_start;
  47       Ast0.logical_end = lend.Ast0.pos_info.Ast0.logical_end;
  48       Ast0.column = lstart.Ast0.pos_info.Ast0.column;
  49       Ast0.offset = lstart.Ast0.pos_info.Ast0.offset;} in
  50   let info =
  51     { Ast0.pos_info = pos_info;
  52       Ast0.attachable_start = check_attachable lstart.Ast0.attachable_start;
  53       Ast0.attachable_end = check_attachable lend.Ast0.attachable_end;
  54       Ast0.mcode_start = lstart.Ast0.mcode_start;
  55       Ast0.mcode_end = lend.Ast0.mcode_end;
  56       (* only for tokens, not inherited upwards *)
  57       Ast0.strings_before = []; Ast0.strings_after = [] } in
  58   {x with Ast0.node = e; Ast0.info = info}
  59
  60 (* This looks like it is there to allow distribution of plus code
  61 over disjunctions.  But this doesn't work with single_statement, as the
  62 plus code has not been distributed to the place that it expects.  So the
  63 only reasonably easy solution seems to be to disallow distribution. *)
  64 (* inherit attachable is because single_statement doesn't work well when +
  65 code is attached outside an or, but this has to be allowed after
  66 isomorphisms have been introduced.  So only set it to true then, or when we
  67 know that the code involved cannot contain a statement, ie it is a
  68 declaration. *)
  69 let inherit_attachable = ref false
  70 let mkmultires x e left right (astart,start_mcodes) (aend,end_mcodes) =
  71   let lstart = Ast0.get_info left in
  72   let lend = Ast0.get_info right in
  73   let pos_info =
  74     { Ast0.line_start = lstart.Ast0.pos_info.Ast0.line_start;
  75       Ast0.line_end = lend.Ast0.pos_info.Ast0.line_end;
  76       Ast0.logical_start = lstart.Ast0.pos_info.Ast0.logical_start;
  77       Ast0.logical_end = lend.Ast0.pos_info.Ast0.logical_end;
  78       Ast0.column = lstart.Ast0.pos_info.Ast0.column;
  79       Ast0.offset = lstart.Ast0.pos_info.Ast0.offset; } in
  80   let info =
  81     { Ast0.pos_info = pos_info;
  82       Ast0.attachable_start =
  83       check_attachable (if !inherit_attachable then astart else false);
  84       Ast0.attachable_end =
  85       check_attachable (if !inherit_attachable then aend else false);
  86       Ast0.mcode_start = start_mcodes;
  87       Ast0.mcode_end = end_mcodes;
  88       (* only for tokens, not inherited upwards *)
  89       Ast0.strings_before = []; Ast0.strings_after = [] } in
  90   {x with Ast0.node = e; Ast0.info = info}
  91
  92 (* --------------------------------------------------------------------- *)
  93
  94 let get_option fn = function
  95     None -> None
  96   | Some x -> Some (fn x)
  97
  98 (* --------------------------------------------------------------------- *)
  99 (* --------------------------------------------------------------------- *)
 100 (* Mcode *)
 101
 102 let promote_mcode (_,_,info,mcodekind,_,_) =
 103   let new_info =
 104     {info with
 105       Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind]} in
 106   {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
 107
 108 let promote_mcode_plus_one (_,_,info,mcodekind,_,_) =
 109   let new_pos_info =
 110     {info.Ast0.pos_info with
 111       Ast0.line_start = info.Ast0.pos_info.Ast0.line_start + 1;
 112       Ast0.logical_start = info.Ast0.pos_info.Ast0.logical_start + 1;
 113       Ast0.line_end = info.Ast0.pos_info.Ast0.line_end + 1;
 114       Ast0.logical_end = info.Ast0.pos_info.Ast0.logical_end + 1; } in
 115   let new_info =
 116     {info with
 117       Ast0.pos_info = new_pos_info;
 118       Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind]} in
 119   {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
 120
 121 let promote_to_statement stm mcodekind =
 122   let info = Ast0.get_info stm in
 123   let new_pos_info =
 124     {info.Ast0.pos_info with
 125       Ast0.logical_start = info.Ast0.pos_info.Ast0.logical_end;
 126       Ast0.line_start = info.Ast0.pos_info.Ast0.line_end; } in
 127   let new_info =
 128     {info with
 129       Ast0.pos_info = new_pos_info;
 130       Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind];
 131       Ast0.attachable_start = check_attachable true;
 132       Ast0.attachable_end = check_attachable true} in
 133   {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
 134
 135 let promote_to_statement_start stm mcodekind =
 136   let info = Ast0.get_info stm in
 137   let new_pos_info =
 138     {info.Ast0.pos_info with
 139       Ast0.logical_end = info.Ast0.pos_info.Ast0.logical_start;
 140       Ast0.line_end = info.Ast0.pos_info.Ast0.line_start; } in
 141   let new_info =
 142     {info with
 143       Ast0.pos_info = new_pos_info;
 144       Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind];
 145       Ast0.attachable_start = check_attachable true;
 146       Ast0.attachable_end = check_attachable true} in
 147   {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
 148
 149 (* mcode is good by default *)
 150 let bad_mcode (t,a,info,mcodekind,pos,adj) =
 151   let new_info =
 152     {info with
 153       Ast0.attachable_start = check_attachable false;
 154       Ast0.attachable_end = check_attachable false} in
 155   (t,a,new_info,mcodekind,pos,adj)
 156
 157 let get_all_start_info l =
 158   (List.for_all (function x -> (Ast0.get_info x).Ast0.attachable_start) l,
 159    List.concat (List.map (function x -> (Ast0.get_info x).Ast0.mcode_start) l))
 160
 161 let get_all_end_info l =
 162   (List.for_all (function x -> (Ast0.get_info x).Ast0.attachable_end) l,
 163    List.concat (List.map (function x -> (Ast0.get_info x).Ast0.mcode_end) l))
 164
 165 (* --------------------------------------------------------------------- *)
 166 (* Dots *)
 167
 168 (* for the logline classification and the mcode field, on both sides, skip
 169 over initial minus dots, as they don't contribute anything *)
 170 let dot_list is_dots fn = function
 171     [] -> failwith "dots should not be empty"
 172   | l ->
 173       let get_node l fn =
 174         let first = List.hd l in
 175         let chosen =
 176           match (is_dots first, l) with (true,_::x::_) -> x | _ -> first in
 177         (* get the logline decorator and the mcodekind of the chosen node *)
 178         fn (Ast0.get_info chosen) in
 179       let forward = List.map fn l in
 180       let backward = List.rev forward in
 181       let (first_attachable,first_mcode) =
 182         get_node forward
 183           (function x -> (x.Ast0.attachable_start,x.Ast0.mcode_start)) in
 184       let (last_attachable,last_mcode) =
 185         get_node backward
 186           (function x -> (x.Ast0.attachable_end,x.Ast0.mcode_end)) in
 187       let first = List.hd forward in
 188       let last = List.hd backward in
 189       let first_info =
 190         { (Ast0.get_info first) with
 191           Ast0.attachable_start = check_attachable first_attachable;
 192           Ast0.mcode_start = first_mcode } in
 193       let last_info =
 194         { (Ast0.get_info last) with
 195           Ast0.attachable_end = check_attachable last_attachable;
 196           Ast0.mcode_end = last_mcode } in
 197       let first = Ast0.set_info first first_info in
 198       let last = Ast0.set_info last last_info in
 199       (forward,first,last)
 200
 201 let dots is_dots prev fn d =
 202   match (prev,Ast0.unwrap d) with
 203     (Some prev,Ast0.DOTS([])) ->
 204       mkres d (Ast0.DOTS []) prev prev
 205   | (None,Ast0.DOTS([])) ->
 206       Ast0.set_info d
 207         {(Ast0.get_info d)
 208         with
 209           Ast0.attachable_start = check_attachable false;
 210           Ast0.attachable_end = check_attachable false}
 211   | (_,Ast0.DOTS(x)) ->
 212       let (l,lstart,lend) = dot_list is_dots fn x in
 213       mkres d (Ast0.DOTS l) lstart lend
 214   | (_,Ast0.CIRCLES(x)) ->
 215       let (l,lstart,lend) = dot_list is_dots fn x in
 216       mkres d (Ast0.CIRCLES l) lstart lend
 217   | (_,Ast0.STARS(x)) ->
 218       let (l,lstart,lend) = dot_list is_dots fn x in
 219       mkres d (Ast0.STARS l) lstart lend
 220
 221 (* --------------------------------------------------------------------- *)
 222 (* Identifier *)
 223
 224 (* for #define name, with no value, to compute right side *)
 225 let mkidres a b c d r = (mkres a b c d,r)
 226
 227 let rec full_ident i =
 228   match Ast0.unwrap i with
 229       Ast0.Id(name) as ui ->
 230         let name = promote_mcode name in mkidres i ui name name name
 231     | Ast0.MetaId(name,_,_)
 232     | Ast0.MetaFunc(name,_,_) | Ast0.MetaLocalFunc(name,_,_) as ui ->
 233         let name = promote_mcode name in mkidres i ui name name name
 234     | Ast0.OptIdent(id) ->
 235         let (id,r) = full_ident id in mkidres i (Ast0.OptIdent(id)) id id r
 236     | Ast0.UniqueIdent(id) ->
 237         let (id,r) = full_ident id in mkidres i (Ast0.UniqueIdent(id)) id id r
 238 and ident i = let (id,_) = full_ident i in id
 239
 240 (* --------------------------------------------------------------------- *)
 241 (* Expression *)
 242
 243 let is_exp_dots e =
 244   match Ast0.unwrap e with
 245     Ast0.Edots(_,_) | Ast0.Ecircles(_,_) | Ast0.Estars(_,_) -> true
 246   | _ -> false
 247
 248 let rec expression e =
 249   match Ast0.unwrap e with
 250     Ast0.Ident(id) ->
 251       let id = ident id in
 252       mkres e (Ast0.Ident(id)) id id
 253   | Ast0.Constant(const) as ue ->
 254       let ln = promote_mcode const in
 255       mkres e ue ln ln
 256   | Ast0.FunCall(fn,lp,args,rp) ->
 257       let fn = expression fn in
 258       let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
 259       mkres e (Ast0.FunCall(fn,lp,args,rp)) fn (promote_mcode rp)
 260   | Ast0.Assignment(left,op,right,simple) ->
 261       let left = expression left in
 262       let right = expression right in
 263       mkres e (Ast0.Assignment(left,op,right,simple)) left right
 264   | Ast0.CondExpr(exp1,why,exp2,colon,exp3) ->
 265       let exp1 = expression exp1 in
 266       let exp2 = get_option expression exp2 in
 267       let exp3 = expression exp3 in
 268       mkres e (Ast0.CondExpr(exp1,why,exp2,colon,exp3)) exp1 exp3
 269   | Ast0.Postfix(exp,op) ->
 270       let exp = expression exp in
 271       mkres e (Ast0.Postfix(exp,op)) exp (promote_mcode op)
 272   | Ast0.Infix(exp,op) ->
 273       let exp = expression exp in
 274       mkres e (Ast0.Infix(exp,op)) (promote_mcode op) exp
 275   | Ast0.Unary(exp,op) ->
 276       let exp = expression exp in
 277       mkres e (Ast0.Unary(exp,op)) (promote_mcode op) exp
 278   | Ast0.Binary(left,op,right) ->
 279       let left = expression left in
 280       let right = expression right in
 281       mkres e (Ast0.Binary(left,op,right)) left right
 282   | Ast0.Nested(left,op,right) ->
 283       let left = expression left in
 284       let right = expression right in
 285       mkres e (Ast0.Nested(left,op,right)) left right
 286   | Ast0.Paren(lp,exp,rp) ->
 287       mkres e (Ast0.Paren(lp,expression exp,rp))
 288         (promote_mcode lp) (promote_mcode rp)
 289   | Ast0.ArrayAccess(exp1,lb,exp2,rb) ->
 290       let exp1 = expression exp1 in
 291       let exp2 = expression exp2 in
 292       mkres e (Ast0.ArrayAccess(exp1,lb,exp2,rb)) exp1 (promote_mcode rb)
 293   | Ast0.RecordAccess(exp,pt,field) ->
 294       let exp = expression exp in
 295       let field = ident field in
 296       mkres e (Ast0.RecordAccess(exp,pt,field)) exp field
 297   | Ast0.RecordPtAccess(exp,ar,field) ->
 298       let exp = expression exp in
 299       let field = ident field in
 300       mkres e (Ast0.RecordPtAccess(exp,ar,field)) exp field
 301   | Ast0.Cast(lp,ty,rp,exp) ->
 302       let exp = expression exp in
 303       mkres e (Ast0.Cast(lp,typeC ty,rp,exp)) (promote_mcode lp) exp
 304   | Ast0.SizeOfExpr(szf,exp) ->
 305       let exp = expression exp in
 306       mkres e (Ast0.SizeOfExpr(szf,exp)) (promote_mcode szf) exp
 307   | Ast0.SizeOfType(szf,lp,ty,rp) ->
 308       mkres e (Ast0.SizeOfType(szf,lp,typeC ty,rp))
 309         (promote_mcode szf)  (promote_mcode rp)
 310   | Ast0.TypeExp(ty) ->
 311       let ty = typeC ty in mkres e (Ast0.TypeExp(ty)) ty ty
 312   | Ast0.MetaErr(name,_,_) | Ast0.MetaExpr(name,_,_,_,_)
 313   | Ast0.MetaExprList(name,_,_) as ue ->
 314       let ln = promote_mcode name in mkres e ue ln ln
 315   | Ast0.EComma(cm) ->
 316       (*let cm = bad_mcode cm in*) (* why was this bad??? *)
 317       let ln = promote_mcode cm in
 318       mkres e (Ast0.EComma(cm)) ln ln
 319   | Ast0.DisjExpr(starter,exps,mids,ender) ->
 320       let starter = bad_mcode starter in
 321       let exps = List.map expression exps in
 322       let mids = List.map bad_mcode mids in
 323       let ender = bad_mcode ender in
 324       mkmultires e (Ast0.DisjExpr(starter,exps,mids,ender))
 325         (promote_mcode starter) (promote_mcode ender)
 326         (get_all_start_info exps) (get_all_end_info exps)
 327   | Ast0.NestExpr(starter,exp_dots,ender,whencode,multi) ->
 328       let exp_dots = dots is_exp_dots None expression exp_dots in
 329       let starter = bad_mcode starter in
 330       let ender = bad_mcode ender in
 331       mkres e (Ast0.NestExpr(starter,exp_dots,ender,whencode,multi))
 332         (promote_mcode starter) (promote_mcode ender)
 333   | Ast0.Edots(dots,whencode) ->
 334       let dots = bad_mcode dots in
 335       let ln = promote_mcode dots in
 336       mkres e (Ast0.Edots(dots,whencode)) ln ln
 337   | Ast0.Ecircles(dots,whencode) ->
 338       let dots = bad_mcode dots in
 339       let ln = promote_mcode dots in
 340       mkres e (Ast0.Ecircles(dots,whencode)) ln ln
 341   | Ast0.Estars(dots,whencode) ->
 342       let dots = bad_mcode dots in
 343       let ln = promote_mcode dots in
 344       mkres e (Ast0.Estars(dots,whencode)) ln ln
 345   | Ast0.OptExp(exp) ->
 346       let exp = expression exp in
 347       mkres e (Ast0.OptExp(exp)) exp exp
 348   | Ast0.UniqueExp(exp) ->
 349       let exp = expression exp in
 350       mkres e (Ast0.UniqueExp(exp)) exp exp
 351
 352 and expression_dots x = dots is_exp_dots None expression x
 353
 354 (* --------------------------------------------------------------------- *)
 355 (* Types *)
 356
 357 and typeC t =
 358   match Ast0.unwrap t with
 359     Ast0.ConstVol(cv,ty) ->
 360       let ty = typeC ty in
 361       mkres t (Ast0.ConstVol(cv,ty)) (promote_mcode cv) ty
 362   | Ast0.BaseType(ty,strings) as ut ->
 363       let first = List.hd strings in
 364       let last = List.hd (List.rev strings) in
 365       mkres t ut (promote_mcode first) (promote_mcode last)
 366   | Ast0.Signed(sgn,None) as ut ->
 367       mkres t ut (promote_mcode sgn) (promote_mcode sgn)
 368   | Ast0.Signed(sgn,Some ty) ->
 369       let ty = typeC ty in
 370       mkres t (Ast0.Signed(sgn,Some ty)) (promote_mcode sgn) ty
 371   | Ast0.Pointer(ty,star) ->
 372       let ty = typeC ty in
 373       mkres t (Ast0.Pointer(ty,star)) ty (promote_mcode star)
 374   | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
 375       let ty = typeC ty in
 376       let params = parameter_list (Some(promote_mcode lp2)) params in
 377       mkres t (Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2))
 378         ty (promote_mcode rp2)
 379   | Ast0.FunctionType(Some ty,lp1,params,rp1) ->
 380       let ty = typeC ty in
 381       let params = parameter_list (Some(promote_mcode lp1)) params in
 382       let res = Ast0.FunctionType(Some ty,lp1,params,rp1) in
 383       mkres t res ty (promote_mcode rp1)
 384   | Ast0.FunctionType(None,lp1,params,rp1) ->
 385       let params = parameter_list (Some(promote_mcode lp1)) params in
 386       let res = Ast0.FunctionType(None,lp1,params,rp1) in
 387       mkres t res (promote_mcode lp1) (promote_mcode rp1)
 388   | Ast0.Array(ty,lb,size,rb) ->
 389       let ty = typeC ty in
 390       mkres t (Ast0.Array(ty,lb,get_option expression size,rb))
 391         ty (promote_mcode rb)
 392   | Ast0.EnumName(kind,name) ->
 393       let name = ident name in
 394       mkres t (Ast0.EnumName(kind,name)) (promote_mcode kind) name
 395   | Ast0.StructUnionName(kind,Some name) ->
 396       let name = ident name in
 397       mkres t (Ast0.StructUnionName(kind,Some name)) (promote_mcode kind) name
 398   | Ast0.StructUnionName(kind,None) ->
 399       let mc = promote_mcode kind in
 400       mkres t (Ast0.StructUnionName(kind,None)) mc mc
 401   | Ast0.StructUnionDef(ty,lb,decls,rb) ->
 402       let ty = typeC ty in
 403       let decls =
 404         dots is_decl_dots (Some(promote_mcode lb)) declaration decls in
 405       mkres t (Ast0.StructUnionDef(ty,lb,decls,rb)) ty (promote_mcode rb)
 406   | Ast0.TypeName(name) as ut ->
 407       let ln = promote_mcode name in mkres t ut ln ln
 408   | Ast0.MetaType(name,_) as ut ->
 409       let ln = promote_mcode name in mkres t ut ln ln
 410   | Ast0.DisjType(starter,types,mids,ender) ->
 411       let starter = bad_mcode starter in
 412       let types = List.map typeC types in
 413       let mids = List.map bad_mcode mids in
 414       let ender = bad_mcode ender in
 415       mkmultires t (Ast0.DisjType(starter,types,mids,ender))
 416         (promote_mcode starter) (promote_mcode ender)
 417         (get_all_start_info types) (get_all_end_info types)
 418   | Ast0.OptType(ty) ->
 419       let ty = typeC ty in mkres t (Ast0.OptType(ty)) ty ty
 420   | Ast0.UniqueType(ty) ->
 421       let ty = typeC ty in mkres t (Ast0.UniqueType(ty)) ty ty
 422
 423 (* --------------------------------------------------------------------- *)
 424 (* Variable declaration *)
 425 (* Even if the Cocci program specifies a list of declarations, they are
 426    split out into multiple declarations of a single variable each. *)
 427
 428 and is_decl_dots s =
 429   match Ast0.unwrap s with
 430     Ast0.Ddots(_,_) -> true
 431   | _ -> false
 432
 433 and declaration d =
 434   match Ast0.unwrap d with
 435     Ast0.Init(stg,ty,id,eq,exp,sem) ->
 436       let ty = typeC ty in
 437       let id = ident id in
 438       let exp = initialiser exp in
 439       (match stg with
 440         None ->
 441           mkres d (Ast0.Init(stg,ty,id,eq,exp,sem)) ty (promote_mcode sem)
 442       | Some x ->
 443           mkres d (Ast0.Init(stg,ty,id,eq,exp,sem))
 444             (promote_mcode x) (promote_mcode sem))
 445   | Ast0.UnInit(stg,ty,id,sem) ->
 446       let ty = typeC ty in
 447       let id = ident id in
 448       (match stg with
 449         None ->
 450           mkres d (Ast0.UnInit(stg,ty,id,sem)) ty (promote_mcode sem)
 451       | Some x ->
 452           mkres d (Ast0.UnInit(stg,ty,id,sem))
 453             (promote_mcode x) (promote_mcode sem))
 454   | Ast0.MacroDecl(name,lp,args,rp,sem) ->
 455       let name = ident name in
 456       let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
 457       mkres d (Ast0.MacroDecl(name,lp,args,rp,sem)) name (promote_mcode sem)
 458   | Ast0.TyDecl(ty,sem) ->
 459       let ty = typeC ty in
 460       mkres d (Ast0.TyDecl(ty,sem)) ty (promote_mcode sem)
 461   | Ast0.Typedef(stg,ty,id,sem) ->
 462       let ty = typeC ty in
 463       let id = typeC id in
 464       mkres d (Ast0.Typedef(stg,ty,id,sem))
 465         (promote_mcode stg) (promote_mcode sem)
 466   | Ast0.DisjDecl(starter,decls,mids,ender) ->
 467       let starter = bad_mcode starter in
 468       let decls = List.map declaration decls in
 469       let mids = List.map bad_mcode mids in
 470       let ender = bad_mcode ender in
 471       mkmultires d (Ast0.DisjDecl(starter,decls,mids,ender))
 472         (promote_mcode starter) (promote_mcode ender)
 473         (get_all_start_info decls) (get_all_end_info decls)
 474   | Ast0.Ddots(dots,whencode) ->
 475       let dots = bad_mcode dots in
 476       let ln = promote_mcode dots in
 477       mkres d (Ast0.Ddots(dots,whencode)) ln ln
 478   | Ast0.OptDecl(decl) ->
 479       let decl = declaration decl in
 480       mkres d (Ast0.OptDecl(declaration decl)) decl decl
 481   | Ast0.UniqueDecl(decl) ->
 482       let decl = declaration decl in
 483       mkres d (Ast0.UniqueDecl(declaration decl)) decl decl
 484
 485 (* --------------------------------------------------------------------- *)
 486 (* Initializer *)
 487
 488 and is_init_dots i =
 489   match Ast0.unwrap i with
 490     Ast0.Idots(_,_) -> true
 491   | _ -> false
 492
 493 and initialiser i =
 494   match Ast0.unwrap i with
 495     Ast0.MetaInit(name,_) as ut ->
 496       let ln = promote_mcode name in mkres i ut ln ln
 497   | Ast0.InitExpr(exp) ->
 498       let exp = expression exp in
 499       mkres i (Ast0.InitExpr(exp)) exp exp
 500   | Ast0.InitList(lb,initlist,rb) ->
 501       let initlist =
 502         dots is_init_dots (Some(promote_mcode lb)) initialiser initlist in
 503       mkres i (Ast0.InitList(lb,initlist,rb))
 504         (promote_mcode lb) (promote_mcode rb)
 505   | Ast0.InitGccExt(designators,eq,ini) ->
 506       let (delims,designators) = (* non empty due to parsing *)
 507         List.split (List.map designator designators) in
 508       let ini = initialiser ini in
 509       mkres i (Ast0.InitGccExt(designators,eq,ini))
 510         (promote_mcode (List.hd delims)) ini
 511   | Ast0.InitGccName(name,eq,ini) ->
 512       let name = ident name in
 513       let ini = initialiser ini in
 514       mkres i (Ast0.InitGccName(name,eq,ini)) name ini
 515   | Ast0.IComma(cm) as up ->
 516       let ln = promote_mcode cm in mkres i up ln ln
 517   | Ast0.Idots(dots,whencode) ->
 518       let dots = bad_mcode dots in
 519       let ln = promote_mcode dots in
 520       mkres i (Ast0.Idots(dots,whencode)) ln ln
 521   | Ast0.OptIni(ini) ->
 522       let ini = initialiser ini in
 523       mkres i (Ast0.OptIni(ini)) ini ini
 524   | Ast0.UniqueIni(ini) ->
 525       let ini = initialiser ini in
 526       mkres i (Ast0.UniqueIni(ini)) ini ini
 527
 528 and designator = function
 529     Ast0.DesignatorField(dot,id) ->
 530       (dot,Ast0.DesignatorField(dot,ident id))
 531   | Ast0.DesignatorIndex(lb,exp,rb) ->
 532       (lb,Ast0.DesignatorIndex(lb,expression exp,rb))
 533   | Ast0.DesignatorRange(lb,min,dots,max,rb) ->
 534       (lb,Ast0.DesignatorRange(lb,expression min,dots,expression max,rb))
 535
 536 and initialiser_list prev = dots is_init_dots prev initialiser
 537
 538 (* for export *)
 539 and initialiser_dots x = dots is_init_dots None initialiser x
 540
 541 (* --------------------------------------------------------------------- *)
 542 (* Parameter *)
 543
 544 and is_param_dots p =
 545   match Ast0.unwrap p with
 546     Ast0.Pdots(_) | Ast0.Pcircles(_) -> true
 547   | _ -> false
 548
 549 and parameterTypeDef p =
 550   match Ast0.unwrap p with
 551     Ast0.VoidParam(ty) ->
 552       let ty = typeC ty in mkres p (Ast0.VoidParam(ty)) ty ty
 553   | Ast0.Param(ty,Some id) ->
 554       let id = ident id in
 555       let ty = typeC ty in mkres p (Ast0.Param(ty,Some id)) ty id
 556   | Ast0.Param(ty,None) ->
 557       let ty = typeC ty in mkres p (Ast0.Param(ty,None)) ty ty
 558   | Ast0.MetaParam(name,_) as up ->
 559       let ln = promote_mcode name in mkres p up ln ln
 560   | Ast0.MetaParamList(name,_,_) as up ->
 561       let ln = promote_mcode name in mkres p up ln ln
 562   | Ast0.PComma(cm) ->
 563       (*let cm = bad_mcode cm in*) (* why was this bad??? *)
 564       let ln = promote_mcode cm in
 565       mkres p (Ast0.PComma(cm)) ln ln
 566   | Ast0.Pdots(dots) ->
 567       let dots = bad_mcode dots in
 568       let ln = promote_mcode dots in
 569       mkres p (Ast0.Pdots(dots)) ln ln
 570   | Ast0.Pcircles(dots) ->
 571       let dots = bad_mcode dots in
 572       let ln = promote_mcode dots in
 573       mkres p (Ast0.Pcircles(dots)) ln ln
 574   | Ast0.OptParam(param) ->
 575       let res = parameterTypeDef param in
 576       mkres p (Ast0.OptParam(res)) res res
 577   | Ast0.UniqueParam(param) ->
 578       let res = parameterTypeDef param in
 579       mkres p (Ast0.UniqueParam(res)) res res
 580
 581 and parameter_list prev = dots is_param_dots prev parameterTypeDef
 582
 583 (* for export *)
 584 let parameter_dots x = dots is_param_dots None parameterTypeDef x
 585
 586 (* --------------------------------------------------------------------- *)
 587
 588 let is_define_param_dots s =
 589   match Ast0.unwrap s with
 590     Ast0.DPdots(_) | Ast0.DPcircles(_) -> true
 591   | _ -> false
 592
 593 let rec define_param p =
 594   match Ast0.unwrap p with
 595     Ast0.DParam(id) ->
 596       let id = ident id in mkres p (Ast0.DParam(id)) id id
 597   | Ast0.DPComma(cm) ->
 598       (*let cm = bad_mcode cm in*) (* why was this bad??? *)
 599       let ln = promote_mcode cm in
 600       mkres p (Ast0.DPComma(cm)) ln ln
 601   | Ast0.DPdots(dots) ->
 602       let dots = bad_mcode dots in
 603       let ln = promote_mcode dots in
 604       mkres p (Ast0.DPdots(dots)) ln ln
 605   | Ast0.DPcircles(dots) ->
 606       let dots = bad_mcode dots in
 607       let ln = promote_mcode dots in
 608       mkres p (Ast0.DPcircles(dots)) ln ln
 609   | Ast0.OptDParam(dp) ->
 610       let res = define_param dp in
 611       mkres p (Ast0.OptDParam(res)) res res
 612   | Ast0.UniqueDParam(dp) ->
 613       let res = define_param dp in
 614       mkres p (Ast0.UniqueDParam(res)) res res
 615
 616 let define_parameters x id =
 617   match Ast0.unwrap x with
 618     Ast0.NoParams -> (x,id) (* no info, should be ignored *)
 619   | Ast0.DParams(lp,dp,rp) ->
 620       let dp = dots is_define_param_dots None define_param dp in
 621       let l = promote_mcode lp in
 622       let r = promote_mcode rp in
 623       (mkres x (Ast0.DParams(lp,dp,rp)) l r, r)
 624
 625 (* --------------------------------------------------------------------- *)
 626 (* Top-level code *)
 627
 628 let is_stm_dots s =
 629   match Ast0.unwrap s with
 630     Ast0.Dots(_,_) | Ast0.Circles(_,_) | Ast0.Stars(_,_) -> true
 631   | _ -> false
 632
 633 let rec statement s =
 634   let res =
 635     match Ast0.unwrap s with
 636       Ast0.Decl((_,bef),decl) ->
 637         let decl = declaration decl in
 638         let left = promote_to_statement_start decl bef in
 639         mkres s (Ast0.Decl((Ast0.get_info left,bef),decl)) decl decl
 640     | Ast0.Seq(lbrace,body,rbrace) ->
 641         let body =
 642           dots is_stm_dots (Some(promote_mcode lbrace)) statement body in
 643         mkres s (Ast0.Seq(lbrace,body,rbrace))
 644           (promote_mcode lbrace) (promote_mcode rbrace)
 645     | Ast0.ExprStatement(exp,sem) ->
 646         let exp = expression exp in
 647         mkres s (Ast0.ExprStatement(exp,sem)) exp (promote_mcode sem)
 648     | Ast0.IfThen(iff,lp,exp,rp,branch,(_,aft)) ->
 649         let exp = expression exp in
 650         let branch = statement branch in
 651         let right = promote_to_statement branch aft in
 652         mkres s (Ast0.IfThen(iff,lp,exp,rp,branch,(Ast0.get_info right,aft)))
 653           (promote_mcode iff) right
 654     | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(_,aft)) ->
 655         let exp = expression exp in
 656         let branch1 = statement branch1 in
 657         let branch2 = statement branch2 in
 658         let right = promote_to_statement branch2 aft in
 659         mkres s
 660           (Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,
 661             (Ast0.get_info right,aft)))
 662           (promote_mcode iff) right
 663     | Ast0.While(wh,lp,exp,rp,body,(_,aft)) ->
 664         let exp = expression exp in
 665         let body = statement body in
 666         let right = promote_to_statement body aft in
 667         mkres s (Ast0.While(wh,lp,exp,rp,body,(Ast0.get_info right,aft)))
 668           (promote_mcode wh) right
 669     | Ast0.Do(d,body,wh,lp,exp,rp,sem) ->
 670         let body = statement body in
 671         let exp = expression exp in
 672         mkres s (Ast0.Do(d,body,wh,lp,exp,rp,sem))
 673           (promote_mcode d) (promote_mcode sem)
 674     | Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,(_,aft)) ->
 675         let exp1 = get_option expression exp1 in
 676         let exp2 = get_option expression exp2 in
 677         let exp3 = get_option expression exp3 in
 678         let body = statement body in
 679         let right = promote_to_statement body aft in
 680         mkres s (Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,
 681                           (Ast0.get_info right,aft)))
 682           (promote_mcode fr) right
 683     | Ast0.Iterator(nm,lp,args,rp,body,(_,aft)) ->
 684         let nm = ident nm in
 685         let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
 686         let body = statement body in
 687         let right = promote_to_statement body aft in
 688         mkres s (Ast0.Iterator(nm,lp,args,rp,body,(Ast0.get_info right,aft)))
 689           nm right
 690     | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) ->
 691         let exp = expression exp in
 692         let decls =
 693           dots is_stm_dots (Some(promote_mcode lb))
 694             statement decls in
 695         let cases =
 696           dots (function _ -> false)
 697             (if Ast0.undots decls = []
 698             then (Some(promote_mcode lb))
 699             else None (* not sure this is right, but not sure the case can
 700                          arise either *))
 701             case_line cases in
 702         mkres s
 703           (Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb))
 704           (promote_mcode switch) (promote_mcode rb)
 705     | Ast0.Break(br,sem) as us ->
 706         mkres s us (promote_mcode br) (promote_mcode sem)
 707     | Ast0.Continue(cont,sem) as us ->
 708         mkres s us (promote_mcode cont) (promote_mcode sem)
 709     | Ast0.Label(l,dd) ->
 710         let l = ident l in
 711         mkres s (Ast0.Label(l,dd)) l (promote_mcode dd)
 712     | Ast0.Goto(goto,id,sem) ->
 713         let id = ident id in
 714         mkres s (Ast0.Goto(goto,id,sem))
 715           (promote_mcode goto) (promote_mcode sem)
 716     | Ast0.Return(ret,sem) as us ->
 717         mkres s us (promote_mcode ret) (promote_mcode sem)
 718     | Ast0.ReturnExpr(ret,exp,sem) ->
 719         let exp = expression exp in
 720         mkres s (Ast0.ReturnExpr(ret,exp,sem))
 721           (promote_mcode ret) (promote_mcode sem)
 722     | Ast0.MetaStmt(name,_)
 723     | Ast0.MetaStmtList(name,_) as us ->
 724         let ln = promote_mcode name in mkres s us ln ln
 725     | Ast0.Exp(exp) ->
 726         let exp = expression exp in
 727         mkres s (Ast0.Exp(exp)) exp exp
 728     | Ast0.TopExp(exp) ->
 729         let exp = expression exp in
 730         mkres s (Ast0.TopExp(exp)) exp exp
 731     | Ast0.Ty(ty) ->
 732         let ty = typeC ty in
 733         mkres s (Ast0.Ty(ty)) ty ty
 734     | Ast0.TopInit(init) ->
 735         let init = initialiser init in
 736         mkres s (Ast0.TopInit(init)) init init
 737     | Ast0.Disj(starter,rule_elem_dots_list,mids,ender) ->
 738         let starter = bad_mcode starter in
 739         let mids = List.map bad_mcode mids in
 740         let ender = bad_mcode ender in
 741         let rec loop prevs = function
 742             [] -> []
 743           | stm::stms ->
 744               (dots is_stm_dots (Some(promote_mcode_plus_one(List.hd prevs)))
 745                  statement stm)::
 746               (loop (List.tl prevs) stms) in
 747         let elems = loop (starter::mids) rule_elem_dots_list in
 748         mkmultires s (Ast0.Disj(starter,elems,mids,ender))
 749           (promote_mcode starter) (promote_mcode ender)
 750           (get_all_start_info elems) (get_all_end_info elems)
 751     | Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi) ->
 752         let starter = bad_mcode starter in
 753         let ender = bad_mcode ender in
 754         let wrapper f =
 755           match Ast0.get_mcode_mcodekind starter with
 756             Ast0.MINUS _ ->
 757               (* if minus, then all nest code has to be minus.  This is
 758                  checked at the token level, in parse_cocci.ml.  All nest code
 759                  is also unattachable.  We strip the minus annotations from
 760                  the nest code because in the CTL another metavariable will
 761                  take care of removing all the code matched by the nest.
 762                  Without stripping the minus annotations, we would get a
 763                  double transformation.  Perhaps there is a more elegant
 764                  way to do this in the CTL, but it is not easy, because of
 765                  the interaction with the whencode and the implementation of
 766                  plus *)
 767               in_nest_count := !in_nest_count + 1;
 768               let res = f() in
 769               in_nest_count := !in_nest_count - 1;
 770               res
 771           | _ -> f() in
 772         let rule_elem_dots =
 773           wrapper
 774             (function _ -> dots is_stm_dots None statement rule_elem_dots) in
 775         mkres s (Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi))
 776           (promote_mcode starter) (promote_mcode ender)
 777     | Ast0.Dots(dots,whencode) ->
 778         let dots = bad_mcode dots in
 779         let ln = promote_mcode dots in
 780         mkres s (Ast0.Dots(dots,whencode)) ln ln
 781     | Ast0.Circles(dots,whencode) ->
 782         let dots = bad_mcode dots in
 783         let ln = promote_mcode dots in
 784         mkres s (Ast0.Circles(dots,whencode)) ln ln
 785     | Ast0.Stars(dots,whencode) ->
 786         let dots = bad_mcode dots in
 787         let ln = promote_mcode dots in
 788         mkres s (Ast0.Stars(dots,whencode)) ln ln
 789     | Ast0.FunDecl((_,bef),fninfo,name,lp,params,rp,lbrace,body,rbrace) ->
 790         let fninfo =
 791           List.map
 792             (function Ast0.FType(ty) -> Ast0.FType(typeC ty) | x -> x)
 793             fninfo in
 794         let name = ident name in
 795         let params = parameter_list (Some(promote_mcode lp)) params in
 796         let body =
 797           dots is_stm_dots (Some(promote_mcode lbrace)) statement body in
 798         let left =
 799         (* cases on what is leftmost *)
 800           match fninfo with
 801             [] -> promote_to_statement_start name bef
 802           | Ast0.FStorage(stg)::_ ->
 803               promote_to_statement_start (promote_mcode stg) bef
 804           | Ast0.FType(ty)::_ ->
 805               promote_to_statement_start ty bef
 806           | Ast0.FInline(inline)::_ ->
 807               promote_to_statement_start (promote_mcode inline) bef
 808           | Ast0.FAttr(attr)::_ ->
 809               promote_to_statement_start (promote_mcode attr) bef in
 810       (* pretend it is one line before the start of the function, so that it
 811          will catch things defined at top level.  We assume that these will not
 812          be defined on the same line as the function.  This is a HACK.
 813          A better approach would be to attach top_level things to this node,
 814          and other things to the node after, but that would complicate
 815          insert_plus, which doesn't distinguish between different mcodekinds *)
 816         let res =
 817           Ast0.FunDecl((Ast0.get_info left,bef),fninfo,name,lp,params,rp,lbrace,
 818                        body,rbrace) in
 819       (* have to do this test again, because of typing problems - can't save
 820          the result, only use it *)
 821         (match fninfo with
 822           [] -> mkres s res name (promote_mcode rbrace)
 823         | Ast0.FStorage(stg)::_ ->
 824             mkres s res (promote_mcode stg) (promote_mcode rbrace)
 825         | Ast0.FType(ty)::_ -> mkres s res ty (promote_mcode rbrace)
 826         | Ast0.FInline(inline)::_ ->
 827             mkres s res (promote_mcode inline) (promote_mcode rbrace)
 828         | Ast0.FAttr(attr)::_ ->
 829             mkres s res (promote_mcode attr) (promote_mcode rbrace))
 830
 831     | Ast0.Include(inc,stm) ->
 832         mkres s (Ast0.Include(inc,stm)) (promote_mcode inc) (promote_mcode stm)
 833     | Ast0.Define(def,id,params,body) ->
 834         let (id,right) = full_ident id in
 835         let (params,prev) = define_parameters params right in
 836         let body = dots is_stm_dots (Some prev) statement body in
 837         mkres s (Ast0.Define(def,id,params,body)) (promote_mcode def) body
 838     | Ast0.OptStm(stm) ->
 839         let stm = statement stm in mkres s (Ast0.OptStm(stm)) stm stm
 840     | Ast0.UniqueStm(stm) ->
 841         let stm = statement stm in mkres s (Ast0.UniqueStm(stm)) stm stm in
 842   Ast0.set_dots_bef_aft res
 843     (match Ast0.get_dots_bef_aft res with
 844       Ast0.NoDots -> Ast0.NoDots
 845     | Ast0.AddingBetweenDots s ->
 846         Ast0.AddingBetweenDots(statement s)
 847     | Ast0.DroppingBetweenDots s ->
 848         Ast0.DroppingBetweenDots(statement s))
 849
 850 and case_line c =
 851   match Ast0.unwrap c with
 852     Ast0.Default(def,colon,code) ->
 853       let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in
 854       mkres c (Ast0.Default(def,colon,code)) (promote_mcode def) code
 855   | Ast0.Case(case,exp,colon,code) ->
 856       let exp = expression exp in
 857       let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in
 858       mkres c (Ast0.Case(case,exp,colon,code)) (promote_mcode case) code
 859   | Ast0.DisjCase(starter,case_lines,mids,ender) ->
 860       let starter = bad_mcode starter in
 861       let case_lines = List.map case_line case_lines in
 862       let mids = List.map bad_mcode mids in
 863       let ender = bad_mcode ender in
 864       mkmultires c (Ast0.DisjCase(starter,case_lines,mids,ender))
 865         (promote_mcode starter) (promote_mcode ender)
 866         (get_all_start_info case_lines) (get_all_end_info case_lines)
 867   | Ast0.OptCase(case) ->
 868       let case = case_line case in mkres c (Ast0.OptCase(case)) case case
 869
 870 and statement_dots x = dots is_stm_dots None statement x
 871
 872 (* --------------------------------------------------------------------- *)
 873 (* Function declaration *)
 874
 875 let top_level t =
 876   match Ast0.unwrap t with
 877     Ast0.FILEINFO(old_file,new_file) -> t
 878   | Ast0.DECL(stmt) ->
 879       let stmt = statement stmt in mkres t (Ast0.DECL(stmt)) stmt stmt
 880   | Ast0.CODE(rule_elem_dots) ->
 881       let rule_elem_dots = dots is_stm_dots None statement rule_elem_dots in
 882       mkres t (Ast0.CODE(rule_elem_dots)) rule_elem_dots rule_elem_dots
 883   | Ast0.ERRORWORDS(exps) -> t
 884   | Ast0.OTHER(_) -> failwith "eliminated by top_level"
 885
 886 (* --------------------------------------------------------------------- *)
 887 (* Entry points *)
 888
 889 let compute_lines attachable_or x =
 890   in_nest_count := 0;
 891   inherit_attachable := attachable_or;
 892   List.map top_level x
 893
 894 let compute_statement_lines attachable_or x =
 895   in_nest_count := 0;
 896   inherit_attachable := attachable_or;
 897   statement x
 898
 899 let compute_statement_dots_lines attachable_or x =
 900   in_nest_count := 0;
 901   inherit_attachable := attachable_or;
 902   statement_dots x
 903