Source

mutated_ocaml / tools / depend.ml

Diff from to

tools/depend.ml

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: depend.ml 12511 2012-05-30 13:29:48Z lefessan $ *)
+(* $Id: depend.ml 12883 2012-08-25 11:35:20Z garrigue $ *)
 
 open Asttypes
 open Format
 
 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 -> ()
   | Ppat_variant(_, op) -> add_opt add_pattern bv op
   | Ppat_type li -> add bv li
   | Ppat_lazy p -> add_pattern bv p
-  | Ppat_unpack _ -> ()
+  | 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) ->
   | 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
   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 ->
     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