dead-code-detection/letrec.ml at master · Michaaell/dead-code-detection · GitHub

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
open Typedtree

(* Function that prints the warning regarding a useless letrec *)
let print_warning_letrec loc =
  Utils.debug "@[%a@] unused rec flag @."
    Utils.print_loc loc.Asttypes.loc

(* Flag to keep the 1st loc of a list of letrec *)
let fst_letrec = ref true

(* The 1st ident of a list of letrec *)
let let_rec = ref (Utils.IdentSet.empty)

(* Loc of let_rec ident *)
let fst_letrec_loc = ref (Location.mknoloc "")

(* Flag to check if a letrec is used *)
let rec_used = ref false

(* Function that checks if a Path is in a set of Path *)
let rec is_in_set p s = match p with
  | Path.Pident id -> Utils.IdentSet.mem id s
  | Path.Pdot (p,_,_) -> is_in_set p s
  | _ -> false

(* Function that looks for a call to a rec fun in the body of the function *)
let rec check_rec_exp e = match e.exp_desc with
  | Texp_ident (path, _, _) ->
      if is_in_set path !let_rec
      then rec_used := true
  | Texp_constant _ -> ()
  | Texp_let (_, l, e) ->
      List.iter (fun (_,e) -> check_rec_exp e) l;
      check_rec_exp e
  | Texp_function (_, l, _) -> List.iter (fun (_,e) -> check_rec_exp e) l
  | Texp_apply (e, list) ->
      begin
        check_rec_exp e;
        List.iter (fun (_, e_opt, _) ->
          match e_opt with Some e -> check_rec_exp e | None -> ()) list
      end
  | Texp_construct (_, _, _, list, _) -> List.iter check_rec_exp list
  | Texp_sequence (e1, e2) -> check_rec_exp e1;check_rec_exp e2
  | Texp_tuple list ->  List.iter check_rec_exp list
  | Texp_match (e, l, _) ->
      begin
        check_rec_exp e;List.iter (fun (_,e) -> check_rec_exp e) l
      end
  | Texp_field (e, _, _, _) -> check_rec_exp e
  | Texp_record (l, e_opt) ->
      begin
         List.iter (fun (_, _, _, e) -> check_rec_exp e) l;
        match e_opt with
          | Some e -> check_rec_exp e
          | None -> ()
      end
  | Texp_when (e1, e2) -> check_rec_exp e1;check_rec_exp e2
  | Texp_pack _ -> ()
  | Texp_object (_, _) -> ()
  | Texp_lazy e -> check_rec_exp e
  | Texp_assert e -> check_rec_exp e
  | Texp_letmodule (_, _, _, e) -> check_rec_exp e
  | Texp_override (_, l) -> List.iter (fun (_, _, e) -> check_rec_exp e) l
  | Texp_setinstvar (_, _, _, e) -> check_rec_exp e
  | Texp_instvar (_, _, _) -> ()
  | Texp_new (_, _, _) -> ()
  | Texp_send (e0, _, e1_opt) ->
      begin
        check_rec_exp e0;
        match e1_opt with
          | Some e -> check_rec_exp e
          | None -> ()
      end
  | Texp_for (_, _, e0, e1, _, e2) ->
      check_rec_exp e0;check_rec_exp e1;check_rec_exp e2
  | Texp_while (e1, e2) -> check_rec_exp e1;check_rec_exp e2
  | Texp_ifthenelse (e0, e1, e2_opt) ->
      begin
        check_rec_exp e0;
        check_rec_exp e1;
        match e2_opt with
          | Some e -> check_rec_exp e
          | None -> ()
      end
  | Texp_array l -> List.iter check_rec_exp l
  | Texp_setfield (e0, _, _, _, e1) -> check_rec_exp e0;check_rec_exp e1
  | Texp_variant (_, _) -> ()
  | Texp_try (e, l) ->
      begin
        check_rec_exp e;
        List.iter (fun (_,e) -> check_rec_exp e) l
      end
  | Texp_assertfalse -> ()

(* Function that create a set od Ident to be analysed and
   keep the loc information *)
let rec check_rec_pat pat = match pat.pat_desc with
  | Tpat_var (id,loc) ->
      if !fst_letrec
      then
        begin
          let_rec := Utils.IdentSet.add id !let_rec;
          fst_letrec_loc := loc;
          fst_letrec := false
        end
      else let_rec := Utils.IdentSet.add id !let_rec;
  | Tpat_tuple l -> List.iter check_rec_pat l
  | _ -> ()

(* Function to analyse a set of ident *)
let check_rec_list l =
  fst_letrec := true;
  let_rec := Utils.IdentSet.empty;
  fst_letrec_loc := Location.mknoloc "";
  rec_used := false;
  let pat_list,exp_list = List.split l in
  List.iter check_rec_pat pat_list;
  List.iter check_rec_exp exp_list;
  if not !rec_used then
    print_warning_letrec !fst_letrec_loc