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