new DCE initial

Makefile

@@ -30,7 +30,7 @@ EXPORT=../../../projects/motionTools/haxe
 
 MODULES=ast type lexer common genxml parser typecore optimizer typeload \
 	codegen genas3 gencommon gencpp genjs genneko genphp genswf8 \
-	gencs genjava genswf9 interp genswf typer main
+	gencs genjava genswf9 interp genswf typer dce main
 
 HAXE_LIBRARY_PATH=$(CURDIR)/std
 
@@ -64,6 +64,8 @@ codegen.cmx: typeload.cmx typecore.cmx type.cmx genxml.cmx common.cmx ast.cmx
 
 common.cmx: type.cmx ast.cmx
 
+dce.cmx: type.cmx typer.cmx
+
 genas3.cmx: type.cmx common.cmx codegen.cmx ast.cmx
 
 gencommon.cmx: type.cmx common.cmx codegen.cmx ast.cmx
@@ -90,7 +92,7 @@ genxml.cmx: type.cmx lexer.cmx common.cmx ast.cmx
 
 interp.cmx: typecore.cmx type.cmx lexer.cmx genneko.cmx common.cmx codegen.cmx ast.cmx
 
-main.cmx: typer.cmx typeload.cmx typecore.cmx type.cmx parser.cmx optimizer.cmx lexer.cmx interp.cmx genxml.cmx genswf.cmx genphp.cmx genneko.cmx genjs.cmx genjava.cmx gencs.cmx gencpp.cmx genas3.cmx common.cmx codegen.cmx ast.cmx
+main.cmx: dce.cmx typer.cmx typeload.cmx typecore.cmx type.cmx parser.cmx optimizer.cmx lexer.cmx interp.cmx genxml.cmx genswf.cmx genphp.cmx genneko.cmx genjs.cmx genjava.cmx gencs.cmx gencpp.cmx genas3.cmx common.cmx codegen.cmx ast.cmx
 
 optimizer.cmx: typecore.cmx type.cmx parser.cmx common.cmx ast.cmx
 

common.ml

@@ -231,7 +231,9 @@ let add_feature com f =
 	Hashtbl.replace com.features f true
 
 let rec has_feature com f =
-	try
+	(* disabled for now because of problems with new DCE *)
+	true
+(* 	try
 		Hashtbl.find com.features f
 	with Not_found ->
 		if com.types = [] then defined com "all_features" else
@@ -242,7 +244,7 @@ let rec has_feature com f =
 			let r = (try
 				let path = List.rev pack, cl in
 				(match List.find (fun t -> t_path t = path && not (has_meta ":realPath" (t_infos t).mt_meta)) com.types with
-				| t when meth = "*" -> (not com.dead_code_elimination) || has_meta ":?used" (t_infos t).mt_meta
+				| t when meth = "*" -> (not com.dead_code_elimination) || has_meta ":used" (t_infos t).mt_meta
 				| TClassDecl c -> PMap.exists meth c.cl_statics || PMap.exists meth c.cl_fields
 				| _ -> false)
 			with Not_found ->
@@ -250,7 +252,7 @@ let rec has_feature com f =
 			) in
 			let r = r || defined com "all_features" in
 			Hashtbl.add com.features f r;
-			r
+			r *)
 
 let error msg p = raise (Abort (msg,p))
 

dce.ml

