]> git.pld-linux.org Git - packages/ocaml.git/blob - 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
1 diff -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  
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
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
27        ++ Typemod.type_implementation sourcefile outputprefix modulename env
28        ++ Translmod.transl_implementation modulename
29        ++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda
30 diff -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\
48 diff -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\
66 diff -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
290 diff -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  
333 diff -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.148408 seconds and 3 git commands to generate.