Release coccinelle-0.2.4
[bpt/coccinelle.git] / parsing_cocci / check_meta.ml
CommitLineData
9bc82bae
C
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
c491d8ee
C
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
34e49164
C
49(* For minus fragment, checks that all of the identifier metavariables that
50are used are not declared as fresh, and check that all declared variables
51are used. For plus fragment, just check that the variables declared as
52fresh are used. What is the issue about error variables? (don't remember) *)
53
54module Ast0 = Ast0_cocci
55module Ast = Ast_cocci
56module V0 = Visitor_ast0
b1b2de81 57module VT0 = Visitor_ast0_types
34e49164
C
58
59(* all fresh identifiers *)
ae4735db 60let fresh_table = (Hashtbl.create(50) : (Ast.meta_name, unit) Hashtbl.t)
34e49164
C
61
62let warning s = Printf.fprintf stderr "warning: %s\n" s
63
708f4980 64let promote name = (name,(),Ast0.default_info(),(),None,-1)
34e49164
C
65
66(* --------------------------------------------------------------------- *)
67
68let 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
708f4980 74let check_table table minus (name,_,info,_,_,_) =
0708f913 75 let rl = info.Ast0.pos_info.Ast0.line_start in
34e49164
C
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
90let get_opt fn = Common.do_option fn
91
92(* --------------------------------------------------------------------- *)
93(* Dots *)
94
95let 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
104type context = ID | FIELD | FN | GLOBAL
105
106(* heuristic for distinguishing ifdef variables from undeclared metavariables*)
107let is_ifdef name =
108 String.length name > 2 && String.uppercase name = name
109
110let ident context old_metas table minus i =
111 match Ast0.unwrap i with
951c7801
C
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)
34e49164 119 then
951c7801
C
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"
34e49164
C
139
140(* --------------------------------------------------------------------- *)
141(* Expression *)
142
143let 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
88e71198 192 | Ast0.MetaExprList(name,Ast0.MetaListLen lenname,_) ->
34e49164
C
193 check_table table minus name;
194 check_table table minus lenname
88e71198
C
195 | Ast0.MetaExprList(name,_,_) ->
196 check_table table minus name
34e49164 197 | Ast0.DisjExpr(_,exps,_,_) ->
0708f913 198 List.iter (expression context old_metas table minus) exps
34e49164
C
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
206and get_type_name = function
faf9a90c
C
207 Type_cocci.ConstVol(_,ty) | Type_cocci.SignedT(_,Some ty)
208 | Type_cocci.Pointer(ty)
34e49164 209 | Type_cocci.FunctionPointer(ty) | Type_cocci.Array(ty) -> get_type_name ty
e6509c05
C
210 | Type_cocci.EnumName(Type_cocci.MV(nm,_,_)) -> Some nm
211 | Type_cocci.StructUnionName(_,Type_cocci.MV(nm,_,_)) -> Some nm
34e49164
C
212 | Type_cocci.MetaType(nm,_,_) -> Some nm
213 | _ -> None
214
215(* --------------------------------------------------------------------- *)
216(* Types *)
217
218and typeC old_metas table minus t =
219 match Ast0.unwrap t with
220 Ast0.ConstVol(cv,ty) -> typeC old_metas table minus ty
faf9a90c
C
221 | Ast0.Signed(sgn,ty) ->
222 get_opt (typeC old_metas table minus) ty
34e49164
C
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
c491d8ee
C
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
34e49164
C
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
254and declaration context old_metas table minus d =
255 match Ast0.unwrap d with
413ffc02
C
256 Ast0.MetaDecl(name,_) | Ast0.MetaField(name,_) ->
257 check_table table minus name
258 | Ast0.Init(stg,ty,id,eq,ini,sem) ->
34e49164
C
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) ->
faf9a90c 276 ident GLOBAL old_metas table minus name;
34e49164
C
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
292and initialiser old_metas table minus ini =
293 match Ast0.unwrap ini with
113803cf
C
294 Ast0.MetaInit(name,_) ->
295 check_table table minus name
296 | Ast0.InitExpr(exp) -> expression ID old_metas table minus exp
c491d8ee 297 | Ast0.InitList(lb,initlist,rb,ordered) ->
34e49164 298 dots (initialiser old_metas table minus) initlist
113803cf
C
299 | Ast0.InitGccExt(designators,eq,ini) ->
300 List.iter (designator old_metas table minus) designators;
34e49164
C
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
34e49164
C
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
113803cf
C
310and 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
34e49164
C
319and initialiser_list old_metas table minus =
320 dots (initialiser old_metas table minus)
321
322(* --------------------------------------------------------------------- *)
323(* Parameter *)
324
325and 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
88e71198 332 | Ast0.MetaParamList(name,Ast0.MetaListLen lenname,_) ->
34e49164
C
333 check_table table minus name;
334 check_table table minus lenname
88e71198
C
335 | Ast0.MetaParamList(name,_,_) ->
336 check_table table minus name
34e49164
C
337 | _ -> () (* no metavariable subterms *)
338
339and parameter_list old_metas table minus =
340 dots (parameterTypeDef old_metas table minus)
341
342(* --------------------------------------------------------------------- *)
343(* Top-level code *)
344
345and 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,_) ->
faf9a90c 369 ident GLOBAL old_metas table minus nm;
34e49164
C
370 dots (expression ID old_metas table minus) args;
371 statement old_metas table minus body
fc1ad971 372 | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) ->
34e49164 373 expression ID old_metas table minus exp;
fc1ad971 374 dots (statement old_metas table minus) decls;
34e49164
C
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
1be43e12 382 | Ast0.TopInit(init) -> initialiser old_metas table minus init
34e49164
C
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))
1be43e12
C
388 (statement old_metas table minus)
389 (expression ID old_metas table minus))
34e49164
C
390 w
391 | Ast0.Dots(_,x) | Ast0.Circles(_,x) | Ast0.Stars(_,x) ->
392 List.iter
393 (whencode (dots (statement old_metas table minus))
1be43e12
C
394 (statement old_metas table minus)
395 (expression ID old_metas table minus)) x
34e49164
C
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 *)
7f004419 402 | Ast0.Define(def,id,params,body) ->
34e49164 403 ident GLOBAL old_metas table minus id;
7f004419 404 define_parameters old_metas table minus params;
34e49164 405 dots (statement old_metas table minus) body
978fd7e5 406 | Ast0.Label(i,_) -> ident ID old_metas table minus i
34e49164
C
407 | Ast0.Goto(_,i,_) -> ident ID old_metas table minus i
408 | _ -> () (* no metavariable subterms *)
409
7f004419
C
410and 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
418and 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
34e49164
C
423and 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
1be43e12 429and whencode notfn alwaysfn expression = function
34e49164
C
430 Ast0.WhenNot a -> notfn a
431 | Ast0.WhenAlways a -> alwaysfn a
432 | Ast0.WhenModifier(_) -> ()
1be43e12
C
433 | Ast0.WhenNotTrue a -> expression a
434 | Ast0.WhenNotFalse a -> expression a
34e49164
C
435
436and 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) ->
c491d8ee 441 expression GLOBAL old_metas table minus exp;
34e49164 442 dots (statement old_metas table minus) code
fc1ad971
C
443 | Ast0.DisjCase(_,case_lines,_,_) ->
444 List.iter (case_line old_metas table minus) case_lines
34e49164
C
445 | Ast0.OptCase(case) -> failwith "unexpected code"
446
447(* --------------------------------------------------------------------- *)
448(* Rules *)
449
450let 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
458let rule old_metas table minus rules =
459 List.iter (top_level old_metas table minus) rules
460
461(* --------------------------------------------------------------------- *)
462
463let 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 =
b1b2de81 474 V0.flat_combiner bind option_default
34e49164 475 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
34e49164
C
476 donothing donothing donothing donothing donothing donothing
477 donothing donothing donothing donothing donothing donothing donothing
478 donothing donothing in
479
b1b2de81 480 List.iter fn.VT0.combiner_rec_top_level rules
34e49164
C
481
482let 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
b1b2de81 499 (List.map r.VT0.combiner_rec_expression explist)
34e49164
C
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
b1b2de81 506 (List.map r.VT0.combiner_rec_typeC types)
34e49164
C
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
b1b2de81 513 (List.map r.VT0.combiner_rec_declaration decls)
34e49164
C
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
b1b2de81 520 (List.map r.VT0.combiner_rec_statement_dots stmts)
34e49164
C
521 | _ -> k e in
522
523 let donothing r k e = k e in
524 let fn =
b1b2de81 525 V0.flat_combiner bind option_default
34e49164 526 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
34e49164
C
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
b1b2de81 534 (List.map fn.VT0.combiner_rec_top_level rules)) in
34e49164
C
535 let rec loop = function
536 [] | [_] -> ()
537 | ((rule,name) as x)::y::_ when x = y ->
ae4735db
C
538 failwith
539 (Printf.sprintf "duplicate use of %s.%s" rule name)
34e49164
C
540 | _::xs -> loop xs in
541 loop res
542
543(* --------------------------------------------------------------------- *)
544
545let make_table l =
546 let table =
547 (Hashtbl.create(List.length l) :
ae4735db 548 (Ast.meta_name, bool ref) Hashtbl.t) in
34e49164
C
549 List.iter
550 (function x -> Hashtbl.add table (Ast.get_meta_name x) (ref false)) l;
551 table
552
553let 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
559let 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
570let 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;
faf9a90c 592 check_all_marked rname "inherited metavariable" iother_table
34e49164
C
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 ""