@@ -0,0 +1,328 @@
+(*
+ * Haxe DCE:
+ * With this new approach the typer is almost not aware of DCE at all. It instead types what
+ * it needs to types (and usually some more) and DCE then takes care of cleaning up. It does
+ * so by following the typed AST expressions and mark accessed classes and fields as used.
+ *
+ * The algorithm works as follows:
+ * 1. Find all entry point class fields:
+ *	- the main method if exists
+ *	- methods marked as @:keep
+ *	- methods of classes marked as @:keep
+ *
+ * 2. Mark implementing/overriding fields of these entry points as @:?used.
+ *
+ * 3. Mark entry points as @:used.
+ *
+ * 4. Follow the field expressions (if exists) and see what other classes/fields are added,
+ *    e.g. by a TField or TNew AST node.
+ *
+ * 5. If new fields were added, go back to 2 with the new fields as entry points.
+ *
+ * 6. Filter the types by keeping those that are used explicitly or have a used field.
+ *
+ * Notes:
+ *	- the only influence of the typer is @:?used marking on structural subtyping
+ *  - properties are currently tricky to handle on some targets
+ *  - cpp target does not like removing unused overridden fields
+ *  - most targets seem to require keeping a property field even if it is used only through its accessor methods
+ *	- I did not consider inlining at all because I'm pretty sure I don't have to at this compilation stage
+ * 
+ *)
+
+open Ast
+open Common
+open Type
+open Typecore
+
+type dce = {
+	ctx : typer;
+	all_types : module_type list;
+	debug : bool;
+	expr : dce -> texpr -> unit;
+	mutable added_fields : (tclass * tclass_field * bool) list;
+}
+
+(* checking *)
+
+(* check for @:keepSub metadata, which forces @:keep on child classes *)
+let rec super_forces_keep c =
+	has_meta ":keepSub" c.cl_meta || match c.cl_super with
+	| Some (csup,_) -> super_forces_keep csup
+	| _ -> false
+
+(* check if a class is kept entirely *)
+let keep_whole_class dce c =
+	has_meta ":keep" c.cl_meta
+	|| super_forces_keep c
+	|| (match c with
+		| { cl_extern = true }
+		| { cl_path = ["flash";"_Boot"],"RealBoot" } -> true
+		| { cl_path = [],"String" }
+		| { cl_path = [],"Array" } -> not (dce.ctx.com.platform = Js)
+		| _ -> false)
+
+(* check if a field is kept *)
+let keep_field dce cf =
+	has_meta ":keep" cf.cf_meta
+	|| has_meta ":used" cf.cf_meta
+	|| cf.cf_name = "__init__"
+
+
+(* marking *)
+
+(* mark a field as kept *)
+let mark_field dce c cf stat = if not (has_meta ":used" cf.cf_meta) then begin
+	cf.cf_meta <- (":used",[],cf.cf_pos) :: cf.cf_meta;
+	dce.added_fields <- (c,cf,stat) :: dce.added_fields;
+end
+
+(* mark a class as kept. If the class has fields marked as @:?keep, make sure to keep them *)
+let rec mark_class dce c = if not (has_meta ":used" c.cl_meta) then begin
+	(* mark all :?used fields as surely :used now *)
+	List.iter (fun cf ->
+		if has_meta ":?used" cf.cf_meta then mark_field dce c cf true
+	) c.cl_ordered_statics;
+	List.iter (fun cf ->
+		if has_meta ":?used" cf.cf_meta then mark_field dce c cf false
+	) c.cl_ordered_fields;
+	c.cl_meta <- (":used",[],c.cl_pos) :: c.cl_meta;
+	(* we always have to keep super classes and implemented interfaces *)
+	List.iter (fun (c,_) -> mark_class dce c) c.cl_implements;
+	match c.cl_super with None -> () | Some (csup,pl) -> mark_class dce csup;
+end
+
+(* mark a type as kept *)
+let rec mark_t dce t = match follow t with
+	| TInst({cl_kind = KTypeParameter tl},pl) -> List.iter (mark_t dce) tl; List.iter (mark_t dce) pl
+	| TInst(c,pl) -> mark_class dce c; List.iter (mark_t dce) pl
+	| TFun(args,ret) -> List.iter (fun (_,_,t) -> mark_t dce t) args; mark_t dce ret
+	| _ -> ()
+
+(* find all dependent fields by checking implementing/subclassing types *)
+let rec mark_dependent_fields dce csup n stat =
+	List.iter (fun mt -> match mt with
+		| TClassDecl c when is_parent csup c ->
+			let rec loop c =
+				(try
+					let cf = PMap.find n (if stat then c.cl_statics else c.cl_fields) in
+					(* if it's clear that the class is kept, the field has to be kept as well *)
+					if has_meta ":used" c.cl_meta then mark_field dce c cf stat
+					(* otherwise it might be kept if the class is kept later, so mark it as :?used *)
+					else if not (has_meta ":?used" cf.cf_meta) then cf.cf_meta <- (":?used",[],cf.cf_pos) :: cf.cf_meta;
+					(* Cpp currently requires all base methods to be marked too *)
+					if dce.ctx.com.platform = Cpp then match c.cl_super with None -> () | Some (csup,_) -> loop csup;
+				with Not_found ->
+					(* if the field is not present on current class, it might come from a base class *)
+					(match c.cl_super with None -> () | Some (csup,_) -> loop csup))
+			in
+			loop c
+		| _ -> ()
+	) dce.all_types
+
+(* expr and field evaluation *)
+
+let opt f e = match e with None -> () | Some e -> f e
+
+let rec field dce c n stat =
+	let find_field n =
+		if n = "new" then match c.cl_constructor with
+			| None -> raise Not_found
+			| Some cf -> cf
+		else PMap.find n (if stat then c.cl_statics else c.cl_fields)
+	in
+	(try
+		let cf = find_field n in
+		mark_field dce c cf stat;
+	with Not_found -> try
+		(* me might have a property access on an interface *)
+		let l = String.length n - 4 in
+		if l < 0 then raise Not_found;
+		let prefix = String.sub n 0 4 in
+		let pn = String.sub n 4 l in
+		let cf = find_field pn in
+		if not (has_meta ":used" cf.cf_meta) then begin
+			let keep () =
+				mark_dependent_fields dce c n stat;
+ 				match dce.ctx.com.platform with
+					(* these platforms currently need the real property field apparently *)
+					| Js | Neko | Php | Flash8 | Cpp | Java -> field dce c pn stat
+					| _ -> ()
+			in
+			(match prefix,cf.cf_kind with
+				| "get_",Var {v_read = AccCall s} when s = n -> keep()
+				| "set_",Var {v_write = AccCall s} when s = n -> keep()	
+				| _ -> raise Not_found
+			);
+		end;
+		raise Not_found
+	with Not_found ->
+		match c.cl_super with Some (csup,_) -> field dce csup n stat | None -> ());
+
+and expr dce e =
+	match e.eexpr with
+	| TNew(c,pl,el) ->
+		mark_class dce c;
+		let rec loop c =
+			field dce c "new" false;
+			match c.cl_super with None -> () | Some (csup,_) -> loop csup
+		in
+		loop c;
+		List.iter (expr dce) el;
+		List.iter (mark_t dce) pl;
+	| TVars vl ->
+		List.iter (fun (v,e) ->
+			opt (expr dce) e;
+			mark_t dce v.v_type;
+		) vl;
+	| TCast(e, Some (TClassDecl c)) ->
+		mark_class dce c;
+		expr dce e;
+	| TTry(e, vl) ->
+		expr dce e;
+		List.iter (fun (v,e) ->
+			expr dce e;
+			mark_t dce v.v_type;
+		) vl;
+	| TTypeExpr (TClassDecl c) ->
+		mark_class dce c;
+	| TCall ({eexpr = TConst TSuper} as e,el) ->
+		mark_t dce e.etype;
+		List.iter (expr dce) el;
+	| TClosure(e,n)
+	| TField(e,n) -> (match follow e.etype with
+		| TInst(c,_) ->
+			mark_class dce c;
+			field dce c n false;
+		| TAnon a ->
+			(match !(a.a_status) with
+			| Statics c ->
+				mark_class dce c;
+				field dce c n true;
+			| _ -> ())
+		| _ -> ());
+		expr dce e;
+	| _ -> Type.iter (expr dce) e
+
+let run ctx main types modules =
+	let dce = {
+		ctx = ctx;
+		all_types = types;
+		debug = Common.defined ctx.com "dce_debug";
+		expr = expr;
+		added_fields = [];
+	} in
+	(* first step: get all entry points, which is the main method and all class methods which are marked with @:keep *)
+	let rec loop acc types = match types with
+		| (TClassDecl c) :: l ->
+			let keep_class = keep_whole_class dce c in
+			if keep_class then mark_class dce c;
+			let rec loop2 acc cfl stat = match cfl with
+				| cf :: l when keep_class || keep_field dce cf ->
+					loop2 ((c,cf,stat) :: acc) l stat
+				| cf :: l ->
+					loop2 acc l stat
+				| [] ->
+					acc
+			in
+			let acc = loop2 acc c.cl_ordered_statics true in
+			let acc = loop2 acc c.cl_ordered_fields false in
+			(match c.cl_init with None -> () | Some init -> expr dce init);
+			loop acc l
+		| _ :: l ->
+			loop acc l
+		| [] ->
+			acc
+	in
+	let entry_points = match main with
+		| Some {eexpr = TCall({eexpr = TField(e,_)},_)} ->
+			(match follow e.etype with
+			| TAnon a ->
+				(match !(a.a_status) with
+				| Statics c ->
+					let cf = PMap.find "main" c.cl_statics in
+					loop [c,cf,true] types
+				| _ -> assert false)
+			| _ -> assert false)
+		| _ -> loop [] types
+	in	
+	if dce.debug then begin
+		List.iter (fun (c,cf,_) -> match cf.cf_expr with
+			| None -> ()
+			| Some _ -> print_endline ("[DCE] Entry point: " ^ (s_type_path c.cl_path) ^ "." ^ cf.cf_name)
+		) entry_points;
+	end;
+
+	(* second step: initiate DCE passes and keep going until no new fields were added *)
+	let rec loop cfl =
+		(* extend to dependent (= overriding/implementing) class fields *)	
+		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) -> mark_field dce c cf stat; mark_t dce cf.cf_type) cfl;
+		(* follow expressions to new types/fields *)
+		List.iter (fun (_,cf,_) -> opt (expr dce) cf.cf_expr) cfl;		
+		match dce.added_fields with
+		| [] -> ()
+		| cfl ->
+			dce.added_fields <- [];
+			loop cfl
+	in
+	loop entry_points;
+
+	(* third step: filter types *)
+	let rec loop acc types =
+		match types with
+		| (TClassDecl c) as mt :: l when keep_whole_class dce c ->
+			loop (mt :: acc) l
+		| (TClassDecl c) as mt :: l ->
+ 			c.cl_ordered_statics <- List.filter (fun cf ->
+				let b = keep_field dce cf in
+				if not b then begin
+					if dce.debug then print_endline ("[DCE] Removed field " ^ (s_type_path c.cl_path) ^ "." ^ (cf.cf_name));
+					c.cl_statics <- PMap.remove cf.cf_name c.cl_statics;
+				end;
+				b
+			) c.cl_ordered_statics;
+			c.cl_ordered_fields <- List.filter (fun cf ->
+				let b = keep_field dce cf in
+				if not b then begin
+					if dce.debug then print_endline ("[DCE] Removed field " ^ (s_type_path c.cl_path) ^ "." ^ (cf.cf_name));
+					c.cl_fields <- PMap.remove cf.cf_name c.cl_fields;
+				end;
+				b
+			) c.cl_ordered_fields;
+			(match c.cl_constructor with Some cf when not (keep_field dce cf) -> c.cl_constructor <- None | _ -> ());
+			(* we keep a class if it was used or has a used field *)
+			if has_meta ":used" c.cl_meta || c.cl_ordered_statics <> [] || c.cl_ordered_fields <> [] then loop (mt :: acc) l else begin
+				if dce.debug then print_endline ("[DCE] Removed class " ^ (s_type_path c.cl_path));
+				loop acc l
+			end
+		| mt :: l ->
+			loop (mt :: acc) l
+		| [] ->
+			acc
+	in
+	let types = loop [] (List.rev types) in
+
+	(* extra step to adjust properties that had accessors removed (required for Php and Cpp) *)
+	List.iter (fun mt -> match mt with
+		| (TClassDecl c) ->
+			let rec has_accessor c n stat =
+				PMap.mem n (if stat then c.cl_statics else c.cl_fields)
+				|| match c.cl_super with Some (csup,_) -> has_accessor csup n stat | None -> false
+			in
+			let check_prop stat cf =
+				(match cf.cf_kind with
+				| Var {v_read = AccCall s; v_write = a} ->
+					cf.cf_kind <- Var {v_read = if has_accessor c s stat then AccCall s else AccNever; v_write = a}
+				| _ -> ());
+				(match cf.cf_kind with
+				| Var {v_write = AccCall s; v_read = a} ->
+					cf.cf_kind <- Var {v_write = if has_accessor c s stat then AccCall s else AccNever; v_read = a}
+				| _ -> ())
+			in		
+			List.iter (check_prop true) c.cl_ordered_statics;
+			List.iter (check_prop false) c.cl_ordered_fields;
+		| _ -> ()
+	) types;
+	types,modules

