parsing_cocci/.#compute_lines.ml.1.90

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