typing/unused_var.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*           Damien Doligez, projet Cristal, INRIA Rocquencourt        *)
   6 (*                                                                     *)
   7 (*  Copyright 2004 Institut National de Recherche en Informatique et   *)
   8 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   9 (*  under the terms of the Q Public License version 1.0.               *)
  10 (*                                                                     *)
  11 (***********************************************************************)
  12
  13 (* $Id$ *)
  14
  15 open Parsetree
  16
  17 let silent v = String.length v > 0 && v.[0] = '_';;
  18
  19 let add_vars tbl (vll1, vll2) =
  20   let add_var (v, _loc, used) = Hashtbl.add tbl v used in
  21   List.iter add_var vll1;
  22   List.iter add_var vll2;
  23 ;;
  24
  25 let rm_vars tbl (vll1, vll2) =
  26   let rm_var (v, _, _) = Hashtbl.remove tbl v in
  27   List.iter rm_var vll1;
  28   List.iter rm_var vll2;
  29 ;;
  30
  31 let w_suspicious x = Warnings.Unused_var x;;
  32 let w_strict x = Warnings.Unused_var_strict x;;
  33
  34 let check_rm_vars ppf tbl (vlul_pat, vlul_as) =
  35   let check_rm_var kind (v, loc, used) =
  36     if not !used && not (silent v)
  37     then Location.print_warning loc ppf (kind v);
  38     Hashtbl.remove tbl v;
  39   in
  40   List.iter (check_rm_var w_strict) vlul_pat;
  41   List.iter (check_rm_var w_suspicious) vlul_as;
  42 ;;
  43
  44 let check_rm_let ppf tbl vlulpl =
  45   let check_rm_one flag (v, loc, used) =
  46     Hashtbl.remove tbl v;
  47     flag && (silent v || not !used)
  48   in
  49   let warn_var w_kind (v, loc, used) =
  50     if not (silent v) && not !used
  51     then Location.print_warning loc ppf (w_kind v)
  52   in
  53   let check_rm_pat (def, def_as) =
  54     let def_unused = List.fold_left check_rm_one true def in
  55     let all_unused = List.fold_left check_rm_one def_unused def_as in
  56     List.iter (warn_var (if all_unused then w_suspicious else w_strict)) def;
  57     List.iter (warn_var w_suspicious) def_as;
  58   in
  59   List.iter check_rm_pat vlulpl;
  60 ;;
  61
  62 let rec get_vars ((vacc, asacc) as acc) p =
  63   match p.ppat_desc with
  64   | Ppat_any -> acc
  65   | Ppat_var v -> ((v, p.ppat_loc, ref false) :: vacc, asacc)
  66   | Ppat_alias (pp, v) ->
  67       get_vars (vacc, ((v, p.ppat_loc, ref false) :: asacc)) pp
  68   | Ppat_constant _ -> acc
  69   | Ppat_tuple pl -> List.fold_left get_vars acc pl
  70   | Ppat_construct (_, po, _) -> get_vars_option acc po
  71   | Ppat_variant (_, po) -> get_vars_option acc po
  72   | Ppat_record ipl ->
  73       List.fold_left (fun a (_, p) -> get_vars a p) acc ipl
  74   | Ppat_array pl -> List.fold_left get_vars acc pl
  75   | Ppat_or (p1, _p2) -> get_vars acc p1
  76   | Ppat_constraint (pp, _) -> get_vars acc pp
  77   | Ppat_type _ -> acc
  78
  79 and get_vars_option acc po =
  80   match po with
  81   | Some p -> get_vars acc p
  82   | None -> acc
  83 ;;
  84
  85 let get_pel_vars pel =
  86   List.map (fun (p, _) -> get_vars ([], []) p) pel
  87 ;;
  88
  89 let rec structure ppf tbl l =
  90   List.iter (structure_item ppf tbl) l
  91
  92 and structure_item ppf tbl s =
  93   match s.pstr_desc with
  94   | Pstr_eval e -> expression ppf tbl e;
  95   | Pstr_value (recflag, pel) -> let_pel ppf tbl recflag pel None;
  96   | Pstr_primitive _ -> ()
  97   | Pstr_type _ -> ()
  98   | Pstr_exception _ -> ()
  99   | Pstr_exn_rebind _ -> ()
 100   | Pstr_module (_, me) -> module_expr ppf tbl me;
 101   | Pstr_recmodule stml ->
 102       List.iter (fun (_, _, me) -> module_expr ppf tbl me) stml;
 103   | Pstr_modtype _ -> ()
 104   | Pstr_open _ -> ()
 105   | Pstr_class cdl -> List.iter (class_declaration ppf tbl) cdl;
 106   | Pstr_class_type _ -> ()
 107   | Pstr_include _ -> ()
 108
 109 and expression ppf tbl e =
 110   match e.pexp_desc with
 111   | Pexp_ident (Longident.Lident id) ->
 112       begin try (Hashtbl.find tbl id) := true;
 113       with Not_found -> ()
 114       end;
 115   | Pexp_ident _ -> ()
 116   | Pexp_constant _ -> ()
 117   | Pexp_let (recflag, pel, e) ->
 118       let_pel ppf tbl recflag pel (Some (fun ppf tbl -> expression ppf tbl e));
 119   | Pexp_function (_, eo, pel) ->
 120       expression_option ppf tbl eo;
 121       match_pel ppf tbl pel;
 122   | Pexp_apply (e, lel) ->
 123       expression ppf tbl e;
 124       List.iter (fun (_, e) -> expression ppf tbl e) lel;
 125   | Pexp_match (e, pel) ->
 126       expression ppf tbl e;
 127       match_pel ppf tbl pel;
 128   | Pexp_try (e, pel) ->
 129       expression ppf tbl e;
 130       match_pel ppf tbl pel;
 131   | Pexp_tuple el -> List.iter (expression ppf tbl) el;
 132   | Pexp_construct (_, eo, _) -> expression_option ppf tbl eo;
 133   | Pexp_variant (_, eo) -> expression_option ppf tbl eo;
 134   | Pexp_record (iel, eo) ->
 135       List.iter (fun (_, e) -> expression ppf tbl e) iel;
 136       expression_option ppf tbl eo;
 137   | Pexp_field (e, _) -> expression ppf tbl e;
 138   | Pexp_setfield (e1, _, e2) ->
 139       expression ppf tbl e1;
 140       expression ppf tbl e2;
 141   | Pexp_array el -> List.iter (expression ppf tbl) el;
 142   | Pexp_ifthenelse (e1, e2, eo) ->
 143       expression ppf tbl e1;
 144       expression ppf tbl e2;
 145       expression_option ppf tbl eo;
 146   | Pexp_sequence (e1, e2) ->
 147       expression ppf tbl e1;
 148       expression ppf tbl e2;
 149   | Pexp_while (e1, e2) ->
 150       expression ppf tbl e1;
 151       expression ppf tbl e2;
 152   | Pexp_for (id, e1, e2, _, e3) ->
 153       expression ppf tbl e1;
 154       expression ppf tbl e2;
 155       let defined = ([ (id, e.pexp_loc, ref true) ], []) in
 156       add_vars tbl defined;
 157       expression ppf tbl e3;
 158       check_rm_vars ppf tbl defined;
 159   | Pexp_constraint (e, _, _) -> expression ppf tbl e;
 160   | Pexp_when (e1, e2) ->
 161       expression ppf tbl e1;
 162       expression ppf tbl e2;
 163   | Pexp_send (e, _) -> expression ppf tbl e;
 164   | Pexp_new _ -> ()
 165   | Pexp_setinstvar (_, e) -> expression ppf tbl e;
 166   | Pexp_override sel -> List.iter (fun (_, e) -> expression ppf tbl e) sel;
 167   | Pexp_letmodule (_, me, e) ->
 168       module_expr ppf tbl me;
 169       expression ppf tbl e;
 170   | Pexp_assert e -> expression ppf tbl e;
 171   | Pexp_assertfalse -> ()
 172   | Pexp_lazy e -> expression ppf tbl e;
 173   | Pexp_poly (e, _) -> expression ppf tbl e;
 174   | Pexp_object cs -> class_structure ppf tbl cs;
 175
 176 and expression_option ppf tbl eo =
 177   match eo with
 178   | Some e -> expression ppf tbl e;
 179   | None -> ()
 180
 181 and let_pel ppf tbl recflag pel body =
 182   match recflag with
 183   | Asttypes.Recursive ->
 184       let defined = get_pel_vars pel in
 185       List.iter (add_vars tbl) defined;
 186       List.iter (fun (_, e) -> expression ppf tbl e) pel;
 187       begin match body with
 188       | None ->
 189           List.iter (rm_vars tbl) defined;
 190       | Some f ->
 191           f ppf tbl;
 192           check_rm_let ppf tbl defined;
 193       end;
 194   | _ ->
 195       List.iter (fun (_, e) -> expression ppf tbl e) pel;
 196       begin match body with
 197       | None -> ()
 198       | Some f ->
 199           let defined = get_pel_vars pel in
 200           List.iter (add_vars tbl) defined;
 201           f ppf tbl;
 202           check_rm_let ppf tbl defined;
 203       end;
 204
 205 and match_pel ppf tbl pel =
 206   List.iter (match_pe ppf tbl) pel
 207
 208 and match_pe ppf tbl (p, e) =
 209  let defined = get_vars ([], []) p in
 210   add_vars tbl defined;
 211   expression ppf tbl e;
 212   check_rm_vars ppf tbl defined;
 213
 214 and module_expr ppf tbl me =
 215   match me.pmod_desc with
 216   | Pmod_ident _ -> ()
 217   | Pmod_structure s -> structure ppf tbl s
 218   | Pmod_functor (_, _, me) -> module_expr ppf tbl me
 219   | Pmod_apply (me1, me2) ->
 220       module_expr ppf tbl me1;
 221       module_expr ppf tbl me2;
 222   | Pmod_constraint (me, _) -> module_expr ppf tbl me
 223
 224 and class_declaration ppf tbl cd = class_expr ppf tbl cd.pci_expr
 225
 226 and class_expr ppf tbl ce =
 227   match ce.pcl_desc with
 228   | Pcl_constr _ -> ()
 229   | Pcl_structure cs -> class_structure ppf tbl cs;
 230   | Pcl_fun (_, _, _, ce) -> class_expr ppf tbl ce;
 231   | Pcl_apply (ce, lel) ->
 232       class_expr ppf tbl ce;
 233       List.iter (fun (_, e) -> expression ppf tbl e) lel;
 234   | Pcl_let (recflag, pel, ce) ->
 235       let_pel ppf tbl recflag pel (Some (fun ppf tbl -> class_expr ppf tbl ce));
 236   | Pcl_constraint (ce, _) -> class_expr ppf tbl ce;
 237
 238 and class_structure ppf tbl (p, cfl) =
 239   let defined = get_vars ([], []) p in
 240   add_vars tbl defined;
 241   List.iter (class_field ppf tbl) cfl;
 242   check_rm_vars ppf tbl defined;
 243
 244 and class_field ppf tbl cf =
 245   match cf with
 246   | Pcf_inher (ce, _) -> class_expr ppf tbl ce;
 247   | Pcf_val (_, _, e, _) -> expression ppf tbl e;
 248   | Pcf_virt _ | Pcf_valvirt _ -> ()
 249   | Pcf_meth (_, _, e, _) -> expression ppf tbl e;
 250   | Pcf_cstr _ -> ()
 251   | Pcf_let (recflag, pel, _) -> let_pel ppf tbl recflag pel None;
 252   | Pcf_init e -> expression ppf tbl e;
 253 ;;
 254
 255 let warn ppf ast =
 256   if Warnings.is_active (w_suspicious "") || Warnings.is_active (w_strict "")
 257   then begin
 258     let tbl = Hashtbl.create 97 in
 259     structure ppf tbl ast;
 260   end;
 261   ast
 262 ;;