main.ml

@@ -1047,6 +1047,7 @@ try
 		end;
 		let t = Common.timer "filters" in
 		let main, types, modules = Typer.generate tctx in
+		let types,modules = if ctx.com.dead_code_elimination then Dce.run tctx main types modules else types,modules in
 		com.main <- main;
 		com.types <- types;
 		com.modules <- modules;

std/haxe/unit/TestCase.hx

@@ -25,6 +25,7 @@
 package haxe.unit;
 import haxe.PosInfos;
 
+@:keepSub
 class TestCase #if mt_build implements mt.Protect, #end implements haxe.Public  {
 	public var currentTest : TestStatus;
 

tests/unit/Test.hx

@@ -205,6 +205,7 @@ package unit;
 			#if java
 			new TestJava(),
 			#end
+			new TestDCE(),
 			//new TestUnspecified(),
 			//new TestRemoting(),
 		];

tests/unit/TestDCE.hx

@@ -0,0 +1,224 @@
+package unit;
+
+class DCEClass {
+	// used statics
+	static function staticUsed() { }
+	@:keep static function staticKeep() { }
+	static var staticVarUsed = "foo";
+	static var staticPropUsed(get_staticPropUsed, set_staticPropUsed):Int = 1;
+	static function get_staticPropUsed() return staticPropUsed
+	static function set_staticPropUsed(i:Int) return 0
+	
+	// used members
+	function memberUsed() { }
+	@:keep function memberKeep() { }
+	var memberVarUsed = 0;
+	var memberPropUsed(get_memberPropUsed, set_memberPropUsed):Int = 1;
+	function get_memberPropUsed() return memberPropUsed
+	function set_memberPropUsed(i:Int) return 0
+	
+	// unused statics
+	static function staticUnused() { }
+	static var staticVarUnused = "bar";
+	static var staticPropUnused(get_staticPropUnused, set_staticPropUnused):Int = 1;
+	static function get_staticPropUnused() return 0
+	static function set_staticPropUnused(i:Int) return 0
+	
+	// unused members
+	function memberUnused() { }
+	var memberVarUnused = 1;
+	var memberPropUnused(get_memberPropUnused, set_memberPropUnused):Int = 1;
+	function get_memberPropUnused() return 0
+	function set_memberPropUnused(i:Int) return 0	
+	
+	static var c :Array<Dynamic> = [null, unit.UsedReferenced2];
+	
+	public function new() {
+		staticUsed();
+		staticVarUsed;
+		staticPropUsed = 1;
+		staticPropUsed;
+		
+		memberUsed();
+		memberVarUsed;
+		memberPropUsed = 2;
+		memberPropUsed;
+		
+		new UsedConstructed();
+		
+		try cast (null, UsedReferenced) catch(e:Dynamic) { }
+				
+		new UsedAsBaseChild();
+		c.length;
+	}
+}
+
+class TestDCE extends Test {
+	
+	public function testFields() {
+		var dce = new DCEClass();
+		var c = Type.getClass(dce);
+		hf(c, "memberKeep");
+		hf(c, "memberUsed");
+		hf(c, "memberVarUsed");
+		hf(c, "memberPropUsed");
+		hf(c, "get_memberPropUsed");
+		hf(c, "set_memberPropUsed");
+		
+		hsf(c, "staticKeep");
+		hsf(c, "staticUsed");
+		hsf(c, "staticVarUsed");
+		hsf(c, "staticPropUsed");
+		hsf(c, "get_staticPropUsed");
+		hsf(c, "set_staticPropUsed");
+		
+		nhf(c, "memberUnused");
+		nhf(c, "memberVarUnused");
+		nhf(c, "memberPropUnused");
+		nhf(c, "get_memberPropUnused");
+		nhf(c, "set_memberPropUnused");
+		
+		nhsf(c, "staticUnused");
+		nhsf(c, "staticVarUnused");
+		nhsf(c, "staticPropUnused");
+		nhsf(c, "get_staticPropUnused");
+		nhsf(c, "set_staticPropUnused");	
+	}
+	
+	public function testInterface() {
+		var l:UsedInterface = new UsedThroughInterface();
+		var l2:UsedInterface = new InterfaceMethodFromBaseClassChild();
+		var ic = Type.resolveClass("unit.UsedInterface");
+		var c = Type.getClass(l);
+		var bc = Type.resolveClass("unit.InterfaceMethodFromBaseClass");
+		
+		l.usedInterfaceFunc();
+		hf(ic, "usedInterfaceFunc");
+		hf(c, "usedInterfaceFunc");
+		hf(bc, "usedInterfaceFunc");
+		nhf(ic, "unusedInterfaceFunc");
+		nhf(c, "unusedInterfaceFunc");
+		nhf(bc, "unusedInterfaceFunc");	
+	}
+	
+	public function testProperty() {
+		var l:PropertyInterface = new PropertyAccessorsFromBaseClassChild();
+		var ic = Type.resolveClass("unit.PropertyInterface");
+		var c = Type.getClass(l);
+		var bc = Type.resolveClass("unit.PropertyAccessorsFromBaseClass");
+		
+		l.x = "bar";
+		hf(c, "set_x");
+		hf(bc, "set_x");
+		nhf(ic, "set_x");
+		nhf(ic, "get_x");
+		nhf(c, "get_x");
+		nhf(bc, "get_x");
+	}
+	
+	public function testClasses() {
+		t(Type.resolveClass("unit.UsedConstructed") != null);
+		t(Type.resolveClass("unit.UsedReferenced") != null);
+		t(Type.resolveClass("unit.UsedReferenced2") != null);
+		t(Type.resolveClass("unit.UsedInterface") != null);
+		t(Type.resolveClass("unit.UsedThroughInterface") != null);
+		t(Type.resolveClass("unit.UsedAsBase") != null);
+		t(Type.resolveClass("unit.UsedAsBaseChild") != null);
+		
+		t(Type.resolveClass("unit.Unused") == null);
+		t(Type.resolveClass("unit.UnusedChild") == null);		
+		t(Type.resolveClass("unit.UnusedImplements") == null);
+		t(Type.resolveClass("unit.UsedConstructedChild") == null);
+		t(Type.resolveClass("unit.UsedReferencedChild") == null);	
+	}
+	
+	function hf(c:Class<Dynamic>, n:String, ?pos:haxe.PosInfos) {
+		Test.count++;
+		if (!Lambda.has(Type.getInstanceFields(c), n))
+			Test.report(Type.getClassName(c) + " should have member field " +n, pos);
+	}
+	
+	function nhf(c:Class<Dynamic>, n:String, ?pos:haxe.PosInfos) {
+		Test.count++;
+		if (Lambda.has(Type.getInstanceFields(c), n))
+			Test.report(Type.getClassName(c) + " should not have member field " +n, pos);
+	}
+	
+	function hsf(c:Class<Dynamic> , n:String, ?pos:haxe.PosInfos) {
+		Test.count++;
+		if (!Lambda.has(Type.getClassFields(c), n))
+			Test.report(Type.getClassName(c) + " should have static field " +n, pos);
+	}	
+	
+	function nhsf(c:Class<Dynamic> , n:String, ?pos:haxe.PosInfos) {
+		Test.count++;
+		if (Lambda.has(Type.getClassFields(c), n))
+			Test.report(Type.getClassName(c) + " should not have static field " +n, pos);
+	}
+}
+
+class UsedConstructed {
+	public function new() { }
+}
+
+class UsedReferenced { }
+class UsedReferenced2 { }
+
+class UsedConstructedChild extends UsedConstructed {
+	
+}
+
+class UsedReferencedChild extends UsedReferenced {
+	
+}
+
+interface UsedInterface {
+	public function usedInterfaceFunc():Void;
+	public function unusedInterfaceFunc():Void;
+}
+
+class UsedThroughInterface implements UsedInterface {
+	public function new() { }
+	public function usedInterfaceFunc():Void { }
+	public function unusedInterfaceFunc():Void { }
+	public function otherFunc() { }
+}
+
+class UsedAsBase { }
+class UsedAsBaseChild extends UsedAsBase {
+	public function new() { }
+}
+
+class Unused {
+	
+}
+
+class UnusedChild extends Unused { }
+
+class UnusedImplements implements UsedInterface {
+	public function usedInterfaceFunc():Void { }
+	public function unusedInterfaceFunc():Void { }
+}
+
+interface PropertyInterface {
+	public var x(get_x, set_x):String;
+}
+
+class PropertyAccessorsFromBaseClass {
+	public function get_x() return throw "must not set"
+	public function set_x(x:String) return "ok"
+}
+
+class PropertyAccessorsFromBaseClassChild extends PropertyAccessorsFromBaseClass, implements PropertyInterface {
+	public var x(get_x, set_x):String;
+	public function new() { }
+}
+
+class InterfaceMethodFromBaseClass {
+	public function usedInterfaceFunc():Void { }
+	public function unusedInterfaceFunc():Void { }
+}
+
+class InterfaceMethodFromBaseClassChild extends InterfaceMethodFromBaseClass, implements UsedInterface {
+	public function new() { }
+}

