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