Przeglądaj źródła

execute DCE after filters and class state saving, but before on_generate

Simon Krajewski 13 lat temu
rodzic
commit
309eb78044
3 zmienionych plików z 29 dodań i 30 usunięć
  1. 15 13
      codegen.ml
  2. 7 15
      dce.ml
  3. 7 2
      main.ml

+ 15 - 13
codegen.ml

@@ -595,18 +595,21 @@ let has_rtti ctx c =
 	end else
 		has_rtti_old c || has_rtti_new c
 
-let restore c =
-	let meta = c.cl_meta and path = c.cl_path and ext = c.cl_extern in
-	let fl = c.cl_fields and ofl = c.cl_ordered_fields and st = c.cl_statics and ost = c.cl_ordered_statics in
-	(fun() ->
-		c.cl_meta <- meta;
-		c.cl_extern <- ext;
-		c.cl_path <- path;
-		c.cl_fields <- fl;
-		c.cl_ordered_fields <- ofl;
-		c.cl_statics <- st;
-		c.cl_ordered_statics <- ost;
-	)
+let save_class_state ctx t = match t with
+	| TClassDecl c ->
+		let meta = c.cl_meta and path = c.cl_path and ext = c.cl_extern in
+		let fl = c.cl_fields and ofl = c.cl_ordered_fields and st = c.cl_statics and ost = c.cl_ordered_statics in
+		c.cl_restore <- (fun() ->
+			c.cl_meta <- meta;
+			c.cl_extern <- ext;
+			c.cl_path <- path;
+			c.cl_fields <- fl;
+			c.cl_ordered_fields <- ofl;
+			c.cl_statics <- st;
+			c.cl_ordered_statics <- ost;
+		)
+	| _ ->
+		()
 
 let on_generate ctx t =
 	match t with
@@ -616,7 +619,6 @@ let on_generate ctx t =
 			if Hashtbl.mem ctx.g.types_module rpath then error ("This private class name will clash with " ^ s_type_path rpath) c.cl_pos;
 		end;
 		if c.cl_kind = KGeneric && not (has_meta ":usedRecursively" c.cl_meta) then c.cl_extern <- true;
-		c.cl_restore <- restore c;
 		List.iter (fun m ->
 			match m with
 			| ":native",[Ast.EConst (Ast.String name),p],mp ->

+ 7 - 15
dce.ml

@@ -37,7 +37,6 @@ open Typecore
 
 type dce = {
 	ctx : typer;
-	all_types : module_type list;
 	debug : bool;
 	follow_expr : dce -> texpr -> unit;
 	mutable added_fields : (tclass * tclass_field * bool) list;
@@ -126,7 +125,7 @@ let rec mark_dependent_fields dce csup n stat =
 			in
 			loop c
 		| _ -> ()
-	) dce.all_types
+	) dce.ctx.com.types
 
 (* expr and field evaluation *)
 
@@ -228,10 +227,9 @@ and expr dce e =
 		expr dce e;
 	| _ -> Type.iter (expr dce) e
 
-let run ctx main types modules =
+let run ctx main =
 	let dce = {
 		ctx = ctx;
-		all_types = types;
 		debug = Common.defined ctx.com "dce_debug";
 		added_fields = [];
 		follow_expr = expr;
@@ -266,10 +264,10 @@ let run ctx main types modules =
 				(match !(a.a_status) with
 				| Statics c ->
 					let cf = PMap.find "main" c.cl_statics in
-					loop [c,cf,true] types
+					loop [c,cf,true] ctx.com.types
 				| _ -> assert false)
 			| _ -> assert false)
-		| _ -> loop [] types
+		| _ -> loop [] ctx.com.types
 	in	
 	if dce.debug then begin
 		List.iter (fun (c,cf,_) -> match cf.cf_expr with
@@ -334,11 +332,7 @@ let run ctx main types modules =
 		| [] ->
 			acc
 	in
-	let types = loop [] (List.rev types) in
-	let modules = List.filter (fun m ->
-		m.m_types <- loop [] m.m_types;
-		m.m_types <> []
-	) modules in
+	ctx.com.types <- loop [] (List.rev ctx.com.types);
 
 	(* extra step to adjust properties that had accessors removed (required for Php and Cpp) *)
 	List.iter (fun mt -> match mt with
@@ -360,7 +354,7 @@ let run ctx main types modules =
 			List.iter (check_prop true) c.cl_ordered_statics;
 			List.iter (check_prop false) c.cl_ordered_fields;
 		| _ -> ()
-	) types;
+	) ctx.com.types;
 
 	(* remove "override" from fields that do not override anything anymore *)
 	List.iter (fun mt -> match mt with
@@ -375,6 +369,4 @@ let run ctx main types modules =
 				loop c
 			) c.cl_overrides;
 		| _ -> ()
-	) types;
-
-	types,modules
+	) ctx.com.types

+ 7 - 2
main.ml

@@ -1027,7 +1027,6 @@ try
 		end;
 		let t = Common.timer "filters" in
 		let main, types, modules = Typer.generate tctx in
-		let types,modules = if Common.defined ctx.com "dce" && not !interp then Dce.run tctx main types modules else types,modules in
 		com.main <- main;
 		com.types <- types;
 		com.modules <- modules;
@@ -1039,7 +1038,13 @@ try
 		] in
 		List.iter (Codegen.post_process filters) com.types;
 		Codegen.post_process_end();
-		Common.add_filter com (fun() -> List.iter (Codegen.on_generate tctx) com.types);
+		List.iter (Codegen.save_class_state tctx) com.types;
+		if Common.defined ctx.com "dce" && not !interp then Dce.run tctx main;
+		let type_filters = [
+			Codegen.on_generate;
+			(* TODO: fill me *)
+		] in
+		List.iter (fun f -> Common.add_filter com (fun() -> List.iter (f tctx) com.types)) type_filters;
 		List.iter (fun f -> f()) (List.rev com.filters);
 		if ctx.has_error then raise Abort;
 		(match !xml_out with