tests/unit/TestMisc.hx

@@ -26,9 +26,9 @@ class MyDynamicClass {
 		return Z + x + y;
 	}
 
-	public static var W(getW, setW) : Int = 55;
-	static function getW() return W + 2
-	static function setW(v) { W = v; return v; }
+	public static var W(get_w, set_w) : Int = 55;
+	static function get_w() return W + 2
+	static function set_w(v) { W = v; return v; }
 	
 }
 

tests/unit/params.hxml

@@ -3,4 +3,4 @@
 -resource res1.txt
 -resource res2.bin
 --no-opt
-#--dead-code-elimination
+--dead-code-elimination

tests/unit/unit.hxml

@@ -43,11 +43,11 @@ params.hxml
 -php php
 
 #as3
---next
-params.hxml
--main unit.Test
--as3 as3
--cmd mxmlc -static-link-runtime-shared-libraries=true -debug as3/__main__.as --output unit9_as3.swf
+#--next
+#params.hxml
+#-main unit.Test
+#-as3 as3
+#-cmd mxmlc -static-link-runtime-shared-libraries=true -debug as3/__main__.as --output unit9_as3.swf
 
 #cpp
 --next
@@ -58,6 +58,7 @@ params.hxml
 params.hxml
 -main unit.Test
 -cpp cpp
