parsing_cocci/compute_lines.ml

   1 (*
   2 * Copyright 2005-2008, 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,None) as ut ->
 320       mkres t ut (promote_mcode ty) (promote_mcode ty)
 321   | Ast0.BaseType(ty,Some sgn) as ut ->
 322       mkres t ut (promote_mcode sgn) (promote_mcode ty)
 323   | Ast0.ImplicitInt(sgn) as ut ->
 324       mkres t ut (promote_mcode sgn) (promote_mcode sgn)
 325   | Ast0.Pointer(ty,star) ->
 326       let ty = typeC ty in
 327       mkres t (Ast0.Pointer(ty,star)) ty (promote_mcode star)
 328   | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
 329       let ty = typeC ty in
 330       let params = parameter_list (Some(promote_mcode lp2)) params in
 331       mkres t (Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2))
 332         ty (promote_mcode rp2)
 333   | Ast0.FunctionType(Some ty,lp1,params,rp1) ->
 334       let ty = typeC ty in
 335       let params = parameter_list (Some(promote_mcode lp1)) params in
 336       let res = Ast0.FunctionType(Some ty,lp1,params,rp1) in
 337       mkres t res ty (promote_mcode rp1)
 338   | Ast0.FunctionType(None,lp1,params,rp1) ->
 339       let params = parameter_list (Some(promote_mcode lp1)) params in
 340       let res = Ast0.FunctionType(None,lp1,params,rp1) in
 341       mkres t res (promote_mcode lp1) (promote_mcode rp1)
 342   | Ast0.Array(ty,lb,size,rb) ->
 343       let ty = typeC ty in
 344       mkres t (Ast0.Array(ty,lb,get_option expression size,rb))
 345         ty (promote_mcode rb)
 346   | Ast0.StructUnionName(kind,Some name) ->
 347       let name = ident name in
 348       mkres t (Ast0.StructUnionName(kind,Some name)) (promote_mcode kind) name
 349   | Ast0.StructUnionName(kind,None) ->
 350       let mc = promote_mcode kind in
 351       mkres t (Ast0.StructUnionName(kind,None)) mc mc
 352   | Ast0.StructUnionDef(ty,lb,decls,rb) ->
 353       let ty = typeC ty in
 354       let decls =
 355         dots is_decl_dots (Some(promote_mcode lb)) declaration decls in
 356       mkres t (Ast0.StructUnionDef(ty,lb,decls,rb)) ty (promote_mcode rb)
 357   | Ast0.TypeName(name) as ut ->
 358       let ln = promote_mcode name in mkres t ut ln ln
 359   | Ast0.MetaType(name,_) as ut ->
 360       let ln = promote_mcode name in mkres t ut ln ln
 361   | Ast0.DisjType(starter,types,mids,ender) ->
 362       let starter = bad_mcode starter in
 363       let types = List.map typeC types in
 364       let mids = List.map bad_mcode mids in
 365       let ender = bad_mcode ender in
 366       mkmultires t (Ast0.DisjType(starter,types,mids,ender))
 367         (promote_mcode starter) (promote_mcode ender)
 368         (get_all_start_info types) (get_all_end_info types)
 369   | Ast0.OptType(ty) ->
 370       let ty = typeC ty in mkres t (Ast0.OptType(ty)) ty ty
 371   | Ast0.UniqueType(ty) ->
 372       let ty = typeC ty in mkres t (Ast0.UniqueType(ty)) ty ty
 373
 374 (* --------------------------------------------------------------------- *)
 375 (* Variable declaration *)
 376 (* Even if the Cocci program specifies a list of declarations, they are
 377    split out into multiple declarations of a single variable each. *)
 378
 379 and is_decl_dots s =
 380   match Ast0.unwrap s with
 381     Ast0.Ddots(_,_) -> true
 382   | _ -> false
 383
 384 and declaration d =
 385   match Ast0.unwrap d with
 386     Ast0.Init(stg,ty,id,eq,exp,sem) ->
 387       let ty = typeC ty in
 388       let id = ident id in
 389       let exp = initialiser exp in
 390       (match stg with
 391         None ->
 392           mkres d (Ast0.Init(stg,ty,id,eq,exp,sem)) ty (promote_mcode sem)
 393       | Some x ->
 394           mkres d (Ast0.Init(stg,ty,id,eq,exp,sem))
 395             (promote_mcode x) (promote_mcode sem))
 396   | Ast0.UnInit(stg,ty,id,sem) ->
 397       let ty = typeC ty in
 398       let id = ident id in
 399       (match stg with
 400         None ->
 401           mkres d (Ast0.UnInit(stg,ty,id,sem)) ty (promote_mcode sem)
 402       | Some x ->
 403           mkres d (Ast0.UnInit(stg,ty,id,sem))
 404             (promote_mcode x) (promote_mcode sem))
 405   | Ast0.MacroDecl(name,lp,args,rp,sem) ->
 406       let name = ident name in
 407       let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
 408       mkres d (Ast0.MacroDecl(name,lp,args,rp,sem)) name (promote_mcode sem)
 409   | Ast0.TyDecl(ty,sem) ->
 410       let ty = typeC ty in
 411       mkres d (Ast0.TyDecl(ty,sem)) ty (promote_mcode sem)
 412   | Ast0.Typedef(stg,ty,id,sem) ->
 413       let ty = typeC ty in
 414       let id = typeC id in
 415       mkres d (Ast0.Typedef(stg,ty,id,sem))
 416         (promote_mcode stg) (promote_mcode sem)
 417   | Ast0.DisjDecl(starter,decls,mids,ender) ->
 418       let starter = bad_mcode starter in
 419       let decls = List.map declaration decls in
 420       let mids = List.map bad_mcode mids in
 421       let ender = bad_mcode ender in
 422       mkmultires d (Ast0.DisjDecl(starter,decls,mids,ender))
 423         (promote_mcode starter) (promote_mcode ender)
 424         (get_all_start_info decls) (get_all_end_info decls)
 425   | Ast0.Ddots(dots,whencode) ->
 426       let dots = bad_mcode dots in
 427       let ln = promote_mcode dots in
 428       mkres d (Ast0.Ddots(dots,whencode)) ln ln
 429   | Ast0.OptDecl(decl) ->
 430       let decl = declaration decl in
 431       mkres d (Ast0.OptDecl(declaration decl)) decl decl
 432   | Ast0.UniqueDecl(decl) ->
 433       let decl = declaration decl in
 434       mkres d (Ast0.UniqueDecl(declaration decl)) decl decl
 435
 436 (* --------------------------------------------------------------------- *)
 437 (* Initializer *)
 438
 439 and is_init_dots i =
 440   match Ast0.unwrap i with
 441     Ast0.Idots(_,_) -> true
 442   | _ -> false
 443
 444 and initialiser i =
 445   match Ast0.unwrap i with
 446     Ast0.InitExpr(exp) ->
 447       let exp = expression exp in
 448       mkres i (Ast0.InitExpr(exp)) exp exp
 449   | Ast0.InitList(lb,initlist,rb) ->
 450       let initlist =
 451         dots is_init_dots (Some(promote_mcode lb)) initialiser initlist in
 452       mkres i (Ast0.InitList(lb,initlist,rb))
 453         (promote_mcode lb) (promote_mcode rb)
 454   | Ast0.InitGccDotName(dot,name,eq,ini) ->
 455       let name = ident name in
 456       let ini = initialiser ini in
 457       mkres i (Ast0.InitGccDotName(dot,name,eq,ini)) (promote_mcode dot) ini
 458   | Ast0.InitGccName(name,eq,ini) ->
 459       let name = ident name in
 460       let ini = initialiser ini in
 461       mkres i (Ast0.InitGccName(name,eq,ini)) name ini
 462   | Ast0.InitGccIndex(lb,exp,rb,eq,ini) ->
 463       let exp = expression exp in
 464       let ini = initialiser ini in
 465       mkres i (Ast0.InitGccIndex(lb,exp,rb,eq,ini)) (promote_mcode lb) ini
 466   | Ast0.InitGccRange(lb,exp1,dots,exp2,rb,eq,ini) ->
 467       let exp1 = expression exp1 in
 468       let exp2 = expression exp2 in
 469       let ini = initialiser ini in
 470       mkres i (Ast0.InitGccRange(lb,exp1,dots,exp2,rb,eq,ini))
 471         (promote_mcode lb) ini
 472   | Ast0.IComma(cm) as up ->
 473       let ln = promote_mcode cm in mkres i up ln ln
 474   | Ast0.Idots(dots,whencode) ->
 475       let dots = bad_mcode dots in
 476       let ln = promote_mcode dots in
 477       mkres i (Ast0.Idots(dots,whencode)) ln ln
 478   | Ast0.OptIni(ini) ->
 479       let ini = initialiser ini in
 480       mkres i (Ast0.OptIni(ini)) ini ini
 481   | Ast0.UniqueIni(ini) ->
 482       let ini = initialiser ini in
 483       mkres i (Ast0.UniqueIni(ini)) ini ini
 484
 485 and initialiser_list prev = dots is_init_dots prev initialiser
 486
 487 (* for export *)
 488 and initialiser_dots x = dots is_init_dots None initialiser x
 489
 490 (* --------------------------------------------------------------------- *)
 491 (* Parameter *)
 492
 493 and is_param_dots p =
 494   match Ast0.unwrap p with
 495     Ast0.Pdots(_) | Ast0.Pcircles(_) -> true
 496   | _ -> false
 497
 498 and parameterTypeDef p =
 499   match Ast0.unwrap p with
 500     Ast0.VoidParam(ty) ->
 501       let ty = typeC ty in mkres p (Ast0.VoidParam(ty)) ty ty
 502   | Ast0.Param(ty,Some id) ->
 503       let id = ident id in
 504       let ty = typeC ty in mkres p (Ast0.Param(ty,Some id)) ty id
 505   | Ast0.Param(ty,None) ->
 506       let ty = typeC ty in mkres p (Ast0.Param(ty,None)) ty ty
 507   | Ast0.MetaParam(name,_) as up ->
 508       let ln = promote_mcode name in mkres p up ln ln
 509   | Ast0.MetaParamList(name,_,_) as up ->
 510       let ln = promote_mcode name in mkres p up ln ln
 511   | Ast0.PComma(cm) ->
 512       let cm = bad_mcode cm in
 513       let ln = promote_mcode cm in
 514       mkres p (Ast0.PComma(cm)) ln ln
 515   | Ast0.Pdots(dots) ->
 516       let dots = bad_mcode dots in
 517       let ln = promote_mcode dots in
 518       mkres p (Ast0.Pdots(dots)) ln ln
 519   | Ast0.Pcircles(dots) ->
 520       let dots = bad_mcode dots in
 521       let ln = promote_mcode dots in
 522       mkres p (Ast0.Pcircles(dots)) ln ln
 523   | Ast0.OptParam(param) ->
 524       let res = parameterTypeDef param in
 525       mkres p (Ast0.OptParam(res)) res res
 526   | Ast0.UniqueParam(param) ->
 527       let res = parameterTypeDef param in
 528       mkres p (Ast0.UniqueParam(res)) res res
 529
 530 and parameter_list prev = dots is_param_dots prev parameterTypeDef
 531
 532 (* for export *)
 533 let parameter_dots x = dots is_param_dots None parameterTypeDef x
 534
 535 (* --------------------------------------------------------------------- *)
 536 (* Top-level code *)
 537
 538 let is_stm_dots s =
 539   match Ast0.unwrap s with
 540     Ast0.Dots(_,_) | Ast0.Circles(_,_) | Ast0.Stars(_,_) -> true
 541   | _ -> false
 542
 543 let rec statement s =
 544   let res =
 545     match Ast0.unwrap s with
 546       Ast0.Decl((_,bef),decl) ->
 547         let decl = declaration decl in
 548         let left = promote_to_statement_start decl bef in
 549         mkres s (Ast0.Decl((Ast0.get_info left,bef),decl)) decl decl
 550     | Ast0.Seq(lbrace,body,rbrace) ->
 551         let body =
 552           dots is_stm_dots (Some(promote_mcode lbrace)) statement body in
 553         mkres s (Ast0.Seq(lbrace,body,rbrace))
 554           (promote_mcode lbrace) (promote_mcode rbrace)
 555     | Ast0.ExprStatement(exp,sem) ->
 556         let exp = expression exp in
 557         mkres s (Ast0.ExprStatement(exp,sem)) exp (promote_mcode sem)
 558     | Ast0.IfThen(iff,lp,exp,rp,branch,(_,aft)) ->
 559         let exp = expression exp in
 560         let branch = statement branch in
 561         let right = promote_to_statement branch aft in
 562         mkres s (Ast0.IfThen(iff,lp,exp,rp,branch,(Ast0.get_info right,aft)))
 563           (promote_mcode iff) right
 564     | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(_,aft)) ->
 565         let exp = expression exp in
 566         let branch1 = statement branch1 in
 567         let branch2 = statement branch2 in
 568         let right = promote_to_statement branch2 aft in
 569         mkres s
 570           (Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,
 571             (Ast0.get_info right,aft)))
 572           (promote_mcode iff) right
 573     | Ast0.While(wh,lp,exp,rp,body,(_,aft)) ->
 574         let exp = expression exp in
 575         let body = statement body in
 576         let right = promote_to_statement body aft in
 577         mkres s (Ast0.While(wh,lp,exp,rp,body,(Ast0.get_info right,aft)))
 578           (promote_mcode wh) right
 579     | Ast0.Do(d,body,wh,lp,exp,rp,sem) ->
 580         let body = statement body in
 581         let exp = expression exp in
 582         mkres s (Ast0.Do(d,body,wh,lp,exp,rp,sem))
 583           (promote_mcode d) (promote_mcode sem)
 584     | Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,(_,aft)) ->
 585         let exp1 = get_option expression exp1 in
 586         let exp2 = get_option expression exp2 in
 587         let exp3 = get_option expression exp3 in
 588         let body = statement body in
 589         let right = promote_to_statement body aft in
 590         mkres s (Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,
 591                           (Ast0.get_info right,aft)))
 592           (promote_mcode fr) right
 593     | Ast0.Iterator(nm,lp,args,rp,body,(_,aft)) ->
 594         let nm = ident nm in
 595         let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
 596         let body = statement body in
 597         let right = promote_to_statement body aft in
 598         mkres s (Ast0.Iterator(nm,lp,args,rp,body,(Ast0.get_info right,aft)))
 599           nm right
 600     | Ast0.Switch(switch,lp,exp,rp,lb,cases,rb) ->
 601         let exp = expression exp in
 602         let cases =
 603           dots (function _ -> false) (Some(promote_mcode lb)) case_line cases in
 604         mkres s
 605           (Ast0.Switch(switch,lp,exp,rp,lb,cases,rb))
 606           (promote_mcode switch) (promote_mcode rb)
 607     | Ast0.Break(br,sem) as us ->
 608         mkres s us (promote_mcode br) (promote_mcode sem)
 609     | Ast0.Continue(cont,sem) as us ->
 610         mkres s us (promote_mcode cont) (promote_mcode sem)
 611     | Ast0.Label(l,dd) ->
 612         let l = ident l in
 613         mkres s (Ast0.Label(l,dd)) l (promote_mcode dd)
 614     | Ast0.Goto(goto,id,sem) ->
 615         let id = ident id in
 616         mkres s (Ast0.Goto(goto,id,sem))
 617           (promote_mcode goto) (promote_mcode sem)
 618     | Ast0.Return(ret,sem) as us ->
 619         mkres s us (promote_mcode ret) (promote_mcode sem)
 620     | Ast0.ReturnExpr(ret,exp,sem) ->
 621         let exp = expression exp in
 622         mkres s (Ast0.ReturnExpr(ret,exp,sem))
 623           (promote_mcode ret) (promote_mcode sem)
 624     | Ast0.MetaStmt(name,_)
 625     | Ast0.MetaStmtList(name,_) as us ->
 626         let ln = promote_mcode name in mkres s us ln ln
 627     | Ast0.Exp(exp) ->
 628         let exp = expression exp in
 629         mkres s (Ast0.Exp(exp)) exp exp
 630     | Ast0.TopExp(exp) ->
 631         let exp = expression exp in
 632         mkres s (Ast0.TopExp(exp)) exp exp
 633     | Ast0.Ty(ty) ->
 634         let ty = typeC ty in
 635         mkres s (Ast0.Ty(ty)) ty ty
 636     | Ast0.Disj(starter,rule_elem_dots_list,mids,ender) ->
 637         let starter = bad_mcode starter in
 638         let mids = List.map bad_mcode mids in
 639         let ender = bad_mcode ender in
 640         let rec loop prevs = function
 641             [] -> []
 642           | stm::stms ->
 643               (dots is_stm_dots (Some(promote_mcode_plus_one(List.hd prevs)))
 644                  statement stm)::
 645               (loop (List.tl prevs) stms) in
 646         let elems = loop (starter::mids) rule_elem_dots_list in
 647         mkmultires s (Ast0.Disj(starter,elems,mids,ender))
 648           (promote_mcode starter) (promote_mcode ender)
 649           (get_all_start_info elems) (get_all_end_info elems)
 650     | Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi) ->
 651         let starter = bad_mcode starter in
 652         let ender = bad_mcode ender in
 653         let rule_elem_dots = dots is_stm_dots None statement rule_elem_dots in
 654         mkres s (Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi))
 655           (promote_mcode starter) (promote_mcode ender)
 656     | Ast0.Dots(dots,whencode) ->
 657         let dots = bad_mcode dots in
 658         let ln = promote_mcode dots in
 659         mkres s (Ast0.Dots(dots,whencode)) ln ln
 660     | Ast0.Circles(dots,whencode) ->
 661         let dots = bad_mcode dots in
 662         let ln = promote_mcode dots in
 663         mkres s (Ast0.Circles(dots,whencode)) ln ln
 664     | Ast0.Stars(dots,whencode) ->
 665         let dots = bad_mcode dots in
 666         let ln = promote_mcode dots in
 667         mkres s (Ast0.Stars(dots,whencode)) ln ln
 668     | Ast0.FunDecl((_,bef),fninfo,name,lp,params,rp,lbrace,body,rbrace) ->
 669         let fninfo =
 670           List.map
 671             (function Ast0.FType(ty) -> Ast0.FType(typeC ty) | x -> x)
 672             fninfo in
 673         let name = ident name in
 674         let params = parameter_list (Some(promote_mcode lp)) params in
 675         let body =
 676           dots is_stm_dots (Some(promote_mcode lbrace)) statement body in
 677         let left =
 678         (* cases on what is leftmost *)
 679           match fninfo with
 680             [] -> promote_to_statement_start name bef
 681           | Ast0.FStorage(stg)::_ ->
 682               promote_to_statement_start (promote_mcode stg) bef
 683           | Ast0.FType(ty)::_ ->
 684               promote_to_statement_start ty bef
 685           | Ast0.FInline(inline)::_ ->
 686               promote_to_statement_start (promote_mcode inline) bef
 687           | Ast0.FAttr(attr)::_ ->
 688               promote_to_statement_start (promote_mcode attr) bef in
 689       (* pretend it is one line before the start of the function, so that it
 690          will catch things defined at top level.  We assume that these will not
 691          be defined on the same line as the function.  This is a HACK.
 692          A better approach would be to attach top_level things to this node,
 693          and other things to the node after, but that would complicate
 694          insert_plus, which doesn't distinguish between different mcodekinds *)
 695         let res =
 696           Ast0.FunDecl((Ast0.get_info left,bef),fninfo,name,lp,params,rp,lbrace,
 697                        body,rbrace) in
 698       (* have to do this test again, because of typing problems - can't save
 699          the result, only use it *)
 700         (match fninfo with
 701           [] -> mkres s res name (promote_mcode rbrace)
 702         | Ast0.FStorage(stg)::_ ->
 703             mkres s res (promote_mcode stg) (promote_mcode rbrace)
 704         | Ast0.FType(ty)::_ -> mkres s res ty (promote_mcode rbrace)
 705         | Ast0.FInline(inline)::_ ->
 706             mkres s res (promote_mcode inline) (promote_mcode rbrace)
 707         | Ast0.FAttr(attr)::_ ->
 708             mkres s res (promote_mcode attr) (promote_mcode rbrace))
 709
 710     | Ast0.Include(inc,stm) ->
 711         mkres s (Ast0.Include(inc,stm)) (promote_mcode inc) (promote_mcode stm)
 712     | Ast0.Define(def,id,params,body) ->
 713         let id = ident id in
 714         let body = dots is_stm_dots None statement body in
 715         mkres s (Ast0.Define(def,id,params,body)) (promote_mcode def) body
 716     | Ast0.OptStm(stm) ->
 717         let stm = statement stm in mkres s (Ast0.OptStm(stm)) stm stm
 718     | Ast0.UniqueStm(stm) ->
 719         let stm = statement stm in mkres s (Ast0.UniqueStm(stm)) stm stm in
 720   Ast0.set_dots_bef_aft res
 721     (match Ast0.get_dots_bef_aft res with
 722       Ast0.NoDots -> Ast0.NoDots
 723     | Ast0.AddingBetweenDots s ->
 724         Ast0.AddingBetweenDots(statement s)
 725     | Ast0.DroppingBetweenDots s ->
 726         Ast0.DroppingBetweenDots(statement s))
 727
 728 and case_line c =
 729   match Ast0.unwrap c with
 730     Ast0.Default(def,colon,code) ->
 731       let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in
 732       mkres c (Ast0.Default(def,colon,code)) (promote_mcode def) code
 733   | Ast0.Case(case,exp,colon,code) ->
 734       let exp = expression exp in
 735       let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in
 736       mkres c (Ast0.Case(case,exp,colon,code)) (promote_mcode case) code
 737   | Ast0.OptCase(case) ->
 738       let case = case_line case in mkres c (Ast0.OptCase(case)) case case
 739
 740 and statement_dots x = dots is_stm_dots None statement x
 741
 742 (* --------------------------------------------------------------------- *)
 743 (* Function declaration *)
 744
 745 let top_level t =
 746   match Ast0.unwrap t with
 747     Ast0.FILEINFO(old_file,new_file) -> t
 748   | Ast0.DECL(stmt) ->
 749       let stmt = statement stmt in mkres t (Ast0.DECL(stmt)) stmt stmt
 750   | Ast0.CODE(rule_elem_dots) ->
 751       let rule_elem_dots = dots is_stm_dots None statement rule_elem_dots in
 752       mkres t (Ast0.CODE(rule_elem_dots)) rule_elem_dots rule_elem_dots
 753   | Ast0.ERRORWORDS(exps) -> t
 754   | Ast0.OTHER(_) -> failwith "eliminated by top_level"
 755
 756 (* --------------------------------------------------------------------- *)
 757 (* Entry points *)
 758
 759 let compute_lines = List.map top_level
 760