separate compilation server logic from main.ml

Makefile

@@ -52,7 +52,7 @@ CC_PARSER_CMD = $(COMPILER) -pp camlp4o $(ALL_CFLAGS) -c src/syntax/parser.ml
 
 RELDIR=../../..
 
-MODULES=json path syntax/ast display/displayTypes typing/type syntax/lexer typing/common generators/genxml syntax/parser \
+MODULES=json version globals path syntax/ast display/displayTypes typing/type syntax/lexer typing/common generators/genxml syntax/parser \
 	typing/typecore display/display \
 	optimization/optimizer typing/typeload generators/codegen generators/gencommon generators/genas3 \
 	generators/gencpp generators/genjs generators/genneko generators/genphp generators/genswf9 \
@@ -60,7 +60,7 @@ MODULES=json path syntax/ast display/displayTypes typing/type syntax/lexer typin
 	generators/genlua \
 	optimization/dce optimization/analyzerConfig optimization/analyzerTypes optimization/analyzerTexpr \
 	optimization/analyzerTexprTransformer optimization/analyzer \
-	optimization/filters typing/typer typing/matcher version main
+	optimization/filters typing/typer typing/matcher server main
 
 ADD_REVISION?=0
 
@@ -172,7 +172,7 @@ src/generators/genxml.$(MODULE_EXT): src/typing/type.$(MODULE_EXT) src/syntax/le
 
 # macro
 
-src/macro/interp.$(MODULE_EXT): src/path.$(MODULE_EXT) src/typing/typecore.$(MODULE_EXT) src/typing/type.$(MODULE_EXT) src/syntax/lexer.$(MODULE_EXT) src/generators/genneko.$(MODULE_EXT) src/typing/common.$(MODULE_EXT) src/generators/codegen.$(MODULE_EXT) src/syntax/ast.$(MODULE_EXT) src/generators/genswf.$(MODULE_EXT) src/generators/genjava.$(MODULE_EXT) src/generators/gencs.$(MODULE_EXT) src/syntax/parser.$(MODULE_EXT) libs/ilib/il.$(LIB_EXT)
+src/macro/interp.$(MODULE_EXT): src/globals.$(MODULE_EXT) src/path.$(MODULE_EXT) src/typing/typecore.$(MODULE_EXT) src/typing/type.$(MODULE_EXT) src/syntax/lexer.$(MODULE_EXT) src/generators/genneko.$(MODULE_EXT) src/typing/common.$(MODULE_EXT) src/generators/codegen.$(MODULE_EXT) src/syntax/ast.$(MODULE_EXT) src/generators/genswf.$(MODULE_EXT) src/generators/genjava.$(MODULE_EXT) src/generators/gencs.$(MODULE_EXT) src/syntax/parser.$(MODULE_EXT) libs/ilib/il.$(LIB_EXT)
 
 # optimization
 