+-D NO_PRECOMPILED_HEADERS
 
 #java
 --next

type.ml

@@ -913,11 +913,11 @@ let rec unify a b =
 					if not (List.exists (fun f1o -> type_iseq f1o.cf_type f2o.cf_type) (f1 :: f1.cf_overloads))
 					then error [Missing_overload (f1, f2o.cf_type)]
 				) f2.cf_overloads;
+				(* we mark the field as :?used because it might be used through the structure *)
+				if not (has_meta ":?used" f1.cf_meta) then f1.cf_meta <- (":?used",[],f1.cf_pos) :: f1.cf_meta;				
 				(match f1.cf_kind with
 				| Method MethInline ->
 					if (c.cl_extern || has_meta ":extern" f1.cf_meta) && not (has_meta ":runtime" f1.cf_meta) then error [Has_no_runtime_field (a,n)];
-					(* mark as used so it's not removed by DCE *)
-					if not (has_meta ":?used" f1.cf_meta) then f1.cf_meta <- (":?used",[],f1.cf_pos) :: f1.cf_meta;
 				| _ -> ());
 			) an.a_fields;
 			if !(an.a_status) = Opened then an.a_status := Closed;

typeload.ml

@@ -59,9 +59,6 @@ let apply_macro ctx mode path el p =
 	) in
 	ctx.g.do_macro ctx mode cpath meth el p
 
