parsing_cocci/compute_lines.ml

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