Procházet zdrojové kódy

forward verbose log to client (local or distant)

Nicolas Cannasse před 13 roky
rodič
revize
dc4a11dfd8
7 změnil soubory, kde provedl 27 přidání a 24 odebrání
  1. 1 1
      codegen.ml
  2. 6 0
      common.ml
  3. 2 3
      interp.ml
  4. 11 10
      main.ml
  5. 0 3
      parser.ml
  6. 3 3
      typeload.ml
  7. 4 4
      typer.ml

+ 1 - 1
codegen.ml

@@ -118,7 +118,7 @@ let extend_remoting ctx c t p async prot =
 	with
 		Error (Module_not_found _,p2) when p == p2 ->
 	(* build it *)
-	if ctx.com.verbose then print_endline ("Building proxy for " ^ s_type_path path);
+	Common.log ctx.com ("Building proxy for " ^ s_type_path path);
 	let file, decls = (try
 		Typeload.parse_module ctx path p
 	with

+ 6 - 0
common.ml

@@ -63,6 +63,7 @@ type context = {
 	mutable load_extern_type : (path -> pos -> (string * Ast.package) option) list; (* allow finding types which are not in sources *)
 	mutable filters : (unit -> unit) list;
 	mutable defines_signature : string option;
+	mutable print : string -> unit;
 	(* output *)
 	mutable file : string;
 	mutable flash_version : float;
@@ -83,6 +84,7 @@ type context = {
 exception Abort of string * Ast.pos
 
 let display_default = ref false
+let default_print = ref print_string
 
 let create v =
 	let m = Type.mk_mono() in
@@ -94,6 +96,7 @@ let create v =
 		foptimize = true;
 		dead_code_elimination = false;
 		platform = Cross;
+		print = !default_print;
 		std_path = [];
 		class_path = [];
 		main_class = None;
@@ -127,6 +130,9 @@ let create v =
 		};
 	}
 
+let log com str =
+	if com.verbose then com.print (str ^ "\n")
+
 let clone com =
 	let t = com.basic in
 	{ com with basic = { t with tvoid = t.tvoid }; main_class = None; }

+ 2 - 3
interp.ml

@@ -659,8 +659,7 @@ let builtins =
 		"print", FunVar (fun vl -> List.iter (fun v ->
 			let ctx = get_ctx() in
 			let com = ctx.curapi.get_com() in
-			let str = ctx.do_string v in
-			if not com.display then print_string str
+			com.print (ctx.do_string v)
 		) vl; VNull);
 		"throw", Fun1 (fun v -> exc v);
 		"rethrow", Fun1 (fun v ->
@@ -802,7 +801,7 @@ let std_lib =
 		"math_cos", Fun1 (fun v -> VFloat (cos (num v)));
 		"math_sin", Fun1 (fun v -> VFloat (sin (num v)));
 		"math_tan", Fun1 (fun v -> VFloat (tan (num v)));
-		"math_log", Fun1 (fun v -> VFloat (log (num v)));
+		"math_log", Fun1 (fun v -> VFloat (Pervasives.log (num v)));
 		"math_exp", Fun1 (fun v -> VFloat (exp (num v)));
 		"math_acos", Fun1 (fun v -> VFloat (acos (num v)));
 		"math_asin", Fun1 (fun v -> VFloat (asin (num v)));

+ 11 - 10
main.ml

@@ -470,7 +470,7 @@ and wait_loop boot_com host port =
 				List.iter (cache_module (get_signature ctx.com)) ctx.com.modules;
 				if verbose then print_endline ("Cached " ^ string_of_int (List.length ctx.com.modules) ^ " modules");
 			end;
-			List.iter (fun s -> ssend sin (s ^ "\n")) (List.rev ctx.messages);
+			List.iter (fun s -> ssend sin (s ^ "\n"); if verbose then print_endline ("> " ^ s)) (List.rev ctx.messages);
 		in
 		(try
 			let data = parse_hxml_data (read_loop()) in
@@ -478,6 +478,7 @@ and wait_loop boot_com host port =
 			if verbose then print_endline ("Processing Arguments [" ^ String.concat "," data ^ "]");
 			(try
 				Common.display_default := false;
+				Common.default_print := ssend sin;
 				Parser.resume_display := Ast.null_pos;
 				measure_times := false;
 				Hashtbl.clear Common.htimers;
@@ -510,7 +511,7 @@ and do_connect host port args =
 		if b > 0 then loop()
 	in
 	loop();
-	prerr_endline (Buffer.contents buf)
+	prerr_string (Buffer.contents buf)
 
 and init flush ctx =
 	let usage = Printf.sprintf
@@ -807,7 +808,7 @@ try
 	if !classes = [([],"Std")] && not !force_typing then begin
 		if !cmds = [] && not !did_something then Arg.usage basic_args_spec usage;
 	end else begin
-		if com.verbose then print_endline ("Classpath : " ^ (String.concat ";" com.class_path));
+		Common.log com ("Classpath : " ^ (String.concat ";" com.class_path));
 		let t = Common.timer "typing" in
 		Typecore.type_expr_ref := (fun ctx e need_val -> Typer.type_expr ~need_val ctx e);
 		let tctx = Typer.create com in
@@ -835,7 +836,7 @@ try
 		| Some "hx" ->
 			Genxml.generate_hx com
 		| Some file ->
-			if com.verbose then print_endline ("Generating xml : " ^ com.file);
+			Common.log com ("Generating xml : " ^ com.file);
 			Genxml.generate com file);
 		if com.platform = Flash9 || com.platform = Cpp then List.iter (Codegen.fix_overrides com) com.types;
 		if Common.defined com "dump" then Codegen.dump_types com;
@@ -852,22 +853,22 @@ try
 		| Cross ->
 			()
 		| Flash | Flash9 when !gen_as3 ->
-			if com.verbose then print_endline ("Generating AS3 in : " ^ com.file);
+			Common.log com ("Generating AS3 in : " ^ com.file);
 			Genas3.generate com;
 		| Flash | Flash9 ->
-			if com.verbose then print_endline ("Generating swf : " ^ com.file);
+			Common.log com ("Generating swf : " ^ com.file);
 			Genswf.generate com !swf_header;
 		| Neko ->
-			if com.verbose then print_endline ("Generating neko : " ^ com.file);
+			Common.log com ("Generating neko : " ^ com.file);
 			Genneko.generate com;
 		| Js ->
-			if com.verbose then print_endline ("Generating js : " ^ com.file);
+			Common.log com ("Generating js : " ^ com.file);
 			Genjs.generate com
 		| Php ->
-			if com.verbose then print_endline ("Generating PHP in : " ^ com.file);
+			Common.log com ("Generating PHP in : " ^ com.file);
 			Genphp.generate com;
 		| Cpp ->
-			if com.verbose then print_endline ("Generating Cpp in : " ^ com.file);
+			Common.log com ("Generating Cpp in : " ^ com.file);
 			Gencpp.generate com;
 		);
 	end;

+ 0 - 3
parser.ml

@@ -147,9 +147,6 @@ let property_ident = parser
 	| [< '(Kwd Dynamic,_) >] -> "dynamic"
 	| [< '(Kwd Default,_) >] -> "default"
 
-let log m s =
-	prerr_endline m
-
 let get_doc s =
 	let d = !doc in
 	doc := None;

+ 3 - 3
typeload.ml

@@ -28,7 +28,7 @@ let parse_file com file p =
 	let data = (try Parser.parse com (Lexing.from_channel ch) with e -> close_in ch; t(); raise e) in
 	close_in ch;
 	t();
-	if com.verbose then print_endline ("Parsed " ^ file);
+	Common.log com ("Parsed " ^ file);
 	data
 
 let parse_hook = ref parse_file
@@ -887,7 +887,7 @@ let init_class ctx c p herits fields =
 				| Some e ->
 					let r = exc_protect (fun r ->
 						r := (fun() -> t);
-						if ctx.com.verbose then print_endline ("Typing " ^ s_type_path c.cl_path ^ "." ^ name);
+						if ctx.com.verbose then Common.log ctx.com ("Typing " ^ s_type_path c.cl_path ^ "." ^ name);
 						mark_used cf;
 						cf.cf_expr <- Some (type_static_var ctx t e p);
 						cf.cf_type <- t;
@@ -971,7 +971,7 @@ let init_class ctx c p herits fields =
 			} in
 			let r = exc_protect (fun r ->
 				r := (fun() -> t);
-				if ctx.com.verbose then print_endline ("Typing " ^ s_type_path c.cl_path ^ "." ^ name);
+				if ctx.com.verbose then Common.log ctx.com ("Typing " ^ s_type_path c.cl_path ^ "." ^ name);
 				let e , fargs = type_function ctx args ret (if constr then FConstructor else if stat then FStatic else FMember) fd p in
 				let f = {
 					tf_args = fargs;

+ 4 - 4
typer.ml

@@ -1979,7 +1979,7 @@ let dce_finalize ctx =
 let dce_optimize ctx =
 	let check_class c =
 		let keep = dce_check_class ctx c in
-		let keep stat f = if not (keep stat f) then begin if ctx.com.verbose then print_endline ("Removing " ^ s_type_path c.cl_path ^ "." ^ f.cf_name); false; end else true in
+		let keep stat f = if not (keep stat f) then begin if ctx.com.verbose then Common.log ctx.com ("Removing " ^ s_type_path c.cl_path ^ "." ^ f.cf_name); false; end else true in
 		c.cl_constructor <- (match c.cl_constructor with Some f when not (keep false f) -> None | x -> x);
 		c.cl_ordered_fields <- List.filter (keep false) c.cl_ordered_fields;
 		c.cl_ordered_statics <- List.filter (keep true) c.cl_ordered_statics;
@@ -1994,12 +1994,12 @@ let dce_optimize ctx =
 			| _ when has_meta ":?used" c.cl_meta || has_meta ":keep" c.cl_meta || (match c.cl_constructor with Some f -> has_meta ":?used" f.cf_meta | _ -> false)
 				-> ()
 			| _ ->
-				if ctx.com.verbose then print_endline ("Removing " ^ s_type_path c.cl_path);
+				Common.log ctx.com ("Removing " ^ s_type_path c.cl_path);
 				c.cl_extern <- true;
 				(match c.cl_path with [],"Std" -> () | _ -> c.cl_init <- None);
 				c.cl_meta <- [":native",[(EConst (String "Dynamic"),c.cl_pos)],c.cl_pos]; (* make sure the type will not be referenced *)
 	in
-	if ctx.com.verbose then print_endline "Performing dead code optimization";
+	Common.log ctx.com "Performing dead code optimization";
 	Hashtbl.iter (fun _ m ->
 		List.iter (fun t ->
 			match t with
@@ -2063,7 +2063,7 @@ let generate ctx =
 		match state p with
 		| Done -> ()
 		| Generating ->
-			prerr_endline ("Warning : maybe loop in static generation of " ^ s_type_path p);
+			ctx.com.warning ("Warning : maybe loop in static generation of " ^ s_type_path p) (t_infos t).mt_pos;
 		| NotYet ->
 			Hashtbl.add states p Generating;
 			let t = (match t with