parsing_cocci/compute_lines.ml

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