[dce] Optimize search for descendants. ~60% faster compilation. (#6181)

* tclass.cl_descendants

* always store recent version of descendant class in tclass.cl_descendants

* ignore outdated dependencies in dce

* move population of tclass.cl_descendants to post-processing

* clear tclass.cl_descendants on cl_restore

* removed is_direct_descendant

* Run, Travis, run!

src/optimization/dce.ml

@@ -206,33 +206,26 @@ let mark_mt dce mt = match mt with
 
 (* find all dependent fields by checking implementing/subclassing types *)
 let rec mark_dependent_fields dce csup n stat =
-	let dependent = try
-		Hashtbl.find dce.dependent_types csup.cl_path
-	with Not_found ->
-		let cl = List.filter (fun mt -> match mt with TClassDecl c -> is_parent csup c | _ -> false) dce.com.types in
-		Hashtbl.add dce.dependent_types csup.cl_path cl;
-		cl
+	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. This is also true for
+				extern interfaces because we cannot remove fields from them *)
+			if Meta.has Meta.Used c.cl_meta || (csup.cl_interface && csup.cl_extern) 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 (Meta.has Meta.MaybeUsed cf.cf_meta) then begin
+				cf.cf_meta <- (Meta.MaybeUsed,[],cf.cf_pos) :: cf.cf_meta;
+				dce.marked_maybe_fields <- cf :: dce.marked_maybe_fields;
+			end
+		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
-	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. This is also true for
-					   extern interfaces because we cannot remove fields from them *)
-					if Meta.has Meta.Used c.cl_meta || (csup.cl_interface && csup.cl_extern) 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 (Meta.has Meta.MaybeUsed cf.cf_meta) then begin
-						cf.cf_meta <- (Meta.MaybeUsed,[],cf.cf_pos) :: cf.cf_meta;
-						dce.marked_maybe_fields <- cf :: dce.marked_maybe_fields;
-					end
-				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
-		| _ -> ()
-	) dependent
+	let rec loop_inheritance c =
+		loop c;
+		Hashtbl.iter (fun _ d -> loop_inheritance d) c.cl_descendants;
+	in
+	loop_inheritance csup
 
 (* expr and field evaluation *)
 

src/optimization/filters.ml

@@ -9,7 +9,7 @@
 
 	This program is distributed in the hope that it will be useful,
 	but WITHOUT ANY WARRANTY; without even the implied warranty of
-	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
 	GNU General Public License for more details.
 
 	You should have received a copy of the GNU General Public License
@@ -394,6 +394,7 @@ let save_class_state ctx t = match t with
 			c.cl_statics <- mk_pmap c.cl_ordered_statics;
 			c.cl_constructor <- Option.map restore_field csr;
 			c.cl_overrides <- over;
+			Hashtbl.clear c.cl_descendants;
 		)
 	| _ ->
 		()
@@ -851,7 +852,16 @@ let filter_timer detailed s =
 
 let run com tctx main =
 	let detail_times = Common.raw_defined com "filter-times" in
-	let new_types = List.filter (fun t -> not (is_cached t)) com.types in
+	let new_types = List.filter (fun t ->
+		(match t with
+			| TClassDecl cls ->
+				List.iter (fun (iface,_) -> add_descendant iface cls) cls.cl_implements;
+				(match cls.cl_super with
+					| Some (csup,_) -> add_descendant csup cls
+					| None -> ())
+			| _ -> ());
+		not (is_cached t)
+	) com.types in
 	(* PASS 1: general expression filters *)
 	let filters = [
 		VarLazifier.apply com;

src/typing/type.ml

@@ -218,6 +218,11 @@ and tclass = {
 
 	mutable cl_build : unit -> build_state;
 	mutable cl_restore : unit -> unit;
+	(*
+		These are classes which directly extend or directly implement this class.
+		Populated automatically in post-processing step (Filters.run)
+	*)
+	mutable cl_descendants : (path, tclass) Hashtbl.t;
 }
 
 and tenum_field = {
@@ -397,6 +402,7 @@ let mk_class m path pos name_pos =
 		cl_overrides = [];
 		cl_build = (fun() -> Built);
 		cl_restore = (fun() -> ());
+		cl_descendants = Hashtbl.create 10
 	}
 
 let module_extra file sign time kind policy =
@@ -489,6 +495,9 @@ let rec is_parent csup c =
 		| None -> false
 		| Some (c,_) -> is_parent csup c
 
+let add_descendant c descendant =
+	Hashtbl.replace c.cl_descendants descendant.cl_path descendant
+
 let map loop t =
 	match t with
 	| TMono r ->