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