-let mark_used_field ctx f =
-	if ctx.com.dead_code_elimination && not (has_meta ":?used" f.cf_meta) then f.cf_meta <- (":?used",[],f.cf_pos) :: f.cf_meta
-
 (** since load_type_def and load_instance are used in PASS2, they should not access the structure of a type **)
 
 (*
@@ -476,18 +473,6 @@ let rec check_interface ctx c p intf params =
 		try
 			let t2, f2 = class_field_no_interf c i in
 			ignore(follow f2.cf_type); (* force evaluation *)
-			(* we have to make sure that the field is mark as used, which might not be the case for inline fields *)
-			mark_used_field ctx f2;
-			(* this is also true for property accessors *)
-			(match f2.cf_kind with
-			| Var v ->
-				let rec mark c s =
-					(try mark_used_field ctx (PMap.find s c.cl_fields) with Not_found -> ());
-					(match c.cl_super with None -> () | Some (c,_) -> mark c s)
-				in
-				(match v.v_read with AccCall s -> mark c s | _ -> ());
-				(match v.v_write with AccCall s -> mark c s | _ -> ())
-			| Method m -> ());
 			let p = (match f2.cf_expr with None -> p | Some e -> e.epos) in
 			let mkind = function
 				| MethNormal | MethInline -> 0
@@ -925,8 +910,6 @@ let init_class ctx c p herits fields =
 
 	let fields = if not display_file || Common.defined ctx.com "no-copt" then fields else Optimizer.optimize_completion c fields in
 
-	let mark_used cf = if ctx.com.dead_code_elimination then cf.cf_meta <- (":?used",[],p) :: cf.cf_meta in
-
 	let rec is_full_type t =
 		match t with
 		| TFun (args,ret) -> is_full_type ret && List.for_all (fun (_,_,t) -> is_full_type t) args
@@ -952,7 +935,7 @@ let init_class ctx c p herits fields =
 			(fun () -> ())
 		else begin
 			cf.cf_type <- TLazy r;
-			if ctx.com.dead_code_elimination && cf.cf_name <> "__init__" then (fun() -> ()) else (fun () -> ignore(!r()))
+			(fun () -> ignore(!r()))
 		end
 	in
 
@@ -961,14 +944,6 @@ let init_class ctx c p herits fields =
 		if not stat && has_field cf.cf_name c.cl_super then error ("Redefinition of variable " ^ cf.cf_name ^ " in subclass is not allowed") p;
 		let t = cf.cf_type in
 		match e with
-		| None when ctx.com.dead_code_elimination && not ctx.com.display ->
-			let r = exc_protect ctx (fun r ->
-				r := (fun() -> t);
-				mark_used cf;
-				t
-			) in
-			cf.cf_type <- TLazy r;
-			(fun() -> ())
 		| None ->
 			(fun() -> ())
 		| Some e ->
@@ -976,7 +951,6 @@ let init_class ctx c p herits fields =
 				if not !return_partial_type then begin
 					r := (fun() -> t);
 					if ctx.com.verbose then Common.log ctx.com ("Typing " ^ (if ctx.in_macro then "macro " else "") ^ s_type_path c.cl_path ^ "." ^ cf.cf_name);
-					if not inline then mark_used cf;
 					let e = type_var_field ctx t e stat p in
 					let e = (match cf.cf_kind with
 					| Var v when not stat || (v.v_read = AccInline && Common.defined ctx.com "haxe3") ->
@@ -1140,7 +1114,6 @@ let init_class ctx c p herits fields =
 						(match e.eexpr with
 						| TBlock [] | TBlock [{ eexpr = TConst _ }] | TConst _ | TObjectDecl [] -> ()
 						| _ -> c.cl_init <- Some e);
-					if not (constr || inline) then mark_used cf;
 					if has_meta ":defineFeature" cf.cf_meta then add_feature ctx.com (s_type_path c.cl_path ^ "." ^ cf.cf_name);
 					cf.cf_expr <- Some (mk (TFunction f) t p);
 					cf.cf_type <- t;

typer.ml

@@ -66,17 +66,6 @@ let check_assign ctx e =
 	| _ ->
 		error "Invalid assign" e.epos
 
-let rec mark_used_class ctx c =
-	if ctx.com.dead_code_elimination && not (has_meta ":?used" c.cl_meta) then begin
-		c.cl_meta <- (":?used",[],c.cl_pos) :: c.cl_meta;
-		match c.cl_super with
-		| Some (csup,_) -> mark_used_class ctx csup
-		| _ -> ()
-	end
-
-let mark_used_enum ctx e  =
-	if ctx.com.dead_code_elimination && not (has_meta ":?used" e.e_meta) then e.e_meta <- (":?used",[],e.e_pos) :: e.e_meta
-
 type type_class =
 	| KInt
 	| KFloat
@@ -384,7 +373,6 @@ let rec type_module_type ctx t tparams p =
 			t_types = [];
 			t_meta = no_meta;
 		} in
-		mark_used_class ctx c;
 		mk (TTypeExpr (TClassDecl c)) (TType (t_tmp,[])) p
 	| TEnumDecl e ->
 		let types = (match tparams with None -> List.map (fun _ -> mk_mono()) e.e_types | Some l -> l) in
@@ -418,7 +406,6 @@ let rec type_module_type ctx t tparams p =
 			t_types = e.e_types;
 			t_meta = no_meta;
 		} in
