parsing_cocci/compute_lines.ml

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