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