瀏覽代碼

DCE fixes 2019 (#7718)

* [dce] always run mark phase, but don't sweep if dce=no

see #7712

* [dce] ensure that we always have a curclass

see #7581
closes #7712

* [js] bring back $hsEnums check

closes #7581
Simon Krajewski 6 年之前
父節點
當前提交
d85f52c9c7
共有 3 個文件被更改,包括 78 次插入46 次删除
  1. 6 5
      src/filters/filters.ml
  2. 1 1
      src/generators/genjs.ml
  3. 71 40
      src/optimization/dce.ml

+ 6 - 5
src/filters/filters.ml

@@ -874,12 +874,13 @@ let run com tctx main =
 	else
 		(try Common.defined_value com Define.Dce with _ -> "no")
 	in
-	begin match dce_mode with
-		| "full" -> Dce.run com main (not (Common.defined com Define.Interp))
-		| "std" -> Dce.run com main false
-		| "no" -> Dce.fix_accessors com
+	let dce_mode = match dce_mode with
+		| "full" -> if Common.defined com Define.Interp then Dce.DceNo else DceFull
+		| "std" -> DceStd
+		| "no" -> DceNo
 		| _ -> failwith ("Unknown DCE mode " ^ dce_mode)
-	end;
+	in
+	Dce.run com main dce_mode;
 	t();
 	(* PASS 3: type filters post-DCE *)
 	let type_filters = [

+ 1 - 1
src/generators/genjs.ml

@@ -1490,7 +1490,7 @@ let generate com =
 	let vars = if has_feature ctx "has_enum"
 		then ("$estr = function() { return " ^ (ctx.type_accessor (TClassDecl { null_class with cl_path = ["js"],"Boot" })) ^ ".__string_rec(this,''); }") :: vars
 		else vars in
-	let vars = if enums_as_objects then "$hxEnums = $hxEnums || {}" :: vars else vars in
+	let vars = if (enums_as_objects && (has_feature ctx "has_enum" || has_feature ctx "Type.resolveEnum")) then "$hxEnums = $hxEnums || {}" :: vars else vars in
 	let vars,has_dollar_underscore =
 		if List.exists (function TEnumDecl { e_extern = false } -> true | _ -> false) com.types then
 			"$_" :: vars,true

+ 71 - 40
src/optimization/dce.ml

@@ -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;