parsing_cocci/check_meta.ml

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