parsing_cocci/check_meta.ml

   1 (*
   2  * Copyright 2010, INRIA, University of Copenhagen
   3  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
   4  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
   5  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
   6  * This file is part of Coccinelle.
   7  *
   8  * Coccinelle is free software: you can redistribute it and/or modify
   9  * it under the terms of the GNU General Public License as published by
  10  * the Free Software Foundation, according to version 2 of the License.
  11  *
  12  * Coccinelle is distributed in the hope that it will be useful,
  13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15  * GNU General Public License for more details.
  16  *
  17  * You should have received a copy of the GNU General Public License
  18  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  19  *
  20  * The authors reserve the right to distribute this or future versions of
  21  * Coccinelle under other licenses.
  22  *)
  23
  24
  25 (* For minus fragment, checks that all of the identifier metavariables that
  26 are used are not declared as fresh, and check that all declared variables
  27 are used.  For plus fragment, just check that the variables declared as
  28 fresh are used.  What is the issue about error variables? (don't remember) *)
  29
  30 module Ast0 = Ast0_cocci
  31 module Ast = Ast_cocci
  32 module V0 = Visitor_ast0
  33 module VT0 = Visitor_ast0_types
  34
  35 (* all fresh identifiers *)
  36 let fresh_table = (Hashtbl.create(50) : (Ast.meta_name, unit) Hashtbl.t)
  37
  38 let warning s = Printf.fprintf stderr "warning: %s\n" s
  39
  40 let promote name = (name,(),Ast0.default_info(),(),None,-1)
  41
  42 (* --------------------------------------------------------------------- *)
  43
  44 let find_loop table name =
  45   let rec loop = function
  46       [] -> raise Not_found
  47     | x::xs -> (try Hashtbl.find x name with Not_found -> loop xs) in
  48   loop table
  49
  50 let check_table table minus (name,_,info,_,_,_) =
  51   let rl = info.Ast0.pos_info.Ast0.line_start in
  52   if minus
  53   then
  54     (try (find_loop table name) := true
  55     with
  56       Not_found ->
  57         (try
  58           Hashtbl.find fresh_table name;
  59           let (_,name) = name in
  60           failwith
  61             (Printf.sprintf
  62                "%d: unexpected use of a fresh identifier %s" rl name)
  63         with Not_found -> ()))
  64   else (try (find_loop table name) := true with Not_found -> ())
  65
  66 let get_opt fn = Common.do_option fn
  67
  68 (* --------------------------------------------------------------------- *)
  69 (* Dots *)
  70
  71 let dots fn d =
  72   match Ast0.unwrap d with
  73     Ast0.DOTS(x) -> List.iter fn x
  74   | Ast0.CIRCLES(x) -> List.iter fn x
  75   | Ast0.STARS(x) -> List.iter fn x
  76
  77 (* --------------------------------------------------------------------- *)
  78 (* Identifier *)
  79
  80 type context = ID | FIELD | FN | GLOBAL
  81
  82 (* heuristic for distinguishing ifdef variables from undeclared metavariables*)
  83 let is_ifdef name =
  84   String.length name > 2 && String.uppercase name = name
  85
  86 let rec ident context old_metas table minus i =
  87   match Ast0.unwrap i with
  88     Ast0.Id((name,_,info,_,_,_) : string Ast0.mcode) ->
  89       let rl = info.Ast0.pos_info.Ast0.line_start in
  90       let is_plus i =
  91         match Ast0.get_mcodekind i with Ast0.PLUS _ -> true | _ -> false in
  92       let err =
  93         if List.exists (function x -> x = name) old_metas
  94             && (minus || is_plus i)
  95         then
  96           begin
  97             warning
  98               (Printf.sprintf
  99                  "line %d: %s, previously declared as a metavariable, is used as an identifier" rl name);
 100             true
 101           end
 102         else false in
 103       (match context with
 104         ID ->
 105           if not (is_ifdef name) && minus && not err(* warn only once per id *)
 106           then
 107             warning
 108               (Printf.sprintf "line %d: should %s be a metavariable?" rl name)
 109       | _ -> ())
 110   | Ast0.MetaId(name,_,seedval,_) ->
 111       check_table table minus name;
 112       seed table minus seedval
 113   | Ast0.MetaFunc(name,_,_) -> check_table table minus name
 114   | Ast0.MetaLocalFunc(name,_,_) -> check_table table minus name
 115   | Ast0.DisjId(_,id_list,_,_) ->
 116       List.iter (ident context old_metas table minus) id_list
 117   | Ast0.OptIdent(_) | Ast0.UniqueIdent(_) ->
 118       failwith "unexpected code"
 119
 120 and seed table minus = function
 121     Ast.NoVal -> ()
 122   | Ast.StringSeed _ -> ()
 123   | Ast.ListSeed elems ->
 124       List.iter
 125         (function
 126             Ast.SeedString _ -> ()
 127           | Ast.SeedId name -> check_table table minus (promote name))
 128         elems
 129
 130 (* --------------------------------------------------------------------- *)
 131 (* Expression *)
 132
 133 let rec expression context old_metas table minus e =
 134   match Ast0.unwrap e with
 135     Ast0.Ident(id) ->
 136       ident context old_metas table minus id
 137   | Ast0.FunCall(fn,lp,args,rp) ->
 138       expression FN old_metas table minus fn;
 139       dots (expression ID old_metas table minus) args
 140   | Ast0.Assignment(left,op,right,_) ->
 141       expression context old_metas table minus left;
 142       expression ID old_metas table minus right
 143   | Ast0.CondExpr(exp1,why,exp2,colon,exp3) ->
 144       expression ID old_metas table minus exp1;
 145       get_opt (expression ID old_metas table minus) exp2;
 146       expression ID old_metas table minus exp3
 147   | Ast0.Postfix(exp,op) ->
 148       expression ID old_metas table minus exp
 149   | Ast0.Infix(exp,op) ->
 150       expression ID old_metas table minus exp
 151   | Ast0.Unary(exp,op) ->
 152       expression ID old_metas table minus exp
 153   | Ast0.Binary(left,op,right) ->
 154       expression ID old_metas table minus left;
 155       expression ID old_metas table minus right
 156   | Ast0.Paren(lp,exp,rp) ->
 157       expression ID old_metas table minus exp
 158   | Ast0.ArrayAccess(exp1,lb,exp2,rb) ->
 159       expression ID old_metas table minus exp1;
 160       expression ID old_metas table minus exp2
 161   | Ast0.RecordAccess(exp,pt,field) ->
 162       expression ID old_metas table minus exp;
 163       ident FIELD old_metas table minus field
 164   | Ast0.RecordPtAccess(exp,ar,field) ->
 165       expression ID old_metas table minus exp;
 166       ident FIELD old_metas table minus field
 167   | Ast0.Cast(lp,ty,rp,exp) ->
 168       typeC old_metas table minus ty; expression ID old_metas table minus exp
 169   | Ast0.SizeOfExpr(szf,exp) -> expression ID old_metas table minus exp
 170   | Ast0.SizeOfType(szf,lp,ty,rp) -> typeC old_metas table minus ty
 171   | Ast0.TypeExp(ty) -> typeC old_metas table minus ty
 172   | Ast0.Constructor(lp,ty,rp,init) ->
 173       typeC old_metas table minus ty; initialiser old_metas table minus init
 174   | Ast0.MetaExpr(name,_,Some tys,_,_) ->
 175       List.iter
 176         (function x ->
 177           match get_type_name x with
 178             Some(ty) -> check_table table minus (promote ty)
 179           | None -> ())
 180         tys;
 181       check_table table minus name
 182   | Ast0.MetaExpr(name,_,_,_,_) | Ast0.MetaErr(name,_,_) ->
 183       check_table table minus name
 184   | Ast0.MetaExprList(name,Ast0.MetaListLen lenname,_) ->
 185       check_table table minus name;
 186       check_table table minus lenname
 187   | Ast0.MetaExprList(name,_,_) ->
 188       check_table table minus name
 189   | Ast0.DisjExpr(_,exps,_,_) ->
 190       List.iter (expression context old_metas table minus) exps
 191   | Ast0.NestExpr(_,exp_dots,_,w,_) ->
 192       dots (expression ID old_metas table minus) exp_dots;
 193       get_opt (expression ID old_metas table minus) w
 194   | Ast0.Edots(_,Some x) | Ast0.Ecircles(_,Some x) | Ast0.Estars(_,Some x) ->
 195       expression ID old_metas table minus x
 196   | _ -> () (* no metavariable subterms *)
 197
 198 and get_type_name = function
 199     Type_cocci.ConstVol(_,ty) | Type_cocci.SignedT(_,Some ty)
 200   | Type_cocci.Pointer(ty)
 201   | Type_cocci.FunctionPointer(ty) | Type_cocci.Array(ty) -> get_type_name ty
 202   | Type_cocci.EnumName(Type_cocci.MV(nm,_,_)) -> Some nm
 203   | Type_cocci.StructUnionName(_,Type_cocci.MV(nm,_,_)) -> Some nm
 204   | Type_cocci.MetaType(nm,_,_) -> Some nm
 205   | _ -> None
 206
 207 (* --------------------------------------------------------------------- *)
 208 (* Types *)
 209
 210 and typeC old_metas table minus t =
 211   match Ast0.unwrap t with
 212     Ast0.ConstVol(cv,ty) -> typeC old_metas table minus ty
 213   | Ast0.Signed(sgn,ty) ->
 214       get_opt (typeC old_metas table minus) ty
 215   | Ast0.Pointer(ty,star) -> typeC old_metas table minus ty
 216   | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
 217       typeC old_metas table minus ty;
 218       parameter_list old_metas table minus params
 219   | Ast0.FunctionType(ty,lp1,params,rp1) ->
 220       get_opt (typeC old_metas table minus) ty;
 221       parameter_list old_metas table minus params
 222   | Ast0.Array(ty,lb,size,rb) ->
 223       typeC old_metas table minus ty;
 224       get_opt (expression ID old_metas table minus) size
 225   | Ast0.MetaType(name,_) ->
 226       check_table table minus name
 227   | Ast0.DisjType(_,types,_,_) ->
 228       List.iter (typeC old_metas table minus) types
 229   | Ast0.EnumName(en,Some id) -> ident GLOBAL old_metas table minus id
 230   | Ast0.EnumDef(ty,lb,ids,rb) ->
 231       typeC old_metas table minus ty;
 232       dots (expression GLOBAL old_metas table minus) ids
 233   | Ast0.StructUnionName(su,Some id) -> ident GLOBAL old_metas table minus id
 234   | Ast0.StructUnionDef(ty,lb,decls,rb) ->
 235       typeC old_metas table minus ty;
 236       dots (declaration GLOBAL old_metas table minus) decls
 237   | Ast0.OptType(ty) | Ast0.UniqueType(ty) ->
 238       failwith "unexpected code"
 239   | _ -> () (* no metavariable subterms *)
 240
 241 (* --------------------------------------------------------------------- *)
 242 (* Variable declaration *)
 243 (* Even if the Cocci program specifies a list of declarations, they are
 244    split out into multiple declarations of a single variable each. *)
 245
 246 and declaration context old_metas table minus d =
 247   match Ast0.unwrap d with
 248     Ast0.MetaDecl(name,_) | Ast0.MetaField(name,_) ->
 249       check_table table minus name
 250   | Ast0.MetaFieldList(name,Ast0.MetaListLen lenname,_) ->
 251       check_table table minus name;
 252       check_table table minus lenname
 253   | Ast0.MetaFieldList(name,_,_) ->
 254       check_table table minus name
 255   | Ast0.Init(stg,ty,id,eq,ini,sem) ->
 256       (match Ast0.unwrap ini with
 257         Ast0.InitExpr exp ->
 258           typeC old_metas table minus ty;
 259           ident context old_metas table minus id;
 260           expression ID old_metas table minus exp
 261       | _ ->
 262           (*
 263           if minus
 264           then
 265             failwith "complex initializer specification not allowed in - code"
 266           else*)
 267             (typeC old_metas table minus ty;
 268              ident context old_metas table minus id;
 269              initialiser old_metas table minus ini))
 270   | Ast0.UnInit(stg,ty,id,sem) ->
 271       typeC old_metas table minus ty; ident context old_metas table minus id
 272   | Ast0.MacroDecl(name,lp,args,rp,sem) ->
 273       ident GLOBAL old_metas table minus name;
 274       dots (expression ID old_metas table minus) args
 275   | Ast0.TyDecl(ty,sem) -> typeC old_metas table minus ty
 276   | Ast0.Typedef(stg,ty,id,sem) ->
 277       typeC old_metas table minus ty;
 278       typeC old_metas table minus id
 279   | Ast0.DisjDecl(_,decls,_,_) ->
 280       List.iter (declaration ID old_metas table minus) decls
 281   | Ast0.Ddots(_,Some x) -> declaration ID old_metas table minus x
 282   | Ast0.Ddots(_,None) -> ()
 283   | Ast0.OptDecl(_) | Ast0.UniqueDecl(_) ->
 284       failwith "unexpected code"
 285
 286 (* --------------------------------------------------------------------- *)
 287 (* Initialiser *)
 288
 289 and initialiser old_metas table minus ini =
 290   match Ast0.unwrap ini with
 291     Ast0.MetaInit(name,_) ->
 292       check_table table minus name
 293   | Ast0.MetaInitList(name,Ast0.MetaListLen lenname,_) ->
 294       check_table table minus name;
 295       check_table table minus lenname
 296   | Ast0.MetaInitList(name,_,_) ->
 297       check_table table minus name
 298   | Ast0.InitExpr(exp) -> expression ID old_metas table minus exp
 299   | Ast0.InitList(lb,initlist,rb,ordered) ->
 300       dots (initialiser old_metas table minus) initlist
 301   | Ast0.InitGccExt(designators,eq,ini) ->
 302       List.iter (designator old_metas table minus) designators;
 303       initialiser old_metas table minus ini
 304   | Ast0.InitGccName(name,eq,ini) ->
 305       ident FIELD old_metas table minus name;
 306       initialiser old_metas table minus ini
 307   | Ast0.Idots(_,Some x) -> initialiser old_metas table minus x
 308   | Ast0.OptIni(_) | Ast0.UniqueIni(_) ->
 309       failwith "unexpected code"
 310   | _ -> () (* no metavariable subterms *)
 311
 312 and designator old_metas table minus = function
 313     Ast0.DesignatorField(dot,id) ->
 314       ident FIELD old_metas table minus id
 315   | Ast0.DesignatorIndex(lb,exp,rb) ->
 316       expression ID old_metas table minus exp
 317   | Ast0.DesignatorRange(lb,min,dots,max,rb) ->
 318       expression ID old_metas table minus min;
 319       expression ID old_metas table minus max
 320
 321 and initialiser_list old_metas table minus =
 322   dots (initialiser old_metas table minus)
 323
 324 (* --------------------------------------------------------------------- *)
 325 (* Parameter *)
 326
 327 and parameterTypeDef old_metas table minus param =
 328   match Ast0.unwrap param with
 329     Ast0.Param(ty,id) ->
 330       get_opt (ident ID old_metas table minus) id;
 331       typeC old_metas table minus ty
 332   | Ast0.MetaParam(name,_) ->
 333       check_table table minus name
 334   | Ast0.MetaParamList(name,Ast0.MetaListLen lenname,_) ->
 335       check_table table minus name;
 336       check_table table minus lenname
 337   | Ast0.MetaParamList(name,_,_) ->
 338       check_table table minus name
 339   | _ -> () (* no metavariable subterms *)
 340
 341 and parameter_list old_metas table minus =
 342   dots (parameterTypeDef old_metas table minus)
 343
 344 (* --------------------------------------------------------------------- *)
 345 (* Top-level code *)
 346
 347 and statement old_metas table minus s =
 348   match Ast0.unwrap s with
 349     Ast0.Decl(_,decl) -> declaration ID old_metas table minus decl
 350   | Ast0.Seq(lbrace,body,rbrace) -> dots (statement old_metas table minus) body
 351   | Ast0.ExprStatement(exp,sem) ->
 352       get_opt (expression ID old_metas table minus) exp
 353   | Ast0.IfThen(iff,lp,exp,rp,branch,_) ->
 354       expression ID old_metas table minus exp;
 355       statement old_metas table minus branch
 356   | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,_) ->
 357       expression ID old_metas table minus exp;
 358       statement old_metas table minus branch1;
 359       statement old_metas table minus branch2
 360   | Ast0.While(wh,lp,exp,rp,body,_) ->
 361       expression ID old_metas table minus exp;
 362       statement old_metas table minus body
 363   | Ast0.Do(d,body,wh,lp,exp,rp,sem) ->
 364       statement old_metas table minus body;
 365       expression ID old_metas table minus exp
 366   | Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,_) ->
 367       get_opt (expression ID old_metas table minus) exp1;
 368       get_opt (expression ID old_metas table minus) exp2;
 369       get_opt (expression ID old_metas table minus) exp3;
 370       statement old_metas table minus body
 371   | Ast0.Iterator(nm,lp,args,rp,body,_) ->
 372       ident GLOBAL old_metas table minus nm;
 373       dots (expression ID old_metas table minus) args;
 374       statement old_metas table minus body
 375   | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) ->
 376       expression ID old_metas table minus exp;
 377       dots (statement old_metas table minus) decls;
 378       dots (case_line old_metas table minus) cases
 379   | Ast0.ReturnExpr(ret,exp,sem) -> expression ID old_metas table minus exp
 380   | Ast0.MetaStmt(name,_) ->     check_table table minus name
 381   | Ast0.MetaStmtList(name,_) -> check_table table minus name
 382   | Ast0.Exp(exp) -> expression ID old_metas table minus exp
 383   | Ast0.TopExp(exp) -> expression ID old_metas table minus exp
 384   | Ast0.Ty(ty) -> typeC old_metas table minus ty
 385   | Ast0.TopInit(init) -> initialiser old_metas table minus init
 386   | Ast0.Disj(_,rule_elem_dots_list,_,_) ->
 387       List.iter (dots (statement old_metas table minus)) rule_elem_dots_list
 388   | Ast0.Nest(_,rule_elem_dots,_,w,_) ->
 389       dots (statement old_metas table minus) rule_elem_dots;
 390       List.iter (whencode (dots (statement old_metas table minus))
 391                    (statement old_metas table minus)
 392                    (expression ID old_metas table minus))
 393         w
 394   | Ast0.Dots(_,x) | Ast0.Circles(_,x) | Ast0.Stars(_,x) ->
 395       List.iter
 396         (whencode (dots (statement old_metas table minus))
 397            (statement old_metas table minus)
 398            (expression ID old_metas table minus)) x
 399   | Ast0.FunDecl(_,fi,name,lp,params,rp,lbrace,body,rbrace) ->
 400       ident FN old_metas table minus name;
 401       List.iter (fninfo old_metas table minus) fi;
 402       parameter_list old_metas table minus params;
 403       dots (statement old_metas table minus) body
 404   | Ast0.Include(inc,s) -> () (* no metavariables possible *)
 405   | Ast0.Undef(def,id) ->
 406       ident GLOBAL old_metas table minus id
 407   | Ast0.Define(def,id,params,body) ->
 408       ident GLOBAL old_metas table minus id;
 409       define_parameters old_metas table minus params;
 410       dots (statement old_metas table minus) body
 411   | Ast0.Label(i,_) -> ident ID old_metas table minus i
 412   | Ast0.Goto(_,i,_) -> ident ID old_metas table minus i
 413   | _ -> () (* no metavariable subterms *)
 414
 415 and define_param old_metas table minus p =
 416   match Ast0.unwrap p with
 417     Ast0.DParam(id) -> ident GLOBAL old_metas table minus id
 418   | Ast0.DPComma(_) | Ast0.DPdots(_) | Ast0.DPcircles(_) ->
 419       () (* no metavariable subterms *)
 420   | Ast0.OptDParam(dp)    -> define_param old_metas table minus dp
 421   | Ast0.UniqueDParam(dp) -> define_param old_metas table minus dp
 422
 423 and define_parameters old_metas table minus x =
 424   match Ast0.unwrap x with
 425     Ast0.NoParams -> ()
 426   | Ast0.DParams(lp,dp,rp) -> dots (define_param old_metas table minus) dp
 427
 428 and fninfo old_metas table minus = function
 429     Ast0.FStorage(stg) -> ()
 430   | Ast0.FType(ty) -> typeC old_metas table minus ty
 431   | Ast0.FInline(inline) -> ()
 432   | Ast0.FAttr(attr) -> ()
 433
 434 and whencode notfn alwaysfn expression = function
 435     Ast0.WhenNot a -> notfn a
 436   | Ast0.WhenAlways a -> alwaysfn a
 437   | Ast0.WhenModifier(_) -> ()
 438   | Ast0.WhenNotTrue a -> expression a
 439   | Ast0.WhenNotFalse a -> expression a
 440
 441 and case_line old_metas table minus c =
 442   match Ast0.unwrap c with
 443     Ast0.Default(def,colon,code) ->
 444       dots (statement old_metas table minus) code
 445   | Ast0.Case(case,exp,colon,code) ->
 446       expression GLOBAL old_metas table minus exp;
 447       dots (statement old_metas table minus) code
 448   | Ast0.DisjCase(_,case_lines,_,_) ->
 449       List.iter (case_line old_metas table minus) case_lines
 450   | Ast0.OptCase(case) -> failwith "unexpected code"
 451
 452 (* --------------------------------------------------------------------- *)
 453 (* Rules *)
 454
 455 let top_level old_metas table minus t =
 456   match Ast0.unwrap t with
 457     Ast0.NONDECL(stmt) -> statement old_metas table minus stmt
 458   | Ast0.CODE(stmt_dots) | Ast0.TOPCODE(stmt_dots) ->
 459       dots (statement old_metas table minus) stmt_dots
 460   | Ast0.ERRORWORDS(exps) ->
 461       List.iter (expression FN old_metas table minus) exps
 462   | _ -> () (* no metavariables possible *)
 463
 464 let rule old_metas table minus rules =
 465   List.iter (top_level old_metas table minus) rules
 466
 467 (* --------------------------------------------------------------------- *)
 468
 469 let positions table rules =
 470   let mcode x =
 471     List.iter
 472       (function Ast0.MetaPos(name,constraints,_) ->
 473         let pos = Ast0.unwrap_mcode name in
 474         (find_loop table pos) := true)
 475       (Ast0.get_pos x) in
 476   let option_default = () in
 477   let bind x y = () in
 478   let donothing r k e = k e in
 479   let fn =
 480     V0.flat_combiner bind option_default
 481       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 482       donothing donothing donothing donothing donothing donothing
 483       donothing donothing donothing donothing donothing donothing donothing
 484       donothing donothing in
 485
 486   List.iter fn.VT0.combiner_rec_top_level rules
 487
 488 let dup_positions rules =
 489   let mcode x =
 490     List.map
 491       (function Ast0.MetaPos(name,constraints,_) -> Ast0.unwrap_mcode name)
 492       (Ast0.get_pos x) in
 493   let option_default = [] in
 494   let bind x y = x@y in
 495
 496   (* Case for everything that has a disj.
 497      Note, no positions on ( | ) of a disjunction, so no need to recurse on
 498      these. *)
 499
 500   let expression r k e =
 501     match Ast0.unwrap e with
 502       Ast0.DisjExpr(_,explist,_,_) ->
 503         List.fold_left Common.union_set option_default
 504           (List.map r.VT0.combiner_rec_expression explist)
 505     | _ -> k e in
 506
 507   let typeC r k e = (* not sure relevent because "only after iso" *)
 508     match Ast0.unwrap e with
 509       Ast0.DisjType(_,types,_,_) ->
 510         List.fold_left Common.union_set option_default
 511           (List.map r.VT0.combiner_rec_typeC types)
 512     | _ -> k e in
 513
 514   let declaration r k e =
 515     match Ast0.unwrap e with
 516       Ast0.DisjDecl(_,decls,_,_) ->
 517         List.fold_left Common.union_set option_default
 518           (List.map r.VT0.combiner_rec_declaration decls)
 519     | _ -> k e in
 520
 521   let statement r k e =
 522     match Ast0.unwrap e with
 523       Ast0.Disj(_,stmts,_,_) ->
 524         List.fold_left Common.union_set option_default
 525           (List.map r.VT0.combiner_rec_statement_dots stmts)
 526     | _ -> k e in
 527
 528   let donothing r k e = k e in
 529   let fn =
 530     V0.flat_combiner bind option_default
 531       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 532       donothing donothing donothing donothing donothing donothing
 533       donothing expression typeC donothing donothing declaration statement
 534       donothing donothing in
 535
 536   let res =
 537     List.sort compare
 538       (List.fold_left Common.union_set option_default
 539          (List.map fn.VT0.combiner_rec_top_level rules)) in
 540   let rec loop = function
 541       [] | [_] -> ()
 542     | ((rule,name) as x)::y::_ when x = y ->
 543         failwith
 544           (Printf.sprintf "duplicate use of %s.%s" rule name)
 545     | _::xs -> loop xs in
 546   loop res
 547
 548 (* --------------------------------------------------------------------- *)
 549
 550 let make_table l =
 551   let table =
 552     (Hashtbl.create(List.length l) :
 553        (Ast.meta_name, bool ref) Hashtbl.t) in
 554   List.iter
 555     (function x -> Hashtbl.add table (Ast.get_meta_name x) (ref false)) l;
 556   table
 557
 558 let add_to_fresh_table l =
 559   List.iter
 560     (function x ->
 561       let name = Ast.get_meta_name x in Hashtbl.replace fresh_table name ())
 562     l
 563
 564 let check_all_marked rname err table after_err =
 565   Hashtbl.iter
 566     (function name ->
 567       function (cell) ->
 568         if not (!cell)
 569         then
 570           let (_,name) = name in
 571           warning
 572             (Printf.sprintf "%s: %s %s not used %s" rname err name after_err))
 573     table
 574
 575 let check_meta rname old_metas inherited_metavars metavars minus plus =
 576   let old_metas =
 577     List.map (function (_,x) -> x) (List.map Ast.get_meta_name old_metas) in
 578   let (fresh,other) =
 579     List.partition (function Ast.MetaFreshIdDecl(_,_) -> true | _ -> false)
 580       metavars in
 581   let (err,other) =
 582     List.partition (function Ast.MetaErrDecl(_,_) -> true | _ -> false)
 583       other in
 584   let (ierr,iother) =
 585     List.partition (function Ast.MetaErrDecl(_,_) -> true | _ -> false)
 586       inherited_metavars in
 587   let fresh_table = make_table fresh in
 588   let err_table = make_table (err@ierr) in
 589   let other_table = make_table other in
 590   let iother_table = make_table iother in
 591   add_to_fresh_table fresh;
 592   rule old_metas [iother_table;other_table;err_table] true minus;
 593   positions [iother_table;other_table] minus;
 594   dup_positions minus;
 595   check_all_marked rname "metavariable" other_table "in the - or context code";
 596   rule old_metas [iother_table;fresh_table;err_table] false plus;
 597   check_all_marked rname "inherited metavariable" iother_table
 598     "in the -, +, or context code";
 599   check_all_marked rname "metavariable" fresh_table "in the + code";
 600   check_all_marked rname "error metavariable" err_table ""