parsing_cocci/.#compute_lines.ml.1.92

   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.MetaInit(name,_) as ut ->
 453       let ln = promote_mcode name in mkres i ut ln ln
 454   | Ast0.InitExpr(exp) ->
 455       let exp = expression exp in
 456       mkres i (Ast0.InitExpr(exp)) exp exp
 457   | Ast0.InitList(lb,initlist,rb) ->
 458       let initlist =
 459         dots is_init_dots (Some(promote_mcode lb)) initialiser initlist in
 460       mkres i (Ast0.InitList(lb,initlist,rb))
 461         (promote_mcode lb) (promote_mcode rb)
 462   | Ast0.InitGccExt(designators,eq,ini) ->
 463       let (delims,designators) = (* non empty due to parsing *)
 464         List.split (List.map designator designators) in
 465       let ini = initialiser ini in
 466       mkres i (Ast0.InitGccExt(designators,eq,ini))
 467         (promote_mcode (List.hd delims)) ini
 468   | Ast0.InitGccName(name,eq,ini) ->
 469       let name = ident name in
 470       let ini = initialiser ini in
 471       mkres i (Ast0.InitGccName(name,eq,ini)) name 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 designator = function
 486     Ast0.DesignatorField(dot,id) ->
 487       (dot,Ast0.DesignatorField(dot,ident id))
 488   | Ast0.DesignatorIndex(lb,exp,rb) ->
 489       (lb,Ast0.DesignatorIndex(lb,expression exp,rb))
 490   | Ast0.DesignatorRange(lb,min,dots,max,rb) ->
 491       (lb,Ast0.DesignatorRange(lb,expression min,dots,expression max,rb))
 492
 493 and initialiser_list prev = dots is_init_dots prev initialiser
 494
 495 (* for export *)
 496 and initialiser_dots x = dots is_init_dots None initialiser x
 497
 498 (* --------------------------------------------------------------------- *)
 499 (* Parameter *)
 500
 501 and is_param_dots p =
 502   match Ast0.unwrap p with
 503     Ast0.Pdots(_) | Ast0.Pcircles(_) -> true
 504   | _ -> false
 505
 506 and parameterTypeDef p =
 507   match Ast0.unwrap p with
 508     Ast0.VoidParam(ty) ->
 509       let ty = typeC ty in mkres p (Ast0.VoidParam(ty)) ty ty
 510   | Ast0.Param(ty,Some id) ->
 511       let id = ident id in
 512       let ty = typeC ty in mkres p (Ast0.Param(ty,Some id)) ty id
 513   | Ast0.Param(ty,None) ->
 514       let ty = typeC ty in mkres p (Ast0.Param(ty,None)) ty ty
 515   | Ast0.MetaParam(name,_) as up ->
 516       let ln = promote_mcode name in mkres p up ln ln
 517   | Ast0.MetaParamList(name,_,_) as up ->
 518       let ln = promote_mcode name in mkres p up ln ln
 519   | Ast0.PComma(cm) ->
 520       let cm = bad_mcode cm in
 521       let ln = promote_mcode cm in
 522       mkres p (Ast0.PComma(cm)) ln ln
 523   | Ast0.Pdots(dots) ->
 524       let dots = bad_mcode dots in
 525       let ln = promote_mcode dots in
 526       mkres p (Ast0.Pdots(dots)) ln ln
 527   | Ast0.Pcircles(dots) ->
 528       let dots = bad_mcode dots in
 529       let ln = promote_mcode dots in
 530       mkres p (Ast0.Pcircles(dots)) ln ln
 531   | Ast0.OptParam(param) ->
 532       let res = parameterTypeDef param in
 533       mkres p (Ast0.OptParam(res)) res res
 534   | Ast0.UniqueParam(param) ->
 535       let res = parameterTypeDef param in
 536       mkres p (Ast0.UniqueParam(res)) res res
 537
 538 and parameter_list prev = dots is_param_dots prev parameterTypeDef
 539
 540 (* for export *)
 541 let parameter_dots x = dots is_param_dots None parameterTypeDef x
 542
 543 (* --------------------------------------------------------------------- *)
 544 (* Top-level code *)
 545
 546 let is_stm_dots s =
 547   match Ast0.unwrap s with
 548     Ast0.Dots(_,_) | Ast0.Circles(_,_) | Ast0.Stars(_,_) -> true
 549   | _ -> false
 550
 551 let rec statement s =
 552   let res =
 553     match Ast0.unwrap s with
 554       Ast0.Decl((_,bef),decl) ->
 555         let decl = declaration decl in
 556         let left = promote_to_statement_start decl bef in
 557         mkres s (Ast0.Decl((Ast0.get_info left,bef),decl)) decl decl
 558     | Ast0.Seq(lbrace,body,rbrace) ->
 559         let body =
 560           dots is_stm_dots (Some(promote_mcode lbrace)) statement body in
 561         mkres s (Ast0.Seq(lbrace,body,rbrace))
 562           (promote_mcode lbrace) (promote_mcode rbrace)
 563     | Ast0.ExprStatement(exp,sem) ->
 564         let exp = expression exp in
 565         mkres s (Ast0.ExprStatement(exp,sem)) exp (promote_mcode sem)
 566     | Ast0.IfThen(iff,lp,exp,rp,branch,(_,aft)) ->
 567         let exp = expression exp in
 568         let branch = statement branch in
 569         let right = promote_to_statement branch aft in
 570         mkres s (Ast0.IfThen(iff,lp,exp,rp,branch,(Ast0.get_info right,aft)))
 571           (promote_mcode iff) right
 572     | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(_,aft)) ->
 573         let exp = expression exp in
 574         let branch1 = statement branch1 in
 575         let branch2 = statement branch2 in
 576         let right = promote_to_statement branch2 aft in
 577         mkres s
 578           (Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,
 579             (Ast0.get_info right,aft)))
 580           (promote_mcode iff) right
 581     | Ast0.While(wh,lp,exp,rp,body,(_,aft)) ->
 582         let exp = expression exp in
 583         let body = statement body in
 584         let right = promote_to_statement body aft in
 585         mkres s (Ast0.While(wh,lp,exp,rp,body,(Ast0.get_info right,aft)))
 586           (promote_mcode wh) right
 587     | Ast0.Do(d,body,wh,lp,exp,rp,sem) ->
 588         let body = statement body in
 589         let exp = expression exp in
 590         mkres s (Ast0.Do(d,body,wh,lp,exp,rp,sem))
 591           (promote_mcode d) (promote_mcode sem)
 592     | Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,(_,aft)) ->
 593         let exp1 = get_option expression exp1 in
 594         let exp2 = get_option expression exp2 in
 595         let exp3 = get_option expression exp3 in
 596         let body = statement body in
 597         let right = promote_to_statement body aft in
 598         mkres s (Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,
 599                           (Ast0.get_info right,aft)))
 600           (promote_mcode fr) right
 601     | Ast0.Iterator(nm,lp,args,rp,body,(_,aft)) ->
 602         let nm = ident nm in
 603         let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
 604         let body = statement body in
 605         let right = promote_to_statement body aft in
 606         mkres s (Ast0.Iterator(nm,lp,args,rp,body,(Ast0.get_info right,aft)))
 607           nm right
 608     | Ast0.Switch(switch,lp,exp,rp,lb,cases,rb) ->
 609         let exp = expression exp in
 610         let cases =
 611           dots (function _ -> false) (Some(promote_mcode lb)) case_line cases in
 612         mkres s
 613           (Ast0.Switch(switch,lp,exp,rp,lb,cases,rb))
 614           (promote_mcode switch) (promote_mcode rb)
 615     | Ast0.Break(br,sem) as us ->
 616         mkres s us (promote_mcode br) (promote_mcode sem)
 617     | Ast0.Continue(cont,sem) as us ->
 618         mkres s us (promote_mcode cont) (promote_mcode sem)
 619     | Ast0.Label(l,dd) ->
 620         let l = ident l in
 621         mkres s (Ast0.Label(l,dd)) l (promote_mcode dd)
 622     | Ast0.Goto(goto,id,sem) ->
 623         let id = ident id in
 624         mkres s (Ast0.Goto(goto,id,sem))
 625           (promote_mcode goto) (promote_mcode sem)
 626     | Ast0.Return(ret,sem) as us ->
 627         mkres s us (promote_mcode ret) (promote_mcode sem)
 628     | Ast0.ReturnExpr(ret,exp,sem) ->
 629         let exp = expression exp in
 630         mkres s (Ast0.ReturnExpr(ret,exp,sem))
 631           (promote_mcode ret) (promote_mcode sem)
 632     | Ast0.MetaStmt(name,_)
 633     | Ast0.MetaStmtList(name,_) as us ->
 634         let ln = promote_mcode name in mkres s us ln ln
 635     | Ast0.Exp(exp) ->
 636         let exp = expression exp in
 637         mkres s (Ast0.Exp(exp)) exp exp
 638     | Ast0.TopExp(exp) ->
 639         let exp = expression exp in
 640         mkres s (Ast0.TopExp(exp)) exp exp
 641     | Ast0.Ty(ty) ->
 642         let ty = typeC ty in
 643         mkres s (Ast0.Ty(ty)) ty ty
 644     | Ast0.TopInit(init) ->
 645         let init = initialiser init in
 646         mkres s (Ast0.TopInit(init)) init init
 647     | Ast0.Disj(starter,rule_elem_dots_list,mids,ender) ->
 648         let starter = bad_mcode starter in
 649         let mids = List.map bad_mcode mids in
 650         let ender = bad_mcode ender in
 651         let rec loop prevs = function
 652             [] -> []
 653           | stm::stms ->
 654               (dots is_stm_dots (Some(promote_mcode_plus_one(List.hd prevs)))
 655                  statement stm)::
 656               (loop (List.tl prevs) stms) in
 657         let elems = loop (starter::mids) rule_elem_dots_list in
 658         mkmultires s (Ast0.Disj(starter,elems,mids,ender))
 659           (promote_mcode starter) (promote_mcode ender)
 660           (get_all_start_info elems) (get_all_end_info elems)
 661     | Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi) ->
 662         let starter = bad_mcode starter in
 663         let ender = bad_mcode ender in
 664         let rule_elem_dots = dots is_stm_dots None statement rule_elem_dots in
 665         mkres s (Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi))
 666           (promote_mcode starter) (promote_mcode ender)
 667     | Ast0.Dots(dots,whencode) ->
 668         let dots = bad_mcode dots in
 669         let ln = promote_mcode dots in
 670         mkres s (Ast0.Dots(dots,whencode)) ln ln
 671     | Ast0.Circles(dots,whencode) ->
 672         let dots = bad_mcode dots in
 673         let ln = promote_mcode dots in
 674         mkres s (Ast0.Circles(dots,whencode)) ln ln
 675     | Ast0.Stars(dots,whencode) ->
 676         let dots = bad_mcode dots in
 677         let ln = promote_mcode dots in
 678         mkres s (Ast0.Stars(dots,whencode)) ln ln
 679     | Ast0.FunDecl((_,bef),fninfo,name,lp,params,rp,lbrace,body,rbrace) ->
 680         let fninfo =
 681           List.map
 682             (function Ast0.FType(ty) -> Ast0.FType(typeC ty) | x -> x)
 683             fninfo in
 684         let name = ident name in
 685         let params = parameter_list (Some(promote_mcode lp)) params in
 686         let body =
 687           dots is_stm_dots (Some(promote_mcode lbrace)) statement body in
 688         let left =
 689         (* cases on what is leftmost *)
 690           match fninfo with
 691             [] -> promote_to_statement_start name bef
 692           | Ast0.FStorage(stg)::_ ->
 693               promote_to_statement_start (promote_mcode stg) bef
 694           | Ast0.FType(ty)::_ ->
 695               promote_to_statement_start ty bef
 696           | Ast0.FInline(inline)::_ ->
 697               promote_to_statement_start (promote_mcode inline) bef
 698           | Ast0.FAttr(attr)::_ ->
 699               promote_to_statement_start (promote_mcode attr) bef in
 700       (* pretend it is one line before the start of the function, so that it
 701          will catch things defined at top level.  We assume that these will not
 702          be defined on the same line as the function.  This is a HACK.
 703          A better approach would be to attach top_level things to this node,
 704          and other things to the node after, but that would complicate
 705          insert_plus, which doesn't distinguish between different mcodekinds *)
 706         let res =
 707           Ast0.FunDecl((Ast0.get_info left,bef),fninfo,name,lp,params,rp,lbrace,
 708                        body,rbrace) in
 709       (* have to do this test again, because of typing problems - can't save
 710          the result, only use it *)
 711         (match fninfo with
 712           [] -> mkres s res name (promote_mcode rbrace)
 713         | Ast0.FStorage(stg)::_ ->
 714             mkres s res (promote_mcode stg) (promote_mcode rbrace)
 715         | Ast0.FType(ty)::_ -> mkres s res ty (promote_mcode rbrace)
 716         | Ast0.FInline(inline)::_ ->
 717             mkres s res (promote_mcode inline) (promote_mcode rbrace)
 718         | Ast0.FAttr(attr)::_ ->
 719             mkres s res (promote_mcode attr) (promote_mcode rbrace))
 720
 721     | Ast0.Include(inc,stm) ->
 722         mkres s (Ast0.Include(inc,stm)) (promote_mcode inc) (promote_mcode stm)
 723     | Ast0.Define(def,id,params,body) ->
 724         let id = ident id in
 725         let body = dots is_stm_dots None statement body in
 726         mkres s (Ast0.Define(def,id,params,body)) (promote_mcode def) body
 727     | Ast0.OptStm(stm) ->
 728         let stm = statement stm in mkres s (Ast0.OptStm(stm)) stm stm
 729     | Ast0.UniqueStm(stm) ->
 730         let stm = statement stm in mkres s (Ast0.UniqueStm(stm)) stm stm in
 731   Ast0.set_dots_bef_aft res
 732     (match Ast0.get_dots_bef_aft res with
 733       Ast0.NoDots -> Ast0.NoDots
 734     | Ast0.AddingBetweenDots s ->
 735         Ast0.AddingBetweenDots(statement s)
 736     | Ast0.DroppingBetweenDots s ->
 737         Ast0.DroppingBetweenDots(statement s))
 738
 739 and case_line c =
 740   match Ast0.unwrap c with
 741     Ast0.Default(def,colon,code) ->
 742       let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in
 743       mkres c (Ast0.Default(def,colon,code)) (promote_mcode def) code
 744   | Ast0.Case(case,exp,colon,code) ->
 745       let exp = expression exp in
 746       let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in
 747       mkres c (Ast0.Case(case,exp,colon,code)) (promote_mcode case) code
 748   | Ast0.OptCase(case) ->
 749       let case = case_line case in mkres c (Ast0.OptCase(case)) case case
 750
 751 and statement_dots x = dots is_stm_dots None statement x
 752
 753 (* --------------------------------------------------------------------- *)
 754 (* Function declaration *)
 755
 756 let top_level t =
 757   match Ast0.unwrap t with
 758     Ast0.FILEINFO(old_file,new_file) -> t
 759   | Ast0.DECL(stmt) ->
 760       let stmt = statement stmt in mkres t (Ast0.DECL(stmt)) stmt stmt
 761   | Ast0.CODE(rule_elem_dots) ->
 762       let rule_elem_dots = dots is_stm_dots None statement rule_elem_dots in
 763       mkres t (Ast0.CODE(rule_elem_dots)) rule_elem_dots rule_elem_dots
 764   | Ast0.ERRORWORDS(exps) -> t
 765   | Ast0.OTHER(_) -> failwith "eliminated by top_level"
 766
 767 (* --------------------------------------------------------------------- *)
 768 (* Entry points *)
 769
 770 let compute_lines = List.map top_level
 771