Nicolas Cannasse пре 18 година
родитељ
комит
48efd8fecf
7 измењених фајлова са 81 додато и 8 уклоњено
  1. 4 1
      genjs.ml
  2. 7 1
      genneko.ml
  3. 5 1
      genswf8.ml
  4. 5 1
      genxml.ml
  5. 18 3
      main.ml
  6. 39 0
      plugin.ml
  7. 3 1
      typer.ml

+ 4 - 1
genjs.ml

@@ -683,6 +683,7 @@ let generate file types hres =
 		id_counter = 0;
 		curmethod = ("",false);
 	} in
+	let t = Plugin.timer "generate js" in
 	List.iter (generate_type ctx) types;
 	print ctx "$_ = {}";
 	newline ctx;
@@ -708,4 +709,6 @@ let generate file types hres =
 	List.iter (generate_static ctx) (List.rev ctx.statics);
 	let ch = open_out file in
 	output_string ch (Buffer.contents ctx.buf);
-	close_out ch
+	close_out ch;
+	t()
+

+ 7 - 1
genneko.ml

@@ -725,6 +725,7 @@ let generate file types hres libs =
 		curblock = [];
 		locals = PMap.empty;
 	} in
+	let t = Plugin.timer "neko ast" in
 	let h = Hashtbl.create 0 in
 	let header = ENeko (
 		"@classes = $new(null);" ^
@@ -741,7 +742,9 @@ let generate file types hres libs =
 	let inits = List.map (gen_expr ctx) (List.rev ctx.inits) in
 	let vars = List.concat (List.map (gen_static_vars ctx) types) in
 	let e = (EBlock (header :: packs @ methods @ boot :: names @ inits @ vars), null_pos) in
+	t();
 	let neko_file = (try Filename.chop_extension file with _ -> file) ^ ".neko" in
+	let w = Plugin.timer "neko ast write" in
 	let ch = IO.output_channel (open_out neko_file) in
 	let source = Plugin.defined "neko_source" in
 	(if source then Nxml.write_fmt else Nxml.write) ch (Nxml.to_xml e);
@@ -752,7 +755,10 @@ let generate file types hres libs =
 		Sys.remove neko_file;
 		Sys.rename ((try Filename.chop_extension file with _ -> file) ^ "2.neko") neko_file;
 	end;
-	if command ("nekoc \"" ^ neko_file ^ "\"") <> 0 then failwith "Neko compilation failure";
+	w();
+	let c = Plugin.timer "neko compilation" in
+	if command ("nekoc " ^ (if !Plugin.times then "-time " else "") ^ "\"" ^ neko_file ^ "\"") <> 0 then failwith "Neko compilation failure";
+	c();
 	let output = Filename.chop_extension neko_file ^ ".n" in
 	if output <> file then Sys.rename output file;
 	if not source then Sys.remove neko_file

+ 5 - 1
genswf8.ml

@@ -1379,6 +1379,7 @@ let generate_code file ver types hres =
 	[TDoAction ctx.opcodes] , ctx.movieclips
 
 let generate file ver header infile types hres =
+	let t = Plugin.timer "generate swf" in
 	let file , codeclip = (try let f , c = ExtString.String.split file "@" in f, Some c with _ -> file , None) in
 	let tag_code, boot_name , movieclips = (if ver = 9 then
 			let c, b = Genswf9.generate types hres in
@@ -1482,9 +1483,12 @@ let generate file ver header infile types hres =
 			(header , tags)
 	) in
 	let swf = if ver = 8 && Plugin.defined "flash_v9" then ({ (fst swf) with h_version = 9 }, snd swf) else swf in
+	t();
+	let t = Plugin.timer "write swf" in
 	let ch = IO.output_channel (open_out_bin file) in
 	Swf.write ch swf;
-	IO.close_out ch
+	IO.close_out ch;
+	t();
 
 ;;
 SwfParser.init SwfZip.inflate SwfZip.deflate;

+ 5 - 1
genxml.ml

@@ -158,10 +158,14 @@ let rec write_xml ch tabs x =
 		IO.printf ch "<![CDATA[%s]]>" s
 
 let generate file ctx types =
+	let t = Plugin.timer "construct xml" in
 	let x = node "haxe" [] (List.map (gen_type_decl ctx) types) in
+	t();
+	let t = Plugin.timer "write xml" in
 	let ch = IO.output_channel (open_out_bin file) in
 	write_xml ch "" x;
-	IO.close_out ch
+	IO.close_out ch;
+	t()
 
 let gen_type_string ctx t =
 	let x = gen_type_decl ctx t in

+ 18 - 3
main.ml

@@ -327,6 +327,7 @@ try
 			};
 		),": display code tips");
 		("--no-output", Arg.Unit (fun() -> no_output := true),": compiles but does not generate any file");
