]> git.pld-linux.org Git - packages/ocaml.git/blame - ocaml-unused-var-warning.patch
- updated compile.ml change; now applies to 3.08, but needs further update (breaks...
[packages/ocaml.git] / ocaml-unused-var-warning.patch
CommitLineData
a415da8b
MM
1diff -ur ocaml-3.07beta2/Makefile ocaml-3.07beta2-/Makefile
2--- ocaml-3.07beta2/Makefile 2003-07-03 17:13:21.000000000 +0200
3+++ ocaml-3.07beta2-/Makefile 2003-08-28 17:29:35.000000000 +0200
4@@ -82,13 +82,13 @@
5 asmcomp/emitaux.cmo asmcomp/emit.cmo asmcomp/asmgen.cmo \
6 asmcomp/asmlink.cmo asmcomp/asmlibrarian.cmo asmcomp/asmpackager.cmo
7
8-DRIVER=driver/pparse.cmo driver/errors.cmo driver/compile.cmo \
9+DRIVER=driver/pparse.cmo driver/warn_unused_variables.cmo driver/errors.cmo driver/compile.cmo \
10 driver/main_args.cmo driver/main.cmo
11
12 OPTDRIVER= driver/pparse.cmo driver/opterrors.cmo driver/optcompile.cmo \
13 driver/optmain.cmo
14
15-TOPLEVEL=driver/pparse.cmo driver/errors.cmo driver/compile.cmo \
16+TOPLEVEL=driver/pparse.cmo driver/warn_unused_variables.cmo driver/errors.cmo driver/compile.cmo \
17 toplevel/genprintval.cmo toplevel/toploop.cmo \
18 toplevel/trace.cmo toplevel/topdirs.cmo toplevel/topmain.cmo
19
a08820ee
JB
20--- ocaml-3.08.0/driver/compile.ml.orig 2004-06-13 14:46:41.000000000 +0200
21+++ ocaml-3.08.0/driver/compile.ml 2004-07-21 23:25:27.788583360 +0200
a415da8b
MM
22@@ -99,6 +99,7 @@
23 try
24 Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
25 ++ print_if ppf Clflags.dump_parsetree Printast.implementation
26+ ++ Warn_unused_variables.doit ppf
a08820ee 27 ++ Typemod.type_implementation sourcefile outputprefix modulename env
a415da8b
MM
28 ++ Translmod.transl_implementation modulename
29 ++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda
30diff -ur ocaml-3.07beta2/driver/main_args.ml ocaml-3.07beta2-/driver/main_args.ml
31--- ocaml-3.07beta2/driver/main_args.ml 2003-07-17 10:38:27.000000000 +0200
32+++ ocaml-3.07beta2-/driver/main_args.ml 2003-08-28 18:06:38.000000000 +0200
33@@ -133,10 +133,12 @@
34 \032 P/p enable/disable partial match\n\
35 \032 S/s enable/disable non-unit statement\n\
36 \032 U/u enable/disable unused match case\n\
37+ \032 I/i enable/disable unused local variable\n\
38 \032 V/v enable/disable hidden instance variable\n\
39 \032 X/x enable/disable all other warnings\n\
40- \032 default setting is \"Ale\"\n\
41- \032 (all warnings but labels and fragile match enabled)";
42+ \032 default setting is \"Alei\"\n\
43+ \032 (all warnings but labels, unused variable and\n\
44+ \032 fragile match enabled)";
45 "-warn-error" , Arg.String F._warn_error,
46 "<flags> Treat the warnings enabled by <flags> as errors.\n\
47 \032 See option -w for the list of flags.\n\
48diff -ur ocaml-3.07beta2/driver/optmain.ml ocaml-3.07beta2-/driver/optmain.ml
49--- ocaml-3.07beta2/driver/optmain.ml 2003-07-17 10:38:27.000000000 +0200
50+++ ocaml-3.07beta2-/driver/optmain.ml 2003-08-28 17:42:02.000000000 +0200
51@@ -149,10 +149,12 @@
52 \032 P/p enable/disable partial match\n\
53 \032 S/s enable/disable non-unit statement\n\
54 \032 U/u enable/disable unused match case\n\
55+ \032 I/i enable/disable unused local variable\n\
56 \032 V/v enable/disable hidden instance variables\n\
57 \032 X/x enable/disable all other warnings\n\
58- \032 default setting is \"Ale\"\n\
59- \032 (all warnings but labels and fragile match enabled)";
60+ \032 default setting is \"Alei\"\n\
61+ \032 (all warnings but labels, unused variable and\n\
62+ \032 fragile match enabled)";
63 "-warn-error" , Arg.String (Warnings.parse_options true),
64 "<flags> Treat the warnings enabled by <flags> as errors.\n\
65 \032 See option -w for the list of flags.\n\
66diff -ur ocaml-3.07beta2/driver/warn_unused_variables.ml ocaml-3.07beta2-/driver/warn_unused_variables.ml
67--- ocaml-3.07beta2/driver/warn_unused_variables.ml 2003-08-28 18:03:53.000000000 +0200
68+++ ocaml-3.07beta2-/driver/warn_unused_variables.ml 2003-08-28 18:05:54.000000000 +0200
69@@ -0,0 +1,220 @@
70+open Parsetree
71+
72+(* initial version by Pascal Brisset <brisset@recherche.enac.fr> *)
73+(* adaptation by Pascal Rigaux <pixel@mandrakesoft.com> *)
74+(* further adaptation for 3.07 Michal Moskal <malekith@pld-linux.org> *)
75+
76+let r_ppf = ref None
77+let ppf() =
78+ match !r_ppf with
79+ | Some ppf -> ppf
80+ | None -> failwith "ppf"
81+
82+let check_and_warn l =
83+ List.iter
84+ (fun ((v,loc), r) ->
85+ if not !r && not (v.[0] = '_') then begin
86+ Location.print_warning loc (ppf()) (Warnings.Other ("unused variable " ^ v))
87+ end)
88+ l;;
89+
90+let add_var vloc r l = (vloc, r)::l;;
91+
92+let rec vars_of_pattern rest pat =
93+ match pat.ppat_desc with
94+ | Ppat_var v -> (v, pat.ppat_loc)::rest
95+ | Ppat_alias (pattern, v) -> vars_of_pattern ((v, pat.ppat_loc)::rest) pattern
96+ | Ppat_tuple pl -> List.fold_left vars_of_pattern rest pl
97+ | Ppat_construct (_,po, _)
98+ | Ppat_variant(_,po) ->
99+ begin match po with
100+ Some p -> vars_of_pattern rest p
101+ | None -> rest end
102+ | Ppat_record pl -> List.fold_left (fun r (_, p) -> vars_of_pattern r p) rest pl
103+ | Ppat_array pl -> List.fold_left vars_of_pattern rest pl
104+ | Ppat_constraint (pat, _) -> vars_of_pattern rest pat
105+ | _ -> rest;;
106+
107+let add_pat prefix pat defined news =
108+ let vs = vars_of_pattern [] pat in
109+ List.fold_right
110+ (fun (v, loc) (def, news) ->
111+ let prefixvloc = (prefix v, loc) in
112+ let r = ref false in
113+ let new_def = add_var prefixvloc r def in
114+ (new_def , (prefixvloc, r)::news))
115+ vs (defined, news);;
116+
117+let add_pel prefix pel defined =
118+ List.fold_right (fun (p, _e) (def, news) -> add_pat prefix p def news) pel (defined, [])
119+
120+let rec defined_assoc s = function
121+ [] -> raise Not_found
122+ | ((s',_), r)::l -> if s = s' then r else defined_assoc s l
123+
124+let mark_used defined = function
125+ Longident.Lident string ->
126+ begin try defined_assoc string defined := true with Not_found -> () end
127+ | _ -> ();; (* from other modules, not yet *)
128+
129+let rec ws_expression defined e =
130+ match e.pexp_desc with
131+ Pexp_ident i -> mark_used defined i
132+ | Pexp_constant _ -> ()
133+ | Pexp_let (rec_flag, pel, e) ->
134+ let new_defined, news = add_pel (fun s->s) pel defined in
135+ ws_pel (if rec_flag = Asttypes.Recursive then new_defined else defined) pel false;
136+ ws_expression new_defined e;
137+ check_and_warn news
138+ | Pexp_function (_label, _eo, pel) ->
139+ ws_pel defined pel true;
140+ | Pexp_apply (expression, lel) ->
141+ ws_expression defined expression;
142+ List.iter (fun (_l, e) -> ws_expression defined e) lel
143+ | Pexp_match (expression, pel) ->
144+ ws_expression defined expression;
145+ ws_pel defined pel true
146+ | Pexp_try (expression, pel) ->
147+ ws_expression defined expression;
148+ ws_pel defined pel true
149+ | Pexp_tuple el ->
150+ ws_expression_list defined el
151+ | Pexp_construct (_, eo, _) ->
152+ ws_expression_option defined eo
153+ | Pexp_variant (_,eo) ->
154+ ws_expression_option defined eo
155+ | Pexp_record (iel, eo) ->
156+ List.iter (fun (_l, e) -> ws_expression defined e) iel;
157+ ws_expression_option defined eo
158+ | Pexp_field (e, _) ->
159+ ws_expression defined e
160+ | Pexp_setfield (e1, _, e2) ->
161+ ws_expression defined e1;
162+ ws_expression defined e2
163+ | Pexp_array el -> ws_expression_list defined el
164+ | Pexp_ifthenelse (e1, e2, eo) ->
165+ ws_expression defined e1;
166+ ws_expression defined e2;
167+ ws_expression_option defined eo
168+ | Pexp_sequence (e1, e2) ->
169+ ws_expression defined e1;
170+ ws_expression defined e2
171+ | Pexp_while(e1, e2) ->
172+ ws_expression defined e1;
173+ ws_expression defined e2
174+ | Pexp_for (string, e1, e2, _, e) ->
175+ ws_expression defined e1;
176+ ws_expression defined e2;
177+ let r = ref false in
178+ let new_def = add_var (string, e.pexp_loc) r defined in
179+ ws_expression new_def e;
180+ if not !r then Printf.fprintf stderr "%s loop index unused ?\n" string
181+ | Pexp_constraint (e, _, _) -> ws_expression defined e
182+
183+ | Pexp_assert e
184+ | Pexp_lazy e
185+ | Pexp_poly (e, _) ->
186+ ws_expression defined e
187+
188+ | Pexp_when (e1, e2) ->
189+ ws_expression defined e1;
190+ ws_expression defined e2
191+ | Pexp_send (e, _) ->
192+ ws_expression defined e
193+ | Pexp_assertfalse
194+ | Pexp_new _ -> ()
195+ | Pexp_setinstvar (_s, e) ->
196+ ws_expression defined e
197+ | Pexp_override sel ->
198+ List.iter (fun (_l, e) -> ws_expression defined e) sel;
199+ | Pexp_letmodule (m,me,e) ->
200+ let new_defined = ws_module (fun s -> m^"."^s) defined me in
201+ ws_expression defined e
202+
203+and ws_pel defined pel take_pat =
204+ List.iter
205+ (fun (p, e) ->
206+ if take_pat then
207+ let new_defined, news = add_pat (fun s-> s) p defined [] in
208+ ws_expression new_defined e;
209+ check_and_warn news
210+ else
211+ ws_expression defined e) pel
212+and ws_expression_option defined = function
213+ Some e -> ws_expression defined e
214+ | None -> ()
215+and ws_expression_list defined el =
216+ List.iter (ws_expression defined) el
217+
218+
219+
220+and ws_structure prefix defined = function
221+ [] -> defined
222+ | s::ss ->
223+ let new_defined =
224+ match s.pstr_desc with
225+ | Pstr_eval e ->
226+ ws_expression defined e;
227+ defined
228+ | Pstr_value (rec_flag, pel) ->
229+ let new_defined, _news = add_pel prefix pel defined in
230+ ws_pel (if rec_flag = Asttypes.Recursive then new_defined else defined) pel false;
231+ new_defined
232+ | Pstr_primitive _ -> defined
233+ | Pstr_type _ -> defined
234+ | Pstr_exception _ -> defined
235+ | Pstr_exn_rebind _ -> defined
236+ | Pstr_module (m, me) -> ws_module (fun s -> prefix (m^"."^s)) defined me
237+ | Pstr_modtype _ -> defined
238+ | Pstr_recmodule mods ->
239+ List.fold_left (fun defined (m, _, me) ->
240+ ws_module (fun s -> prefix (m^"."^s)) defined me)
241+ defined mods
242+ | Pstr_open _ -> defined
243+ | Pstr_include _ -> defined
244+ | Pstr_class cdl ->
245+ List.iter (fun cd -> ws_class_expr defined cd.pci_expr) cdl;
246+ defined
247+ | Pstr_class_type _ -> defined
248+ in
249+ ws_structure prefix new_defined ss
250+and ws_module prefix defined me =
251+ match me.pmod_desc with
252+ Pmod_structure s ->
253+ ws_structure prefix defined s
254+ | Pmod_apply (m1, m2) -> defined
255+ | Pmod_ident _ -> defined
256+ | _ -> defined
257+and ws_class_expr defined ce =
258+ match ce.pcl_desc with
259+ Pcl_structure cs ->
260+ ws_class_structure defined cs
261+ | Pcl_fun (_, e, p, ce) ->
262+ ws_class_expr defined ce
263+ | Pcl_let (rec_flag, pel, ce) ->
264+ let new_defined, news = add_pel (fun s->s) pel defined in
265+ ws_pel (if rec_flag = Asttypes.Recursive then new_defined else defined) pel false;
266+ ws_class_expr new_defined ce;
267+ check_and_warn news
268+ | Pcl_constr _ -> ()
269+ | _ -> ()
270+and ws_class_structure defined (pat, cfl) =
271+ let new_defined, news = add_pat (fun s-> s) pat defined [] in
272+ List.iter (ws_class_field new_defined) cfl;
273+ check_and_warn news
274+and ws_class_field defined = function
275+ Pcf_inher _ -> ()
276+ | Pcf_val _ -> ()
277+ | Pcf_virt _ -> ()
278+ | Pcf_meth (_string, _private_flag , expression, _loc) ->
279+ ws_expression defined expression
280+ | Pcf_cstr _ -> ()
281+ | Pcf_let _ -> ()
282+ | Pcf_init expression ->
283+ ws_expression defined expression
284+
285+let doit ppf ast =
286+ r_ppf := Some ppf ;
287+ if Warnings.is_active (Warnings.Unused_variable "") then
288+ ignore (ws_structure (fun s->s) [] ast);
289+ ast
290diff -ur ocaml-3.07beta2/utils/warnings.ml ocaml-3.07beta2-/utils/warnings.ml
291--- ocaml-3.07beta2/utils/warnings.ml 2003-05-02 14:52:11.000000000 +0200
292+++ ocaml-3.07beta2-/utils/warnings.ml 2003-08-28 17:42:38.000000000 +0200
293@@ -25,6 +25,7 @@
294 | Statement_type (* S *)
295 | Unused_match (* U *)
296 | Unused_pat (* U *)
297+ | Unused_variable of string (* I *)
298 | Hide_instance_variable of string (* V *)
299 | Other of string (* X *)
300 ;;
301@@ -39,12 +40,13 @@
302 | Partial_match _ -> 'p'
303 | Statement_type -> 's'
304 | Unused_match|Unused_pat -> 'u'
305+ | Unused_variable _ -> 'i'
306 | Hide_instance_variable _ -> 'v'
307 | Other _ -> 'x'
308 ;;
309
310 let check c =
311- try ignore (String.index "acdeflmpsuvxACDEFLMPSUVX" c)
312+ try ignore (String.index "acdeflmpsuvixACDEFLMPSUVIX" c)
313 with _ -> raise (Arg.Bad (Printf.sprintf "unknown warning option %c" c))
314 ;;
315
316@@ -81,7 +83,7 @@
317 done
318 ;;
319
320-let () = parse_options false "el";;
321+let () = parse_options false "eli";;
322
323 let message = function
324 | Partial_match "" -> "this pattern-matching is not exhaustive."
325@@ -113,6 +115,7 @@
326 "this expression should have type unit."
327 | Comment s -> "this is " ^ s ^ "."
328 | Deprecated -> "this syntax is deprecated."
329+ | Unused_variable s -> "unused variable " ^ s
330 | Other s -> s
331 ;;
332
333diff -ur ocaml-3.07beta2/utils/warnings.mli ocaml-3.07beta2-/utils/warnings.mli
334--- ocaml-3.07beta2/utils/warnings.mli 2003-05-02 10:46:06.000000000 +0200
335+++ ocaml-3.07beta2-/utils/warnings.mli 2003-08-28 17:39:51.000000000 +0200
336@@ -25,6 +25,7 @@
337 | Statement_type (* S *)
338 | Unused_match (* U *)
339 | Unused_pat (* U *)
340+ | Unused_variable of string (* I *)
341 | Hide_instance_variable of string (* V *)
342 | Other of string (* X *)
343 ;;
This page took 0.145144 seconds and 4 git commands to generate.