@@ -215,10 +215,16 @@ src/typing/typeload.$(MODULE_EXT): src/path.$(MODULE_EXT) src/typing/typecore.$(
 
 src/typing/typer.$(MODULE_EXT): src/path.$(MODULE_EXT) src/typing/typeload.$(MODULE_EXT) src/typing/typecore.$(MODULE_EXT) src/typing/type.$(MODULE_EXT) src/syntax/parser.$(MODULE_EXT) src/optimization/optimizer.$(MODULE_EXT) src/syntax/lexer.$(MODULE_EXT) src/macro/interp.$(MODULE_EXT) src/typing/common.$(MODULE_EXT) src/generators/codegen.$(MODULE_EXT) src/syntax/ast.$(MODULE_EXT) src/optimization/filters.$(MODULE_EXT) src/generators/genjs.$(MODULE_EXT) src/generators/genlua.$(MODULE_EXT) src/display/display.$(MODULE_EXT)
 
-
 # main
 
-src/main.$(MODULE_EXT): src/path.$(MODULE_EXT) src/optimization/filters.$(MODULE_EXT) src/typing/matcher.$(MODULE_EXT) src/typing/typer.$(MODULE_EXT) src/typing/typeload.$(MODULE_EXT) src/typing/typecore.$(MODULE_EXT) src/typing/type.$(MODULE_EXT) src/syntax/parser.$(MODULE_EXT) src/optimization/optimizer.$(MODULE_EXT) src/syntax/lexer.$(MODULE_EXT) src/macro/interp.$(MODULE_EXT) src/generators/genxml.$(MODULE_EXT) src/generators/genswf.$(MODULE_EXT) src/generators/genphp.$(MODULE_EXT) src/generators/genneko.$(MODULE_EXT) src/generators/genjs.$(MODULE_EXT) src/generators/genlua.$(MODULE_EXT) src/generators/gencpp.$(MODULE_EXT) src/generators/genas3.$(MODULE_EXT) src/typing/common.$(MODULE_EXT) src/generators/codegen.$(MODULE_EXT) src/syntax/ast.$(MODULE_EXT) src/generators/genjava.$(MODULE_EXT) src/generators/gencs.$(MODULE_EXT) src/generators/genpy.$(MODULE_EXT) src/generators/genhl.$(MODULE_EXT) src/version.$(MODULE_EXT) src/display/display.$(MODULE_EXT) libs/ilib/il.$(LIB_EXT)
+src/main.$(MODULE_EXT): src/globals.$(MODULE_EXT) src/path.$(MODULE_EXT) src/optimization/filters.$(MODULE_EXT) src/typing/matcher.$(MODULE_EXT) src/typing/typer.$(MODULE_EXT) src/typing/typeload.$(MODULE_EXT) src/typing/typecore.$(MODULE_EXT) src/typing/type.$(MODULE_EXT) src/syntax/parser.$(MODULE_EXT) src/optimization/optimizer.$(MODULE_EXT) src/syntax/lexer.$(MODULE_EXT) src/macro/interp.$(MODULE_EXT) src/generators/genxml.$(MODULE_EXT) src/generators/genswf.$(MODULE_EXT) src/generators/genphp.$(MODULE_EXT) src/generators/genneko.$(MODULE_EXT) src/generators/genjs.$(MODULE_EXT) src/generators/genlua.$(MODULE_EXT) src/generators/gencpp.$(MODULE_EXT) src/generators/genas3.$(MODULE_EXT) src/typing/common.$(MODULE_EXT) src/generators/codegen.$(MODULE_EXT) src/syntax/ast.$(MODULE_EXT) src/generators/genjava.$(MODULE_EXT) src/generators/gencs.$(MODULE_EXT) src/generators/genpy.$(MODULE_EXT) src/generators/genhl.$(MODULE_EXT) src/display/display.$(MODULE_EXT) src/server.$(MODULE_EXT) libs/ilib/il.$(LIB_EXT)
+
+src/globals.$(MODULE_EXT): src/version.$(MODULE_EXT)
+
+src/path.$(MODULE_EXT): src/globals.$(MODULE_EXT)
+
+src/server.$(MODULE_EXT): src/globals.$(MODULE_EXT)
+
 
 src/version.$(MODULE_EXT):
 	$(MAKE) -f Makefile.version_extra -s --no-print-directory ADD_REVISION=$(ADD_REVISION) BRANCH=$(BRANCH) COMMIT_SHA=$(COMMIT_SHA) COMMIT_DATE=$(COMMIT_DATE) > src/version.ml

src/globals.ml

@@ -0,0 +1,10 @@
+let version = 3300
+let version_major = version / 1000
+let version_minor = (version mod 1000) / 100
+let version_revision = (version mod 100)
+let version_is_stable = version_minor land 1 = 0
+
+let is_windows = Sys.os_type = "Win32" || Sys.os_type = "Cygwin"
+
+let s_version =
+	Printf.sprintf "%d.%d.%d%s" version_major version_minor version_revision (match Version.version_extra with None -> "" | Some v -> " " ^ v)

src/macro/interp.ml

@@ -511,7 +511,7 @@ let rec dlopen dls =
 		None
 
 let neko =
-	match dlopen (if Path.is_windows then
+	match dlopen (if Globals.is_windows then
 		["neko.dll"]
 	else
 		(*

src/main.ml

@@ -48,39 +48,13 @@ open Genswf
 open Common
 open Common.DisplayMode
 open Type
-
-type context = {
-	com : Common.context;
-	mutable flush : unit -> unit;
-	mutable setup : unit -> unit;
-	mutable messages : string list;
-	mutable has_next : bool;
-	mutable has_error : bool;
-}
+open Server
 
 exception Abort
-exception Completion of string
-
-let version = 3300
-let version_major = version / 1000
-let version_minor = (version mod 1000) / 100
-let version_revision = (version mod 100)
-let version_is_stable = version_minor land 1 = 0
-
-let measure_times = ref false
-let prompt = ref false
-let start_time = ref (get_time())
-
 
 let executable_path() =
 	Extc.executable_path()
 
-let is_debug_run() =
-	try Sys.getenv "HAXEDEBUG" = "1" with _ -> false
-
-let s_version =
-	Printf.sprintf "%d.%d.%d%s" version_major version_minor version_revision (match Version.version_extra with None -> "" | Some v -> " " ^ v)
-
 let format msg p =
 	if p = Ast.null_pos then
 		msg
@@ -91,16 +65,6 @@ let format msg p =
 		sprintf "%s : %s" epos msg
 	end
 
-let ssend sock str =
-	let rec loop pos len =
-		if len = 0 then
-			()
-		else
-			let s = Unix.send sock str pos len [] in
-			loop (pos + s) (len - s)
-	in
-	loop 0 (String.length str)
-
 let message ctx msg p =
 	ctx.messages <- format msg p :: ctx.messages
 
@@ -150,17 +114,6 @@ let reserved_flags = [
 	"as3";"swc";"macro";"sys"
 	]
 
-
-let report_times print =
-	let tot = ref 0. in
-	Hashtbl.iter (fun _ t -> tot := !tot +. t.total) Common.htimers;
-	print (Printf.sprintf "Total time : %.3fs" !tot);
-	if !tot > 0. then begin
-		print "------------------------------------";
-		let timers = List.sort (fun t1 t2 -> compare t1.name t2.name) (Hashtbl.fold (fun _ t acc -> t :: acc) Common.htimers []) in
-		List.iter (fun t -> print (Printf.sprintf "  %s : %.3fs, %.0f%%" t.name t.total (t.total *. 100. /. !tot))) timers
-	end
-
 let unique l =
 	let rec _unique = function
 		| [] -> []
@@ -330,32 +283,6 @@ let expand_env ?(h=None) path  =
 			"%" ^ key ^ "%"
 	) path
 
-let unquote v =
-	let len = String.length v in
-	if len > 0 && v.[0] = '"' && v.[len - 1] = '"' then String.sub v 1 (len - 2) else v
-
-let parse_hxml_data data =
-	let lines = Str.split (Str.regexp "[\r\n]+") data in
-	List.concat (List.map (fun l ->
-		let l = unquote (ExtString.String.strip l) in
-		if l = "" || l.[0] = '#' then
-			[]
-		else if l.[0] = '-' then
-			try
-				let a, b = ExtString.String.split l " " in
-				[unquote a; unquote (ExtString.String.strip b)]
-			with
-				_ -> [l]
-		else
-			[l]
-	) lines)
-
-let parse_hxml file =
-	let ch = IO.input_channel (try open_in_bin file with _ -> raise Not_found) in
-	let data = IO.read_all ch in
-	IO.close_in ch;
-	parse_hxml_data data
-
 let add_libs com libs =
 	let call_haxelib() =
 		let t = Common.timer "haxelib" in
@@ -415,7 +342,7 @@ let run_command ctx cmd =
 		0
 	end else
 	let binary_string s =
-		if not Path.is_windows then s else String.concat "\n" (Str.split (Str.regexp "\r\n") s)
+		if not Globals.is_windows then s else String.concat "\n" (Str.split (Str.regexp "\r\n") s)
 	in
 	let pout, pin, perr = Unix.open_process_full cmd (Unix.environment()) in
 	let iout = Unix.descr_of_in_channel pout in
@@ -575,26 +502,6 @@ let display_memory ctx =
 		print "Cache dump complete")
 
 module Initialize = struct
-	let default_flush ctx =
-		List.iter prerr_endline (List.rev ctx.messages);
-		if ctx.has_error && !prompt then begin
-			print_endline "Press enter to exit...";
-			ignore(read_line());
-		end;
-		if ctx.has_error then exit 1
-
-	let create_context params =
-		let ctx = {
-			com = Common.create version s_version params;
-			flush = (fun()->());
-			setup = (fun()->());
-			messages = [];
-			has_next = false;
-			has_error = false;
-		} in
-		ctx.flush <- (fun() -> default_flush ctx);
-		ctx
-
 	let set_platform com pf file =
 		if com.platform <> Cross then failwith "Multiple targets";
 		Common.init_platform com pf;
@@ -790,364 +697,12 @@ let rec process_params create pl =
 	) in
 	loop [] pl
 
-and wait_loop verbose accept =
-	Sys.catch_break false;
-	let has_parse_error = ref false in
-	let cache = {
-		c_haxelib = Hashtbl.create 0;
-		c_files = Hashtbl.create 0;
-		c_modules = Hashtbl.create 0;
-	} in
-	global_cache := Some cache;
-	Typer.macro_enable_cache := true;
-	let current_stdin = ref None in
-	Typeload.parse_hook := (fun com2 file p ->
-		let ffile = Path.unique_full_path file in
-		let is_display_file = ffile = (!Parser.resume_display).Ast.pfile in
 
-		match is_display_file, !current_stdin with
-		| true, Some stdin when Common.defined com2 Define.DisplayStdin ->
-			Typeload.parse_file_from_string com2 file p stdin
-		| _ ->
-			let sign = get_signature com2 in
-			let ftime = file_time ffile in
-			let fkey = (ffile,sign) in
-			try
-				let time, data = Hashtbl.find cache.c_files fkey in
-				if time <> ftime then raise Not_found;
-				data
-			with Not_found ->
-				has_parse_error := false;
-				let data = Typeload.parse_file com2 file p in
-				if verbose then print_endline ("Parsed " ^ ffile);
-				if not !has_parse_error && (not is_display_file) then Hashtbl.replace cache.c_files fkey (ftime,data);
-				data
-	);
-	let cache_module m =
-		Hashtbl.replace cache.c_modules (m.m_path,m.m_extra.m_sign) m;
-	in
-	let check_module_path com m p =
-		if m.m_extra.m_file <> Path.unique_full_path (Typeload.resolve_module_file com m.m_path (ref[]) p) then begin
-			if verbose then print_endline ("Module path " ^ s_type_path m.m_path ^ " has been changed");
-			raise Not_found;
-		end
-	in
-	let compilation_step = ref 0 in
-	let compilation_mark = ref 0 in
-	let mark_loop = ref 0 in
-	Typeload.type_module_hook := (fun (ctx:Typecore.typer) mpath p ->
-		let t = Common.timer "module cache check" in
-		let com2 = ctx.Typecore.com in
-		let sign = get_signature com2 in
-		let dep = ref None in
-		incr mark_loop;
-		let mark = !mark_loop in
-		let start_mark = !compilation_mark in
-		let rec check m =
-			if m.m_extra.m_dirty then begin
-				dep := Some m;
-				false
-			end else if m.m_extra.m_mark = mark then
-				true
-			else try
-				if m.m_extra.m_mark <= start_mark then begin
-					(match m.m_extra.m_kind with
-					| MFake | MSub | MImport -> () (* don't get classpath *)
-					| MExtern ->
-						(* if we have a file then this will override our extern type *)
-						let has_file = (try ignore(Typeload.resolve_module_file com2 m.m_path (ref[]) p); true with Not_found -> false) in
-						if has_file then begin
-							if verbose then print_endline ("A file is masking the library file " ^ s_type_path m.m_path);
-							raise Not_found;
-						end;
-						let rec loop = function
-							| [] ->
-								if verbose then print_endline ("No library file was found for " ^ s_type_path m.m_path);
-								raise Not_found (* no extern registration *)
-							| load :: l ->
-								match load m.m_path p with
-								| None -> loop l
-								| Some (file,_) ->
-									if Path.unique_full_path file <> m.m_extra.m_file then begin
-										if verbose then print_endline ("Library file was changed for " ^ s_type_path m.m_path);
-										raise Not_found;
-									end
-						in
-						loop com2.load_extern_type
-					| MCode -> check_module_path com2 m p
-					| MMacro when ctx.Typecore.in_macro -> check_module_path com2 m p
-					| MMacro ->
-						let _, mctx = Typer.get_macro_context ctx p in
-						check_module_path mctx.Typecore.com m p
-					);
-					if file_time m.m_extra.m_file <> m.m_extra.m_time then begin
-						if verbose then print_endline ("File " ^ m.m_extra.m_file ^ (if m.m_extra.m_time = -1. then " not cached (macro-in-macro)" else " has been modified"));
-						if m.m_extra.m_kind = MFake then Hashtbl.remove Typecore.fake_modules m.m_extra.m_file;
-						raise Not_found;
-					end;
-				end;
-				m.m_extra.m_mark <- mark;
-				PMap.iter (fun _ m2 -> if not (check m2) then begin dep := Some m2; raise Not_found end) m.m_extra.m_deps;
-				true
-			with Not_found ->
-				m.m_extra.m_dirty <- true;
-				false
-		in
-		let rec add_modules m0 m =
-			if m.m_extra.m_added < !compilation_step then begin
-				(match m0.m_extra.m_kind, m.m_extra.m_kind with
-				| MCode, MMacro | MMacro, MCode ->
-					(* this was just a dependency to check : do not add to the context *)
-					PMap.iter (Hashtbl.replace com2.resources) m.m_extra.m_binded_res;
-				| _ ->
-					if verbose then print_endline ("Reusing  cached module " ^ Ast.s_type_path m.m_path);
-					m.m_extra.m_added <- !compilation_step;
-					List.iter (fun t ->
-						match t with
-						| TClassDecl c -> c.cl_restore()
-						| TEnumDecl e ->
-							let rec loop acc = function
-								| [] -> ()
-								| (Ast.Meta.RealPath,[Ast.EConst (Ast.String path),_],_) :: l ->
-									e.e_path <- Ast.parse_path path;
-									e.e_meta <- (List.rev acc) @ l;
-								| x :: l -> loop (x::acc) l
-							in
-							loop [] e.e_meta
-						| TAbstractDecl a ->
-							a.a_meta <- List.filter (fun (m,_,_) -> m <> Ast.Meta.ValueUsed) a.a_meta
-						| _ -> ()
-					) m.m_types;
-					if m.m_extra.m_kind <> MSub then Typeload.add_module ctx m p;
-					PMap.iter (Hashtbl.replace com2.resources) m.m_extra.m_binded_res;
-					PMap.iter (fun _ m2 -> add_modules m0 m2) m.m_extra.m_deps);
-					List.iter (Typer.call_init_macro ctx) m.m_extra.m_macro_calls
-			end
-		in
-		try
-			let m = Hashtbl.find cache.c_modules (mpath,sign) in
-			if not (check m) then begin
-				if verbose then print_endline ("Skipping cached module " ^ Ast.s_type_path mpath ^ (match !dep with None -> "" | Some m -> "(" ^ Ast.s_type_path m.m_path ^ ")"));
-				raise Not_found;
-			end;
-			add_modules m m;
-			t();
-			Some m
-		with Not_found ->
-			t();
-			None
-	);
-	let run_count = ref 0 in
-	while true do
-		let read, write, close = accept() in
-		let t0 = get_time() in
-		let rec cache_context com =
-			if com.display.dms_full_typing then begin
-				List.iter cache_module com.modules;
-				if verbose then print_endline ("Cached " ^ string_of_int (List.length com.modules) ^ " modules");
-			end;
-			match com.get_macros() with
-			| None -> ()
-			| Some com -> cache_context com
-		in
-		let create params =
-			let ctx = Initialize.create_context params in
-			ctx.flush <- (fun() ->
-				incr compilation_step;
-				compilation_mark := !mark_loop;
-				List.iter (fun s -> write (s ^ "\n"); if verbose then print_endline ("> " ^ s)) (List.rev ctx.messages);
-				if ctx.has_error then write "\x02\n" else cache_context ctx.com;
-			);
-			ctx.setup <- (fun() ->
-				if verbose then begin
-					let defines = PMap.foldi (fun k v acc -> (k ^ "=" ^ v) :: acc) ctx.com.defines [] in
-					print_endline ("Defines " ^ (String.concat "," (List.sort compare defines)));
-					print_endline ("Using signature " ^ Digest.to_hex (get_signature ctx.com));
-				end;
-				Parser.display_error := (fun e p -> has_parse_error := true; ctx.com.error (Parser.error_msg e) p);
-				if ctx.com.display.dms_display then begin
-					let file = (!Parser.resume_display).Ast.pfile in
-					let fkey = (file,get_signature ctx.com) in
-					(* force parsing again : if the completion point have been changed *)
-					Hashtbl.remove cache.c_files fkey;
-					(* force module reloading (if cached) *)
-					Hashtbl.iter (fun _ m -> if m.m_extra.m_file = file then m.m_extra.m_dirty <- true) cache.c_modules
-				end
-			);
-			ctx.com.print <- (fun str -> write ("\x01" ^ String.concat "\x01" (ExtString.String.nsplit str "\n") ^ "\n"));
-			ctx
-		in
-		(try
-			let s = read() in
-			let hxml =
-				try
-					let idx = String.index s '\001' in
-					current_stdin := Some (String.sub s (idx + 1) ((String.length s) - idx - 1));
-					(String.sub s 0 idx)
-				with Not_found ->
-					s
-			in
-			let data = parse_hxml_data hxml in
-			if verbose then print_endline ("Processing Arguments [" ^ String.concat "," data ^ "]");
-			(try
-				Common.display_default := DMNone;
-				Parser.resume_display := Ast.null_pos;
-				Typeload.return_partial_type := false;
-				measure_times := false;
-				close_times();
-				stats.s_files_parsed := 0;
-				stats.s_classes_built := 0;
-				stats.s_methods_typed := 0;
-				stats.s_macros_called := 0;
-				Hashtbl.clear Common.htimers;
-				let _ = Common.timer "other" in
-				incr compilation_step;
-				compilation_mark := !mark_loop;
-				start_time := get_time();
-				process_params create data;
-				close_times();
-				if !measure_times then report_times (fun s -> write (s ^ "\n"))
-			with
-			| Completion str ->
-				if verbose then print_endline ("Completion Response =\n" ^ str);
-				write str
-			| Arg.Bad msg ->
-				prerr_endline ("Error: " ^ msg);
-			);
-			if verbose then begin
-				print_endline (Printf.sprintf "Stats = %d files, %d classes, %d methods, %d macros" !(stats.s_files_parsed) !(stats.s_classes_built) !(stats.s_methods_typed) !(stats.s_macros_called));
-				print_endline (Printf.sprintf "Time spent : %.3fs" (get_time() -. t0));
-			end
-		with Unix.Unix_error _ ->
-			if verbose then print_endline "Connection Aborted"
-		| e ->
-			let estr = Printexc.to_string e in
-			if verbose then print_endline ("Uncaught Error : " ^ estr);
-			(try write estr with _ -> ());
-			if is_debug_run() then print_endline (Printexc.get_backtrace());
-		);
-		close();
-		current_stdin := None;
-		(* prevent too much fragmentation by doing some compactions every X run *)
-		incr run_count;
-		if !run_count mod 10 = 0 then begin
-			let t0 = get_time() in
-			Gc.compact();
-			if verbose then begin
-				let stat = Gc.quick_stat() in
-				let size = (float_of_int stat.Gc.heap_words) *. 4. in
-				print_endline (Printf.sprintf "Compacted memory %.3fs %.1fMB" (get_time() -. t0) (size /. (1024. *. 1024.)));
-			end
-		end else Gc.minor();
-	done
-
-and init_wait_stdio() =
-	set_binary_mode_in stdin true;
-	set_binary_mode_out stderr true;
-
-	let chin = IO.input_channel stdin in
-	let cherr = IO.output_channel stderr in
-
-	let berr = Buffer.create 0 in
-	let read = fun () ->
-		let len = IO.read_i32 chin in
-		IO.really_nread chin len
-	in
-	let write = Buffer.add_string berr in
-	let close = fun() ->
-		IO.write_i32 cherr (Buffer.length berr);
-		IO.nwrite cherr (Buffer.contents berr);
-		IO.flush cherr
-	in
-	fun() ->
-		Buffer.clear berr;
-		read, write, close
-
-and init_wait_socket verbose host port =
-	let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
-	(try Unix.setsockopt sock Unix.SO_REUSEADDR true with _ -> ());
-	(try Unix.bind sock (Unix.ADDR_INET (Unix.inet_addr_of_string host,port)) with _ -> failwith ("Couldn't wait on " ^ host ^ ":" ^ string_of_int port));
-	if verbose then print_endline ("Waiting on " ^ host ^ ":" ^ string_of_int port);
-	Unix.listen sock 10;
-	let bufsize = 1024 in
-	let tmp = String.create bufsize in
-	let accept() = (
-		let sin, _ = Unix.accept sock in
-		Unix.set_nonblock sin;
-		if verbose then print_endline "Client connected";
-		let b = Buffer.create 0 in
-		let rec read_loop count =
-			try
-				let r = Unix.recv sin tmp 0 bufsize [] in
-				if r = 0 then
-					failwith "Incomplete request"
-				else begin
-					if verbose then Printf.printf "Reading %d bytes\n" r;
-					Buffer.add_substring b tmp 0 r;
-					if tmp.[r-1] = '\000' then
-						Buffer.sub b 0 (Buffer.length b - 1)
-					else
-						read_loop 0
-				end
-			with Unix.Unix_error((Unix.EWOULDBLOCK|Unix.EAGAIN),_,_) ->
-				if count = 100 then
-					failwith "Aborting inactive connection"
-				else begin
-					if verbose then print_endline "Waiting for data...";
-					ignore(Unix.select [] [] [] 0.05); (* wait a bit *)
-					read_loop (count + 1);
-				end
-		in
-		let read = fun() -> (let s = read_loop 0 in Unix.clear_nonblock sin; s) in
-		let write = ssend sin in
-		let close() = Unix.close sin in
-		read, write, close
-	) in
-	accept
-
-and do_connect host port args =
-	let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
-	(try Unix.connect sock (Unix.ADDR_INET (Unix.inet_addr_of_string host,port)) with _ -> failwith ("Couldn't connect on " ^ host ^ ":" ^ string_of_int port));
-	let args = ("--cwd " ^ Unix.getcwd()) :: args in
-	ssend sock (String.concat "" (List.map (fun a -> a ^ "\n") args) ^ "\000");
-	let has_error = ref false in
-	let rec print line =
-		match (if line = "" then '\x00' else line.[0]) with
-		| '\x01' ->
-			print_string (String.concat "\n" (List.tl (ExtString.String.nsplit line "\x01")));
-			flush stdout
-		| '\x02' ->
-			has_error := true;
-		| _ ->
-			prerr_endline line;
-	in
-	let buf = Buffer.create 0 in
-	let process() =
-		let lines = ExtString.String.nsplit (Buffer.contents buf) "\n" in
-		(* the last line ends with \n *)
-		let lines = (match List.rev lines with "" :: l -> List.rev l | _ -> lines) in
-		List.iter print lines;
-	in
-	let tmp = String.create 1024 in
-	let rec loop() =
-		let b = Unix.recv sock tmp 0 1024 [] in
-		Buffer.add_substring buf tmp 0 b;
-		if b > 0 then begin
-			if String.get tmp (b - 1) = '\n' then begin
-				process();
-				Buffer.reset buf;
-			end;
-			loop();
-		end
-	in
-	loop();
-	process();
-	if !has_error then exit 1
 
 and init ctx =
 	let usage = Printf.sprintf
 		"Haxe Compiler %s - (C)2005-2016 Haxe Foundation\n Usage : haxe%s -main <class> [-swf|-js|-neko|-php|-cpp|-cppia|-as3|-cs|-java|-python|-hl|-lua] <output> [options]\n Options :"
-		s_version (if Sys.os_type = "Win32" then ".exe" else "")
+		Globals.s_version (if Sys.os_type = "Win32" then ".exe" else "")
 	in
 	let com = ctx.com in
 	let classes = ref [([],"Std")] in
@@ -1165,7 +720,7 @@ try
 	let interp = ref false in
 	let swf_version = ref false in
 	let evals = ref [] in
-	Common.define_value com Define.HaxeVer (float_repres (float_of_int version /. 1000.));
+	Common.define_value com Define.HaxeVer (float_repres (float_of_int Globals.version /. 1000.));
 	Common.raw_define com "haxe3";
 	Common.define_value com Define.Dce "std";
 	com.warning <- (fun msg p -> message ctx ("Warning : " ^ msg) p);
@@ -1486,13 +1041,13 @@ try
 		("--wait", Arg.String (fun hp ->
 			let accept = match hp with
 				| "stdio" ->
-					init_wait_stdio()
+					Server.init_wait_stdio()
 				| _ ->
 					let host, port = (try ExtString.String.split hp ":" with _ -> "127.0.0.1", hp) in
 					let port = try int_of_string port with _ -> raise (Arg.Bad "Invalid port") in
 					init_wait_socket com.verbose host port
 			in
-			wait_loop com.verbose accept
+			wait_loop process_params com.verbose accept
 		),"<[host:]port> : wait on the given port for commands to run)");
 		("--connect",Arg.String (fun _ ->
 			assert false
@@ -1501,7 +1056,7 @@ try
 			assert false
 		),"<dir> : set current working directory");
 		("-version",Arg.Unit (fun() ->
-			message ctx s_version Ast.null_pos;
+			message ctx Globals.s_version Ast.null_pos;
 			did_something := true;
 		),": print version and exit");
 		("--help-defines", Arg.Unit (fun() ->
@@ -1708,7 +1263,7 @@ let args = List.tl (Array.to_list Sys.argv) in
 	let host, port = (try ExtString.String.split server ":" with _ -> "127.0.0.1", server) in
 	do_connect host (try int_of_string port with _ -> failwith "Invalid HAXE_COMPILATION_SERVER port") args
 with Not_found -> try
-	process_params Initialize.create_context args
+	process_params create_context args
 with Completion c ->
 	prerr_endline c;
 	exit 0

src/path.ml

@@ -83,8 +83,7 @@ let normalize_path path =
 	in
 	String.concat "/" (normalize [] (Str.full_split path_regex path))
 
-let is_windows = Sys.os_type = "Win32" || Sys.os_type = "Cygwin"
-let path_sep = if is_windows then "\\" else "/"
+let path_sep = if Globals.is_windows then "\\" else "/"
 
 (** Returns absolute path. Doesn't fix path case on Windows. *)
 let get_full_path f = try Extc.get_full_path f with _ -> f
@@ -92,7 +91,7 @@ let get_full_path f = try Extc.get_full_path f with _ -> f
 (** Returns absolute path (on Windows ensures proper case with drive letter upper-cased)
     Use for returning positions from IDE support functions *)
 let get_real_path =
-	if is_windows then
+	if Globals.is_windows then
 		(fun p -> try Extc.get_real_path p with _ -> p)
 	else
 		get_full_path
@@ -100,7 +99,7 @@ let get_real_path =
 (** Returns absolute path guaranteed to be the same for different letter case.
     Use where equality comparison is required, lowercases the path on Windows *)
 let unique_full_path =
-	if is_windows then
+	if Globals.is_windows then
 		(fun f -> String.lowercase (get_full_path f))
 	else
 		get_full_path

src/server.ml

@@ -0,0 +1,444 @@
+open Printf
+open Ast
+open Genswf
+open Common
+open Common.DisplayMode
+open Type
+
+exception Completion of string
+
+let measure_times = ref false
+let prompt = ref false
+let start_time = ref (get_time())
+
+let is_debug_run() =
+	try Sys.getenv "HAXEDEBUG" = "1" with _ -> false
+
+type context = {
+	com : Common.context;
+	mutable flush : unit -> unit;
+	mutable setup : unit -> unit;
+	mutable messages : string list;
+	mutable has_next : bool;
+	mutable has_error : bool;
+}
+
+let report_times print =
+	let tot = ref 0. in
+	Hashtbl.iter (fun _ t -> tot := !tot +. t.total) Common.htimers;
+	print (Printf.sprintf "Total time : %.3fs" !tot);
+	if !tot > 0. then begin
+		print "------------------------------------";
+		let timers = List.sort (fun t1 t2 -> compare t1.name t2.name) (Hashtbl.fold (fun _ t acc -> t :: acc) Common.htimers []) in
+		List.iter (fun t -> print (Printf.sprintf "  %s : %.3fs, %.0f%%" t.name t.total (t.total *. 100. /. !tot))) timers
+	end
+
+let default_flush ctx =
+	List.iter prerr_endline (List.rev ctx.messages);
+	if ctx.has_error && !prompt then begin
+		print_endline "Press enter to exit...";
+		ignore(read_line());
+	end;
+	if ctx.has_error then exit 1
+
+let create_context params =
+	let ctx = {
+		com = Common.create Globals.version Globals.s_version params;
+		flush = (fun()->());
+		setup = (fun()->());
+		messages = [];
+		has_next = false;
+		has_error = false;
+	} in
+	ctx.flush <- (fun() -> default_flush ctx);
+	ctx
+
+let unquote v =
+	let len = String.length v in
+	if len > 0 && v.[0] = '"' && v.[len - 1] = '"' then String.sub v 1 (len - 2) else v
+
+let parse_hxml_data data =
+	let lines = Str.split (Str.regexp "[\r\n]+") data in
+	List.concat (List.map (fun l ->
+		let l = unquote (ExtString.String.strip l) in
+		if l = "" || l.[0] = '#' then
+			[]
+		else if l.[0] = '-' then
+			try
+				let a, b = ExtString.String.split l " " in
+				[unquote a; unquote (ExtString.String.strip b)]
+			with
+				_ -> [l]
+		else
+			[l]
+	) lines)
+
+let parse_hxml file =
+	let ch = IO.input_channel (try open_in_bin file with _ -> raise Not_found) in
+	let data = IO.read_all ch in
+	IO.close_in ch;
+	parse_hxml_data data
+
+let ssend sock str =
+	let rec loop pos len =
+		if len = 0 then
+			()
+		else
+			let s = Unix.send sock str pos len [] in
+			loop (pos + s) (len - s)
+	in
+	loop 0 (String.length str)
+
+let rec wait_loop process_params verbose accept =
+	Sys.catch_break false;
+	let has_parse_error = ref false in
+	let cache = {
+		c_haxelib = Hashtbl.create 0;
+		c_files = Hashtbl.create 0;
+		c_modules = Hashtbl.create 0;
+	} in
+	global_cache := Some cache;
+	Typer.macro_enable_cache := true;
+	let current_stdin = ref None in
+	Typeload.parse_hook := (fun com2 file p ->
+		let ffile = Path.unique_full_path file in
+		let is_display_file = ffile = (!Parser.resume_display).Ast.pfile in
+
+		match is_display_file, !current_stdin with
+		| true, Some stdin when Common.defined com2 Define.DisplayStdin ->
+			Typeload.parse_file_from_string com2 file p stdin
+		| _ ->
+			let sign = get_signature com2 in
+			let ftime = file_time ffile in
+			let fkey = (ffile,sign) in
+			try
+				let time, data = Hashtbl.find cache.c_files fkey in
+				if time <> ftime then raise Not_found;
+				data
+			with Not_found ->
+				has_parse_error := false;
+				let data = Typeload.parse_file com2 file p in
+				if verbose then print_endline ("Parsed " ^ ffile);
+				if not !has_parse_error && (not is_display_file) then Hashtbl.replace cache.c_files fkey (ftime,data);
+				data
+	);
+	let cache_module m =
+		Hashtbl.replace cache.c_modules (m.m_path,m.m_extra.m_sign) m;
+	in
+	let check_module_path com m p =
+		if m.m_extra.m_file <> Path.unique_full_path (Typeload.resolve_module_file com m.m_path (ref[]) p) then begin
+			if verbose then print_endline ("Module path " ^ s_type_path m.m_path ^ " has been changed");
+			raise Not_found;
+		end
+	in
+	let compilation_step = ref 0 in
+	let compilation_mark = ref 0 in
+	let mark_loop = ref 0 in
+	Typeload.type_module_hook := (fun (ctx:Typecore.typer) mpath p ->
+		let t = Common.timer "module cache check" in
+		let com2 = ctx.Typecore.com in
+		let sign = get_signature com2 in
+		let dep = ref None in
+		incr mark_loop;
+		let mark = !mark_loop in
+		let start_mark = !compilation_mark in
+		let rec check m =
+			if m.m_extra.m_dirty then begin
+				dep := Some m;
+				false
+			end else if m.m_extra.m_mark = mark then
+				true
+			else try
+				if m.m_extra.m_mark <= start_mark then begin
+					(match m.m_extra.m_kind with
+					| MFake | MSub | MImport -> () (* don't get classpath *)
+					| MExtern ->
+						(* if we have a file then this will override our extern type *)
+						let has_file = (try ignore(Typeload.resolve_module_file com2 m.m_path (ref[]) p); true with Not_found -> false) in
+						if has_file then begin
+							if verbose then print_endline ("A file is masking the library file " ^ s_type_path m.m_path);
+							raise Not_found;
+						end;
+						let rec loop = function
+							| [] ->
+								if verbose then print_endline ("No library file was found for " ^ s_type_path m.m_path);
+								raise Not_found (* no extern registration *)
+							| load :: l ->
+								match load m.m_path p with
+								| None -> loop l
+								| Some (file,_) ->
+									if Path.unique_full_path file <> m.m_extra.m_file then begin
+										if verbose then print_endline ("Library file was changed for " ^ s_type_path m.m_path);
+										raise Not_found;
+									end
+						in
+						loop com2.load_extern_type
+					| MCode -> check_module_path com2 m p
+					| MMacro when ctx.Typecore.in_macro -> check_module_path com2 m p
+					| MMacro ->
+						let _, mctx = Typer.get_macro_context ctx p in
+						check_module_path mctx.Typecore.com m p
+					);
+					if file_time m.m_extra.m_file <> m.m_extra.m_time then begin
+						if verbose then print_endline ("File " ^ m.m_extra.m_file ^ (if m.m_extra.m_time = -1. then " not cached (macro-in-macro)" else " has been modified"));
+						if m.m_extra.m_kind = MFake then Hashtbl.remove Typecore.fake_modules m.m_extra.m_file;
+						raise Not_found;
+					end;
+				end;
+				m.m_extra.m_mark <- mark;
+				PMap.iter (fun _ m2 -> if not (check m2) then begin dep := Some m2; raise Not_found end) m.m_extra.m_deps;
+				true
+			with Not_found ->
+				m.m_extra.m_dirty <- true;
+				false
+		in
+		let rec add_modules m0 m =
+			if m.m_extra.m_added < !compilation_step then begin
+				(match m0.m_extra.m_kind, m.m_extra.m_kind with
+				| MCode, MMacro | MMacro, MCode ->
+					(* this was just a dependency to check : do not add to the context *)
+					PMap.iter (Hashtbl.replace com2.resources) m.m_extra.m_binded_res;
+				| _ ->
+					if verbose then print_endline ("Reusing  cached module " ^ Ast.s_type_path m.m_path);
+					m.m_extra.m_added <- !compilation_step;
+					List.iter (fun t ->
+						match t with
+						| TClassDecl c -> c.cl_restore()
+						| TEnumDecl e ->
+							let rec loop acc = function
+								| [] -> ()
+								| (Ast.Meta.RealPath,[Ast.EConst (Ast.String path),_],_) :: l ->
+									e.e_path <- Ast.parse_path path;
+									e.e_meta <- (List.rev acc) @ l;
+								| x :: l -> loop (x::acc) l
+							in
+							loop [] e.e_meta
+						| TAbstractDecl a ->
+							a.a_meta <- List.filter (fun (m,_,_) -> m <> Ast.Meta.ValueUsed) a.a_meta
+						| _ -> ()
+					) m.m_types;
+					if m.m_extra.m_kind <> MSub then Typeload.add_module ctx m p;
+					PMap.iter (Hashtbl.replace com2.resources) m.m_extra.m_binded_res;
+					PMap.iter (fun _ m2 -> add_modules m0 m2) m.m_extra.m_deps);
+					List.iter (Typer.call_init_macro ctx) m.m_extra.m_macro_calls
+			end
+		in
+		try
+			let m = Hashtbl.find cache.c_modules (mpath,sign) in
+			if not (check m) then begin
+				if verbose then print_endline ("Skipping cached module " ^ Ast.s_type_path mpath ^ (match !dep with None -> "" | Some m -> "(" ^ Ast.s_type_path m.m_path ^ ")"));
+				raise Not_found;
+			end;
+			add_modules m m;
+			t();
+			Some m
+		with Not_found ->
+			t();
+			None
+	);
+	let run_count = ref 0 in
+	while true do
+		let read, write, close = accept() in
+		let t0 = get_time() in
+		let rec cache_context com =
+			if com.display.dms_full_typing then begin
+				List.iter cache_module com.modules;
+				if verbose then print_endline ("Cached " ^ string_of_int (List.length com.modules) ^ " modules");
+			end;
+			match com.get_macros() with
+			| None -> ()
+			| Some com -> cache_context com
+		in
+		let create params =
+			let ctx = create_context params in
+			ctx.flush <- (fun() ->
+				incr compilation_step;
+				compilation_mark := !mark_loop;
+				List.iter (fun s -> write (s ^ "\n"); if verbose then print_endline ("> " ^ s)) (List.rev ctx.messages);
+				if ctx.has_error then write "\x02\n" else cache_context ctx.com;
+			);
+			ctx.setup <- (fun() ->
+				if verbose then begin
+					let defines = PMap.foldi (fun k v acc -> (k ^ "=" ^ v) :: acc) ctx.com.defines [] in
+					print_endline ("Defines " ^ (String.concat "," (List.sort compare defines)));
+					print_endline ("Using signature " ^ Digest.to_hex (get_signature ctx.com));
+				end;
+				Parser.display_error := (fun e p -> has_parse_error := true; ctx.com.error (Parser.error_msg e) p);
+				if ctx.com.display.dms_display then begin
+					let file = (!Parser.resume_display).Ast.pfile in
+					let fkey = (file,get_signature ctx.com) in
+					(* force parsing again : if the completion point have been changed *)
+					Hashtbl.remove cache.c_files fkey;
+					(* force module reloading (if cached) *)
+					Hashtbl.iter (fun _ m -> if m.m_extra.m_file = file then m.m_extra.m_dirty <- true) cache.c_modules
+				end
+			);
+			ctx.com.print <- (fun str -> write ("\x01" ^ String.concat "\x01" (ExtString.String.nsplit str "\n") ^ "\n"));
+			ctx
+		in
+		(try
+			let s = read() in
+			let hxml =
+				try
+					let idx = String.index s '\001' in
+					current_stdin := Some (String.sub s (idx + 1) ((String.length s) - idx - 1));
+					(String.sub s 0 idx)
+				with Not_found ->
+					s
+			in
+			let data = parse_hxml_data hxml in
+			if verbose then print_endline ("Processing Arguments [" ^ String.concat "," data ^ "]");
+			(try
+				Common.display_default := DMNone;
+				Parser.resume_display := Ast.null_pos;
+				Typeload.return_partial_type := false;
+				measure_times := false;
+				close_times();
+				stats.s_files_parsed := 0;
+				stats.s_classes_built := 0;
+				stats.s_methods_typed := 0;
+				stats.s_macros_called := 0;
+				Hashtbl.clear Common.htimers;
+				let _ = Common.timer "other" in
+				incr compilation_step;
+				compilation_mark := !mark_loop;
+				start_time := get_time();
+				process_params create data;
+				close_times();
+				if !measure_times then report_times (fun s -> write (s ^ "\n"))
+			with
+			| Completion str ->
+				if verbose then print_endline ("Completion Response =\n" ^ str);
+				write str
+			| Arg.Bad msg ->
+				prerr_endline ("Error: " ^ msg);
+			);
+			if verbose then begin
+				print_endline (Printf.sprintf "Stats = %d files, %d classes, %d methods, %d macros" !(stats.s_files_parsed) !(stats.s_classes_built) !(stats.s_methods_typed) !(stats.s_macros_called));
+				print_endline (Printf.sprintf "Time spent : %.3fs" (get_time() -. t0));
+			end
+		with Unix.Unix_error _ ->
+			if verbose then print_endline "Connection Aborted"
+		| e ->
+			let estr = Printexc.to_string e in
+			if verbose then print_endline ("Uncaught Error : " ^ estr);
+			(try write estr with _ -> ());
+			if is_debug_run() then print_endline (Printexc.get_backtrace());
+		);
+		close();
+		current_stdin := None;
+		(* prevent too much fragmentation by doing some compactions every X run *)
+		incr run_count;
+		if !run_count mod 10 = 0 then begin
+			let t0 = get_time() in
+			Gc.compact();
+			if verbose then begin
+				let stat = Gc.quick_stat() in
+				let size = (float_of_int stat.Gc.heap_words) *. 4. in
+				print_endline (Printf.sprintf "Compacted memory %.3fs %.1fMB" (get_time() -. t0) (size /. (1024. *. 1024.)));
+			end
+		end else Gc.minor();
+	done
+
+and init_wait_stdio() =
+	set_binary_mode_in stdin true;
+	set_binary_mode_out stderr true;
+
+	let chin = IO.input_channel stdin in
+	let cherr = IO.output_channel stderr in
+
+	let berr = Buffer.create 0 in
+	let read = fun () ->
+		let len = IO.read_i32 chin in
+		IO.really_nread chin len
+	in
+	let write = Buffer.add_string berr in
+	let close = fun() ->
+		IO.write_i32 cherr (Buffer.length berr);
+		IO.nwrite cherr (Buffer.contents berr);
+		IO.flush cherr
+	in
+	fun() ->
+		Buffer.clear berr;
+		read, write, close
+
+and init_wait_socket verbose host port =
+	let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
+	(try Unix.setsockopt sock Unix.SO_REUSEADDR true with _ -> ());
+	(try Unix.bind sock (Unix.ADDR_INET (Unix.inet_addr_of_string host,port)) with _ -> failwith ("Couldn't wait on " ^ host ^ ":" ^ string_of_int port));
+	if verbose then print_endline ("Waiting on " ^ host ^ ":" ^ string_of_int port);
+	Unix.listen sock 10;
+	let bufsize = 1024 in
+	let tmp = String.create bufsize in
+	let accept() = (
+		let sin, _ = Unix.accept sock in
+		Unix.set_nonblock sin;
+		if verbose then print_endline "Client connected";
+		let b = Buffer.create 0 in
+		let rec read_loop count =
+			try
+				let r = Unix.recv sin tmp 0 bufsize [] in
+				if r = 0 then
+					failwith "Incomplete request"
+				else begin
+					if verbose then Printf.printf "Reading %d bytes\n" r;
+					Buffer.add_substring b tmp 0 r;
+					if tmp.[r-1] = '\000' then
+						Buffer.sub b 0 (Buffer.length b - 1)
+					else
+						read_loop 0
+				end
+			with Unix.Unix_error((Unix.EWOULDBLOCK|Unix.EAGAIN),_,_) ->
+				if count = 100 then
+					failwith "Aborting inactive connection"
+				else begin
+					if verbose then print_endline "Waiting for data...";
+					ignore(Unix.select [] [] [] 0.05); (* wait a bit *)
+					read_loop (count + 1);
+				end
+		in
+		let read = fun() -> (let s = read_loop 0 in Unix.clear_nonblock sin; s) in
+		let write = ssend sin in
+		let close() = Unix.close sin in
+		read, write, close
+	) in
+	accept
+
+and do_connect host port args =
+	let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
+	(try Unix.connect sock (Unix.ADDR_INET (Unix.inet_addr_of_string host,port)) with _ -> failwith ("Couldn't connect on " ^ host ^ ":" ^ string_of_int port));
+	let args = ("--cwd " ^ Unix.getcwd()) :: args in
+	ssend sock (String.concat "" (List.map (fun a -> a ^ "\n") args) ^ "\000");
+	let has_error = ref false in
+	let rec print line =
+		match (if line = "" then '\x00' else line.[0]) with
+		| '\x01' ->
+			print_string (String.concat "\n" (List.tl (ExtString.String.nsplit line "\x01")));
+			flush stdout
+		| '\x02' ->
+			has_error := true;
+		| _ ->
+			prerr_endline line;
+	in
+	let buf = Buffer.create 0 in
+	let process() =
+		let lines = ExtString.String.nsplit (Buffer.contents buf) "\n" in
+		(* the last line ends with \n *)
+		let lines = (match List.rev lines with "" :: l -> List.rev l | _ -> lines) in
+		List.iter print lines;
+	in
+	let tmp = String.create 1024 in
+	let rec loop() =
+		let b = Unix.recv sock tmp 0 1024 [] in
+		Buffer.add_substring buf tmp 0 b;
+		if b > 0 then begin
+			if String.get tmp (b - 1) = '\n' then begin
+				process();
+				Buffer.reset buf;
+			end;
+			loop();
+		end
+	in
+	loop();
+	process();
+	if !has_error then exit 1