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