parsing_cocci/check_meta.ml

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