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,Some name) ->
 393       let name = ident name in
 394       mkres t (Ast0.EnumName(kind,Some name)) (promote_mcode kind) name
 395   | Ast0.EnumName(kind,None) ->
 396       let mc = promote_mcode kind in
 397       mkres t (Ast0.EnumName(kind,None)) mc mc
 398   | Ast0.EnumDef(ty,lb,ids,rb) ->
 399       let ty = typeC ty in
 400       let ids = dots is_exp_dots (Some(promote_mcode lb)) expression ids in
 401       mkres t (Ast0.EnumDef(ty,lb,ids,rb)) ty (promote_mcode rb)
 402   | Ast0.StructUnionName(kind,Some name) ->
 403       let name = ident name in
 404       mkres t (Ast0.StructUnionName(kind,Some name)) (promote_mcode kind) name
 405   | Ast0.StructUnionName(kind,None) ->
 406       let mc = promote_mcode kind in
 407       mkres t (Ast0.StructUnionName(kind,None)) mc mc
 408   | Ast0.StructUnionDef(ty,lb,decls,rb) ->
 409       let ty = typeC ty in
 410       let decls =
 411         dots is_decl_dots (Some(promote_mcode lb)) declaration decls in
 412       mkres t (Ast0.StructUnionDef(ty,lb,decls,rb)) ty (promote_mcode rb)
 413   | Ast0.TypeName(name) as ut ->
 414       let ln = promote_mcode name in mkres t ut ln ln
 415   | Ast0.MetaType(name,_) as ut ->
 416       let ln = promote_mcode name in mkres t ut ln ln
 417   | Ast0.DisjType(starter,types,mids,ender) ->
 418       let starter = bad_mcode starter in
 419       let types = List.map typeC types in
 420       let mids = List.map bad_mcode mids in
 421       let ender = bad_mcode ender in
 422       mkmultires t (Ast0.DisjType(starter,types,mids,ender))
 423         (promote_mcode starter) (promote_mcode ender)
 424         (get_all_start_info types) (get_all_end_info types)
 425   | Ast0.OptType(ty) ->
 426       let ty = typeC ty in mkres t (Ast0.OptType(ty)) ty ty
 427   | Ast0.UniqueType(ty) ->
 428       let ty = typeC ty in mkres t (Ast0.UniqueType(ty)) ty ty
 429
 430 (* --------------------------------------------------------------------- *)
 431 (* Variable declaration *)
 432 (* Even if the Cocci program specifies a list of declarations, they are
 433    split out into multiple declarations of a single variable each. *)
 434
 435 and is_decl_dots s =
 436   match Ast0.unwrap s with
 437     Ast0.Ddots(_,_) -> true
 438   | _ -> false
 439
 440 and declaration d =
 441   match Ast0.unwrap d with
 442     (Ast0.MetaDecl(name,_) | Ast0.MetaField(name,_)) as up ->
 443       let ln = promote_mcode name in mkres d up ln ln
 444   | Ast0.Init(stg,ty,id,eq,exp,sem) ->
 445       let ty = typeC ty in
 446       let id = ident id in
 447       let exp = initialiser exp in
 448       (match stg with
 449         None ->
 450           mkres d (Ast0.Init(stg,ty,id,eq,exp,sem)) ty (promote_mcode sem)
 451       | Some x ->
 452           mkres d (Ast0.Init(stg,ty,id,eq,exp,sem))
 453             (promote_mcode x) (promote_mcode sem))
 454   | Ast0.UnInit(stg,ty,id,sem) ->
 455       let ty = typeC ty in
 456       let id = ident id in
 457       (match stg with
 458         None ->
 459           mkres d (Ast0.UnInit(stg,ty,id,sem)) ty (promote_mcode sem)
 460       | Some x ->
 461           mkres d (Ast0.UnInit(stg,ty,id,sem))
 462             (promote_mcode x) (promote_mcode sem))
 463   | Ast0.MacroDecl(name,lp,args,rp,sem) ->
 464       let name = ident name in
 465       let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
 466       mkres d (Ast0.MacroDecl(name,lp,args,rp,sem)) name (promote_mcode sem)
 467   | Ast0.TyDecl(ty,sem) ->
 468       let ty = typeC ty in
 469       mkres d (Ast0.TyDecl(ty,sem)) ty (promote_mcode sem)
 470   | Ast0.Typedef(stg,ty,id,sem) ->
 471       let ty = typeC ty in
 472       let id = typeC id in
 473       mkres d (Ast0.Typedef(stg,ty,id,sem))
 474         (promote_mcode stg) (promote_mcode sem)
 475   | Ast0.DisjDecl(starter,decls,mids,ender) ->
 476       let starter = bad_mcode starter in
 477       let decls = List.map declaration decls in
 478       let mids = List.map bad_mcode mids in
 479       let ender = bad_mcode ender in
 480       mkmultires d (Ast0.DisjDecl(starter,decls,mids,ender))
 481         (promote_mcode starter) (promote_mcode ender)
 482         (get_all_start_info decls) (get_all_end_info decls)
 483   | Ast0.Ddots(dots,whencode) ->
 484       let dots = bad_mcode dots in
 485       let ln = promote_mcode dots in
 486       mkres d (Ast0.Ddots(dots,whencode)) ln ln
 487   | Ast0.OptDecl(decl) ->
 488       let decl = declaration decl in
 489       mkres d (Ast0.OptDecl(declaration decl)) decl decl
 490   | Ast0.UniqueDecl(decl) ->
 491       let decl = declaration decl in
 492       mkres d (Ast0.UniqueDecl(declaration decl)) decl decl
 493
 494 (* --------------------------------------------------------------------- *)
 495 (* Initializer *)
 496
 497 and is_init_dots i =
 498   match Ast0.unwrap i with
 499     Ast0.Idots(_,_) -> true
 500   | _ -> false
 501
 502 and initialiser i =
 503   match Ast0.unwrap i with
 504     Ast0.MetaInit(name,_) as ut ->
 505       let ln = promote_mcode name in mkres i ut ln ln
 506   | Ast0.InitExpr(exp) ->
 507       let exp = expression exp in
 508       mkres i (Ast0.InitExpr(exp)) exp exp
 509   | Ast0.InitList(lb,initlist,rb,ordered) ->
 510       let initlist =
 511         dots is_init_dots (Some(promote_mcode lb)) initialiser initlist in
 512       mkres i (Ast0.InitList(lb,initlist,rb,ordered))
 513         (promote_mcode lb) (promote_mcode rb)
 514   | Ast0.InitGccExt(designators,eq,ini) ->
 515       let (delims,designators) = (* non empty due to parsing *)
 516         List.split (List.map designator designators) in
 517       let ini = initialiser ini in
 518       mkres i (Ast0.InitGccExt(designators,eq,ini))
 519         (promote_mcode (List.hd delims)) ini
 520   | Ast0.InitGccName(name,eq,ini) ->
 521       let name = ident name in
 522       let ini = initialiser ini in
 523       mkres i (Ast0.InitGccName(name,eq,ini)) name ini
 524   | Ast0.IComma(cm) as up ->
 525       let ln = promote_mcode cm in mkres i up ln ln
 526   | Ast0.Idots(dots,whencode) ->
 527       let dots = bad_mcode dots in
 528       let ln = promote_mcode dots in
 529       mkres i (Ast0.Idots(dots,whencode)) ln ln
 530   | Ast0.OptIni(ini) ->
 531       let ini = initialiser ini in
 532       mkres i (Ast0.OptIni(ini)) ini ini
 533   | Ast0.UniqueIni(ini) ->
 534       let ini = initialiser ini in
 535       mkres i (Ast0.UniqueIni(ini)) ini ini
 536
 537 and designator = function
 538     Ast0.DesignatorField(dot,id) ->
 539       (dot,Ast0.DesignatorField(dot,ident id))
 540   | Ast0.DesignatorIndex(lb,exp,rb) ->
 541       (lb,Ast0.DesignatorIndex(lb,expression exp,rb))
 542   | Ast0.DesignatorRange(lb,min,dots,max,rb) ->
 543       (lb,Ast0.DesignatorRange(lb,expression min,dots,expression max,rb))
 544
 545 and initialiser_list prev = dots is_init_dots prev initialiser
 546
 547 (* for export *)
 548 and initialiser_dots x = dots is_init_dots None initialiser x
 549
 550 (* --------------------------------------------------------------------- *)
 551 (* Parameter *)
 552
 553 and is_param_dots p =
 554   match Ast0.unwrap p with
 555     Ast0.Pdots(_) | Ast0.Pcircles(_) -> true
 556   | _ -> false
 557
 558 and parameterTypeDef p =
 559   match Ast0.unwrap p with
 560     Ast0.VoidParam(ty) ->
 561       let ty = typeC ty in mkres p (Ast0.VoidParam(ty)) ty ty
 562   | Ast0.Param(ty,Some id) ->
 563       let id = ident id in
 564       let ty = typeC ty in mkres p (Ast0.Param(ty,Some id)) ty id
 565   | Ast0.Param(ty,None) ->
 566       let ty = typeC ty in mkres p (Ast0.Param(ty,None)) ty ty
 567   | Ast0.MetaParam(name,_) as up ->
 568       let ln = promote_mcode name in mkres p up ln ln
 569   | Ast0.MetaParamList(name,_,_) as up ->
 570       let ln = promote_mcode name in mkres p up ln ln
 571   | Ast0.PComma(cm) ->
 572       (*let cm = bad_mcode cm in*) (* why was this bad??? *)
 573       let ln = promote_mcode cm in
 574       mkres p (Ast0.PComma(cm)) ln ln
 575   | Ast0.Pdots(dots) ->
 576       let dots = bad_mcode dots in
 577       let ln = promote_mcode dots in
 578       mkres p (Ast0.Pdots(dots)) ln ln
 579   | Ast0.Pcircles(dots) ->
 580       let dots = bad_mcode dots in
 581       let ln = promote_mcode dots in
 582       mkres p (Ast0.Pcircles(dots)) ln ln
 583   | Ast0.OptParam(param) ->
 584       let res = parameterTypeDef param in
 585       mkres p (Ast0.OptParam(res)) res res
 586   | Ast0.UniqueParam(param) ->
 587       let res = parameterTypeDef param in
 588       mkres p (Ast0.UniqueParam(res)) res res
 589
 590 and parameter_list prev = dots is_param_dots prev parameterTypeDef
 591
 592 (* for export *)
 593 let parameter_dots x = dots is_param_dots None parameterTypeDef x
 594
 595 (* --------------------------------------------------------------------- *)
 596
 597 let is_define_param_dots s =
 598   match Ast0.unwrap s with
 599     Ast0.DPdots(_) | Ast0.DPcircles(_) -> true
 600   | _ -> false
 601
 602 let rec define_param p =
 603   match Ast0.unwrap p with
 604     Ast0.DParam(id) ->
 605       let id = ident id in mkres p (Ast0.DParam(id)) id id
 606   | Ast0.DPComma(cm) ->
 607       (*let cm = bad_mcode cm in*) (* why was this bad??? *)
 608       let ln = promote_mcode cm in
 609       mkres p (Ast0.DPComma(cm)) ln ln
 610   | Ast0.DPdots(dots) ->
 611       let dots = bad_mcode dots in
 612       let ln = promote_mcode dots in
 613       mkres p (Ast0.DPdots(dots)) ln ln
 614   | Ast0.DPcircles(dots) ->
 615       let dots = bad_mcode dots in
 616       let ln = promote_mcode dots in
 617       mkres p (Ast0.DPcircles(dots)) ln ln
 618   | Ast0.OptDParam(dp) ->
 619       let res = define_param dp in
 620       mkres p (Ast0.OptDParam(res)) res res
 621   | Ast0.UniqueDParam(dp) ->
 622       let res = define_param dp in
 623       mkres p (Ast0.UniqueDParam(res)) res res
 624
 625 let define_parameters x id =
 626   match Ast0.unwrap x with
 627     Ast0.NoParams -> (x,id) (* no info, should be ignored *)
 628   | Ast0.DParams(lp,dp,rp) ->
 629       let dp = dots is_define_param_dots None define_param dp in
 630       let l = promote_mcode lp in
 631       let r = promote_mcode rp in
 632       (mkres x (Ast0.DParams(lp,dp,rp)) l r, r)
 633
 634 (* --------------------------------------------------------------------- *)
 635 (* Top-level code *)
 636
 637 let is_stm_dots s =
 638   match Ast0.unwrap s with
 639     Ast0.Dots(_,_) | Ast0.Circles(_,_) | Ast0.Stars(_,_) -> true
 640   | _ -> false
 641
 642 let rec statement s =
 643   let res =
 644     match Ast0.unwrap s with
 645       Ast0.Decl((_,bef),decl) ->
 646         let decl = declaration decl in
 647         let left = promote_to_statement_start decl bef in
 648         mkres s (Ast0.Decl((Ast0.get_info left,bef),decl)) decl decl
 649     | Ast0.Seq(lbrace,body,rbrace) ->
 650         let body =
 651           dots is_stm_dots (Some(promote_mcode lbrace)) statement body in
 652         mkres s (Ast0.Seq(lbrace,body,rbrace))
 653           (promote_mcode lbrace) (promote_mcode rbrace)
 654     | Ast0.ExprStatement(exp,sem) ->
 655         let exp = expression exp in
 656         mkres s (Ast0.ExprStatement(exp,sem)) exp (promote_mcode sem)
 657     | Ast0.IfThen(iff,lp,exp,rp,branch,(_,aft)) ->
 658         let exp = expression exp in
 659         let branch = statement branch in
 660         let right = promote_to_statement branch aft in
 661         mkres s (Ast0.IfThen(iff,lp,exp,rp,branch,(Ast0.get_info right,aft)))
 662           (promote_mcode iff) right
 663     | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(_,aft)) ->
 664         let exp = expression exp in
 665         let branch1 = statement branch1 in
 666         let branch2 = statement branch2 in
 667         let right = promote_to_statement branch2 aft in
 668         mkres s
 669           (Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,
 670             (Ast0.get_info right,aft)))
 671           (promote_mcode iff) right
 672     | Ast0.While(wh,lp,exp,rp,body,(_,aft)) ->
 673         let exp = expression exp in
 674         let body = statement body in
 675         let right = promote_to_statement body aft in
 676         mkres s (Ast0.While(wh,lp,exp,rp,body,(Ast0.get_info right,aft)))
 677           (promote_mcode wh) right
 678     | Ast0.Do(d,body,wh,lp,exp,rp,sem) ->
 679         let body = statement body in
 680         let exp = expression exp in
 681         mkres s (Ast0.Do(d,body,wh,lp,exp,rp,sem))
 682           (promote_mcode d) (promote_mcode sem)
 683     | Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,(_,aft)) ->
 684         let exp1 = get_option expression exp1 in
 685         let exp2 = get_option expression exp2 in
 686         let exp3 = get_option expression exp3 in
 687         let body = statement body in
 688         let right = promote_to_statement body aft in
 689         mkres s (Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,
 690                           (Ast0.get_info right,aft)))
 691           (promote_mcode fr) right
 692     | Ast0.Iterator(nm,lp,args,rp,body,(_,aft)) ->
 693         let nm = ident nm in
 694         let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
 695         let body = statement body in
 696         let right = promote_to_statement body aft in
 697         mkres s (Ast0.Iterator(nm,lp,args,rp,body,(Ast0.get_info right,aft)))
 698           nm right
 699     | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) ->
 700         let exp = expression exp in
 701         let decls =
 702           dots is_stm_dots (Some(promote_mcode lb))
 703             statement decls in
 704         let cases =
 705           dots (function _ -> false)
 706             (if Ast0.undots decls = []
 707             then (Some(promote_mcode lb))
 708             else None (* not sure this is right, but not sure the case can
 709                          arise either *))
 710             case_line cases in
 711         mkres s
 712           (Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb))
 713           (promote_mcode switch) (promote_mcode rb)
 714     | Ast0.Break(br,sem) as us ->
 715         mkres s us (promote_mcode br) (promote_mcode sem)
 716     | Ast0.Continue(cont,sem) as us ->
 717         mkres s us (promote_mcode cont) (promote_mcode sem)
 718     | Ast0.Label(l,dd) ->
 719         let l = ident l in
 720         mkres s (Ast0.Label(l,dd)) l (promote_mcode dd)
 721     | Ast0.Goto(goto,id,sem) ->
 722         let id = ident id in
 723         mkres s (Ast0.Goto(goto,id,sem))
 724           (promote_mcode goto) (promote_mcode sem)
 725     | Ast0.Return(ret,sem) as us ->
 726         mkres s us (promote_mcode ret) (promote_mcode sem)
 727     | Ast0.ReturnExpr(ret,exp,sem) ->
 728         let exp = expression exp in
 729         mkres s (Ast0.ReturnExpr(ret,exp,sem))
 730           (promote_mcode ret) (promote_mcode sem)
 731     | Ast0.MetaStmt(name,_)
 732     | Ast0.MetaStmtList(name,_) as us ->
 733         let ln = promote_mcode name in mkres s us ln ln
 734     | Ast0.Exp(exp) ->
 735         let exp = expression exp in
 736         mkres s (Ast0.Exp(exp)) exp exp
 737     | Ast0.TopExp(exp) ->
 738         let exp = expression exp in
 739         mkres s (Ast0.TopExp(exp)) exp exp
 740     | Ast0.Ty(ty) ->
 741         let ty = typeC ty in
 742         mkres s (Ast0.Ty(ty)) ty ty
 743     | Ast0.TopInit(init) ->
 744         let init = initialiser init in
 745         mkres s (Ast0.TopInit(init)) init init
 746     | Ast0.Disj(starter,rule_elem_dots_list,mids,ender) ->
 747         let starter = bad_mcode starter in
 748         let mids = List.map bad_mcode mids in
 749         let ender = bad_mcode ender in
 750         let rec loop prevs = function
 751             [] -> []
 752           | stm::stms ->
 753               (dots is_stm_dots (Some(promote_mcode_plus_one(List.hd prevs)))
 754                  statement stm)::
 755               (loop (List.tl prevs) stms) in
 756         let elems = loop (starter::mids) rule_elem_dots_list in
 757         mkmultires s (Ast0.Disj(starter,elems,mids,ender))
 758           (promote_mcode starter) (promote_mcode ender)
 759           (get_all_start_info elems) (get_all_end_info elems)
 760     | Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi) ->
 761         let starter = bad_mcode starter in
 762         let ender = bad_mcode ender in
 763         let wrapper f =
 764           match Ast0.get_mcode_mcodekind starter with
 765             Ast0.MINUS _ ->
 766               (* if minus, then all nest code has to be minus.  This is
 767                  checked at the token level, in parse_cocci.ml.  All nest code
 768                  is also unattachable.  We strip the minus annotations from
 769                  the nest code because in the CTL another metavariable will
 770                  take care of removing all the code matched by the nest.
 771                  Without stripping the minus annotations, we would get a
 772                  double transformation.  Perhaps there is a more elegant
 773                  way to do this in the CTL, but it is not easy, because of
 774                  the interaction with the whencode and the implementation of
 775                  plus *)
 776               in_nest_count := !in_nest_count + 1;
 777               let res = f() in
 778               in_nest_count := !in_nest_count - 1;
 779               res
 780           | _ -> f() in
 781         let rule_elem_dots =
 782           wrapper
 783             (function _ -> dots is_stm_dots None statement rule_elem_dots) in
 784         mkres s (Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi))
 785           (promote_mcode starter) (promote_mcode ender)
 786     | Ast0.Dots(dots,whencode) ->
 787         let dots = bad_mcode dots in
 788         let ln = promote_mcode dots in
 789         mkres s (Ast0.Dots(dots,whencode)) ln ln
 790     | Ast0.Circles(dots,whencode) ->
 791         let dots = bad_mcode dots in
 792         let ln = promote_mcode dots in
 793         mkres s (Ast0.Circles(dots,whencode)) ln ln
 794     | Ast0.Stars(dots,whencode) ->
 795         let dots = bad_mcode dots in
 796         let ln = promote_mcode dots in
 797         mkres s (Ast0.Stars(dots,whencode)) ln ln
 798     | Ast0.FunDecl((_,bef),fninfo,name,lp,params,rp,lbrace,body,rbrace) ->
 799         let fninfo =
 800           List.map
 801             (function Ast0.FType(ty) -> Ast0.FType(typeC ty) | x -> x)
 802             fninfo in
 803         let name = ident name in
 804         let params = parameter_list (Some(promote_mcode lp)) params in
 805         let body =
 806           dots is_stm_dots (Some(promote_mcode lbrace)) statement body in
 807         let left =
 808         (* cases on what is leftmost *)
 809           match fninfo with
 810             [] -> promote_to_statement_start name bef
 811           | Ast0.FStorage(stg)::_ ->
 812               promote_to_statement_start (promote_mcode stg) bef
 813           | Ast0.FType(ty)::_ ->
 814               promote_to_statement_start ty bef
 815           | Ast0.FInline(inline)::_ ->
 816               promote_to_statement_start (promote_mcode inline) bef
 817           | Ast0.FAttr(attr)::_ ->
 818               promote_to_statement_start (promote_mcode attr) bef in
 819       (* pretend it is one line before the start of the function, so that it
 820          will catch things defined at top level.  We assume that these will not
 821          be defined on the same line as the function.  This is a HACK.
 822          A better approach would be to attach top_level things to this node,
 823          and other things to the node after, but that would complicate
 824          insert_plus, which doesn't distinguish between different mcodekinds *)
 825         let res =
 826           Ast0.FunDecl((Ast0.get_info left,bef),fninfo,name,lp,params,rp,lbrace,
 827                        body,rbrace) in
 828       (* have to do this test again, because of typing problems - can't save
 829          the result, only use it *)
 830         (match fninfo with
 831           [] -> mkres s res name (promote_mcode rbrace)
 832         | Ast0.FStorage(stg)::_ ->
 833             mkres s res (promote_mcode stg) (promote_mcode rbrace)
 834         | Ast0.FType(ty)::_ -> mkres s res ty (promote_mcode rbrace)
 835         | Ast0.FInline(inline)::_ ->
 836             mkres s res (promote_mcode inline) (promote_mcode rbrace)
 837         | Ast0.FAttr(attr)::_ ->
 838             mkres s res (promote_mcode attr) (promote_mcode rbrace))
 839
 840     | Ast0.Include(inc,stm) ->
 841         mkres s (Ast0.Include(inc,stm)) (promote_mcode inc) (promote_mcode stm)
 842     | Ast0.Define(def,id,params,body) ->
 843         let (id,right) = full_ident id in
 844         let (params,prev) = define_parameters params right in
 845         let body = dots is_stm_dots (Some prev) statement body in
 846         mkres s (Ast0.Define(def,id,params,body)) (promote_mcode def) body
 847     | Ast0.OptStm(stm) ->
 848         let stm = statement stm in mkres s (Ast0.OptStm(stm)) stm stm
 849     | Ast0.UniqueStm(stm) ->
 850         let stm = statement stm in mkres s (Ast0.UniqueStm(stm)) stm stm in
 851   Ast0.set_dots_bef_aft res
 852     (match Ast0.get_dots_bef_aft res with
 853       Ast0.NoDots -> Ast0.NoDots
 854     | Ast0.AddingBetweenDots s ->
 855         Ast0.AddingBetweenDots(statement s)
 856     | Ast0.DroppingBetweenDots s ->
 857         Ast0.DroppingBetweenDots(statement s))
 858
 859 and case_line c =
 860   match Ast0.unwrap c with
 861     Ast0.Default(def,colon,code) ->
 862       let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in
 863       mkres c (Ast0.Default(def,colon,code)) (promote_mcode def) code
 864   | Ast0.Case(case,exp,colon,code) ->
 865       let exp = expression exp in
 866       let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in
 867       mkres c (Ast0.Case(case,exp,colon,code)) (promote_mcode case) code
 868   | Ast0.DisjCase(starter,case_lines,mids,ender) ->
 869       let starter = bad_mcode starter in
 870       let case_lines = List.map case_line case_lines in
 871       let mids = List.map bad_mcode mids in
 872       let ender = bad_mcode ender in
 873       mkmultires c (Ast0.DisjCase(starter,case_lines,mids,ender))
 874         (promote_mcode starter) (promote_mcode ender)
 875         (get_all_start_info case_lines) (get_all_end_info case_lines)
 876   | Ast0.OptCase(case) ->
 877       let case = case_line case in mkres c (Ast0.OptCase(case)) case case
 878
 879 and statement_dots x = dots is_stm_dots None statement x
 880
 881 (* --------------------------------------------------------------------- *)
 882 (* Function declaration *)
 883
 884 let top_level t =
 885   match Ast0.unwrap t with
 886     Ast0.FILEINFO(old_file,new_file) -> t
 887   | Ast0.DECL(stmt) ->
 888       let stmt = statement stmt in mkres t (Ast0.DECL(stmt)) stmt stmt
 889   | Ast0.CODE(rule_elem_dots) ->
 890       let rule_elem_dots = dots is_stm_dots None statement rule_elem_dots in
 891       mkres t (Ast0.CODE(rule_elem_dots)) rule_elem_dots rule_elem_dots
 892   | Ast0.ERRORWORDS(exps) -> t
 893   | Ast0.OTHER(_) -> failwith "eliminated by top_level"
 894
 895 (* --------------------------------------------------------------------- *)
 896 (* Entry points *)
 897
 898 let compute_lines attachable_or x =
 899   in_nest_count := 0;
 900   inherit_attachable := attachable_or;
 901   List.map top_level x
 902
 903 let compute_statement_lines attachable_or x =
 904   in_nest_count := 0;
 905   inherit_attachable := attachable_or;
 906   statement x
 907
 908 let compute_statement_dots_lines attachable_or x =
 909   in_nest_count := 0;
 910   inherit_attachable := attachable_or;
 911   statement_dots x
 912