-		mark_used_enum ctx e;
 		mk (TTypeExpr (TEnumDecl e)) (TType (t_tmp,types)) p
 	| TTypeDecl s ->
 		let t = apply_params s.t_types (List.map (fun _ -> mk_mono()) s.t_types) s.t_type in
@@ -452,8 +439,7 @@ let make_call ctx e params t p =
 			| _ -> false
 		) in
 		(* we have to make sure that we mark the field as used here so DCE does not remove it *)
-		let exit () = Typeload.mark_used_field ctx f; raise Exit in
-		if not ctx.g.doinline && not is_extern then exit();
+		if not ctx.g.doinline && not is_extern then raise Exit;
 		ignore(follow f.cf_type); (* force evaluation *)
 		let params = List.map (ctx.g.do_optimize ctx) params in
 		(match f.cf_expr with
@@ -461,7 +447,7 @@ let make_call ctx e params t p =
 			(match Optimizer.type_inline ctx f fd ethis params t p is_extern with
 			| None ->
 				if is_extern then error "Inline could not be done" p;
-				exit()
+				raise Exit;
 			| Some e -> e)
 		| _ ->
 			error "Recursive inline is not supported" p)
@@ -508,7 +494,6 @@ let rec acc_get ctx g p =
 			| TInst (c,_) -> chk_class c
 			| TAnon a -> (match !(a.a_status) with Statics c -> chk_class c | _ -> ())
 			| _ -> ());
-			Typeload.mark_used_field ctx f;
 			mk (TClosure (e,f.cf_name)) t p
 		| Some e ->
 			let rec loop e = Type.map_expr loop { e with epos = p } in
@@ -535,7 +520,6 @@ let field_access ctx mode f t e p =
 		| TAnon a -> 
 			(match !(a.a_status) with
 			| EnumStatics e -> 
-				mark_used_enum ctx e;
 				AKField ((mk (TEnumField (e,f.cf_name)) t p),f)
 			| _ -> fnormal())
 		| _ -> fnormal()
@@ -548,7 +532,6 @@ let field_access ctx mode f t e p =
 		| MethMacro, MGet -> display_error ctx "Macro functions must be called immediatly" p; normal()
 		| MethMacro, MCall -> AKMacro (e,f)
 		| _ , MGet ->
-			Typeload.mark_used_field ctx f;
 			AKExpr (mk (TClosure (e,f.cf_name)) t p)
 		| _ -> normal())
 	| Var v ->
@@ -739,7 +722,6 @@ let type_ident_raise ?(imported_enums=true) ctx i p mode =
 				| TEnumDecl e ->
 					try
 						let ef = PMap.find i e.e_constrs in
-						mark_used_enum ctx e;
 						mk (TEnumField (e,i)) (monomorphs e.e_types ef.ef_type) p
 					with
 						Not_found -> loop l
@@ -1474,7 +1456,6 @@ and type_expr_with_type_raise ?(print_error=true) ctx e t =
 				raise Exit
 			with Not_found -> try
 				let ef = PMap.find s e.e_constrs in
-				mark_used_enum ctx e;
 				let constr = mk (TEnumField (e,s)) (apply_params e.e_types pl ef.ef_type) p in
 				build_call ctx (AKExpr constr) el (Some t) p
 			with Not_found ->
@@ -1536,7 +1517,6 @@ and type_expr_with_type_raise ?(print_error=true) ctx e t =
 				| TEnum (e,pl) ->
 					(try
 						let ef = PMap.find s e.e_constrs in
-						mark_used_enum ctx e;
 						mk (TEnumField (e,s)) (apply_params e.e_types pl ef.ef_type) p
 					with Not_found ->
 						error ("Identifier '" ^ s ^ "' is not part of enum " ^ s_type_path e.e_path) p;
@@ -1967,12 +1947,10 @@ and type_expr ctx ?(need_val=true) (e,p) =
 		let t = Typeload.load_instance ctx t p true in
 		let el, c , params = (match follow t with
 		| TInst (c,params) ->
-			mark_used_class ctx c;
 			let name = (match c.cl_path with [], name -> name | x :: _ , _ -> x) in
 			if PMap.mem name ctx.locals then error ("Local variable " ^ name ^ " is preventing usage of this class here") p;
 			let ct, f = get_constructor ctx c params p in
 			if not f.cf_public && not (is_parent c ctx.curclass) && not ctx.untyped then display_error ctx "Cannot access private constructor" p;
-			Typeload.mark_used_field ctx f;
 			(match f.cf_kind with
 			| Var { v_read = AccRequire r } -> error_require r p
 			| _ -> ());
@@ -2235,7 +2213,6 @@ and type_call ctx e el twith p =
 		| None -> error "Current class does not have a super" p
 		| Some (c,params) ->
 			let ct, f = get_constructor ctx c params p in
-			Typeload.mark_used_field ctx f;
 			let el, _ = (match follow ct with
 			| TFun (args,r) ->
 				unify_call_params ctx (Some (TInst(c,params),f)) el args r p false
@@ -2338,10 +2315,6 @@ and build_call ctx acc el twith p =
 			else
 				error (s_type (print_context()) e.etype ^ " cannot be called") e.epos), e
 		) in
-		if ctx.com.dead_code_elimination then
-			(match e.eexpr, el with
-			| TField ({ eexpr = TTypeExpr (TClassDecl { cl_path = [],"Std"  }) },"string"), [ep] -> check_to_string ctx ep.etype
-			| _ -> ());
 		mk (TCall (e,el)) t p
 
 and check_to_string ctx t =
@@ -2354,111 +2327,6 @@ and check_to_string ctx t =
 			())
 	| _ -> ()
 
