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