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.NONDECL(stmt) -> statement old_metas table minus stmt
 456   | Ast0.CODE(stmt_dots) | Ast0.TOPCODE(stmt_dots) ->
 457       dots (statement old_metas table minus) stmt_dots
 458   | Ast0.ERRORWORDS(exps) ->
 459       List.iter (expression FN old_metas table minus) exps
 460   | _ -> () (* no metavariables possible *)
 461
 462 let rule old_metas table minus rules =
 463   List.iter (top_level old_metas table minus) rules
 464
 465 (* --------------------------------------------------------------------- *)
 466
 467 let positions table rules =
 468   let mcode x =
 469     List.iter
 470       (function Ast0.MetaPos(name,constraints,_) ->
 471         let pos = Ast0.unwrap_mcode name in
 472         (find_loop table pos) := true)
 473       (Ast0.get_pos x) in
 474   let option_default = () in
 475   let bind x y = () in
 476   let donothing r k e = k e in
 477   let fn =
 478     V0.flat_combiner bind option_default
 479       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 480       donothing donothing donothing donothing donothing donothing
 481       donothing donothing donothing donothing donothing donothing donothing
 482       donothing donothing in
 483
 484   List.iter fn.VT0.combiner_rec_top_level rules
 485
 486 let dup_positions rules =
 487   let mcode x =
 488     List.map
 489       (function Ast0.MetaPos(name,constraints,_) -> Ast0.unwrap_mcode name)
 490       (Ast0.get_pos x) in
 491   let option_default = [] in
 492   let bind x y = x@y in
 493
 494   (* Case for everything that has a disj.
 495      Note, no positions on ( | ) of a disjunction, so no need to recurse on
 496      these. *)
 497
 498   let expression r k e =
 499     match Ast0.unwrap e with
 500       Ast0.DisjExpr(_,explist,_,_) ->
 501         List.fold_left Common.union_set option_default
 502           (List.map r.VT0.combiner_rec_expression explist)
 503     | _ -> k e in
 504
 505   let typeC r k e = (* not sure relevent because "only after iso" *)
 506     match Ast0.unwrap e with
 507       Ast0.DisjType(_,types,_,_) ->
 508         List.fold_left Common.union_set option_default
 509           (List.map r.VT0.combiner_rec_typeC types)
 510     | _ -> k e in
 511
 512   let declaration r k e =
 513     match Ast0.unwrap e with
 514       Ast0.DisjDecl(_,decls,_,_) ->
 515         List.fold_left Common.union_set option_default
 516           (List.map r.VT0.combiner_rec_declaration decls)
 517     | _ -> k e in
 518
 519   let statement r k e =
 520     match Ast0.unwrap e with
 521       Ast0.Disj(_,stmts,_,_) ->
 522         List.fold_left Common.union_set option_default
 523           (List.map r.VT0.combiner_rec_statement_dots stmts)
 524     | _ -> k e in
 525
 526   let donothing r k e = k e in
 527   let fn =
 528     V0.flat_combiner bind option_default
 529       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 530       donothing donothing donothing donothing donothing donothing
 531       donothing expression typeC donothing donothing declaration statement
 532       donothing donothing in
 533
 534   let res =
 535     List.sort compare
 536       (List.fold_left Common.union_set option_default
 537          (List.map fn.VT0.combiner_rec_top_level rules)) in
 538   let rec loop = function
 539       [] | [_] -> ()
 540     | ((rule,name) as x)::y::_ when x = y ->
 541         failwith
 542           (Printf.sprintf "duplicate use of %s.%s" rule name)
 543     | _::xs -> loop xs in
 544   loop res
 545
 546 (* --------------------------------------------------------------------- *)
 547
 548 let make_table l =
 549   let table =
 550     (Hashtbl.create(List.length l) :
 551        (Ast.meta_name, bool ref) Hashtbl.t) in
 552   List.iter
 553     (function x -> Hashtbl.add table (Ast.get_meta_name x) (ref false)) l;
 554   table
 555
 556 let add_to_fresh_table l =
 557   List.iter
 558     (function x ->
 559       let name = Ast.get_meta_name x in Hashtbl.replace fresh_table name ())
 560     l
 561
 562 let check_all_marked rname err table after_err =
 563   Hashtbl.iter
 564     (function name ->
 565       function (cell) ->
 566         if not (!cell)
 567         then
 568           let (_,name) = name in
 569           warning
 570             (Printf.sprintf "%s: %s %s not used %s" rname err name after_err))
 571     table
 572
 573 let check_meta rname old_metas inherited_metavars metavars minus plus =
 574   let old_metas =
 575     List.map (function (_,x) -> x) (List.map Ast.get_meta_name old_metas) in
 576   let (fresh,other) =
 577     List.partition (function Ast.MetaFreshIdDecl(_,_) -> true | _ -> false)
 578       metavars in
 579   let (err,other) =
 580     List.partition (function Ast.MetaErrDecl(_,_) -> true | _ -> false)
 581       other in
 582   let (ierr,iother) =
 583     List.partition (function Ast.MetaErrDecl(_,_) -> true | _ -> false)
 584       inherited_metavars in
 585   let fresh_table = make_table fresh in
 586   let err_table = make_table (err@ierr) in
 587   let other_table = make_table other in
 588   let iother_table = make_table iother in
 589   add_to_fresh_table fresh;
 590   rule old_metas [iother_table;other_table;err_table] true minus;
 591   positions [iother_table;other_table] minus;
 592   dup_positions minus;
 593   check_all_marked rname "metavariable" other_table "in the - or context code";
 594   rule old_metas [iother_table;fresh_table;err_table] false plus;
 595   check_all_marked rname "inherited metavariable" iother_table
 596     "in the -, +, or context code";
 597   check_all_marked rname "metavariable" fresh_table "in the + code";
 598   check_all_marked rname "error metavariable" err_table ""