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.MetaExpr(name,_,Some tys,_,_) ->
 173       List.iter
 174         (function x ->
 175           match get_type_name x with
 176             Some(ty) -> check_table table minus (promote ty)
 177           | None -> ())
 178         tys;
 179       check_table table minus name
 180   | Ast0.MetaExpr(name,_,_,_,_) | Ast0.MetaErr(name,_,_) ->
 181       check_table table minus name
 182   | Ast0.MetaExprList(name,Ast0.MetaListLen lenname,_) ->
 183       check_table table minus name;
 184       check_table table minus lenname
 185   | Ast0.MetaExprList(name,_,_) ->
 186       check_table table minus name
 187   | Ast0.DisjExpr(_,exps,_,_) ->
 188       List.iter (expression context old_metas table minus) exps
 189   | Ast0.NestExpr(_,exp_dots,_,w,_) ->
 190       dots (expression ID old_metas table minus) exp_dots;
 191       get_opt (expression ID old_metas table minus) w
 192   | Ast0.Edots(_,Some x) | Ast0.Ecircles(_,Some x) | Ast0.Estars(_,Some x) ->
 193       expression ID old_metas table minus x
 194   | _ -> () (* no metavariable subterms *)
 195
 196 and get_type_name = function
 197     Type_cocci.ConstVol(_,ty) | Type_cocci.SignedT(_,Some ty)
 198   | Type_cocci.Pointer(ty)
 199   | Type_cocci.FunctionPointer(ty) | Type_cocci.Array(ty) -> get_type_name ty
 200   | Type_cocci.EnumName(Type_cocci.MV(nm,_,_)) -> Some nm
 201   | Type_cocci.StructUnionName(_,Type_cocci.MV(nm,_,_)) -> Some nm
 202   | Type_cocci.MetaType(nm,_,_) -> Some nm
 203   | _ -> None
 204
 205 (* --------------------------------------------------------------------- *)
 206 (* Types *)
 207
 208 and typeC old_metas table minus t =
 209   match Ast0.unwrap t with
 210     Ast0.ConstVol(cv,ty) -> typeC old_metas table minus ty
 211   | Ast0.Signed(sgn,ty) ->
 212       get_opt (typeC old_metas table minus) ty
 213   | Ast0.Pointer(ty,star) -> typeC old_metas table minus ty
 214   | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
 215       typeC old_metas table minus ty;
 216       parameter_list old_metas table minus params
 217   | Ast0.FunctionType(ty,lp1,params,rp1) ->
 218       get_opt (typeC old_metas table minus) ty;
 219       parameter_list old_metas table minus params
 220   | Ast0.Array(ty,lb,size,rb) ->
 221       typeC old_metas table minus ty;
 222       get_opt (expression ID old_metas table minus) size
 223   | Ast0.MetaType(name,_) ->
 224       check_table table minus name
 225   | Ast0.DisjType(_,types,_,_) ->
 226       List.iter (typeC old_metas table minus) types
 227   | Ast0.EnumName(en,Some id) -> ident GLOBAL old_metas table minus id
 228   | Ast0.EnumDef(ty,lb,ids,rb) ->
 229       typeC old_metas table minus ty;
 230       dots (expression GLOBAL old_metas table minus) ids
 231   | Ast0.StructUnionName(su,Some id) -> ident GLOBAL old_metas table minus id
 232   | Ast0.StructUnionDef(ty,lb,decls,rb) ->
 233       typeC old_metas table minus ty;
 234       dots (declaration GLOBAL old_metas table minus) decls
 235   | Ast0.OptType(ty) | Ast0.UniqueType(ty) ->
 236       failwith "unexpected code"
 237   | _ -> () (* no metavariable subterms *)
 238
 239 (* --------------------------------------------------------------------- *)
 240 (* Variable declaration *)
 241 (* Even if the Cocci program specifies a list of declarations, they are
 242    split out into multiple declarations of a single variable each. *)
 243
 244 and declaration context old_metas table minus d =
 245   match Ast0.unwrap d with
 246     Ast0.MetaDecl(name,_) | Ast0.MetaField(name,_) ->
 247       check_table table minus name
 248   | Ast0.MetaFieldList(name,Ast0.MetaListLen lenname,_) ->
 249       check_table table minus name;
 250       check_table table minus lenname
 251   | Ast0.MetaFieldList(name,_,_) ->
 252       check_table table minus name
 253   | Ast0.Init(stg,ty,id,eq,ini,sem) ->
 254       (match Ast0.unwrap ini with
 255         Ast0.InitExpr exp ->
 256           typeC old_metas table minus ty;
 257           ident context old_metas table minus id;
 258           expression ID old_metas table minus exp
 259       | _ ->
 260           (*
 261           if minus
 262           then
 263             failwith "complex initializer specification not allowed in - code"
 264           else*)
 265             (typeC old_metas table minus ty;
 266              ident context old_metas table minus id;
 267              initialiser old_metas table minus ini))
 268   | Ast0.UnInit(stg,ty,id,sem) ->
 269       typeC old_metas table minus ty; ident context old_metas table minus id
 270   | Ast0.MacroDecl(name,lp,args,rp,sem) ->
 271       ident GLOBAL old_metas table minus name;
 272       dots (expression ID old_metas table minus) args
 273   | Ast0.TyDecl(ty,sem) -> typeC old_metas table minus ty
 274   | Ast0.Typedef(stg,ty,id,sem) ->
 275       typeC old_metas table minus ty;
 276       typeC old_metas table minus id
 277   | Ast0.DisjDecl(_,decls,_,_) ->
 278       List.iter (declaration ID old_metas table minus) decls
 279   | Ast0.Ddots(_,Some x) -> declaration ID old_metas table minus x
 280   | Ast0.Ddots(_,None) -> ()
 281   | Ast0.OptDecl(_) | Ast0.UniqueDecl(_) ->
 282       failwith "unexpected code"
 283
 284 (* --------------------------------------------------------------------- *)
 285 (* Initialiser *)
 286
 287 and initialiser old_metas table minus ini =
 288   match Ast0.unwrap ini with
 289     Ast0.MetaInit(name,_) ->
 290       check_table table minus name
 291   | Ast0.MetaInitList(name,Ast0.MetaListLen lenname,_) ->
 292       check_table table minus name;
 293       check_table table minus lenname
 294   | Ast0.MetaInitList(name,_,_) ->
 295       check_table table minus name
 296   | Ast0.InitExpr(exp) -> expression ID old_metas table minus exp
 297   | Ast0.InitList(lb,initlist,rb,ordered) ->
 298       dots (initialiser old_metas table minus) initlist
 299   | Ast0.InitGccExt(designators,eq,ini) ->
 300       List.iter (designator old_metas table minus) designators;
 301       initialiser old_metas table minus ini
 302   | Ast0.InitGccName(name,eq,ini) ->
 303       ident FIELD old_metas table minus name;
 304       initialiser old_metas table minus ini
 305   | Ast0.Idots(_,Some x) -> initialiser old_metas table minus x
 306   | Ast0.OptIni(_) | Ast0.UniqueIni(_) ->
 307       failwith "unexpected code"
 308   | _ -> () (* no metavariable subterms *)
 309
 310 and designator old_metas table minus = function
 311     Ast0.DesignatorField(dot,id) ->
 312       ident FIELD old_metas table minus id
 313   | Ast0.DesignatorIndex(lb,exp,rb) ->
 314       expression ID old_metas table minus exp
 315   | Ast0.DesignatorRange(lb,min,dots,max,rb) ->
 316       expression ID old_metas table minus min;
 317       expression ID old_metas table minus max
 318
 319 and initialiser_list old_metas table minus =
 320   dots (initialiser old_metas table minus)
 321
 322 (* --------------------------------------------------------------------- *)
 323 (* Parameter *)
 324
 325 and parameterTypeDef old_metas table minus param =
 326   match Ast0.unwrap param with
 327     Ast0.Param(ty,id) ->
 328       get_opt (ident ID old_metas table minus) id;
 329       typeC old_metas table minus ty
 330   | Ast0.MetaParam(name,_) ->
 331       check_table table minus name
 332   | Ast0.MetaParamList(name,Ast0.MetaListLen lenname,_) ->
 333       check_table table minus name;
 334       check_table table minus lenname
 335   | Ast0.MetaParamList(name,_,_) ->
 336       check_table table minus name
 337   | _ -> () (* no metavariable subterms *)
 338
 339 and parameter_list old_metas table minus =
 340   dots (parameterTypeDef old_metas table minus)
 341
 342 (* --------------------------------------------------------------------- *)
 343 (* Top-level code *)
 344
 345 and statement old_metas table minus s =
 346   match Ast0.unwrap s with
 347     Ast0.Decl(_,decl) -> declaration ID old_metas table minus decl
 348   | Ast0.Seq(lbrace,body,rbrace) -> dots (statement old_metas table minus) body
 349   | Ast0.ExprStatement(exp,sem) ->
 350       get_opt (expression ID old_metas table minus) exp
 351   | Ast0.IfThen(iff,lp,exp,rp,branch,_) ->
 352       expression ID old_metas table minus exp;
 353       statement old_metas table minus branch
 354   | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,_) ->
 355       expression ID old_metas table minus exp;
 356       statement old_metas table minus branch1;
 357       statement old_metas table minus branch2
 358   | Ast0.While(wh,lp,exp,rp,body,_) ->
 359       expression ID old_metas table minus exp;
 360       statement old_metas table minus body
 361   | Ast0.Do(d,body,wh,lp,exp,rp,sem) ->
 362       statement old_metas table minus body;
 363       expression ID old_metas table minus exp
 364   | Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,_) ->
 365       get_opt (expression ID old_metas table minus) exp1;
 366       get_opt (expression ID old_metas table minus) exp2;
 367       get_opt (expression ID old_metas table minus) exp3;
 368       statement old_metas table minus body
 369   | Ast0.Iterator(nm,lp,args,rp,body,_) ->
 370       ident GLOBAL old_metas table minus nm;
 371       dots (expression ID old_metas table minus) args;
 372       statement old_metas table minus body
 373   | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) ->
 374       expression ID old_metas table minus exp;
 375       dots (statement old_metas table minus) decls;
 376       dots (case_line old_metas table minus) cases
 377   | Ast0.ReturnExpr(ret,exp,sem) -> expression ID old_metas table minus exp
 378   | Ast0.MetaStmt(name,_) ->     check_table table minus name
 379   | Ast0.MetaStmtList(name,_) -> check_table table minus name
 380   | Ast0.Exp(exp) -> expression ID old_metas table minus exp
 381   | Ast0.TopExp(exp) -> expression ID old_metas table minus exp
 382   | Ast0.Ty(ty) -> typeC old_metas table minus ty
 383   | Ast0.TopInit(init) -> initialiser old_metas table minus init
 384   | Ast0.Disj(_,rule_elem_dots_list,_,_) ->
 385       List.iter (dots (statement old_metas table minus)) rule_elem_dots_list
 386   | Ast0.Nest(_,rule_elem_dots,_,w,_) ->
 387       dots (statement old_metas table minus) rule_elem_dots;
 388       List.iter (whencode (dots (statement old_metas table minus))
 389                    (statement old_metas table minus)
 390                    (expression ID old_metas table minus))
 391         w
 392   | Ast0.Dots(_,x) | Ast0.Circles(_,x) | Ast0.Stars(_,x) ->
 393       List.iter
 394         (whencode (dots (statement old_metas table minus))
 395            (statement old_metas table minus)
 396            (expression ID old_metas table minus)) x
 397   | Ast0.FunDecl(_,fi,name,lp,params,rp,lbrace,body,rbrace) ->
 398       ident FN old_metas table minus name;
 399       List.iter (fninfo old_metas table minus) fi;
 400       parameter_list old_metas table minus params;
 401       dots (statement old_metas table minus) body
 402   | Ast0.Include(inc,s) -> () (* no metavariables possible *)
 403   | Ast0.Undef(def,id) ->
 404       ident GLOBAL old_metas table minus id
 405   | Ast0.Define(def,id,params,body) ->
 406       ident GLOBAL old_metas table minus id;
 407       define_parameters old_metas table minus params;
 408       dots (statement old_metas table minus) body
 409   | Ast0.Label(i,_) -> ident ID old_metas table minus i
 410   | Ast0.Goto(_,i,_) -> ident ID old_metas table minus i
 411   | _ -> () (* no metavariable subterms *)
 412
 413 and define_param old_metas table minus p =
 414   match Ast0.unwrap p with
 415     Ast0.DParam(id) -> ident GLOBAL old_metas table minus id
 416   | Ast0.DPComma(_) | Ast0.DPdots(_) | Ast0.DPcircles(_) ->
 417       () (* no metavariable subterms *)
 418   | Ast0.OptDParam(dp)    -> define_param old_metas table minus dp
 419   | Ast0.UniqueDParam(dp) -> define_param old_metas table minus dp
 420
 421 and define_parameters old_metas table minus x =
 422   match Ast0.unwrap x with
 423     Ast0.NoParams -> ()
 424   | Ast0.DParams(lp,dp,rp) -> dots (define_param old_metas table minus) dp
 425
 426 and fninfo old_metas table minus = function
 427     Ast0.FStorage(stg) -> ()
 428   | Ast0.FType(ty) -> typeC old_metas table minus ty
 429   | Ast0.FInline(inline) -> ()
 430   | Ast0.FAttr(attr) -> ()
 431
 432 and whencode notfn alwaysfn expression = function
 433     Ast0.WhenNot a -> notfn a
 434   | Ast0.WhenAlways a -> alwaysfn a
 435   | Ast0.WhenModifier(_) -> ()
 436   | Ast0.WhenNotTrue a -> expression a
 437   | Ast0.WhenNotFalse a -> expression a
 438
 439 and case_line old_metas table minus c =
 440   match Ast0.unwrap c with
 441     Ast0.Default(def,colon,code) ->
 442       dots (statement old_metas table minus) code
 443   | Ast0.Case(case,exp,colon,code) ->
 444       expression GLOBAL old_metas table minus exp;
 445       dots (statement old_metas table minus) code
 446   | Ast0.DisjCase(_,case_lines,_,_) ->
 447       List.iter (case_line old_metas table minus) case_lines
 448   | Ast0.OptCase(case) -> failwith "unexpected code"
 449
 450 (* --------------------------------------------------------------------- *)
 451 (* Rules *)
 452
 453 let top_level old_metas table minus t =
 454   match Ast0.unwrap t with
 455     Ast0.DECL(stmt) -> statement old_metas table minus stmt
 456   | Ast0.CODE(stmt_dots) -> dots (statement old_metas table minus) stmt_dots
 457   | Ast0.ERRORWORDS(exps) ->
 458       List.iter (expression FN old_metas table minus) exps
 459   | _ -> () (* no metavariables possible *)
 460
 461 let rule old_metas table minus rules =
 462   List.iter (top_level old_metas table minus) rules
 463
 464 (* --------------------------------------------------------------------- *)
 465
 466 let positions table rules =
 467   let mcode x =
 468     List.iter
 469       (function Ast0.MetaPos(name,constraints,_) ->
 470         let pos = Ast0.unwrap_mcode name in
 471         (find_loop table pos) := true)
 472       (Ast0.get_pos x) in
 473   let option_default = () in
 474   let bind x y = () in
 475   let donothing r k e = k e in
 476   let fn =
 477     V0.flat_combiner bind option_default
 478       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 479       donothing donothing donothing donothing donothing donothing
 480       donothing donothing donothing donothing donothing donothing donothing
 481       donothing donothing in
 482
 483   List.iter fn.VT0.combiner_rec_top_level rules
 484
 485 let dup_positions rules =
 486   let mcode x =
 487     List.map
 488       (function Ast0.MetaPos(name,constraints,_) -> Ast0.unwrap_mcode name)
 489       (Ast0.get_pos x) in
 490   let option_default = [] in
 491   let bind x y = x@y in
 492
 493   (* Case for everything that has a disj.
 494      Note, no positions on ( | ) of a disjunction, so no need to recurse on
 495      these. *)
 496
 497   let expression r k e =
 498     match Ast0.unwrap e with
 499       Ast0.DisjExpr(_,explist,_,_) ->
 500         List.fold_left Common.union_set option_default
 501           (List.map r.VT0.combiner_rec_expression explist)
 502     | _ -> k e in
 503
 504   let typeC r k e = (* not sure relevent because "only after iso" *)
 505     match Ast0.unwrap e with
 506       Ast0.DisjType(_,types,_,_) ->
 507         List.fold_left Common.union_set option_default
 508           (List.map r.VT0.combiner_rec_typeC types)
 509     | _ -> k e in
 510
 511   let declaration r k e =
 512     match Ast0.unwrap e with
 513       Ast0.DisjDecl(_,decls,_,_) ->
 514         List.fold_left Common.union_set option_default
 515           (List.map r.VT0.combiner_rec_declaration decls)
 516     | _ -> k e in
 517
 518   let statement r k e =
 519     match Ast0.unwrap e with
 520       Ast0.Disj(_,stmts,_,_) ->
 521         List.fold_left Common.union_set option_default
 522           (List.map r.VT0.combiner_rec_statement_dots stmts)
 523     | _ -> k e in
 524
 525   let donothing r k e = k e in
 526   let fn =
 527     V0.flat_combiner bind option_default
 528       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 529       donothing donothing donothing donothing donothing donothing
 530       donothing expression typeC donothing donothing declaration statement
 531       donothing donothing in
 532
 533   let res =
 534     List.sort compare
 535       (List.fold_left Common.union_set option_default
 536          (List.map fn.VT0.combiner_rec_top_level rules)) in
 537   let rec loop = function
 538       [] | [_] -> ()
 539     | ((rule,name) as x)::y::_ when x = y ->
 540         failwith
 541           (Printf.sprintf "duplicate use of %s.%s" rule name)
 542     | _::xs -> loop xs in
 543   loop res
 544
 545 (* --------------------------------------------------------------------- *)
 546
 547 let make_table l =
 548   let table =
 549     (Hashtbl.create(List.length l) :
 550        (Ast.meta_name, bool ref) Hashtbl.t) in
 551   List.iter
 552     (function x -> Hashtbl.add table (Ast.get_meta_name x) (ref false)) l;
 553   table
 554
 555 let add_to_fresh_table l =
 556   List.iter
 557     (function x ->
 558       let name = Ast.get_meta_name x in Hashtbl.replace fresh_table name ())
 559     l
 560
 561 let check_all_marked rname err table after_err =
 562   Hashtbl.iter
 563     (function name ->
 564       function (cell) ->
 565         if not (!cell)
 566         then
 567           let (_,name) = name in
 568           warning
 569             (Printf.sprintf "%s: %s %s not used %s" rname err name after_err))
 570     table
 571
 572 let check_meta rname old_metas inherited_metavars metavars minus plus =
 573   let old_metas =
 574     List.map (function (_,x) -> x) (List.map Ast.get_meta_name old_metas) in
 575   let (fresh,other) =
 576     List.partition (function Ast.MetaFreshIdDecl(_,_) -> true | _ -> false)
 577       metavars in
 578   let (err,other) =
 579     List.partition (function Ast.MetaErrDecl(_,_) -> true | _ -> false)
 580       other in
 581   let (ierr,iother) =
 582     List.partition (function Ast.MetaErrDecl(_,_) -> true | _ -> false)
 583       inherited_metavars in
 584   let fresh_table = make_table fresh in
 585   let err_table = make_table (err@ierr) in
 586   let other_table = make_table other in
 587   let iother_table = make_table iother in
 588   add_to_fresh_table fresh;
 589   rule old_metas [iother_table;other_table;err_table] true minus;
 590   positions [iother_table;other_table] minus;
 591   dup_positions minus;
 592   check_all_marked rname "metavariable" other_table "in the - or context code";
 593   rule old_metas [iother_table;fresh_table;err_table] false plus;
 594   check_all_marked rname "inherited metavariable" iother_table
 595     "in the -, +, or context code";
 596   check_all_marked rname "metavariable" fresh_table "in the + code";
 597   check_all_marked rname "error metavariable" err_table ""