remove imported libraries debug infos when not compiled with -debug

common.ml

@@ -80,6 +80,8 @@ type context = {
 
 exception Abort of string * Ast.pos
 
+let display = ref false
+
 let create v =
 	let m = Type.mk_mono() in
 	{

doc/CHANGES.txt

@@ -20,6 +20,7 @@
 		no longer support automatic creation of classes for f8 swfs in f9 mode
 		classes defined in f9 swf are not redefinable in haXe code (use extern)
 	flash9 : allow direct access and completion with classes defined in -swf-lib's
+	flash9 : remove imported libraries debug infos when not compiled with -debug
 
 2010-01-09: 2.05
 	js : added js.Scroll

genswf.ml

@@ -318,6 +318,7 @@ let extract_data swf =
 		| Some h -> h
 		| None ->
 			let _, tags = swf() in
+			let t = Common.timer "read swf" in
 			let h = Hashtbl.create 0 in
 			let rec loop_field f =
 				match f.hlf_kind with
@@ -333,8 +334,100 @@ let extract_data swf =
 				| _ -> ()
 			) tags;
 			cache := Some h;
+			t();
 			h)
 
+let remove_debug_infos as3 =
+	let hl = As3hlparse.parse as3 in
+	let methods = Hashtbl.create 0 in
+	let rec loop_field f =
+		{ f with hlf_kind = (match f.hlf_kind with
+			| HFMethod m -> HFMethod { m with hlm_type = loop_method m.hlm_type }
+			| HFFunction f -> HFFunction (loop_method f)
+			| HFVar v -> HFVar v
+			| HFClass c -> HFClass (loop_class c))
+		}
+	and loop_class c =
+		(* mutate in order to preserve sharing *)
+		c.hlc_construct <- loop_method c.hlc_construct;
+		c.hlc_fields <- Array.map loop_field c.hlc_fields;
+		c.hlc_static_construct <- loop_method c.hlc_static_construct;
+		c.hlc_static_fields <- Array.map loop_field c.hlc_static_fields;
+		c
+	and loop_static s =
+		{ 
+			hls_method = loop_method s.hls_method;
+			hls_fields = Array.map loop_field s.hls_fields;
+		}
+	and loop_method m =
+		try
+			Hashtbl.find methods m.hlmt_index
+		with Not_found ->
+			let m2 = { m with hlmt_debug_name = None; hlmt_pnames = None } in
+			Hashtbl.add methods m.hlmt_index m2;
+			m2.hlmt_function <- (match m.hlmt_function with None -> None | Some f -> Some (loop_function f));
+			m2
+	and loop_function f =
+		let cur = ref 0 in
+		let positions = Array.map (fun op ->
+			let p = !cur in
+			(match op with
+			| HDebugReg _ | HDebugLine _ | HDebugFile _ | HBreakPointLine _ | HTimestamp -> ()
+			| _ -> incr cur);
+			p
+		) f.hlf_code in
+		let positions = Array.concat [positions;[|!cur|]] in
+		let code = DynArray.create() in
+		Array.iteri (fun pos op ->
+			match op with
+			| HDebugReg _ | HDebugLine _ | HDebugFile _ | HBreakPointLine _ | HTimestamp -> ()
+			| _ -> 
+				let p delta = 
+					positions.(pos + delta) - DynArray.length code
+				in
+				let op = (match op with
+				| HJump (j,delta) -> HJump (j, p delta)
+				| HSwitch (d,deltas) -> HSwitch (p d,List.map p deltas)
+				| HFunction m -> HFunction (loop_method m)
+				| HCallStatic (m,args) -> HCallStatic (loop_method m,args)
+				| HClassDef c -> HClassDef c (* mutated *)
+				| _ -> op) in
+				DynArray.add code op
+		) f.hlf_code;
+		f.hlf_code <- DynArray.to_array code;
+		f.hlf_trys <- Array.map (fun t ->
+			{
+				t with
+				hltc_start = positions.(t.hltc_start);
+				hltc_end = positions.(t.hltc_end);
+				hltc_handle = positions.(t.hltc_handle);
+			}
+		) f.hlf_trys;
+		f
+	in	
+	As3hlparse.flatten (List.map loop_static hl)
+
+let parse_swf com file =
+	let data = ref None in
+	(fun () ->
+		match !data with
+		| Some swf -> swf
+		| None ->
+			let t = Common.timer "read swf" in
+			let file = (try Common.find_file com file with Not_found -> failwith ("SWF Library not found : " ^ file)) in
+			let ch = IO.input_channel (open_in_bin file) in
+			let h, tags = (try Swf.parse ch with _ -> failwith ("The input swf " ^ file ^ " is corrupted")) in
+			IO.close_in ch;
+			List.iter (fun t ->
+				match t.tdata with
+				| TActionScript3 (id,as3) when not com.debug && not !Common.display ->					
+					t.tdata <- TActionScript3 (id,remove_debug_infos as3)
+				| _ -> ()
+			) tags;
+			t();
+			data := Some (h,tags);
+			(h,tags))
+
 (* ------------------------------- *)
 
 let tag ?(ext=false) d = {

main.ml

@@ -23,7 +23,6 @@ open Common
 let version = 205
 
 let prompt = ref false
-let display = ref false
 let measure_times = ref false
 
 let executable_path() =
@@ -312,11 +311,11 @@ try
 			Common.define com var
 		),"<var> : define a conditional compilation flag");
 		("-v",Arg.Unit (fun () ->
-			if not !display then com.verbose <- true
+			com.verbose <- true
 		),": turn on verbose mode");
 		("-debug", Arg.Unit (fun() ->
-			Common.define com "debug"; com.debug <- true)
-		, ": add debug informations to the compiled code");
+			Common.define com "debug"; com.debug <- true
+		), ": add debug informations to the compiled code");
 	] in
 	let adv_args_spec = [
 		("-swf-version",Arg.Int (fun v ->
@@ -334,18 +333,7 @@ try
 				_ -> raise (Arg.Bad "Invalid SWF header format")
 		),"<header> : define SWF header (width:height:fps:color)");
 		("-swf-lib",Arg.String (fun file ->
-			let data = ref None in
-			let getSWF() =
-				match !data with
-				| Some swf -> swf
-				| None ->
-					let file = (try Common.find_file com file with Not_found -> failwith ("SWF Library not found : " ^ file)) in
-					let ch = IO.input_channel (open_in_bin file) in
-					let swf = (try Swf.parse ch with _ -> failwith ("The input swf " ^ file ^ " is corrupted")) in
-					IO.close_in ch;
-					data := Some swf;
-					swf
-			in
+			let getSWF = Genswf.parse_swf com file in
 			let extract = Genswf.extract_data getSWF in
 			let build cl p = Genswf.build_class com (Hashtbl.find (extract()) cl) file in
 			com.type_api.load_extern_type <- com.type_api.load_extern_type @ [build];
@@ -416,8 +404,7 @@ try
 			| _ ->
 				let file, pos = try ExtString.String.split file_pos "@" with _ -> failwith ("Invalid format : " ^ file_pos) in
 				let pos = try int_of_string pos with _ -> failwith ("Invalid format : "  ^ pos) in
-				display := true;
-				no_output := true;
+				Common.display := true;
 				Parser.resume_display := {
 					Ast.pfile = Common.get_full_path file;
 					Ast.pmin = pos;
@@ -480,6 +467,11 @@ try
 		if ret <> Unix.WEXITED 0 then failwith (String.concat "\n" lines);
 		com.class_path <- lines @ com.class_path;
 	);
+	if !Common.display then begin
+		com.verbose <- false;
+		xml_out := None;
+		no_output := true;
+	end;
 	let ext = (match com.platform with
 		| Cross ->
 			(* no platform selected *)
@@ -515,7 +507,6 @@ try
 		Typer.finalize ctx;
 		t();
 		if !has_error then do_exit();
-		if !display then xml_out := None;
 		if !no_output then com.platform <- Cross;
 		com.types <- Typer.types ctx com.main_class (!excludes);
 		com.lines <- Lexer.build_line_index();