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