|
@@ -22,6 +22,11 @@ open Common
|
|
|
open Type
|
|
|
open Globals
|
|
|
|
|
|
+type dce_mode =
|
|
|
+ | DceNo
|
|
|
+ | DceStd
|
|
|
+ | DceFull
|
|
|
+
|
|
|
type dce = {
|
|
|
com : context;
|
|
|
full : bool;
|
|
@@ -38,6 +43,13 @@ type dce = {
|
|
|
mutable features : (string,(tclass * tclass_field * bool) list) Hashtbl.t;
|
|
|
}
|
|
|
|
|
|
+let push_class dce c =
|
|
|
+ let old = dce.curclass in
|
|
|
+ dce.curclass <- c;
|
|
|
+ (fun () ->
|
|
|
+ dce.curclass <- old
|
|
|
+ )
|
|
|
+
|
|
|
(* checking *)
|
|
|
|
|
|
(* check for @:keepSub metadata, which forces @:keep on child classes *)
|
|
@@ -116,7 +128,7 @@ let rec check_feature dce s =
|
|
|
|
|
|
and check_and_add_feature dce s =
|
|
|
check_feature dce s;
|
|
|
- (* assert (dce.curclass != null_class); *)
|
|
|
+ assert (dce.curclass != null_class);
|
|
|
Hashtbl.replace dce.curclass.cl_module.m_extra.m_features s true
|
|
|
|
|
|
(* mark a field as kept *)
|
|
@@ -154,6 +166,7 @@ and mark_field dce c cf stat =
|
|
|
end
|
|
|
|
|
|
let rec update_marked_class_fields dce c =
|
|
|
+ let pop = push_class dce c in
|
|
|
(* mark all :?used fields as surely :used now *)
|
|
|
List.iter (fun cf ->
|
|
|
if Meta.has Meta.MaybeUsed cf.cf_meta then mark_field dce c cf true
|
|
@@ -164,7 +177,8 @@ let rec update_marked_class_fields dce c =
|
|
|
(* we always have to keep super classes and implemented interfaces *)
|
|
|
(match c.cl_init with None -> () | Some init -> dce.follow_expr dce init);
|
|
|
List.iter (fun (c,_) -> mark_class dce c) c.cl_implements;
|
|
|
- (match c.cl_super with None -> () | Some (csup,pl) -> mark_class dce csup)
|
|
|
+ (match c.cl_super with None -> () | Some (csup,pl) -> mark_class dce csup);
|
|
|
+ pop()
|
|
|
|
|
|
(* mark a class as kept. If the class has fields marked as @:?keep, make sure to keep them *)
|
|
|
and mark_class dce c = if not (Meta.has Meta.Used c.cl_meta) then begin
|
|
@@ -657,35 +671,7 @@ let fix_accessors com =
|
|
|
| _ -> ()
|
|
|
) com.types
|
|
|
|
|
|
-let run com main full =
|
|
|
- let dce = {
|
|
|
- com = com;
|
|
|
- full = full;
|
|
|
- dependent_types = Hashtbl.create 0;
|
|
|
- std_dirs = if full then [] else List.map Path.unique_full_path com.std_path;
|
|
|
- debug = Common.defined com Define.DceDebug;
|
|
|
- added_fields = [];
|
|
|
- follow_expr = expr;
|
|
|
- marked_fields = [];
|
|
|
- marked_maybe_fields = [];
|
|
|
- t_stack = [];
|
|
|
- ts_stack = [];
|
|
|
- features = Hashtbl.create 0;
|
|
|
- curclass = null_class;
|
|
|
- } in
|
|
|
- begin match main with
|
|
|
- | Some {eexpr = TCall({eexpr = TField(e,(FStatic(c,cf)))},_)} | Some {eexpr = TBlock ({ eexpr = TCall({eexpr = TField(e,(FStatic(c,cf)))},_)} :: _)} ->
|
|
|
- cf.cf_meta <- (Meta.Keep,[],cf.cf_pos) :: cf.cf_meta
|
|
|
- | _ ->
|
|
|
- ()
|
|
|
- end;
|
|
|
- List.iter (fun m ->
|
|
|
- List.iter (fun (s,v) ->
|
|
|
- if Hashtbl.mem dce.features s then Hashtbl.replace dce.features s (v :: Hashtbl.find dce.features s)
|
|
|
- else Hashtbl.add dce.features s [v]
|
|
|
- ) m.m_extra.m_if_feature;
|
|
|
- ) com.modules;
|
|
|
- (* first step: get all entry points, which is the main method and all class methods which are marked with @:keep *)
|
|
|
+let collect_entry_points dce com =
|
|
|
List.iter (fun t -> match t with
|
|
|
| TClassDecl c ->
|
|
|
let keep_class = keep_whole_class dce c && (not c.cl_extern || c.cl_interface) in
|
|
@@ -708,7 +694,9 @@ let run com main full =
|
|
|
()
|
|
|
end;
|
|
|
| TEnumDecl en when keep_whole_enum dce en ->
|
|
|
- mark_enum dce en
|
|
|
+ let pop = push_class dce {null_class with cl_module = en.e_module} in
|
|
|
+ mark_enum dce en;
|
|
|
+ pop()
|
|
|
| _ ->
|
|
|
()
|
|
|
) com.types;
|
|
@@ -717,8 +705,9 @@ let run com main full =
|
|
|
| None -> ()
|
|
|
| Some _ -> print_endline ("[DCE] Entry point: " ^ (s_type_path c.cl_path) ^ "." ^ cf.cf_name)
|
|
|
) dce.added_fields;
|
|
|
- end;
|
|
|
- (* second step: initiate DCE passes and keep going until no new fields were added *)
|
|
|
+ end
|
|
|
+
|
|
|
+let mark dce =
|
|
|
let rec loop () =
|
|
|
match dce.added_fields with
|
|
|
| [] -> ()
|
|
@@ -728,21 +717,24 @@ let run com main full =
|
|
|
List.iter (fun (c,cf,stat) -> mark_dependent_fields dce c cf.cf_name stat) cfl;
|
|
|
(* mark fields as used *)
|
|
|
List.iter (fun (c,cf,stat) ->
|
|
|
+ let pop = push_class dce c in
|
|
|
if is_physical_field cf then mark_class dce c;
|
|
|
mark_field dce c cf stat;
|
|
|
- mark_t dce cf.cf_pos cf.cf_type
|
|
|
+ mark_t dce cf.cf_pos cf.cf_type;
|
|
|
+ pop()
|
|
|
) cfl;
|
|
|
(* follow expressions to new types/fields *)
|
|
|
List.iter (fun (c,cf,_) ->
|
|
|
- dce.curclass <- c;
|
|
|
+ let pop = push_class dce c in
|
|
|
opt (expr dce) cf.cf_expr;
|
|
|
List.iter (fun cf -> if cf.cf_expr <> None then opt (expr dce) cf.cf_expr) cf.cf_overloads;
|
|
|
- dce.curclass <- null_class
|
|
|
+ pop();
|
|
|
) cfl;
|
|
|
loop ()
|
|
|
in
|
|
|
- loop ();
|
|
|
- (* third step: filter types *)
|
|
|
+ loop ()
|
|
|
+
|
|
|
+let sweep dce com =
|
|
|
let rec loop acc types =
|
|
|
match types with
|
|
|
| (TClassDecl c) as mt :: l when keep_whole_class dce c ->
|
|
@@ -817,7 +809,46 @@ let run com main full =
|
|
|
| [] ->
|
|
|
acc
|
|
|
in
|
|
|
- com.types <- loop [] (List.rev com.types);
|
|
|
+ com.types <- loop [] (List.rev com.types)
|
|
|
+
|
|
|
+let run com main mode =
|
|
|
+ let full = mode = DceFull in
|
|
|
+ let dce = {
|
|
|
+ com = com;
|
|
|
+ full = full;
|
|
|
+ dependent_types = Hashtbl.create 0;
|
|
|
+ std_dirs = if full then [] else List.map Path.unique_full_path com.std_path;
|
|
|
+ debug = Common.defined com Define.DceDebug;
|
|
|
+ added_fields = [];
|
|
|
+ follow_expr = expr;
|
|
|
+ marked_fields = [];
|
|
|
+ marked_maybe_fields = [];
|
|
|
+ t_stack = [];
|
|
|
+ ts_stack = [];
|
|
|
+ features = Hashtbl.create 0;
|
|
|
+ curclass = null_class;
|
|
|
+ } in
|
|
|
+ begin match main with
|
|
|
+ | Some {eexpr = TCall({eexpr = TField(e,(FStatic(c,cf)))},_)} | Some {eexpr = TBlock ({ eexpr = TCall({eexpr = TField(e,(FStatic(c,cf)))},_)} :: _)} ->
|
|
|
+ cf.cf_meta <- (Meta.Keep,[],cf.cf_pos) :: cf.cf_meta
|
|
|
+ | _ ->
|
|
|
+ ()
|
|
|
+ end;
|
|
|
+ List.iter (fun m ->
|
|
|
+ List.iter (fun (s,v) ->
|
|
|
+ if Hashtbl.mem dce.features s then Hashtbl.replace dce.features s (v :: Hashtbl.find dce.features s)
|
|
|
+ else Hashtbl.add dce.features s [v]
|
|
|
+ ) m.m_extra.m_if_feature;
|
|
|
+ ) com.modules;
|
|
|
+
|
|
|
+ (* first step: get all entry points, which is the main method and all class methods which are marked with @:keep *)
|
|
|
+ collect_entry_points dce com;
|
|
|
+
|
|
|
+ (* second step: initiate DCE passes and keep going until no new fields were added *)
|
|
|
+ mark dce;
|
|
|
+
|
|
|
+ (* third step: filter types *)
|
|
|
+ if mode <> DceNo then sweep dce com;
|
|
|
|
|
|
(* extra step to adjust properties that had accessors removed (required for Php and Cpp) *)
|
|
|
fix_accessors com;
|