+		("--times", Arg.Unit (fun() -> Plugin.times := true),": mesure compilation times");
 	] in
 	let current = ref 0 in
 	let args = Array.of_list ("" :: params) in
@@ -398,9 +399,11 @@ try
 		if !cmds = [] && not !gen_hx then Arg.usage args_spec usage;
 	end else begin
 		if !Plugin.verbose then print_endline ("Classpath : " ^ (String.concat ";" !Plugin.class_path));
+		let t = Plugin.timer "typing" in
 		let ctx = Typer.context type_error warn in
 		List.iter (fun cpath -> ignore(Typer.load ctx cpath Ast.null_pos)) (List.rev !classes);
 		Typer.finalize ctx;
+		t();
 		if !has_error then do_exit();
 		if !display then begin
 			xml_out := None;
@@ -434,11 +437,13 @@ try
 			Genxml.generate file ctx types);
 	end;
 	if not !no_output then List.iter (fun cmd ->
+		let t = Plugin.timer "command" in
 		let len = String.length cmd in
 		if len > 3 && String.sub cmd 0 3 = "cd " then
 			Sys.chdir (String.sub cmd 3 (len - 3))
 		else
-			if Sys.command cmd <> 0 then failwith "Command failed"
+			if Sys.command cmd <> 0 then failwith "Command failed";
+		t();
 	) (List.rev !cmds)
 with
 	| Lexer.Error (m,p) -> report (Lexer.error_msg m) p
@@ -470,7 +475,17 @@ with
 	| e -> report (Printexc.to_string e) Ast.null_pos
 
 ;;
-let time = Sys.time() in
+let all = Plugin.timer "other" in
+Plugin.times := false;
 Plugin.get_full_path := get_full_path;
 process_params [] (List.tl (Array.to_list Sys.argv));
-if !Plugin.verbose then print_endline ("Time spent : " ^ string_of_float (Sys.time() -. time));
+all();
+if !Plugin.times then begin
+	let tot = ref 0. in
+	Hashtbl.iter (fun _ t -> tot := !tot +. t.Plugin.total) Plugin.htimers;
+	Printf.eprintf "Total time : %.3fs\n" !tot;
+	Printf.eprintf "------------------------------------\n";
+	Hashtbl.iter (fun _ t ->
+		Printf.eprintf "  %s : %.3fs, %.0f%%\n" t.Plugin.name t.Plugin.total (t.Plugin.total *. 100. /. !tot);
+	) Plugin.htimers;
+end;

+ 39 - 0
plugin.ml

@@ -39,3 +39,42 @@ let find_file f =
 				loop l
 	in
 	loop !class_path
+
+type timer_infos = {
+	name : string;
+	mutable start : float;
+	mutable total : float;
+}
+
+let times = ref true
+
+let get_time = Unix.gettimeofday
+let htimers = Hashtbl.create 0
+
+let new_timer name = 
+	try
+		let t = Hashtbl.find htimers name in
+		t.start <- get_time();
+		t
+	with Not_found ->
+		let t = { name = name; start = get_time(); total = 0.; } in
+		Hashtbl.add htimers name t;
+		t
+
+let curtime = ref None
+
+let timer name =
+	if not !times then
+		(function() -> ())
+	else
+	let t = new_timer name in
+	let old = !curtime in	
+	curtime := Some t;
+	(function() ->
+		let dt = get_time() -. t.start in
+		t.total <- t.total +. dt;		
+		curtime := old;
+		match !curtime with
+		| None -> ()
+		| Some ct -> ct.start <- ct.start +. dt
+	)

+ 3 - 1
typer.ml

@@ -2668,7 +2668,9 @@ let load ctx m p =
 			) ^ ".hx" in
 			let file = (try Plugin.find_file file with Not_found -> raise (Error (Module_not_found m,p))) in
 			let ch = (try open_in_bin file with _ -> error ("Could not open " ^ file) p) in
-			let pack , decls = (try Parser.parse (Lexing.from_channel ch) file with e -> close_in ch; raise e) in
+			let t = Plugin.timer "parsing" in
+			let pack , decls = (try Parser.parse (Lexing.from_channel ch) file with e -> close_in ch; t(); raise e) in
+			t();
 			let pack , decls = (match pack , fst m with "flash" :: l , "flash9" :: l2 when l = l2 && Plugin.defined "flash9doc" -> fst m, List.map f9decl decls | _ -> pack , decls) in
 			close_in ch;
 			if !Plugin.verbose then print_endline ("Parsed " ^ file);