Explorar o código

- all : dead-code-elimination, reverted class vars removal because unreliable
- all : dead-code-elimination, added class removal for classes without methods and vars

Franco Ponticelli %!s(int64=14) %!d(string=hai) anos
pai
achega
8468be4f5e
Modificáronse 3 ficheiros con 61 adicións e 18 borrados
  1. 2 0
      main.ml
  2. 32 0
      optimizer.ml
  3. 27 18
      typeload.ml

+ 2 - 0
main.ml

@@ -565,6 +565,8 @@ try
 		let filters = (match com.platform with Js | Php | Cpp -> Optimizer.sanitize :: filters | _ -> filters) in
 		let filters = (if not com.foptimize then filters else Optimizer.reduce_expression ctx :: filters) in
 		Codegen.post_process com filters;
+		if com.dead_code_elimination then
+			Common.add_filter com (fun() -> Optimizer.filter_dead_classes com);
 		Common.add_filter com (fun() -> List.iter (Codegen.on_generate ctx) com.types);
 		List.iter (fun f -> f()) (List.rev com.filters);
 		if Common.defined com "dump" then Codegen.dump_types com;

+ 32 - 0
optimizer.ml

@@ -483,6 +483,38 @@ let rec reduce_loop ctx is_sub e =
 
 let reduce_expression ctx e =
 	if ctx.com.foptimize then reduce_loop ctx false e else e
+	
+(* ---------------------------------------------------------------------- *)
+(* ELIMINATE DEAD CLASSES *)
+
+(*
+	if dead code elimination is on, any class without fields is eliminated from the output.
+*)
+	
+let filter_dead_classes com =
+	let must_keep_classes = match com.platform with
+(*		| Flash
+		| Flash9 ->
+			[["flash"], "Lib"]
+		| Js -> 
+			[["js"], "Lib"] *)
+		| _ -> 
+			[] in
+	com.types <- List.filter (fun t ->
+		match t with
+		| TClassDecl c ->
+			if c.cl_extern || (List.exists (fun i -> i = c.cl_path) must_keep_classes) then 
+				true 
+			else (match (c.cl_ordered_statics, c.cl_ordered_fields, c.cl_constructor) with
+			| ([], [], None) ->
+				if com.verbose then print_endline ("Remove class " ^ s_type_path c.cl_path);
+				false
+			| _ ->
+				true)
+		| _ ->
+			true
+	) com.types
+
 
 (* ---------------------------------------------------------------------- *)
 (* SANITIZE *)

+ 27 - 18
typeload.ml

@@ -689,22 +689,28 @@ let init_class ctx c p herits fields =
 		| Cpp -> [["cpp"], "Boot"]
 		| _ -> [] in
 	let must_keep_class = (List.exists (fun p -> p = c.cl_path) (must_keep_types ctx.com.platform)) in
-	let keep f stat = core_api || (is_main f.cff_name) || must_keep_class || has_meta ":keep" c.cl_meta || has_meta ":keep" f.cff_meta || (stat && f.cff_name = "__init__") in
+	let keep f stat = core_api || (is_main f.cff_name) || c.cl_extern || must_keep_class || has_meta ":keep" c.cl_meta || has_meta ":keep" f.cff_meta || (stat && f.cff_name = "__init__") in
 	let remove_by_cfname item lst = List.filter (fun i -> item <> i.cf_name) lst in
-	let remove_untyped_field cf stat = (fun () ->
+	let remove_field cf stat =
+		if ctx.com.verbose then print_endline ("Remove field " ^ (s_type_path c.cl_path) ^ "." ^ cf.cf_name);
+		if stat then begin
+			c.cl_statics <- PMap.remove cf.cf_name c.cl_statics;
+			c.cl_ordered_statics <- remove_by_cfname cf.cf_name c.cl_ordered_statics;
+		end else begin
+			if cf.cf_name = "new" then c.cl_constructor <- None;
+			c.cl_fields <- PMap.remove cf.cf_name c.cl_fields;
+			c.cl_ordered_fields <- remove_by_cfname cf.cf_name c.cl_ordered_fields;
+		end
+	in
+	let remove_method_if_unreferenced cf stat = (fun () ->
 		match cf.cf_expr with
 		| None ->
-			if ctx.com.verbose then print_endline ("Removed " ^ (s_type_path c.cl_path) ^ "." ^ cf.cf_name);
-			if stat then begin
-				c.cl_statics <- PMap.remove cf.cf_name c.cl_statics;
-				c.cl_ordered_statics <- remove_by_cfname cf.cf_name c.cl_ordered_statics;
-			end else begin
-				if cf.cf_name = "new" then c.cl_constructor <- None;
-				c.cl_fields <- PMap.remove cf.cf_name c.cl_fields;
-				c.cl_ordered_fields <- remove_by_cfname cf.cf_name c.cl_ordered_fields;
-			end
+			remove_field cf stat
 		| _ -> ()) 
 	in
+	let remove_var_if_unreferenced cf stat = (fun () ->
+		())
+	in
 	let loop_cf f =
 		let name = f.cff_name in
 		let p = f.cff_pos in
@@ -738,7 +744,9 @@ let init_class ctx c p herits fields =
 			} in
 			let delay = if (ctx.com.dead_code_elimination && not !Common.display) then begin
 				(match e with
-				| None -> (fun() -> ())
+				| None -> (fun() -> 
+					if not (keep f stat) then delay ctx (remove_var_if_unreferenced cf stat);
+					())
 				| Some e ->
 					let ctx = { ctx with curclass = c; tthis = tthis } in
 					let r = exc_protect (fun r ->
@@ -748,10 +756,11 @@ let init_class ctx c p herits fields =
 						t
 					) in
 					cf.cf_type <- TLazy r;
-					(fun () -> 
-						if not (keep f stat) then begin
-							delay ctx (remove_untyped_field cf stat)
-						end else
+					(fun () ->
+						if ctx.com.verbose then print_endline ("field " ^ (s_type_path c.cl_path) ^ "." ^ cf.cf_name);
+						if not (keep f stat) then
+							delay ctx (remove_var_if_unreferenced cf stat)
+						else
 							ignore(!r())
 					)
 				)
@@ -851,7 +860,7 @@ let init_class ctx c p herits fields =
 					cf.cf_type <- TLazy r;
 					(fun() -> 
 						if not (keep f stat) then begin
-							delay ctx (remove_untyped_field cf stat)
+							delay ctx (remove_method_if_unreferenced cf stat)
 						end else
 							ignore((!r)())
 					)
@@ -1245,7 +1254,7 @@ let type_module ctx m tdecls loadp =
 			| _ -> assert false);
 	) tdecls;
 	(* PASS 3 : type checking, delayed until all modules and types are built *)
-	List.iter (delay ctx) (List.rev (!delays));
+	List.iter (delay ctx) (List.rev (!delays));	
 	m
 
 let parse_module ctx m p =