diff options
| -rw-r--r-- | tools/depend.ml | 36 |
1 files changed, 26 insertions, 10 deletions
diff --git a/tools/depend.ml b/tools/depend.ml index 020289292..0ad748d14 100644 --- a/tools/depend.ml +++ b/tools/depend.ml @@ -108,6 +108,8 @@ let add_class_description bv infos = let add_class_type_declaration = add_class_description +let pattern_bv = ref StringSet.empty + let rec add_pattern bv pat = match pat.ppat_desc with Ppat_any -> () @@ -124,13 +126,19 @@ let rec add_pattern bv pat = | Ppat_variant(_, op) -> add_opt add_pattern bv op | Ppat_type li -> add bv li | Ppat_lazy p -> add_pattern bv p - | Ppat_unpack id -> add bv (mkloc (Lident id.txt) id.loc) + | Ppat_unpack id -> pattern_bv := StringSet.add id.txt !pattern_bv + +let add_pattern bv pat = + pattern_bv := bv; + add_pattern bv pat; + !pattern_bv let rec add_expr bv exp = match exp.pexp_desc with Pexp_ident l -> add bv l | Pexp_constant _ -> () - | Pexp_let(_, pel, e) -> add_pat_expr_list bv pel; add_expr bv e + | Pexp_let(rf, pel, e) -> + let bv = add_bindings rf bv pel in add_expr bv e | Pexp_function (_, opte, pel) -> add_opt add_expr bv opte; add_pat_expr_list bv pel | Pexp_apply(e, el) -> @@ -168,12 +176,19 @@ let rec add_expr bv exp = | Pexp_lazy (e) -> add_expr bv e | Pexp_poly (e, t) -> add_expr bv e; add_opt add_type bv t | Pexp_object { pcstr_pat = pat; pcstr_fields = fieldl } -> - add_pattern bv pat; List.iter (add_class_field bv) fieldl + let bv = add_pattern bv pat in List.iter (add_class_field bv) fieldl | Pexp_newtype (_, e) -> add_expr bv e | Pexp_pack m -> add_module bv m | Pexp_open (m, e) -> addmodule bv m; add_expr bv e + and add_pat_expr_list bv pel = - List.iter (fun (p, e) -> add_pattern bv p; add_expr bv e) pel + List.iter (fun (p, e) -> let bv = add_pattern bv p in add_expr bv e) pel + +and add_bindings recf bv pel = + let bv' = List.fold_left (fun bv (p, _) -> add_pattern bv p) bv pel in + let bv = if recf = Recursive then bv else bv' in + List.iter (fun (_, e) -> add_expr bv e) pel; + bv' and add_modtype bv mty = match mty.pmty_desc with @@ -245,8 +260,8 @@ and add_struct_item bv item = match item.pstr_desc with Pstr_eval e -> add_expr bv e; bv - | Pstr_value(id, pel) -> - add_pat_expr_list bv pel; bv + | Pstr_value(rf, pel) -> + let bv = add_bindings rf bv pel in bv | Pstr_primitive(id, vd) -> add_type bv vd.pval_type; bv | Pstr_type dcls -> @@ -291,13 +306,14 @@ and add_class_expr bv ce = Pcl_constr(l, tyl) -> add bv l; List.iter (add_type bv) tyl | Pcl_structure { pcstr_pat = pat; pcstr_fields = fieldl } -> - add_pattern bv pat; List.iter (add_class_field bv) fieldl + let bv = add_pattern bv pat in List.iter (add_class_field bv) fieldl | Pcl_fun(_, opte, pat, ce) -> - add_opt add_expr bv opte; add_pattern bv pat; add_class_expr bv ce + add_opt add_expr bv opte; + let bv = add_pattern bv pat in add_class_expr bv ce | Pcl_apply(ce, exprl) -> add_class_expr bv ce; List.iter (fun (_,e) -> add_expr bv e) exprl - | Pcl_let(_, pel, ce) -> - add_pat_expr_list bv pel; add_class_expr bv ce + | Pcl_let(rf, pel, ce) -> + let bv = add_bindings rf bv pel in add_class_expr bv ce | Pcl_constraint(ce, ct) -> add_class_expr bv ce; add_class_type bv ct |