summaryrefslogtreecommitdiff
path: root/cparser/Cleanup.ml
blob: 00ff662a200e1ea2c71ff96be11dd5e885a1b602 (plain)
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
(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the GNU General Public License as published by  *)
(*  the Free Software Foundation, either version 2 of the License, or  *)
(*  (at your option) any later version.  This file is also distributed *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)

(* Removing unused declarations *)

open C
open Cutil

(* The set of all identifiers referenced so far *)
let referenced = ref IdentSet.empty

(* Record that a new identifier was added to this set *)
let ref_changed = ref false

(* Record a reference to an identifier.  If seen for the first time,
   add it to worklist. *)

let addref id =
  if not (IdentSet.mem id !referenced) then begin
(* Printf.printf "Referenced: %s$%d\n" id.name id.stamp; *)
    referenced := IdentSet.add id !referenced;
    ref_changed := true
  end

let needed id =
  IdentSet.mem id !referenced

(* Iterate [addref] on all syntactic categories. *)

let rec add_typ = function
  | TPtr(ty, _) -> add_typ ty
  | TArray(ty, _, _) -> add_typ ty
  | TFun(res, None, _, _) -> add_typ res
  | TFun(res, Some params, _, _) -> add_typ res; add_vars params
  | TNamed(id, _) -> addref id
  | TStruct(id, _) -> addref id
  | TUnion(id, _) -> addref id
  | TEnum(id, _) -> addref id
  | _ -> ()

and add_vars vl =
  List.iter (fun (id, ty) -> add_typ ty) vl

let rec add_exp e =
  add_typ e.etyp; (* perhaps not necessary but play it safe *)
  match e.edesc with
  | EConst (CEnum(id, v)) -> addref id
  | EConst _ -> ()
  | ESizeof ty -> add_typ ty
  | EAlignof ty -> add_typ ty
  | EVar id -> addref id
  | EUnop(op, e1) -> add_exp e1
  | EBinop(op, e1, e2, ty) -> add_exp e1; add_exp e2
  | EConditional(e1, e2, e3) -> add_exp e1; add_exp e2; add_exp e3
  | ECast(ty, e1) -> add_typ ty; add_exp e1
  | ECall(e1, el) -> add_exp e1; List.iter add_exp el

let rec add_init = function
  | Init_single e -> add_exp e
  | Init_array il -> List.iter add_init il
  | Init_struct(id, il) -> addref id; List.iter (fun (_, i) -> add_init i) il
  | Init_union(id, _, i) -> addref id; add_init i

let add_decl (sto, id, ty, init) =
  add_typ ty;
  match init with None -> () | Some i -> add_init i

let rec add_stmt s =
  match s.sdesc with
  | Sskip -> ()
  | Sdo e -> add_exp e
  | Sseq(s1, s2) -> add_stmt s1; add_stmt s2
  | Sif(e, s1, s2) -> add_exp e; add_stmt s1; add_stmt s2
  | Swhile(e, s1) -> add_exp e; add_stmt s1
  | Sdowhile(s1, e) -> add_stmt s1; add_exp e
  | Sfor(e1, e2, e3, s1) -> add_stmt e1; add_exp e2; add_stmt e3; add_stmt s1
  | Sbreak -> ()
  | Scontinue -> ()
  | Sswitch(e, s1) -> add_exp e; add_stmt s1
  | Slabeled(lbl, s) -> 
      begin match lbl with Scase e -> add_exp e | _ -> () end;
      add_stmt s
  | Sgoto lbl -> ()
  | Sreturn None -> ()
  | Sreturn(Some e) -> add_exp e
  | Sblock sl -> List.iter add_stmt sl
  | Sdecl d -> add_decl d
  | Sasm _ -> ()

let add_fundef f =
  add_typ f.fd_ret;
  add_vars f.fd_params;
  List.iter add_decl f.fd_locals;
  add_stmt f.fd_body

let add_field f = add_typ f.fld_typ

let add_enum e =
  List.iter
    (fun (id, v, opt_e) -> match opt_e with Some e -> add_exp e | None -> ())
    e

(* Saturate the set of referenced identifiers, starting with externally
   visible global declarations *)

let visible_decl (sto, id, ty, init) =
  sto = Storage_default &&
  match ty with TFun _ -> false | _ -> true

let rec add_init_globdecls accu = function
  | [] -> accu
  | g :: rem ->
      match g.gdesc with
      | Gdecl decl when visible_decl decl ->
          add_decl decl; add_init_globdecls accu rem
      | Gfundef({fd_storage = Storage_default} as f) ->
          add_fundef f; add_init_globdecls accu rem
      | Gdecl _ | Gfundef _ | Gcompositedef _ | Gtypedef _ | Genumdef _ ->
          (* Keep for later iterations *)
          add_init_globdecls (g :: accu) rem
      | Gcompositedecl _ | Gpragma _ ->
          (* Discard, since these cannot introduce more references later *)
          add_init_globdecls accu rem

let rec add_needed_globdecls accu = function
  | [] -> accu
  | g :: rem ->
      match g.gdesc with
      | Gdecl((sto, id, ty, init) as decl) ->
          if needed id
          then (add_decl decl; add_needed_globdecls accu rem)
          else add_needed_globdecls (g :: accu) rem
      | Gfundef f ->
          if needed f.fd_name
          then (add_fundef f; add_needed_globdecls accu rem)
          else add_needed_globdecls (g :: accu) rem
      | Gcompositedef(_, id, _, flds) ->
          if needed id
          then (List.iter add_field flds; add_needed_globdecls accu rem)
          else add_needed_globdecls (g :: accu) rem
      | Gtypedef(id, ty) ->
          if needed id
          then (add_typ ty; add_needed_globdecls accu rem)
          else add_needed_globdecls (g :: accu) rem
      | Genumdef(id, _, enu) ->
          if needed id || List.exists (fun (id, _, _) -> needed id) enu
          then (add_enum enu; add_needed_globdecls accu rem)
          else add_needed_globdecls (g :: accu) rem
      | _ ->
          assert false

let saturate p =
  let rec loop p =
    if !ref_changed then begin
      ref_changed := false;
      loop (add_needed_globdecls [] p)
    end in
  ref_changed := false;
  loop (add_init_globdecls [] p)

(* Remove unreferenced definitions *)

let rec simpl_globdecls accu = function
  | [] -> accu
  | g :: rem ->
      let need =
        match g.gdesc with
        | Gdecl((sto, id, ty, init) as decl) -> visible_decl decl || needed id
        | Gfundef f -> f.fd_storage = Storage_default || needed f.fd_name
        | Gcompositedecl(_, id, _) -> needed id
        | Gcompositedef(_, id, _, flds) -> needed id
        | Gtypedef(id, ty) -> needed id
        | Genumdef(id, _, enu) ->
            needed id || List.exists (fun (id, _, _) -> needed id) enu
        | Gpragma s -> true in
      if need
      then simpl_globdecls (g :: accu) rem
      else simpl_globdecls accu rem

let program p =
  referenced := IdentSet.empty;
  saturate p;
  let p' = simpl_globdecls [] p in
  referenced := IdentSet.empty;
  p'