parsing_cocci/get_metas.ml

   1 (*
   2  * Copyright 2012, INRIA
   3  * Julia Lawall, Gilles Muller
   4  * Copyright 2010-2011, INRIA, University of Copenhagen
   5  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
   6  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
   7  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
   8  * This file is part of Coccinelle.
   9  *
  10  * Coccinelle is free software: you can redistribute it and/or modify
  11  * it under the terms of the GNU General Public License as published by
  12  * the Free Software Foundation, according to version 2 of the License.
  13  *
  14  * Coccinelle is distributed in the hope that it will be useful,
  15  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  16  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17  * GNU General Public License for more details.
  18  *
  19  * You should have received a copy of the GNU General Public License
  20  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  21  *
  22  * The authors reserve the right to distribute this or future versions of
  23  * Coccinelle under other licenses.
  24  *)
  25
  26
  27 (* --------------------------------------------------------------------- *)
  28 (* creates AsExpr, etc *)
  29 (* @ attached metavariables can only be associated with positions, so nothing
  30 to do for them *)
  31
  32 module Ast = Ast_cocci
  33 module Ast0 = Ast0_cocci
  34
  35 let map_split f l = List.split(List.map f l)
  36
  37 let rewrap x (n,e) = (n,Ast0.rewrap x e)
  38
  39 let mcode x =
  40   let nonpos l =
  41     List.filter (function Ast0.MetaPosTag _ -> false | _ -> true) l in
  42   (nonpos(Ast0.get_pos x),x)
  43
  44 let option_default = []
  45
  46 let bind l1 l2 =
  47   let oldnames = List.map Ast0.meta_pos_name l2 in
  48   List.fold_left
  49     (function prev -> function e1 ->
  50       if List.mem (Ast0.meta_pos_name e1) oldnames then prev else e1::prev)
  51     l2 l1
  52
  53 let multibind l =
  54   let rec loop = function
  55       [] -> option_default
  56     | [x] -> x
  57     | x::xs -> bind x (loop xs) in
  58   loop l
  59
  60 let map_split_bind f l =
  61   let (n,e) = List.split(List.map f l) in (multibind n,e)
  62
  63 let get_option f = function
  64     Some x -> let (n,e) = f x in (n,Some e)
  65   | None -> (option_default,None)
  66
  67 let do_disj starter lst mids ender processor rebuilder =
  68   let (starter_n,starter) = mcode starter in
  69   let (lst_n,lst) = map_split processor lst in
  70   let (mids_n,mids) = map_split mcode mids in
  71   let (ender_n,ender) = mcode ender in
  72   (multibind
  73      [starter_n;List.hd lst_n;
  74        multibind (List.map2 bind mids_n (List.tl lst_n));ender_n],
  75    rebuilder starter lst mids ender)
  76
  77 let dots fn d =
  78   rewrap d
  79     (match Ast0.unwrap d with
  80       Ast0.DOTS(l) ->
  81         let (n,l) = map_split_bind fn l in (n, Ast0.DOTS(l))
  82     | Ast0.CIRCLES(l) ->
  83         let (n,l) = map_split_bind fn l in (n, Ast0.CIRCLES(l))
  84     | Ast0.STARS(l) ->
  85         let (n,l) = map_split_bind fn l in (n, Ast0.STARS(l)))
  86
  87 let rec ident i =
  88   rewrap i
  89     (match Ast0.unwrap i with
  90       Ast0.Id(name) ->
  91         let (n,name) = mcode name in (n,Ast0.Id(name))
  92     | Ast0.MetaId(name,constraints,seed,pure) ->
  93         let (n,name) = mcode name in
  94         (n,Ast0.MetaId(name,constraints,seed,pure))
  95     | Ast0.MetaFunc(name,constraints,pure) ->
  96         let (n,name) = mcode name in
  97         (n,Ast0.MetaFunc(name,constraints,pure))
  98     | Ast0.MetaLocalFunc(name,constraints,pure) ->
  99         let (n,name) = mcode name in
 100         (n,Ast0.MetaLocalFunc(name,constraints,pure))
 101     | Ast0.DisjId(starter,id_list,mids,ender) ->
 102         do_disj starter id_list mids ender ident
 103           (fun starter id_list mids ender ->
 104             Ast0.DisjId(starter,id_list,mids,ender))
 105     | Ast0.OptIdent(id) ->
 106         let (n,id) = ident id in (n,Ast0.OptIdent(id))
 107     | Ast0.UniqueIdent(id) ->
 108         let (n,id) = ident id in (n,Ast0.UniqueIdent(id)))
 109
 110 and expression e =
 111   let (metas,e) =
 112     rewrap e
 113       (match Ast0.unwrap e with
 114         Ast0.Ident(id) ->
 115           let (n,id) = ident id in (n,Ast0.Ident(id))
 116       | Ast0.Constant(const) ->
 117           let (n,const) = mcode const in (n,Ast0.Constant(const))
 118       | Ast0.FunCall(fn,lp,args,rp) ->
 119           let (fn_n,fn) = expression fn in
 120           let (lp_n,lp) = mcode lp in
 121           let (args_n,args) = dots expression args in
 122           let (rp_n,rp) = mcode rp in
 123           (multibind [fn_n;lp_n;args_n;rp_n], Ast0.FunCall(fn,lp,args,rp))
 124       | Ast0.Assignment(left,op,right,simple) ->
 125           let (left_n,left) = expression left in
 126           let (op_n,op) = mcode op in
 127           let (right_n,right) = expression right in
 128           (multibind [left_n;op_n;right_n],
 129            Ast0.Assignment(left,op,right,simple))
 130       | Ast0.Sequence(left,op,right) ->
 131           let (left_n,left) = expression left in
 132           let (op_n,op) = mcode op in
 133           let (right_n,right) = expression right in
 134           (multibind [left_n;op_n;right_n],
 135            Ast0.Sequence(left,op,right))
 136       | Ast0.CondExpr(exp1,why,exp2,colon,exp3) ->
 137           let (exp1_n,exp1) = expression exp1 in
 138           let (why_n,why) = mcode why in
 139           let (exp2_n,exp2) = get_option expression exp2 in
 140           let (colon_n,colon) = mcode colon in
 141           let (exp3_n,exp3) = expression exp3 in
 142           (multibind [exp1_n;why_n;exp2_n;colon_n;exp3_n],
 143            Ast0.CondExpr(exp1,why,exp2,colon,exp3))
 144       | Ast0.Postfix(exp,op) ->
 145           let (exp_n,exp) = expression exp in
 146           let (op_n,op) = mcode op in
 147           (bind exp_n op_n, Ast0.Postfix(exp,op))
 148       | Ast0.Infix(exp,op) ->
 149           let (exp_n,exp) = expression exp in
 150           let (op_n,op) = mcode op in
 151           (bind op_n exp_n, Ast0.Infix(exp,op))
 152       | Ast0.Unary(exp,op) ->
 153           let (exp_n,exp) = expression exp in
 154           let (op_n,op) = mcode op in
 155           (bind op_n exp_n, Ast0.Unary(exp,op))
 156       | Ast0.Binary(left,op,right) ->
 157           let (left_n,left) = expression left in
 158           let (op_n,op) = mcode op in
 159           let (right_n,right) = expression right in
 160           (multibind [left_n;op_n;right_n], Ast0.Binary(left,op,right))
 161       | Ast0.Nested(left,op,right) ->
 162           let (left_n,left) = expression left in
 163           let (op_n,op) = mcode op in
 164           let (right_n,right) = expression right in
 165           (multibind [left_n;op_n;right_n], Ast0.Nested(left,op,right))
 166       | Ast0.Paren(lp,exp,rp) ->
 167           let (lp_n,lp) = mcode lp in
 168           let (exp_n,exp) = expression exp in
 169           let (rp_n,rp) = mcode rp in
 170           (multibind [lp_n;exp_n;rp_n], Ast0.Paren(lp,exp,rp))
 171       | Ast0.ArrayAccess(exp1,lb,exp2,rb) ->
 172           let (exp1_n,exp1) = expression exp1 in
 173           let (lb_n,lb) = mcode lb in
 174           let (exp2_n,exp2) = expression exp2 in
 175           let (rb_n,rb) = mcode rb in
 176           (multibind [exp1_n;lb_n;exp2_n;rb_n],
 177            Ast0.ArrayAccess(exp1,lb,exp2,rb))
 178       | Ast0.RecordAccess(exp,pt,field) ->
 179           let (exp_n,exp) = expression exp in
 180           let (pt_n,pt) = mcode pt in
 181           let (field_n,field) = ident field in
 182           (multibind [exp_n;pt_n;field_n], Ast0.RecordAccess(exp,pt,field))
 183       | Ast0.RecordPtAccess(exp,ar,field) ->
 184           let (exp_n,exp) = expression exp in
 185           let (ar_n,ar) = mcode ar in
 186           let (field_n,field) = ident field in
 187           (multibind [exp_n;ar_n;field_n], Ast0.RecordPtAccess(exp,ar,field))
 188       | Ast0.Cast(lp,ty,rp,exp) ->
 189           let (lp_n,lp) = mcode lp in
 190           let (ty_n,ty) = typeC ty in
 191           let (rp_n,rp) = mcode rp in
 192           let (exp_n,exp) = expression exp in
 193           (multibind [lp_n;ty_n;rp_n;exp_n], Ast0.Cast(lp,ty,rp,exp))
 194       | Ast0.SizeOfExpr(szf,exp) ->
 195           let (szf_n,szf) = mcode szf in
 196           let (exp_n,exp) = expression exp in
 197           (multibind [szf_n;exp_n],Ast0.SizeOfExpr(szf,exp))
 198       | Ast0.SizeOfType(szf,lp,ty,rp) ->
 199           let (szf_n,szf) = mcode szf in
 200           let (lp_n,lp) = mcode lp in
 201           let (ty_n,ty) = typeC ty in
 202           let (rp_n,rp) = mcode rp in
 203           (multibind [szf_n;lp_n;ty_n;rp_n], Ast0.SizeOfType(szf,lp,ty,rp))
 204       | Ast0.TypeExp(ty) ->
 205           let (ty_n,ty) = typeC ty in
 206           (ty_n,Ast0.TypeExp(ty))
 207       | Ast0.Constructor(lp,ty,rp,init) ->
 208           let (lp_n,lp) = mcode lp in
 209           let (ty_n,ty) = typeC ty in
 210           let (rp_n,rp) = mcode rp in
 211           let (init_n,init) = initialiser init in
 212           (multibind [lp_n;ty_n;rp_n;init_n], Ast0.Constructor(lp,ty,rp,init))
 213       | Ast0.MetaErr(name,constraints,pure) ->
 214           let (name_n,name) = mcode name in
 215           (name_n,Ast0.MetaErr(name,constraints,pure))
 216       | Ast0.MetaExpr(name,constraints,ty,form,pure) ->
 217           let (name_n,name) = mcode name in
 218           (name_n,Ast0.MetaExpr(name,constraints,ty,form,pure))
 219       | Ast0.MetaExprList(name,lenname,pure) ->
 220           let (name_n,name) = mcode name in
 221           (name_n,Ast0.MetaExprList(name,lenname,pure))
 222       | Ast0.AsExpr _ -> failwith "not possible"
 223       | Ast0.EComma(cm) ->
 224           let (cm_n,cm) = mcode cm in (cm_n,Ast0.EComma(cm))
 225       | Ast0.DisjExpr(starter,expr_list,mids,ender) ->
 226           do_disj starter expr_list mids ender expression
 227             (fun starter expr_list mids ender ->
 228               Ast0.DisjExpr(starter,expr_list,mids,ender))
 229       | Ast0.NestExpr(starter,expr_dots,ender,whencode,multi) ->
 230           let (starter_n,starter) = mcode starter in
 231           let (expr_dots_n,expr_dots) = dots expression expr_dots in
 232           let (ender_n,ender) = mcode ender in
 233           let (whencode_n,whencode) = get_option expression whencode in
 234           (multibind [starter_n;expr_dots_n;ender_n;whencode_n],
 235            Ast0.NestExpr(starter,expr_dots,ender,whencode,multi))
 236       | Ast0.Edots(dots,whencode) ->
 237           let (dots_n,dots) = mcode dots in
 238           let (whencode_n,whencode) = get_option expression whencode in
 239           (bind dots_n whencode_n,Ast0.Edots(dots,whencode))
 240       | Ast0.Ecircles(dots,whencode) ->
 241           let (dots_n,dots) = mcode dots in
 242           let (whencode_n,whencode) = get_option expression whencode in
 243           (bind dots_n whencode_n,Ast0.Ecircles(dots,whencode))
 244       | Ast0.Estars(dots,whencode) ->
 245           let (dots_n,dots) = mcode dots in
 246           let (whencode_n,whencode) = get_option expression whencode in
 247           (bind dots_n whencode_n,Ast0.Estars(dots,whencode))
 248       | Ast0.OptExp(exp) ->
 249           let (exp_n,exp) = expression exp in
 250           (exp_n,Ast0.OptExp(exp))
 251       | Ast0.UniqueExp(exp) ->
 252           let (exp_n,exp) = expression exp in
 253           (exp_n,Ast0.UniqueExp(exp))) in
 254     List.fold_left
 255       (function (other_metas,exp) ->
 256         function
 257             Ast0.ExprTag(exp_meta) ->
 258               (other_metas,Ast0.rewrap exp (Ast0.AsExpr(exp,exp_meta)))
 259           | x -> (x::other_metas,exp))
 260       ([],e) metas
 261
 262 and typeC t =
 263   let (metas,t) =
 264     rewrap t
 265       (match Ast0.unwrap t with
 266         Ast0.ConstVol(cv,ty) ->
 267           let (cv_n,cv) = mcode cv in
 268           let (ty_n,ty) = typeC ty in
 269           (bind cv_n ty_n, Ast0.ConstVol(cv,ty))
 270       | Ast0.BaseType(ty,strings) ->
 271           let (strings_n,strings) = map_split_bind mcode strings in
 272           (strings_n, Ast0.BaseType(ty,strings))
 273       | Ast0.Signed(sign,ty) ->
 274           let (sign_n,sign) = mcode sign in
 275           let (ty_n,ty) = get_option typeC ty in
 276           (bind sign_n ty_n, Ast0.Signed(sign,ty))
 277       | Ast0.Pointer(ty,star) ->
 278           let (ty_n,ty) = typeC ty in
 279           let (star_n,star) = mcode star in
 280           (bind ty_n star_n, Ast0.Pointer(ty,star))
 281       | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
 282           function_pointer (ty,lp1,star,rp1,lp2,params,rp2) []
 283       | Ast0.FunctionType(ty,lp1,params,rp1) ->
 284           function_type (ty,lp1,params,rp1) []
 285       | Ast0.Array(ty,lb,size,rb) -> array_type (ty,lb,size,rb) []
 286       | Ast0.EnumName(kind,name) ->
 287           let (kind_n,kind) = mcode kind in
 288           let (name_n,name) = get_option ident name in
 289           (bind kind_n name_n, Ast0.EnumName(kind,name))
 290       | Ast0.EnumDef(ty,lb,ids,rb) ->
 291           let (ty_n,ty) = typeC ty in
 292           let (lb_n,lb) = mcode lb in
 293           let (ids_n,ids) = dots expression ids in
 294           let (rb_n,rb) = mcode rb in
 295           (multibind [ty_n;lb_n;ids_n;rb_n], Ast0.EnumDef(ty,lb,ids,rb))
 296       | Ast0.StructUnionName(kind,name) ->
 297           let (kind_n,kind) = mcode kind in
 298           let (name_n,name) = get_option ident name in
 299           (bind kind_n name_n, Ast0.StructUnionName(kind,name))
 300       | Ast0.StructUnionDef(ty,lb,decls,rb) ->
 301           let (ty_n,ty) = typeC ty in
 302           let (lb_n,lb) = mcode lb in
 303           let (decls_n,decls) = dots declaration decls in
 304           let (rb_n,rb) = mcode rb in
 305           (multibind [ty_n;lb_n;decls_n;rb_n],
 306            Ast0.StructUnionDef(ty,lb,decls,rb))
 307       | Ast0.TypeName(name) ->
 308           let (name_n,name) = mcode name in
 309           (name_n,Ast0.TypeName(name))
 310       | Ast0.MetaType(name,pure) ->
 311           let (name_n,name) = mcode name in
 312           (name_n,Ast0.MetaType(name,pure))
 313       | Ast0.AsType _ -> failwith "not possible"
 314       | Ast0.DisjType(starter,types,mids,ender) ->
 315           do_disj starter types mids ender typeC
 316             (fun starter types mids ender ->
 317               Ast0.DisjType(starter,types,mids,ender))
 318       | Ast0.OptType(ty) ->
 319           let (ty_n,ty) = typeC ty in (ty_n, Ast0.OptType(ty))
 320       | Ast0.UniqueType(ty) ->
 321           let (ty_n,ty) = typeC ty in (ty_n, Ast0.UniqueType(ty))) in
 322   List.fold_left
 323     (function (other_metas,ty) ->
 324       function
 325           Ast0.TypeCTag(ty_meta) ->
 326             (other_metas,Ast0.rewrap ty (Ast0.AsType(ty,ty_meta)))
 327         | x -> (x::other_metas,ty))
 328     ([],t) metas
 329
 330 and function_pointer (ty,lp1,star,rp1,lp2,params,rp2) extra =
 331   let (ty_n,ty) = typeC ty in
 332   let (lp1_n,lp1) = mcode lp1 in
 333   let (star_n,star) = mcode star in
 334   let (rp1_n,rp1) = mcode rp1 in
 335   let (lp2_n,lp2) = mcode lp2 in
 336   let (params_n,params) = dots parameterTypeDef params in
 337   let (rp2_n,rp2) = mcode rp2 in
 338     (* have to put the treatment of the identifier into the right position *)
 339   (multibind ([ty_n;lp1_n;star_n] @ extra @ [rp1_n;lp2_n;params_n;rp2_n]),
 340    Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2))
 341 and function_type (ty,lp1,params,rp1) extra =
 342   let (ty_n,ty) = get_option typeC ty in
 343   let (lp1_n,lp1) = mcode lp1 in
 344   let (params_n,params) = dots parameterTypeDef params in
 345   let (rp1_n,rp1) = mcode rp1 in
 346     (* have to put the treatment of the identifier into the right position *)
 347   (multibind (ty_n :: extra @ [lp1_n;params_n;rp1_n]),
 348    Ast0.FunctionType(ty,lp1,params,rp1))
 349 and array_type (ty,lb,size,rb) extra =
 350   let (ty_n,ty) = typeC ty in
 351   let (lb_n,lb) = mcode lb in
 352   let (size_n,size) = get_option expression size in
 353   let (rb_n,rb) = mcode rb in
 354   (multibind (ty_n :: extra @ [lb_n;size_n;rb_n]),
 355    Ast0.Array(ty,lb,size,rb))
 356
 357 and named_type ty id =
 358   let (id_n,id) = ident id in
 359   match Ast0.unwrap ty with
 360     Ast0.FunctionPointer(rty,lp1,star,rp1,lp2,params,rp2) ->
 361       let tyres =
 362         function_pointer (rty,lp1,star,rp1,lp2,params,rp2) [id_n] in
 363       (rewrap ty tyres, id)
 364   | Ast0.FunctionType(rty,lp1,params,rp1) ->
 365       let tyres = function_type (rty,lp1,params,rp1) [id_n] in
 366       (rewrap ty tyres, id)
 367   | Ast0.Array(rty,lb,size,rb) ->
 368       let tyres = array_type (rty,lb,size,rb) [id_n] in
 369       (rewrap ty tyres, id)
 370   | _ -> let (ty_n,ty) = typeC ty in ((bind ty_n id_n, ty), id)
 371
 372 and declaration d =
 373   let (metas,d) =
 374     rewrap d
 375       (match Ast0.unwrap d with
 376         Ast0.MetaDecl(name,pure) ->
 377           let (n,name) = mcode name in
 378           (n,Ast0.MetaDecl(name,pure))
 379       | Ast0.MetaField(name,pure) ->
 380           let (n,name) = mcode name in
 381           (n,Ast0.MetaField(name,pure))
 382       | Ast0.MetaFieldList(name,lenname,pure) ->
 383           let (n,name) = mcode name in
 384           (n,Ast0.MetaFieldList(name,lenname,pure))
 385       | Ast0.AsDecl _ -> failwith "not possible"
 386       | Ast0.Init(stg,ty,id,eq,ini,sem) ->
 387           let (stg_n,stg) = get_option mcode stg in
 388           let ((ty_id_n,ty),id) = named_type ty id in
 389           let (eq_n,eq) = mcode eq in
 390           let (ini_n,ini) = initialiser ini in
 391           let (sem_n,sem) = mcode sem in
 392           (multibind [stg_n;ty_id_n;eq_n;ini_n;sem_n],
 393            Ast0.Init(stg,ty,id,eq,ini,sem))
 394       | Ast0.UnInit(stg,ty,id,sem) ->
 395           let (stg_n,stg) = get_option mcode stg in
 396           let ((ty_id_n,ty),id) = named_type ty id in
 397           let (sem_n,sem) = mcode sem in
 398           (multibind [stg_n;ty_id_n;sem_n], Ast0.UnInit(stg,ty,id,sem))
 399       | Ast0.MacroDecl(name,lp,args,rp,sem) ->
 400           let (name_n,name) = ident name in
 401           let (lp_n,lp) = mcode lp in
 402           let (args_n,args) = dots expression args in
 403           let (rp_n,rp) = mcode rp in
 404           let (sem_n,sem) = mcode sem in
 405           (multibind [name_n;lp_n;args_n;rp_n;sem_n],
 406            Ast0.MacroDecl(name,lp,args,rp,sem))
 407       | Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem) ->
 408           let (name_n,name) = ident name in
 409           let (lp_n,lp) = mcode lp in
 410           let (args_n,args) = dots expression args in
 411           let (rp_n,rp) = mcode rp in
 412           let (eq_n,eq) = mcode eq in
 413           let (ini_n,ini) = initialiser ini in
 414           let (sem_n,sem) = mcode sem in
 415           (multibind [name_n;lp_n;args_n;rp_n;eq_n;ini_n;sem_n],
 416            Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem))
 417       | Ast0.TyDecl(ty,sem) ->
 418           let (ty_n,ty) = typeC ty in
 419           let (sem_n,sem) = mcode sem in
 420           (bind ty_n sem_n, Ast0.TyDecl(ty,sem))
 421       | Ast0.Typedef(stg,ty,id,sem) ->
 422           let (stg_n,stg) = mcode stg in
 423           let (ty_n,ty) = typeC ty in
 424           let (id_n,id) = typeC id in
 425           let (sem_n,sem) = mcode sem in
 426           (multibind [stg_n;ty_n;id_n;sem_n], Ast0.Typedef(stg,ty,id,sem))
 427       | Ast0.DisjDecl(starter,decls,mids,ender) ->
 428           do_disj starter decls mids ender declaration
 429             (fun starter decls mids ender ->
 430               Ast0.DisjDecl(starter,decls,mids,ender))
 431       | Ast0.Ddots(dots,whencode) ->
 432           let (dots_n,dots) = mcode dots in
 433           let (whencode_n,whencode) = get_option declaration whencode in
 434           (bind dots_n whencode_n, Ast0.Ddots(dots,whencode))
 435       | Ast0.OptDecl(decl) ->
 436           let (n,decl) = declaration decl in (n,Ast0.OptDecl(decl))
 437       | Ast0.UniqueDecl(decl) ->
 438           let (n,decl) = declaration decl in (n,Ast0.UniqueDecl(decl))) in
 439   List.fold_left
 440     (function (other_metas,decl) ->
 441       function
 442           Ast0.DeclTag(decl_meta) ->
 443             (other_metas,Ast0.rewrap decl (Ast0.AsDecl(decl,decl_meta)))
 444         | x -> (x::other_metas,decl))
 445     ([],d) metas
 446
 447 and initialiser i =
 448   let (metas,i) =
 449     rewrap i
 450       (match Ast0.unwrap i with
 451         Ast0.MetaInit(name,pure) ->
 452           let (name_n,name) = mcode name in
 453           (name_n,Ast0.MetaInit(name,pure))
 454       | Ast0.MetaInitList(name,lenname,pure) ->
 455           let (name_n,name) = mcode name in
 456           (name_n,Ast0.MetaInitList(name,lenname,pure))
 457       | Ast0.AsInit _ -> failwith "not possible"
 458       | Ast0.InitExpr(exp) ->
 459           let (exp_n,exp) = expression exp in
 460           (exp_n,Ast0.InitExpr(exp))
 461       | Ast0.InitList(lb,initlist,rb,ordered) ->
 462           let (lb_n,lb) = mcode lb in
 463           let (initlist_n,initlist) = dots initialiser initlist in
 464           let (rb_n,rb) = mcode rb in
 465           (multibind [lb_n;initlist_n;rb_n],
 466            Ast0.InitList(lb,initlist,rb,ordered))
 467       | Ast0.InitGccExt(designators,eq,ini) ->
 468           let (dn,designators) = map_split_bind designator designators in
 469           let (eq_n,eq) = mcode eq in
 470           let (ini_n,ini) = initialiser ini in
 471           (multibind [dn;eq_n;ini_n], Ast0.InitGccExt(designators,eq,ini))
 472       | Ast0.InitGccName(name,eq,ini) ->
 473           let (name_n,name) = ident name in
 474           let (eq_n,eq) = mcode eq in
 475           let (ini_n,ini) = initialiser ini in
 476           (multibind [name_n;eq_n;ini_n], Ast0.InitGccName(name,eq,ini))
 477       | Ast0.IComma(cm) ->
 478           let (n,cm) = mcode cm in (n,Ast0.IComma(cm))
 479       | Ast0.Idots(d,whencode) ->
 480           let (d_n,d) = mcode d in
 481           let (whencode_n,whencode) = get_option initialiser whencode in
 482           (bind d_n whencode_n, Ast0.Idots(d,whencode))
 483       | Ast0.OptIni(i) ->
 484           let (n,i) = initialiser i in (n,Ast0.OptIni(i))
 485       | Ast0.UniqueIni(i) ->
 486           let (n,i) = initialiser i in (n,Ast0.UniqueIni(i))) in
 487   List.fold_left
 488     (function (other_metas,init) ->
 489       function
 490           Ast0.InitTag(init_meta) ->
 491             (other_metas,Ast0.rewrap init (Ast0.AsInit(init,init_meta)))
 492         | x -> (x::other_metas,init))
 493     ([],i) metas
 494
 495 and designator = function
 496     Ast0.DesignatorField(dot,id) ->
 497       let (dot_n,dot) = mcode dot in
 498       let (id_n,id) = ident id in
 499       (bind dot_n id_n, Ast0.DesignatorField(dot,id))
 500   | Ast0.DesignatorIndex(lb,exp,rb) ->
 501       let (lb_n,lb) = mcode lb in
 502       let (exp_n,exp) = expression exp in
 503       let (rb_n,rb) = mcode rb in
 504       (multibind [lb_n;exp_n;rb_n], Ast0.DesignatorIndex(lb,exp,rb))
 505   | Ast0.DesignatorRange(lb,min,dots,max,rb) ->
 506       let (lb_n,lb) = mcode lb in
 507       let (min_n,min) = expression min in
 508       let (dots_n,dots) = mcode dots in
 509       let (max_n,max) = expression max in
 510       let (rb_n,rb) = mcode rb in
 511       (multibind [lb_n;min_n;dots_n;max_n;rb_n],
 512        Ast0.DesignatorRange(lb,min,dots,max,rb))
 513
 514 and parameterTypeDef p =
 515   rewrap p
 516     (match Ast0.unwrap p with
 517       Ast0.VoidParam(ty) ->
 518         let (n,ty) = typeC ty in (n,Ast0.VoidParam(ty))
 519     | Ast0.Param(ty,Some id) ->
 520         let ((ty_id_n,ty),id) = named_type ty id in
 521         (ty_id_n, Ast0.Param(ty,Some id))
 522     | Ast0.Param(ty,None) ->
 523         let (ty_n,ty) = typeC ty in
 524         (ty_n, Ast0.Param(ty,None))
 525     | Ast0.MetaParam(name,pure) ->
 526         let (n,name) = mcode name in
 527         (n,Ast0.MetaParam(name,pure))
 528     | Ast0.MetaParamList(name,lenname,pure) ->
 529         let (n,name) = mcode name in
 530         (n,Ast0.MetaParamList(name,lenname,pure))
 531     | Ast0.PComma(cm) ->
 532         let (n,cm) = mcode cm in (n,Ast0.PComma(cm))
 533     | Ast0.Pdots(dots) ->
 534         let (n,dots) = mcode dots in (n,Ast0.Pdots(dots))
 535     | Ast0.Pcircles(dots) ->
 536         let (n,dots) = mcode dots in (n,Ast0.Pcircles(dots))
 537     | Ast0.OptParam(param) ->
 538         let (n,param) = parameterTypeDef param in (n,Ast0.OptParam(param))
 539     | Ast0.UniqueParam(param) ->
 540         let (n,param) = parameterTypeDef param in
 541         (n,Ast0.UniqueParam(param)))
 542
 543 and statement s =
 544   let (metas,s) =
 545     rewrap s
 546       (match Ast0.unwrap s with
 547         Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace) ->
 548           let (fi_n,fi) = map_split_bind fninfo fi in
 549           let (name_n,name) = ident name in
 550           let (lp_n,lp) = mcode lp in
 551           let (params_n,params) = dots parameterTypeDef params in
 552           let (rp_n,rp) = mcode rp in
 553           let (lbrace_n,lbrace) = mcode lbrace in
 554           let (body_n,body) = dots statement body in
 555           let (rbrace_n,rbrace) = mcode rbrace in
 556           (multibind
 557              [fi_n;name_n;lp_n;params_n;rp_n;lbrace_n;body_n;rbrace_n],
 558            Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace))
 559       | Ast0.Decl(bef,decl) ->
 560           let (decl_n,decl) = declaration decl in
 561           (decl_n,Ast0.Decl(bef,decl))
 562       | Ast0.Seq(lbrace,body,rbrace) ->
 563           let (lbrace_n,lbrace) = mcode lbrace in
 564           let (body_n,body) = dots statement body in
 565           let (rbrace_n,rbrace) = mcode rbrace in
 566           (multibind [lbrace_n;body_n;rbrace_n],
 567            Ast0.Seq(lbrace,body,rbrace))
 568       | Ast0.ExprStatement(exp,sem) ->
 569           let (exp_n,exp) = get_option expression exp in
 570           let (sem_n,sem) = mcode sem in
 571           (bind exp_n sem_n, Ast0.ExprStatement(exp,sem))
 572       | Ast0.IfThen(iff,lp,exp,rp,branch1,aft) ->
 573           let (iff_n,iff) = mcode iff in
 574           let (lp_n,lp) = mcode lp in
 575           let (exp_n,exp) = expression exp in
 576           let (rp_n,rp) = mcode rp in
 577           let (branch1_n,branch1) = statement branch1 in
 578           (multibind [iff_n;lp_n;exp_n;rp_n;branch1_n],
 579            Ast0.IfThen(iff,lp,exp,rp,branch1,aft))
 580       | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft) ->
 581           let (iff_n,iff) = mcode iff in
 582           let (lp_n,lp) = mcode lp in
 583           let (exp_n,exp) = expression exp in
 584           let (rp_n,rp) = mcode rp in
 585           let (branch1_n,branch1) = statement branch1 in
 586           let (els_n,els) = mcode els in
 587           let (branch2_n,branch2) = statement branch2 in
 588           (multibind [iff_n;lp_n;exp_n;rp_n;branch1_n;els_n;branch2_n],
 589            Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft))
 590       | Ast0.While(whl,lp,exp,rp,body,aft) ->
 591           let (whl_n,whl) = mcode whl in
 592           let (lp_n,lp) = mcode lp in
 593           let (exp_n,exp) = expression exp in
 594           let (rp_n,rp) = mcode rp in
 595           let (body_n,body) = statement body in
 596           (multibind [whl_n;lp_n;exp_n;rp_n;body_n],
 597            Ast0.While(whl,lp,exp,rp,body,aft))
 598       | Ast0.Do(d,body,whl,lp,exp,rp,sem) ->
 599           let (d_n,d) = mcode d in
 600           let (body_n,body) = statement body in
 601           let (whl_n,whl) = mcode whl in
 602           let (lp_n,lp) = mcode lp in
 603           let (exp_n,exp) = expression exp in
 604           let (rp_n,rp) =  mcode rp in
 605           let (sem_n,sem) = mcode sem in
 606           (multibind [d_n;body_n;whl_n;lp_n;exp_n;rp_n;sem_n],
 607            Ast0.Do(d,body,whl,lp,exp,rp,sem))
 608       | Ast0.For(fr,lp,e1,sem1,e2,sem2,e3,rp,body,aft) ->
 609           let (fr_n,fr) = mcode fr in
 610           let (lp_n,lp) = mcode lp in
 611           let (e1_n,e1) = get_option expression e1 in
 612           let (sem1_n,sem1) = mcode sem1 in
 613           let (e2_n,e2) = get_option expression e2 in
 614           let (sem2_n,sem2) = mcode sem2 in
 615           let (e3_n,e3) = get_option expression e3 in
 616           let (rp_n,rp) = mcode rp in
 617           let (body_n,body) = statement body in
 618           (multibind [fr_n;lp_n;e1_n;sem1_n;e2_n;sem2_n;e3_n;rp_n;body_n],
 619            Ast0.For(fr,lp,e1,sem1,e2,sem2,e3,rp,body,aft))
 620       | Ast0.Iterator(nm,lp,args,rp,body,aft) ->
 621           let (nm_n,nm) = ident nm in
 622           let (lp_n,lp) = mcode lp in
 623           let (args_n,args) = dots expression args in
 624           let (rp_n,rp) = mcode rp in
 625           let (body_n,body) = statement body in
 626           (multibind [nm_n;lp_n;args_n;rp_n;body_n],
 627            Ast0.Iterator(nm,lp,args,rp,body,aft))
 628       | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) ->
 629           let (switch_n,switch) = mcode switch in
 630           let (lp_n,lp) = mcode lp in
 631           let (exp_n,exp) = expression exp in
 632           let (rp_n,rp) = mcode rp in
 633           let (lb_n,lb) = mcode lb in
 634           let (decls_n,decls) = dots statement decls in
 635           let (cases_n,cases) = dots case_line cases in
 636           let (rb_n,rb) = mcode rb in
 637           (multibind [switch_n;lp_n;exp_n;rp_n;lb_n;decls_n;cases_n;rb_n],
 638            Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb))
 639       | Ast0.Break(br,sem) ->
 640           let (br_n,br) = mcode br in
 641           let (sem_n,sem) = mcode sem in
 642           (bind br_n sem_n, Ast0.Break(br,sem))
 643       | Ast0.Continue(cont,sem) ->
 644           let (cont_n,cont) = mcode cont in
 645           let (sem_n,sem) = mcode sem in
 646           (bind cont_n sem_n, Ast0.Continue(cont,sem))
 647       | Ast0.Label(l,dd) ->
 648           let (l_n,l) = ident l in
 649           let (dd_n,dd) = mcode dd in
 650           (bind l_n dd_n, Ast0.Label(l,dd))
 651       | Ast0.Goto(goto,l,sem) ->
 652           let (goto_n,goto) = mcode goto in
 653           let (l_n,l) = ident l in
 654           let (sem_n,sem) = mcode sem in
 655           (bind goto_n (bind l_n sem_n), Ast0.Goto(goto,l,sem))
 656       | Ast0.Return(ret,sem) ->
 657           let (ret_n,ret) = mcode ret in
 658           let (sem_n,sem) = mcode sem in
 659           (bind ret_n sem_n, Ast0.Return(ret,sem))
 660       | Ast0.ReturnExpr(ret,exp,sem) ->
 661           let (ret_n,ret) = mcode ret in
 662           let (exp_n,exp) = expression exp in
 663           let (sem_n,sem) = mcode sem in
 664           (multibind [ret_n;exp_n;sem_n], Ast0.ReturnExpr(ret,exp,sem))
 665       | Ast0.MetaStmt(name,pure) ->
 666           let (name_n,name) = mcode name in
 667           (name_n,Ast0.MetaStmt(name,pure))
 668       | Ast0.MetaStmtList(name,pure) ->
 669           let (name_n,name) = mcode name in
 670           (name_n,Ast0.MetaStmtList(name,pure))
 671       | Ast0.AsStmt _ -> failwith "not possible"
 672       | Ast0.Disj(starter,statement_dots_list,mids,ender) ->
 673           do_disj starter statement_dots_list mids ender (dots statement)
 674             (fun starter statement_dots_list mids ender ->
 675               Ast0.Disj(starter,statement_dots_list,mids,ender))
 676       | Ast0.Nest(starter,stmt_dots,ender,whn,multi) ->
 677           let (starter_n,starter) = mcode starter in
 678           let (stmt_dots_n,stmt_dots) = dots statement stmt_dots in
 679           let (ender_n,ender) = mcode ender in
 680           let (whn_n,whn) =
 681             map_split_bind (whencode (dots statement) statement) whn in
 682           (multibind [starter_n;stmt_dots_n;ender_n;whn_n],
 683            Ast0.Nest(starter,stmt_dots,ender,whn,multi))
 684       | Ast0.Exp(exp) ->
 685           let (exp_n,exp) = expression exp in
 686           (exp_n,Ast0.Exp(exp))
 687       | Ast0.TopExp(exp) ->
 688           let (exp_n,exp) = expression exp in
 689           (exp_n,Ast0.TopExp(exp))
 690       | Ast0.Ty(ty) ->
 691           let (ty_n,ty) = typeC ty in
 692           (ty_n,Ast0.Ty(ty))
 693       | Ast0.TopInit(init) ->
 694           let (init_n,init) = initialiser init in
 695           (init_n,Ast0.TopInit(init))
 696       | Ast0.Dots(d,whn) ->
 697           let (d_n,d) = mcode d in
 698           let (whn_n,whn) =
 699             map_split_bind (whencode (dots statement) statement) whn in
 700           (bind d_n whn_n, Ast0.Dots(d,whn))
 701       | Ast0.Circles(d,whn) ->
 702           let (d_n,d) = mcode d in
 703           let (whn_n,whn) =
 704             map_split_bind (whencode (dots statement) statement) whn in
 705           (bind d_n whn_n, Ast0.Circles(d,whn))
 706       | Ast0.Stars(d,whn) ->
 707           let (d_n,d) = mcode d in
 708           let (whn_n,whn) =
 709             map_split_bind (whencode (dots statement) statement) whn in
 710           (bind d_n whn_n, Ast0.Stars(d,whn))
 711       | Ast0.Include(inc,name) ->
 712           let (inc_n,inc) = mcode inc in
 713           let (name_n,name) = mcode name in
 714           (bind inc_n name_n, Ast0.Include(inc,name))
 715       | Ast0.Undef(def,id) ->
 716           let (def_n,def) = mcode def in
 717           let (id_n,id) = ident id in
 718           (multibind [def_n;id_n],Ast0.Undef(def,id))
 719       | Ast0.Define(def,id,params,body) ->
 720           let (def_n,def) = mcode def in
 721           let (id_n,id) = ident id in
 722           let (params_n,params) = define_parameters params in
 723           let (body_n,body) = dots statement body in
 724           (multibind [def_n;id_n;params_n;body_n],
 725            Ast0.Define(def,id,params,body))
 726       | Ast0.OptStm(re) ->
 727           let (re_n,re) = statement re in (re_n,Ast0.OptStm(re))
 728       | Ast0.UniqueStm(re) ->
 729           let (re_n,re) = statement re in (re_n,Ast0.UniqueStm(re))) in
 730   List.fold_left
 731     (function (other_metas,stmt) ->
 732       function
 733           Ast0.StmtTag(stmt_meta) ->
 734             (other_metas,Ast0.rewrap stmt (Ast0.AsStmt(stmt,stmt_meta)))
 735         | x -> (x::other_metas,stmt))
 736     ([],s) metas
 737
 738   (* not parameterizable for now... *)
 739 and define_parameters p =
 740   rewrap p
 741     (match Ast0.unwrap p with
 742       Ast0.NoParams -> (option_default,Ast0.NoParams)
 743     | Ast0.DParams(lp,params,rp) ->
 744         let (lp_n,lp) = mcode lp in
 745         let (params_n,params) = dots define_param params in
 746         let (rp_n,rp) = mcode rp in
 747         (multibind [lp_n;params_n;rp_n], Ast0.DParams(lp,params,rp)))
 748
 749 and define_param p =
 750   rewrap p
 751     (match Ast0.unwrap p with
 752       Ast0.DParam(id) -> let (n,id) = ident id in (n,Ast0.DParam(id))
 753     | Ast0.DPComma(comma) ->
 754         let (n,comma) = mcode comma in (n,Ast0.DPComma(comma))
 755     | Ast0.DPdots(d) ->
 756         let (n,d) = mcode d in (n,Ast0.DPdots(d))
 757     | Ast0.DPcircles(c) ->
 758         let (n,c) = mcode c in (n,Ast0.DPcircles(c))
 759     | Ast0.OptDParam(dp) ->
 760         let (n,dp) = define_param dp in (n,Ast0.OptDParam(dp))
 761     | Ast0.UniqueDParam(dp) ->
 762         let (n,dp) = define_param dp in (n,Ast0.UniqueDParam(dp)))
 763
 764 and fninfo = function
 765     Ast0.FStorage(stg) ->
 766       let (n,stg) = mcode stg in (n,Ast0.FStorage(stg))
 767   | Ast0.FType(ty) -> let (n,ty) = typeC ty in (n,Ast0.FType(ty))
 768   | Ast0.FInline(inline) ->
 769       let (n,inline) = mcode inline in (n,Ast0.FInline(inline))
 770   | Ast0.FAttr(init) ->
 771       let (n,init) = mcode init in (n,Ast0.FAttr(init))
 772
 773 and whencode notfn alwaysfn = function
 774     Ast0.WhenNot a -> let (n,a) = notfn a in (n,Ast0.WhenNot(a))
 775   | Ast0.WhenAlways a -> let (n,a) = alwaysfn a in (n,Ast0.WhenAlways(a))
 776   | Ast0.WhenModifier(x) -> (option_default,Ast0.WhenModifier(x))
 777   | Ast0.WhenNotTrue(e) ->
 778       let (n,e) = expression e in (n,Ast0.WhenNotTrue(e))
 779   | Ast0.WhenNotFalse(e) ->
 780       let (n,e) = expression e in (n,Ast0.WhenNotFalse(e))
 781
 782 and case_line c =
 783   rewrap c
 784     (match Ast0.unwrap c with
 785       Ast0.Default(def,colon,code) ->
 786         let (def_n,def) = mcode def in
 787         let (colon_n,colon) = mcode colon in
 788         let (code_n,code) = dots statement code in
 789         (multibind [def_n;colon_n;code_n], Ast0.Default(def,colon,code))
 790     | Ast0.Case(case,exp,colon,code) ->
 791         let (case_n,case) = mcode case in
 792         let (exp_n,exp) = expression exp in
 793         let (colon_n,colon) = mcode colon in
 794         let (code_n,code) = dots statement code in
 795         (multibind [case_n;exp_n;colon_n;code_n],
 796          Ast0.Case(case,exp,colon,code))
 797     | Ast0.DisjCase(starter,case_lines,mids,ender) ->
 798         do_disj starter case_lines mids ender case_line
 799           (fun starter case_lines mids ender ->
 800             Ast0.DisjCase(starter,case_lines,mids,ender))
 801     | Ast0.OptCase(case) ->
 802         let (n,case) = case_line case in (n,Ast0.OptCase(case)))
 803
 804 and top_level t =
 805   rewrap t
 806     (match Ast0.unwrap t with
 807       Ast0.FILEINFO(old_file,new_file) ->
 808         let (old_file_n,old_file) = mcode old_file in
 809         let (new_file_n,new_file) = mcode new_file in
 810         (bind old_file_n new_file_n,Ast0.FILEINFO(old_file,new_file))
 811     | Ast0.NONDECL(statement_dots) ->
 812         let (n,statement_dots) = statement statement_dots in
 813         (n,Ast0.NONDECL(statement_dots))
 814     | Ast0.CODE(stmt_dots) ->
 815         let (stmt_dots_n,stmt_dots) = dots statement stmt_dots in
 816         (stmt_dots_n, Ast0.CODE(stmt_dots))
 817     | Ast0.TOPCODE(stmt_dots) ->
 818         let (stmt_dots_n,stmt_dots) = dots statement stmt_dots in
 819         (stmt_dots_n, Ast0.TOPCODE(stmt_dots))
 820     | Ast0.ERRORWORDS(exps) ->
 821         let (n,exps) = map_split_bind expression exps in
 822         (n, Ast0.ERRORWORDS(exps))
 823     | Ast0.OTHER(_) -> failwith "unexpected code")
 824
 825 let process t =
 826   List.map
 827     (function x ->
 828       match top_level x with
 829         ([],code) -> code
 830       | (l,_) ->
 831           failwith
 832             (Printf.sprintf
 833                "rule starting on line %d contains unattached metavariables: %s"
 834                (Ast0.get_line x)
 835                (String.concat ", "
 836                   (List.map
 837                      (function nm ->
 838                        let (r,n) = Ast0.unwrap_mcode nm in r^"."^n)
 839                      (List.map Ast0.meta_pos_name l)))))
 840     t