-(* ---------------------------------------------------------------------- *)
-(* DEAD CODE ELIMINATION *)
-
-let dce_check_metadata ctx meta =
-	List.exists (fun (m,e,_) ->
-		match m,e with
-		| ":?used",_
-		| ":keep",_ ->
-			true
- 		| ":feature",el ->
-			List.exists (fun e -> match e with (EConst(String s),_) -> has_feature ctx.com s | _ -> false) el
-		| _ -> false
-	) meta
-
-let dce_check_class ctx c =
-	let rec super_forces_keep c =
-		has_meta ":keepSub" c.cl_meta || match c.cl_super with
-		| Some (csup,_) -> super_forces_keep csup
-		| _ -> false
-	in
-	let keep_whole_class = c.cl_interface
-		|| has_meta ":keep" c.cl_meta
-		|| (match c.cl_path with [],"Array" | [],"String" -> not (platform ctx.com Js) | _ -> false)
-		|| super_forces_keep c
-	in
-	let keep stat f =
-		keep_whole_class
-		|| (c.cl_extern && (match f.cf_kind with Method MethInline -> false | _ -> true))
-		|| dce_check_metadata ctx f.cf_meta
-		|| (stat && f.cf_name = "__init__")
-		|| (not stat && f.cf_name = "resolve" && (match c.cl_dynamic with Some _ -> true | None -> false))
-		|| (f.cf_name = "new" && has_meta ":?used" c.cl_meta)
-		|| match String.concat "." (fst c.cl_path @ [snd c.cl_path;f.cf_name]) with
-		| "EReg.new" -> true
-		| _ -> false
-	in
-	keep
-
-(*
-	make sure that all things we are supposed to keep are correctly typed
-*)
-let dce_finalize ctx =
-	let feature_changed = ref false in
-	let add_feature f =
-		if not (has_feature ctx.com f) then begin
-			add_feature ctx.com f;
-			feature_changed := true;
-		end
-	in
-	let check_class c =
-		let keep = dce_check_class ctx c in
-		let check stat f = if keep stat f then ignore(follow f.cf_type) in
-		(match c.cl_constructor with Some f -> check false f | _ -> ());
-		List.iter (check false) c.cl_ordered_fields;
-		List.iter (check true) c.cl_ordered_statics;
-	in
-	Hashtbl.iter (fun _ m ->
-		List.iter (fun t ->
-			match t with
-			| TClassDecl c -> check_class c
-			| TEnumDecl e when not e.e_extern && dce_check_metadata ctx e.e_meta ->
-				add_feature "has_enum"
-			| _ -> ()
-		) m.m_types
-	) ctx.g.modules;
-	not !feature_changed
-
-(*
-	remove unused fields and mark unused classes as extern
-*)
-let dce_optimize ctx =
-	let check_class c =
-		let keep = dce_check_class ctx c in
-		let keep stat f = if not (keep stat f) then begin if ctx.com.verbose then Common.log ctx.com ("Removing " ^ s_type_path c.cl_path ^ "." ^ f.cf_name); false; end else true in
-		c.cl_constructor <- (match c.cl_constructor with Some f when not (keep false f) -> None | x -> x);
-		c.cl_ordered_fields <- List.filter (keep false) c.cl_ordered_fields;
-		c.cl_ordered_statics <- List.filter (keep true) c.cl_ordered_statics;
-		c.cl_fields <- List.fold_left (fun acc f -> PMap.add f.cf_name f acc) PMap.empty c.cl_ordered_fields;
-		c.cl_statics <- List.fold_left (fun acc f -> PMap.add f.cf_name f acc) PMap.empty c.cl_ordered_statics;
-		if c.cl_ordered_statics = [] && c.cl_ordered_fields = [] then
-			match c with
-			| { cl_extern = true }
-			| { cl_interface = true }
-			| { cl_path = ["flash";"_Boot"],"RealBoot" }
-				-> ()
-			| _ when has_meta ":?used" c.cl_meta || has_meta ":keep" c.cl_meta || (match c.cl_constructor with Some f -> has_meta ":?used" f.cf_meta | _ -> false)
-				-> ()
-			| _ ->
-				Common.log ctx.com ("Removing " ^ s_type_path c.cl_path);
-				c.cl_extern <- true;
-				(match c.cl_path with [],"Std"|["js"],"Boot" -> () | _ -> c.cl_init <- None);
-				c.cl_meta <- [":native",[(EConst (String "Dynamic"),c.cl_pos)],c.cl_pos]; (* make sure the type will not be referenced *)
-	in
-	Common.log ctx.com "Performing dead code optimization";
-	Hashtbl.iter (fun _ m ->
-		List.iter (fun t ->
-			match t with
-			| TClassDecl c -> check_class c
-			| TEnumDecl e when not e.e_extern && not (dce_check_metadata ctx e.e_meta) ->
-				e.e_extern <- true;
-				Common.log ctx.com ("Removing " ^ s_type_path e.e_path);
-			| _ -> ()
-		) m.m_types
-	) ctx.g.modules
-
 (* ---------------------------------------------------------------------- *)
 (* FINALIZATION *)
 
@@ -2485,9 +2353,6 @@ let get_main ctx =
 
 let rec finalize ctx =
 	match ctx.g.delayed.df_normal,ctx.g.delayed.df_late with
-	| [],[] when ctx.com.dead_code_elimination ->
-		ignore(get_main ctx);
-		if dce_finalize ctx && ctx.g.delayed.df_normal = [] && ctx.g.delayed.df_late = [] then dce_optimize ctx else finalize ctx
 	| [],[] ->
 		(* at last done *)
 		()