parsing_cocci/compute_lines.ml

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