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