parsing_cocci/compute_lines.ml

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