Explorar el Código

[compiler] move all display-related processing out

Simon Krajewski hace 3 años
padre
commit
6249183f59

+ 2 - 0
src/compiler/compilationContext.ml

@@ -1,5 +1,7 @@
 open Globals
 
+exception Abort
+
 type server_mode =
 	| SMNone
 	| SMListen of string

+ 236 - 481
src/compiler/compiler.ml

@@ -1,193 +1,13 @@
-open Extlib_leftovers
 open Globals
 open Common
 open CompilationContext
-open DisplayException
-open DisplayTypes.CompletionResultKind
-
-exception Abort
-
-let initialize_target ctx com actx =
-	let add_std dir =
-		com.class_path <- List.filter (fun s -> not (List.mem s com.std_path)) com.class_path @ List.map (fun p -> p ^ dir ^ "/_std/") com.std_path @ com.std_path
-	in
-	match com.platform with
-		| Cross ->
-			(* no platform selected *)
-			set_platform com Cross "";
-			"?"
-		| Flash ->
-			let rec loop = function
-				| [] -> ()
-				| (v,_) :: _ when v > com.flash_version -> ()
-				| (v,def) :: l ->
-					Common.raw_define com ("flash" ^ def);
-					loop l
-			in
-			loop Common.flash_versions;
-			com.package_rules <- PMap.remove "flash" com.package_rules;
-			add_std "flash";
-			"swf"
-		| Neko ->
-			add_std "neko";
-			"n"
-		| Js ->
-			let es_version =
-				try
-					int_of_string (Common.defined_value com Define.JsEs)
-				with
-				| Not_found ->
-					(Common.define_value com Define.JsEs "5"; 5)
-				| _ ->
-					0
-			in
-
-			if es_version < 3 || es_version = 4 then (* we don't support ancient and there's no 4th *)
-				failwith "Invalid -D js-es value";
-
-			if es_version >= 5 then Common.raw_define com "js_es5"; (* backward-compatibility *)
-
-			add_std "js";
-			"js"
-		| Lua ->
-			add_std "lua";
-			"lua"
-		| Php ->
-			add_std "php";
-			"php"
-		| Cpp ->
-			Common.define_value com Define.HxcppApiLevel "430";
-			add_std "cpp";
-			if Common.defined com Define.Cppia then
-				actx.classes <- (Path.parse_path "cpp.cppia.HostClasses" ) :: actx.classes;
-			"cpp"
-		| Cs ->
-			Dotnet.before_generate com;
-			add_std "cs"; "cs"
-		| Java ->
-			Java.before_generate com;
-			if defined com Define.Jvm then begin
-				add_std "jvm";
-				com.package_rules <- PMap.remove "jvm" com.package_rules;
-			end;
-			add_std "java";
-			"java"
-		| Python ->
-			add_std "python";
-			if not (Common.defined com Define.PythonVersion) then
-				Common.define_value com Define.PythonVersion "3.3";
-			"python"
-		| Hl ->
-			add_std "hl";
-			if not (Common.defined com Define.HlVer) then Define.define_value com.defines Define.HlVer (try Std.input_file (Common.find_file com "hl/hl_version") with Not_found -> die "" __LOC__);
-			"hl"
-		| Eval ->
-			add_std "eval";
-			"eval"
-
-let process_display_configuration ctx =
-	let com = ctx.com in
-	if com.display.dms_kind <> DMNone then begin
-		com.warning <-
-			if is_diagnostics com then
-				(fun w options s p ->
-					match Warning.get_mode w (com.warning_options @ options) with
-					| WMEnable ->
-						add_diagnostics_message com s p DKCompilerError DisplayTypes.DiagnosticsSeverity.Warning
-					| WMDisable ->
-						()
-				)
-			else
-				(fun w options msg p ->
-					match Warning.get_mode w (com.warning_options @ options) with
-					| WMEnable ->
-						message ctx (CMWarning(msg,p))
-					| WMDisable ->
-						()
-				);
-		com.error <- error ctx;
-	end;
-	Lexer.old_format := Common.defined com Define.OldErrorFormat;
-	if !Lexer.old_format && !Parser.in_display then begin
-		let p = DisplayPosition.display_position#get in
-		(* convert byte position to utf8 position *)
-		try
-			let content = Std.input_file ~bin:true (Path.get_real_path p.pfile) in
-			let pos = UTF8.length (String.sub content 0 p.pmin) in
-			DisplayPosition.display_position#set { p with pmin = pos; pmax = pos }
-		with _ ->
-			() (* ignore *)
-	end
-
-let create_typer_context ctx native_libs =
-	let com = ctx.com in
-	Common.log com ("Classpath: " ^ (String.concat ";" com.class_path));
-	let buffer = Buffer.create 64 in
-	Buffer.add_string buffer "Defines: ";
-	PMap.iter (fun k v -> match v with
-		| "1" -> Printf.bprintf buffer "%s;" k
-		| _ -> Printf.bprintf buffer "%s=%s;" k v
-	) com.defines.values;
-	Buffer.truncate buffer (Buffer.length buffer - 1);
-	Common.log com (Buffer.contents buffer);
-	Typecore.type_expr_ref := (fun ?(mode=MGet) ctx e with_type -> Typer.type_expr ~mode ctx e with_type);
-	List.iter (fun f -> f ()) (List.rev com.callbacks#get_before_typer_create);
-	(* Native lib pass 1: Register *)
-	let fl = List.map (fun (file,extern) -> NativeLibraryHandler.add_native_lib com file extern) (List.rev native_libs) in
-	(* Native lib pass 2: Initialize *)
-	List.iter (fun f -> f()) fl;
-	Typer.create com
-
-let load_display_module_in_macro tctx display_file_dot_path clear = match display_file_dot_path with
-	| Some cpath ->
-		let p = null_pos in
-		begin try
-			let open Typecore in
-			let _, mctx = MacroContext.get_macro_context tctx p in
-			(* Tricky stuff: We want to remove the module from our lookups and load it again in
-				display mode. This covers some cases like --macro typing it in non-display mode (issue #7017). *)
-			if clear then begin
-				begin try
-					let m = Hashtbl.find mctx.com.module_lut cpath in
-					Hashtbl.remove mctx.com.module_lut cpath;
-					Hashtbl.remove mctx.com.type_to_module cpath;
-					List.iter (fun mt ->
-						let ti = Type.t_infos mt in
-						Hashtbl.remove mctx.com.module_lut ti.mt_path;
-						Hashtbl.remove mctx.com.type_to_module ti.mt_path;
-					) m.m_types
-				with Not_found ->
-					()
-				end;
-			end;
-			let _ = MacroContext.load_macro_module tctx cpath true p in
-			Finalization.finalize mctx;
-			Some mctx
-		with DisplayException _ | Parser.TypePath _ as exc ->
-			raise exc
-		| _ ->
-			None
-		end
-	| None ->
-		None
-
-let emit_diagnostics ctx =
-	let dctx = Diagnostics.run ctx.com in
-	let s = Json.string_of_json (DiagnosticsPrinter.json_of_diagnostics ctx.com dctx) in
-	DisplayPosition.display_position#reset;
-	raise (DisplayOutput.Completion s)
-
-let emit_statistics ctx tctx =
-	let stats = Statistics.collect_statistics tctx [SFFile (DisplayPosition.display_position#get).pfile] true in
-	let s = Statistics.Printer.print_statistics stats in
-	raise (DisplayOutput.Completion s)
 
 let run_or_diagnose ctx f arg =
 	let com = ctx.com in
 	let handle_diagnostics msg p kind =
 		ctx.has_error <- true;
 		add_diagnostics_message com msg p kind DisplayTypes.DiagnosticsSeverity.Error;
-		emit_diagnostics ctx
+		DisplayOutput.emit_diagnostics ctx.com
 	in
 	if is_diagnostics com then begin try
 			f arg
@@ -202,88 +22,6 @@ let run_or_diagnose ctx f arg =
 	else
 		f arg
 
-(** Creates the typer context and types [classes] into it. *)
-let do_type ctx tctx actx =
-	let com = tctx.Typecore.com in
-	let t = Timer.timer ["typing"] in
-	let cs = com.cs in
-	CommonCache.maybe_add_context_sign cs com "before_init_macros";
-	com.stage <- CInitMacrosStart;
-	List.iter (MacroContext.call_init_macro tctx) (List.rev actx.config_macros);
-	com.stage <- CInitMacrosDone;
-	CommonCache.lock_signature com "after_init_macros";
-	List.iter (fun f -> f ()) (List.rev com.callbacks#get_after_init_macros);
-	run_or_diagnose ctx (fun () ->
-		if com.display.dms_kind <> DMNone then DisplayTexpr.check_display_file tctx cs;
-		List.iter (fun cpath -> ignore(tctx.Typecore.g.Typecore.do_load_module tctx cpath null_pos)) (List.rev actx.classes);
-		Finalization.finalize tctx;
-	) ();
-	com.stage <- CTypingDone;
-	(* If we are trying to find references, let's syntax-explore everything we know to check for the
-		identifier we are interested in. We then type only those modules that contain the identifier. *)
-	begin match com.display.dms_kind with
-		| (DMUsage _ | DMImplementation) -> FindReferences.find_possible_references tctx cs;
-		| _ -> ()
-	end;
-	t()
-
-let handle_display ctx tctx display_file_dot_path =
-	let com = ctx.com in
-	if ctx.com.display.dms_kind = DMNone & ctx.has_error then raise Abort;
-	begin match ctx.com.display.dms_kind,!Parser.delayed_syntax_completion with
-		| DMDefault,Some(kind,subj) -> DisplayOutput.handle_syntax_completion com kind subj
-		| _ -> ()
-	end;
-	if ctx.com.display.dms_exit_during_typing then begin
-		if ctx.has_next || ctx.has_error then raise Abort;
-		(* If we didn't find a completion point, load the display file in macro mode. *)
-		if com.display_information.display_module_has_macro_defines then
-			ignore(load_display_module_in_macro tctx display_file_dot_path true);
-		let no_completion_point_found = "No completion point was found" in
-		match com.json_out with
-		| Some _ ->
-			raise (DisplayException DisplayNoResult)
-		| None ->
-			failwith no_completion_point_found;
-	end
-
-let filter ctx tctx display_file_dot_path =
-	let com = ctx.com in
-	com.stage <- CFilteringStart;
-	let t = Timer.timer ["filters"] in
-	let main, types, modules = run_or_diagnose ctx Finalization.generate tctx in
-	com.main <- main;
-	com.types <- types;
-	com.modules <- modules;
-	(* Special case for diagnostics: We don't want to load the display file in macro mode because there's a chance it might not be
-		macro-compatible. This means that we might some macro-specific diagnostics, but I don't see what we could do about that. *)
-	let should_load_in_macro =
-		(* Special case for the special case: If the display file has a block which becomes active if `macro` is defined, we can safely
-		   type the module in macro context. (#8682). *)
-		not (is_diagnostics com) || com.display_information.display_module_has_macro_defines
-	in
-	if ctx.com.display.dms_force_macro_typing && should_load_in_macro then begin
-		match load_display_module_in_macro  tctx display_file_dot_path false with
-		| None -> ()
-		| Some mctx ->
-			(* We don't need a full macro flush here because we're not going to run any macros. *)
-			let _, types, modules = Finalization.generate mctx in
-			mctx.Typecore.com.types <- types;
-			mctx.Typecore.com.Common.modules <- modules
-	end;
-	DisplayOutput.process_global_display_mode com tctx;
-	begin match com.report_mode with
-	| RMDiagnostics _ ->
-		emit_diagnostics ctx
-	| RMStatistics ->
-		emit_statistics ctx tctx
-	| RMNone ->
-		()
-	end;
-	DeprecationCheck.run com;
-	Filters.run com tctx main;
-	t()
-
 let run_command ctx cmd =
 	let t = Timer.timer ["command"] in
 	(* TODO: this is a hack *)
@@ -327,85 +65,226 @@ let run_command ctx cmd =
 	t();
 	result
 
-let executable_path() =
-	Extc.executable_path()
-
-let get_std_class_paths () =
-	try
-		let p = Sys.getenv "HAXE_STD_PATH" in
-		let rec loop = function
-			| drive :: path :: l ->
-				if String.length drive = 1 && ((drive.[0] >= 'a' && drive.[0] <= 'z') || (drive.[0] >= 'A' && drive.[0] <= 'Z')) then
-					(drive ^ ":" ^ path) :: loop l
-				else
-					drive :: loop (path :: l)
-			| l ->
-				l
+module Setup = struct
+	let initialize_target ctx com actx =
+		let add_std dir =
+			com.class_path <- List.filter (fun s -> not (List.mem s com.std_path)) com.class_path @ List.map (fun p -> p ^ dir ^ "/_std/") com.std_path @ com.std_path
 		in
-		let parts = Str.split_delim (Str.regexp "[;:]") p in
-		"" :: List.map Path.add_trailing_slash (loop parts)
-	with Not_found ->
-		let base_path = Path.get_real_path (try executable_path() with _ -> "./") in
-		if Sys.os_type = "Unix" then
-			let prefix_path = Filename.dirname base_path in
-			let lib_path = Filename.concat prefix_path "lib" in
-			let share_path = Filename.concat prefix_path "share" in
-			[
-				"";
-				Path.add_trailing_slash (Filename.concat lib_path "haxe/std");
-				Path.add_trailing_slash (Filename.concat lib_path "haxe/extraLibs");
-				Path.add_trailing_slash (Filename.concat share_path "haxe/std");
-				Path.add_trailing_slash (Filename.concat share_path "haxe/extraLibs");
-				Path.add_trailing_slash (Filename.concat base_path "std");
-				Path.add_trailing_slash (Filename.concat base_path "extraLibs")
-			]
-		else
-			[
-				"";
-				Path.add_trailing_slash (Filename.concat base_path "std");
-				Path.add_trailing_slash (Filename.concat base_path "extraLibs")
-			]
+		match com.platform with
+			| Cross ->
+				(* no platform selected *)
+				set_platform com Cross "";
+				"?"
+			| Flash ->
+				let rec loop = function
+					| [] -> ()
+					| (v,_) :: _ when v > com.flash_version -> ()
+					| (v,def) :: l ->
+						Common.raw_define com ("flash" ^ def);
+						loop l
+				in
+				loop Common.flash_versions;
+				com.package_rules <- PMap.remove "flash" com.package_rules;
+				add_std "flash";
+				"swf"
+			| Neko ->
+				add_std "neko";
+				"n"
+			| Js ->
+				let es_version =
+					try
+						int_of_string (Common.defined_value com Define.JsEs)
+					with
+					| Not_found ->
+						(Common.define_value com Define.JsEs "5"; 5)
+					| _ ->
+						0
+				in
+
+				if es_version < 3 || es_version = 4 then (* we don't support ancient and there's no 4th *)
+					failwith "Invalid -D js-es value";
+
+				if es_version >= 5 then Common.raw_define com "js_es5"; (* backward-compatibility *)
+
+				add_std "js";
+				"js"
+			| Lua ->
+				add_std "lua";
+				"lua"
+			| Php ->
+				add_std "php";
+				"php"
+			| Cpp ->
+				Common.define_value com Define.HxcppApiLevel "430";
+				add_std "cpp";
+				if Common.defined com Define.Cppia then
+					actx.classes <- (Path.parse_path "cpp.cppia.HostClasses" ) :: actx.classes;
+				"cpp"
+			| Cs ->
+				Dotnet.before_generate com;
+				add_std "cs"; "cs"
+			| Java ->
+				Java.before_generate com;
+				if defined com Define.Jvm then begin
+					add_std "jvm";
+					com.package_rules <- PMap.remove "jvm" com.package_rules;
+				end;
+				add_std "java";
+				"java"
+			| Python ->
+				add_std "python";
+				if not (Common.defined com Define.PythonVersion) then
+					Common.define_value com Define.PythonVersion "3.3";
+				"python"
+			| Hl ->
+				add_std "hl";
+				if not (Common.defined com Define.HlVer) then Define.define_value com.defines Define.HlVer (try Std.input_file (Common.find_file com "hl/hl_version") with Not_found -> die "" __LOC__);
+				"hl"
+			| Eval ->
+				add_std "eval";
+				"eval"
+
+	let create_typer_context ctx native_libs =
+		let com = ctx.com in
+		Common.log com ("Classpath: " ^ (String.concat ";" com.class_path));
+		let buffer = Buffer.create 64 in
+		Buffer.add_string buffer "Defines: ";
+		PMap.iter (fun k v -> match v with
+			| "1" -> Printf.bprintf buffer "%s;" k
+			| _ -> Printf.bprintf buffer "%s=%s;" k v
+		) com.defines.values;
+		Buffer.truncate buffer (Buffer.length buffer - 1);
+		Common.log com (Buffer.contents buffer);
+		Typecore.type_expr_ref := (fun ?(mode=MGet) ctx e with_type -> Typer.type_expr ~mode ctx e with_type);
+		List.iter (fun f -> f ()) (List.rev com.callbacks#get_before_typer_create);
+		(* Native lib pass 1: Register *)
+		let fl = List.map (fun (file,extern) -> NativeLibraryHandler.add_native_lib com file extern) (List.rev native_libs) in
+		(* Native lib pass 2: Initialize *)
+		List.iter (fun f -> f()) fl;
+		Typer.create com
+
+	let executable_path() =
+		Extc.executable_path()
+
+	let get_std_class_paths () =
+		try
+			let p = Sys.getenv "HAXE_STD_PATH" in
+			let rec loop = function
+				| drive :: path :: l ->
+					if String.length drive = 1 && ((drive.[0] >= 'a' && drive.[0] <= 'z') || (drive.[0] >= 'A' && drive.[0] <= 'Z')) then
+						(drive ^ ":" ^ path) :: loop l
+					else
+						drive :: loop (path :: l)
+				| l ->
+					l
+			in
+			let parts = Str.split_delim (Str.regexp "[;:]") p in
+			"" :: List.map Path.add_trailing_slash (loop parts)
+		with Not_found ->
+			let base_path = Path.get_real_path (try executable_path() with _ -> "./") in
+			if Sys.os_type = "Unix" then
+				let prefix_path = Filename.dirname base_path in
+				let lib_path = Filename.concat prefix_path "lib" in
+				let share_path = Filename.concat prefix_path "share" in
+				[
+					"";
+					Path.add_trailing_slash (Filename.concat lib_path "haxe/std");
+					Path.add_trailing_slash (Filename.concat lib_path "haxe/extraLibs");
+					Path.add_trailing_slash (Filename.concat share_path "haxe/std");
+					Path.add_trailing_slash (Filename.concat share_path "haxe/extraLibs");
+					Path.add_trailing_slash (Filename.concat base_path "std");
+					Path.add_trailing_slash (Filename.concat base_path "extraLibs")
+				]
+			else
+				[
+					"";
+					Path.add_trailing_slash (Filename.concat base_path "std");
+					Path.add_trailing_slash (Filename.concat base_path "extraLibs")
+				]
+
+	let setup_common_context ctx =
+		let com = ctx.com in
+		ctx.com.print <- ctx.comm.write_out;
+		Common.define_value com Define.HaxeVer (Printf.sprintf "%.3f" (float_of_int Globals.version /. 1000.));
+		Common.raw_define com "haxe3";
+		Common.raw_define com "haxe4";
+		Common.define_value com Define.Haxe s_version;
+		Common.raw_define com "true";
+		Common.define_value com Define.Dce "std";
+		com.info <- (fun msg p -> message ctx (CMInfo(msg,p)));
+		com.warning <- (fun w options msg p ->
+			match Warning.get_mode w (com.warning_options @ options) with
+			| WMEnable ->
+				message ctx (CMWarning(msg,p))
+			| WMDisable ->
+				()
+		);
+		com.error <- error ctx;
+		let filter_messages = (fun keep_errors predicate -> (List.filter (fun msg ->
+			(match msg with
+			| CMError(_,_) -> keep_errors;
+			| CMInfo(_,_) | CMWarning(_,_) -> predicate msg;)
+		) (List.rev ctx.messages))) in
+		com.get_messages <- (fun () -> (List.map (fun msg ->
+			(match msg with
+			| CMError(_,_) -> die "" __LOC__;
+			| CMInfo(_,_) | CMWarning(_,_) -> msg;)
+		) (filter_messages false (fun _ -> true))));
+		com.filter_messages <- (fun predicate -> (ctx.messages <- (List.rev (filter_messages true predicate))));
+		com.run_command <- run_command ctx;
+		com.class_path <- get_std_class_paths ();
+		com.std_path <- List.filter (fun p -> ExtString.String.ends_with p "std/" || ExtString.String.ends_with p "std\\") com.class_path
+
+end
 
-let setup_common_context ctx =
+(** Creates the typer context and types [classes] into it. *)
+let do_type ctx tctx actx =
+	let com = tctx.Typecore.com in
+	let t = Timer.timer ["typing"] in
+	let cs = com.cs in
+	CommonCache.maybe_add_context_sign cs com "before_init_macros";
+	com.stage <- CInitMacrosStart;
+	List.iter (MacroContext.call_init_macro tctx) (List.rev actx.config_macros);
+	com.stage <- CInitMacrosDone;
+	CommonCache.lock_signature com "after_init_macros";
+	List.iter (fun f -> f ()) (List.rev com.callbacks#get_after_init_macros);
+	run_or_diagnose ctx (fun () ->
+		if com.display.dms_kind <> DMNone then DisplayTexpr.check_display_file tctx cs;
+		List.iter (fun cpath -> ignore(tctx.Typecore.g.Typecore.do_load_module tctx cpath null_pos)) (List.rev actx.classes);
+		Finalization.finalize tctx;
+	) ();
+	com.stage <- CTypingDone;
+	(* If we are trying to find references, let's syntax-explore everything we know to check for the
+		identifier we are interested in. We then type only those modules that contain the identifier. *)
+	begin match com.display.dms_kind with
+		| (DMUsage _ | DMImplementation) -> FindReferences.find_possible_references tctx cs;
+		| _ -> ()
+	end;
+	t()
+
+let finalize_typing ctx tctx =
+	let t = Timer.timer ["finalize"] in
 	let com = ctx.com in
-	ctx.com.print <- ctx.comm.write_out;
-	Common.define_value com Define.HaxeVer (Printf.sprintf "%.3f" (float_of_int Globals.version /. 1000.));
-	Common.raw_define com "haxe3";
-	Common.raw_define com "haxe4";
-	Common.define_value com Define.Haxe s_version;
-	Common.raw_define com "true";
-	Common.define_value com Define.Dce "std";
-	com.info <- (fun msg p -> message ctx (CMInfo(msg,p)));
-	com.warning <- (fun w options msg p ->
-		match Warning.get_mode w (com.warning_options @ options) with
-		| WMEnable ->
-			message ctx (CMWarning(msg,p))
-		| WMDisable ->
-			()
-	);
-	com.error <- error ctx;
-	let filter_messages = (fun keep_errors predicate -> (List.filter (fun msg ->
-		(match msg with
-		| CMError(_,_) -> keep_errors;
-		| CMInfo(_,_) | CMWarning(_,_) -> predicate msg;)
-	) (List.rev ctx.messages))) in
-	com.get_messages <- (fun () -> (List.map (fun msg ->
-		(match msg with
-		| CMError(_,_) -> die "" __LOC__;
-		| CMInfo(_,_) | CMWarning(_,_) -> msg;)
-	) (filter_messages false (fun _ -> true))));
-	com.filter_messages <- (fun predicate -> (ctx.messages <- (List.rev (filter_messages true predicate))));
-	com.run_command <- run_command ctx;
-	com.class_path <- get_std_class_paths ();
-	com.std_path <- List.filter (fun p -> ExtString.String.ends_with p "std/" || ExtString.String.ends_with p "std\\") com.class_path
+	com.stage <- CFilteringStart;
+	let main, types, modules = run_or_diagnose ctx Finalization.generate tctx in
+	com.main <- main;
+	com.types <- types;
+	com.modules <- modules;
+	t()
+
+let filter ctx tctx =
+	let t = Timer.timer ["filters"] in
+	DeprecationCheck.run ctx.com;
+	Filters.run ctx.com tctx ctx.com.main;
+	t()
 
 let compile ctx actx =
 	let com = ctx.com in
 	(* Set up display configuration *)
-	process_display_configuration ctx;
-	let display_file_dot_path = DisplayOutput.process_display_file com actx in
+	DisplayProcessing.process_display_configuration ctx;
+	let display_file_dot_path = DisplayProcessing.process_display_file com actx in
 	(* Initialize target: This allows access to the appropriate std packages and sets the -D defines. *)
-	let ext = initialize_target ctx com actx in
+	let ext = Setup.initialize_target ctx com actx in
 	com.config <- get_config com; (* make sure to adapt all flags changes defined after platform *)
 	let t = Timer.timer ["init"] in
 	List.iter (fun f -> f()) (List.rev (actx.pre_compilation));
@@ -415,30 +294,18 @@ let compile ctx actx =
 		if actx.cmds = [] && not actx.did_something then actx.raise_usage();
 	end else begin
 		(* Actual compilation starts here *)
-		let tctx = create_typer_context ctx actx.native_libs in
+		let tctx = Setup.create_typer_context ctx actx.native_libs in
 		com.stage <- CTyperCreated;
-		let display_file_dot_path = match display_file_dot_path with
-			| DPKMacro path ->
-				ignore(load_display_module_in_macro tctx (Some path) true);
-				Some path
-			| DPKNormal path ->
-				Some path
-			| DPKNone ->
-				None
-			| DPKDirect file ->
-				DisplayOutput.load_display_file_standalone tctx file;
-				None
-			| DPKInput input ->
-				DisplayOutput.load_display_content_standalone tctx input;
-				None
-		in
+		let display_file_dot_path = DisplayProcessing.maybe_load_display_file_before_typing tctx display_file_dot_path in
 		begin try
 			do_type ctx tctx actx
 		with TypeloadParse.DisplayInMacroBlock ->
-			ignore(load_display_module_in_macro tctx display_file_dot_path true);
+			ignore(DisplayProcessing.load_display_module_in_macro tctx display_file_dot_path true);
 		end;
-		handle_display ctx tctx display_file_dot_path;
-		filter ctx tctx display_file_dot_path;
+		DisplayProcessing.handle_display_after_typing ctx tctx display_file_dot_path;
+		finalize_typing ctx tctx;
+		DisplayProcessing.handle_display_after_finalization ctx tctx display_file_dot_path;
+		filter ctx tctx;
 		if ctx.has_error then raise Abort;
 		Generate.check_auxiliary_output com actx;
 		com.stage <- CGenerationStart;
@@ -454,88 +321,6 @@ let compile ctx actx =
 		) (List.rev actx.cmds)
 	end
 
-let finalize ctx =
-	ctx.comm.flush ctx;
-	(* In server mode any open libs are closed by the lib_build_task. In offline mode
-	   we should do it here to be safe. *)
-	if not ctx.comm.is_server then begin
-		List.iter (fun lib -> lib#close) ctx.com.native_libs.java_libs;
-		List.iter (fun lib -> lib#close) ctx.com.native_libs.net_libs;
-		List.iter (fun lib -> lib#close) ctx.com.native_libs.swf_libs;
-	end
-
-open DisplayTypes
-
-let handle_display_exception_old ctx dex = match dex with
-	| DisplayPackage pack ->
-		DisplayPosition.display_position#reset;
-		raise (DisplayOutput.Completion (String.concat "." pack))
-	| DisplayFields r ->
-		DisplayPosition.display_position#reset;
-		let fields = if !Timer.measure_times then begin
-			Timer.close_times();
-			(List.map (fun (name,value) ->
-				CompletionItem.make_ci_timer ("@TIME " ^ name) value
-			) (DisplayOutput.get_timer_fields !Helper.start_time)) @ r.fitems
-		end else
-			r.fitems
-		in
-		let s = match r.fkind with
-			| CRToplevel _
-			| CRTypeHint
-			| CRExtends
-			| CRImplements
-			| CRStructExtension _
-			| CRImport
-			| CRUsing
-			| CRNew
-			| CRPattern _
-			| CRTypeRelation
-			| CRTypeDecl ->
-				DisplayOutput.print_toplevel fields
-			| CRField _
-			| CRStructureField
-			| CRMetadata
-			| CROverride ->
-				DisplayOutput.print_fields fields
-		in
-		raise (DisplayOutput.Completion s)
-	| DisplayHover ({hitem = {CompletionItem.ci_type = Some (t,_)}} as hover) ->
-		DisplayPosition.display_position#reset;
-		let doc = CompletionItem.get_documentation hover.hitem in
-		raise (DisplayOutput.Completion (DisplayOutput.print_type t hover.hpos doc))
-	| DisplaySignatures (signatures,_,display_arg,_) ->
-		DisplayPosition.display_position#reset;
-		if ctx.com.display.dms_kind = DMSignature then
-			raise (DisplayOutput.Completion (DisplayOutput.print_signature signatures display_arg))
-		else
-			raise (DisplayOutput.Completion (DisplayOutput.print_signatures signatures))
-	| DisplayPositions pl ->
-		DisplayPosition.display_position#reset;
-		raise (DisplayOutput.Completion (DisplayOutput.print_positions pl))
-	| ModuleSymbols s | Metadata s ->
-		DisplayPosition.display_position#reset;
-		raise (DisplayOutput.Completion s)
-	| DisplayHover _ | DisplayNoResult ->
-		raise (DisplayOutput.Completion "")
-
-let handle_display_exception_json ctx dex api =
-	match dex with
-	| DisplayHover _ | DisplayPositions _ | DisplayFields _ | DisplayPackage _  | DisplaySignatures _ ->
-		DisplayPosition.display_position#reset;
-		let ctx = DisplayJson.create_json_context api.jsonrpc (match dex with DisplayFields _ -> true | _ -> false) in
-		api.send_result (DisplayException.to_json ctx dex)
-	| DisplayNoResult ->
-		api.send_result JNull
-	| _ ->
-		handle_display_exception_old ctx dex
-
-let handle_display_exception ctx dex = match ctx.com.json_out with
-	| Some api ->
-		handle_display_exception_json ctx dex api
-	| None ->
-		handle_display_exception_old ctx dex
-
 let compile_safe ctx f =
 	let com = ctx.com in
 try
@@ -570,52 +355,35 @@ with
 	| Helper.HelpMessage msg ->
 		com.info msg null_pos
 	| Parser.TypePath (p,c,is_import,pos) ->
-		let fields =
-			try begin match c with
-				| None ->
-					DisplayPath.TypePathHandler.complete_type_path com p
-				| Some (c,cur_package) ->
-					let ctx = Typer.create com in
-					DisplayPath.TypePathHandler.complete_type_path_inner ctx p c cur_package is_import
-			end with Common.Abort(msg,p) ->
-				error ctx msg p;
-				None
-		in
-		begin match ctx.com.json_out,fields with
-		| None,None ->
-			()
-		| None,Some fields ->
-			raise (DisplayOutput.Completion (DisplayOutput.print_fields fields))
-		| Some api,None when is_legacy_completion com ->
-			api.send_result JNull
-		| Some api,fields ->
-			let fields = Option.default [] fields in
-			let ctx = DisplayJson.create_json_context api.jsonrpc false in
-			let path = match List.rev p with
-				| name :: pack -> List.rev pack,name
-				| [] -> [],""
-			in
-			let kind = CRField ((CompletionItem.make_ci_module path,pos,None,None)) in
-			api.send_result (DisplayException.fields_to_json ctx fields kind (DisplayTypes.make_subject None pos));
-		end
+		DisplayOutput.handle_type_path_exception ctx p c is_import pos
 	| Parser.SyntaxCompletion(kind,subj) ->
 		DisplayOutput.handle_syntax_completion com kind subj;
 		error ctx ("Error: No completion point was found") null_pos
 	| EvalExceptions.Sys_exit _ | Hlinterp.Sys_exit _ as exc ->
 		raise exc
-	| DisplayException dex ->
-		handle_display_exception ctx dex
+	| DisplayException.DisplayException dex ->
+		DisplayOutput.handle_display_exception ctx dex
 	| Out_of_memory as exc ->
 		raise exc
 	| e when (try Sys.getenv "OCAMLRUNPARAM" <> "b" with _ -> true) && not Helper.is_debug_run ->
 		error ctx (Printexc.to_string e) null_pos
 
+let finalize ctx =
+	ctx.comm.flush ctx;
+	(* In server mode any open libs are closed by the lib_build_task. In offline mode
+		we should do it here to be safe. *)
+	if not ctx.comm.is_server then begin
+		List.iter (fun lib -> lib#close) ctx.com.native_libs.java_libs;
+		List.iter (fun lib -> lib#close) ctx.com.native_libs.net_libs;
+		List.iter (fun lib -> lib#close) ctx.com.native_libs.swf_libs;
+	end
+
 let catch_completion_and_exit ctx callbacks run =
 	try
 		run ctx;
 		if ctx.has_error then 1 else 0
 	with
-		| DisplayOutput.Completion str ->
+		| DisplayProcessingGlobals.Completion str ->
 			callbacks.after_compilation ctx;
 			ServerMessage.completion str;
 			ctx.comm.write_err str;
@@ -625,20 +393,8 @@ let catch_completion_and_exit ctx callbacks run =
 			finalize ctx;
 			i
 
-let process_display_arg ctx actx =
-	match actx.display_arg with
-	| Some input ->
-		let input = String.trim input in
-		if String.length input > 0 && (input.[0] = '[' || input.[0] = '{') then begin
-			actx.did_something <- true;
-			actx.force_typing <- true;
-			DisplayJson.parse_input ctx.com input Timer.measure_times
-		end else
-			DisplayOutput.handle_display_argument ctx.com input actx;
-	| None ->
-		()
-
 let process_actx ctx actx =
+	DisplayProcessing.process_display_arg ctx actx;
 	List.iter (fun s ->
 		ctx.com.warning WDeprecated [] s null_pos
 	) actx.deprecations
@@ -646,10 +402,9 @@ let process_actx ctx actx =
 let compile_ctx callbacks ctx =
 	let run ctx =
 		callbacks.before_anything ctx;
-		setup_common_context ctx;
+		Setup.setup_common_context ctx;
 		compile_safe ctx (fun () ->
 			let actx = Args.parse_args ctx.com in
-			process_display_arg ctx actx;
 			process_actx ctx actx;
 			callbacks.after_arg_parsing ctx;
 			compile ctx actx;

+ 116 - 211
src/compiler/displayOutput.ml

@@ -2,7 +2,6 @@ open Globals
 open Ast
 open Common
 open Filename
-open CompilationContext
 open Timer
 open DisplayTypes.DisplayMode
 open DisplayTypes.CompletionResultKind
@@ -17,6 +16,8 @@ open DisplayTypes
 open CompletionModuleType
 open Typecore
 open Genjson
+open CompilationContext
+open DisplayProcessingGlobals
 
 (* Old XML stuff *)
 
@@ -208,215 +209,6 @@ let print_signature tl display_arg =
 
 (* Mode processing *)
 
-exception Completion of string
-
-let handle_display_argument com file_pos actx =
-	match file_pos with
-	| "classes" ->
-		actx.pre_compilation <- (fun() -> raise (Parser.TypePath (["."],None,true,null_pos))) :: actx.pre_compilation;
-	| "keywords" ->
-		raise (Completion (print_keywords ()))
-	| "memory" ->
-		actx.did_something <- true;
-		(try Memory.display_memory com with e -> prerr_endline (Printexc.get_backtrace ()));
-	| "diagnostics" ->
-		com.report_mode <- RMDiagnostics []
-	| _ ->
-		let file, pos = try ExtString.String.split file_pos "@" with _ -> failwith ("Invalid format: " ^ file_pos) in
-		let file = Helper.unquote file in
-		let file_unique = com.file_keys#get file in
-		let pos, smode = try ExtString.String.split pos "@" with _ -> pos,"" in
-		let create mode =
-			Parser.display_mode := mode;
-			DisplayMode.create mode
-		in
-		let dm = match smode with
-			| "position" ->
-				create DMDefinition
-			| "usage" ->
-				create (DMUsage (false,false,false))
-			| "package" ->
-				create DMPackage
-			| "type" ->
-				create DMHover
-			| "toplevel" ->
-				create DMDefault
-			| "module-symbols" ->
-				create (DMModuleSymbols None)
-			| "diagnostics" ->
-				com.report_mode <- RMDiagnostics [file_unique];
-				let dm = create DMNone in
-				{dm with dms_display_file_policy = DFPAlso; dms_per_file = true}
-			| "statistics" ->
-				com.report_mode <- RMStatistics;
-				let dm = create DMNone in
-				{dm with dms_display_file_policy = DFPAlso; dms_error_policy = EPIgnore; dms_per_file = true}
-			| "signature" ->
-				create DMSignature
-			| "" ->
-				create DMDefault
-			| _ ->
-				let smode,arg = try ExtString.String.split smode "@" with _ -> pos,"" in
-				match smode with
-					| "workspace-symbols" ->
-						create (DMModuleSymbols (Some arg))
-					| _ ->
-						create DMDefault
-		in
-		let pos = try int_of_string pos with _ -> failwith ("Invalid format: "  ^ pos) in
-		com.display <- dm;
-		if not com.display.dms_full_typing then Common.define_value com Define.Display (if smode <> "" then smode else "1");
-		DisplayPosition.display_position#set {
-			pfile = Path.get_full_path file;
-			pmin = pos;
-			pmax = pos;
-		}
-
-let file_input_marker = Path.get_full_path "? input"
-
-type display_path_kind =
-	| DPKNormal of path
-	| DPKMacro of path
-	| DPKDirect of string
-	| DPKInput of string
-	| DPKNone
-
-let process_display_file com actx =
-	let get_module_path_from_file_path com spath =
-		let rec loop = function
-			| [] -> None
-			| cp :: l ->
-				let cp = (if cp = "" then "./" else cp) in
-				let c = Path.add_trailing_slash (Path.get_real_path cp) in
-				let clen = String.length c in
-				if clen < String.length spath && String.sub spath 0 clen = c then begin
-					let path = String.sub spath clen (String.length spath - clen) in
-					(try
-						let path = Path.parse_path path in
-						(match loop l with
-						| Some x as r when String.length (s_type_path x) < String.length (s_type_path path) -> r
-						| _ -> Some path)
-					with _ -> loop l)
-				end else
-					loop l
-		in
-		loop com.class_path
-	in
-	match com.display.dms_display_file_policy with
-		| DFPNo ->
-			DPKNone
-		| DFPOnly when (DisplayPosition.display_position#get).pfile = file_input_marker ->
-			actx.classes <- [];
-			com.main_class <- None;
-			begin match !TypeloadParse.current_stdin with
-			| Some input ->
-				TypeloadParse.current_stdin := None;
-				DPKInput input
-			| None ->
-				DPKNone
-			end
-		| dfp ->
-			if dfp = DFPOnly then begin
-				actx.classes <- [];
-				com.main_class <- None;
-			end;
-			let real = Path.get_real_path (DisplayPosition.display_position#get).pfile in
-			let path = match get_module_path_from_file_path com real with
-			| Some path ->
-				if com.display.dms_kind = DMPackage then raise_package (fst path);
-				let path = match ExtString.String.nsplit (snd path) "." with
-					| [name;"macro"] ->
-						(* If we have a .macro.hx path, don't add the file to classes because the compiler won't find it.
-						   This can happen if we're completing in such a file. *)
-						DPKMacro (fst path,name)
-					| [name] ->
-						actx.classes <- path :: actx.classes;
-						DPKNormal path
-					| [name;target] ->
-						let path = fst path, name in
-						actx.classes <- path :: actx.classes;
-						DPKNormal path
-					| e ->
-						die "" __LOC__
-				in
-				path
-			| None ->
-				if not (Sys.file_exists real) then failwith "Display file does not exist";
-				(match List.rev (ExtString.String.nsplit real Path.path_sep) with
-				| file :: _ when file.[0] >= 'a' && file.[0] <= 'z' -> failwith ("Display file '" ^ file ^ "' should not start with a lowercase letter")
-				| _ -> ());
-				DPKDirect real
-			in
-			Common.log com ("Display file : " ^ real);
-			Common.log com ("Classes found : ["  ^ (String.concat "," (List.map s_type_path actx.classes)) ^ "]");
-			path
-
-let load_display_file_standalone ctx file =
-	let com = ctx.com in
-	let pack,decls = TypeloadParse.parse_module_file com file null_pos in
-	let path = Path.FilePath.parse file in
-	let name = match path.file_name with
-		| None -> "?DISPLAY"
-		| Some name -> name
-	in
-	begin match path.directory with
-		| None -> ()
-		| Some dir ->
-			(* Chop off number of package parts from the dir and use that as class path. *)
-			let parts = ExtString.String.nsplit dir (if path.backslash then "\\" else "/") in
-			let parts = List.rev (ExtList.List.drop (List.length pack) (List.rev parts)) in
-			let dir = ExtString.String.join (if path.backslash then "\\" else "/") parts in
-			com.class_path <- dir :: com.class_path
-	end;
-	ignore(TypeloadModule.type_module ctx (pack,name) file ~dont_check_path:true decls null_pos)
-
-let load_display_content_standalone ctx input =
-	let com = ctx.com in
-	let file = file_input_marker in
-	let p = {pfile = file; pmin = 0; pmax = 0} in
-	let parsed = TypeloadParse.parse_file_from_string com file p input in
-	let pack,decls = TypeloadParse.handle_parser_result com p parsed in
-	ignore(TypeloadModule.type_module ctx (pack,"?DISPLAY") file ~dont_check_path:true decls p)
-
-let promote_type_hints tctx =
-	let rec explore_type_hint (md,p,t) =
-		match t with
-		| TMono r -> (match r.tm_type with None -> () | Some t -> explore_type_hint (md,p,t))
-		| TLazy f -> explore_type_hint (md,p,lazy_type f)
-		| TInst(({cl_name_pos = pn;cl_path = (_,name)}),_)
-		| TEnum(({e_name_pos = pn;e_path = (_,name)}),_)
-		| TType(({t_name_pos = pn;t_path = (_,name)}),_)
-		| TAbstract(({a_name_pos = pn;a_path = (_,name)}),_) ->
-			md.m_type_hints <- (p,pn) :: md.m_type_hints;
-		| TDynamic _ -> ()
-		| TFun _ | TAnon _ -> ()
-	in
-	List.iter explore_type_hint tctx.g.type_hints
-
-let process_global_display_mode com tctx =
-	promote_type_hints tctx;
-	match com.display.dms_kind with
-	| DMUsage (with_definition,_,_) ->
-		FindReferences.find_references tctx com with_definition
-	| DMImplementation ->
-		FindReferences.find_implementations tctx com
-	| DMModuleSymbols (Some "") -> ()
-	| DMModuleSymbols filter ->
-		let open CompilationCache in
-		let cs = com.cs in
-		let symbols =
-			let l = cs#get_context_files ((Define.get_signature com.defines) :: (match com.get_macros() with None -> [] | Some com -> [Define.get_signature com.defines])) in
-			List.fold_left (fun acc (file_key,cfile) ->
-				let file = cfile.c_file_path in
-				if (filter <> None || DisplayPosition.display_position#is_in_file (com.file_keys#get file)) then
-					(file,DocumentSymbols.collect_module_symbols (Some (file,get_module_name_of_cfile file cfile)) (filter = None) (cfile.c_package,cfile.c_decls)) :: acc
-				else
-					acc
-			) [] l
-		in
-		raise_module_symbols (DocumentSymbols.Printer.print_module_symbols com symbols filter)
-	| _ -> ()
-
 let find_doc t =
 	let doc = match follow t with
 		| TAnon an ->
@@ -476,4 +268,117 @@ let handle_syntax_completion com kind subj =
 			raise (Completion s)
 		| Some api ->
 			let ctx = Genjson.create_context ~jsonrpc:api.jsonrpc GMFull in
-			api.send_result(fields_to_json ctx l kind subj)
+			api.send_result(fields_to_json ctx l kind subj)
+
+let handle_display_exception_old ctx dex = match dex with
+	| DisplayPackage pack ->
+		DisplayPosition.display_position#reset;
+		raise (Completion (String.concat "." pack))
+	| DisplayFields r ->
+		DisplayPosition.display_position#reset;
+		let fields = if !Timer.measure_times then begin
+			Timer.close_times();
+			(List.map (fun (name,value) ->
+				CompletionItem.make_ci_timer ("@TIME " ^ name) value
+			) (get_timer_fields !Helper.start_time)) @ r.fitems
+		end else
+			r.fitems
+		in
+		let s = match r.fkind with
+			| CRToplevel _
+			| CRTypeHint
+			| CRExtends
+			| CRImplements
+			| CRStructExtension _
+			| CRImport
+			| CRUsing
+			| CRNew
+			| CRPattern _
+			| CRTypeRelation
+			| CRTypeDecl ->
+				print_toplevel fields
+			| CRField _
+			| CRStructureField
+			| CRMetadata
+			| CROverride ->
+				print_fields fields
+		in
+		raise (Completion s)
+	| DisplayHover ({hitem = {CompletionItem.ci_type = Some (t,_)}} as hover) ->
+		DisplayPosition.display_position#reset;
+		let doc = CompletionItem.get_documentation hover.hitem in
+		raise (Completion (print_type t hover.hpos doc))
+	| DisplaySignatures (signatures,_,display_arg,_) ->
+		DisplayPosition.display_position#reset;
+		if ctx.com.display.dms_kind = DMSignature then
+			raise (Completion (print_signature signatures display_arg))
+		else
+			raise (Completion (print_signatures signatures))
+	| DisplayPositions pl ->
+		DisplayPosition.display_position#reset;
+		raise (Completion (print_positions pl))
+	| ModuleSymbols s | Metadata s ->
+		DisplayPosition.display_position#reset;
+		raise (Completion s)
+	| DisplayHover _ | DisplayNoResult ->
+		raise (Completion "")
+
+let handle_display_exception_json ctx dex api =
+	match dex with
+	| DisplayHover _ | DisplayPositions _ | DisplayFields _ | DisplayPackage _  | DisplaySignatures _ ->
+		DisplayPosition.display_position#reset;
+		let ctx = DisplayJson.create_json_context api.jsonrpc (match dex with DisplayFields _ -> true | _ -> false) in
+		api.send_result (DisplayException.to_json ctx dex)
+	| DisplayNoResult ->
+		api.send_result JNull
+	| _ ->
+		handle_display_exception_old ctx dex
+
+let handle_display_exception ctx dex = match ctx.com.json_out with
+	| Some api ->
+		handle_display_exception_json ctx dex api
+	| None ->
+		handle_display_exception_old ctx dex
+
+let handle_type_path_exception ctx p c is_import pos =
+	let open DisplayTypes.CompletionResultKind in
+	let com = ctx.com in
+	let fields =
+		try begin match c with
+			| None ->
+				DisplayPath.TypePathHandler.complete_type_path com p
+			| Some (c,cur_package) ->
+				let ctx = Typer.create com in
+				DisplayPath.TypePathHandler.complete_type_path_inner ctx p c cur_package is_import
+		end with Common.Abort(msg,p) ->
+			error ctx msg p;
+			None
+	in
+	begin match ctx.com.json_out,fields with
+	| None,None ->
+		()
+	| None,Some fields ->
+		raise (Completion (print_fields fields))
+	| Some api,None when is_legacy_completion com ->
+		api.send_result JNull
+	| Some api,fields ->
+		let fields = Option.default [] fields in
+		let ctx = DisplayJson.create_json_context api.jsonrpc false in
+		let path = match List.rev p with
+			| name :: pack -> List.rev pack,name
+			| [] -> [],""
+		in
+		let kind = CRField ((CompletionItem.make_ci_module path,pos,None,None)) in
+		api.send_result (DisplayException.fields_to_json ctx fields kind (DisplayTypes.make_subject None pos));
+	end
+
+let emit_diagnostics com =
+	let dctx = Diagnostics.run com in
+	let s = Json.string_of_json (DiagnosticsPrinter.json_of_diagnostics com dctx) in
+	DisplayPosition.display_position#reset;
+	raise (Completion s)
+
+let emit_statistics tctx =
+	let stats = Statistics.collect_statistics tctx [SFFile (DisplayPosition.display_position#get).pfile] true in
+	let s = Statistics.Printer.print_statistics stats in
+	raise (Completion s)

+ 365 - 0
src/compiler/displayProcessing.ml

@@ -0,0 +1,365 @@
+open Globals
+open Common
+open CompilationContext
+open DisplayProcessingGlobals
+
+type display_path_kind =
+	| DPKNormal of path
+	| DPKMacro of path
+	| DPKDirect of string
+	| DPKInput of string
+	| DPKNone
+
+(* 1. Argument processing from --display *)
+
+let handle_display_argument_old com file_pos actx =
+	match file_pos with
+	| "classes" ->
+		actx.pre_compilation <- (fun() -> raise (Parser.TypePath (["."],None,true,null_pos))) :: actx.pre_compilation;
+	| "keywords" ->
+		raise (Completion (DisplayOutput.print_keywords ()))
+	| "memory" ->
+		actx.did_something <- true;
+		(try Memory.display_memory com with e -> prerr_endline (Printexc.get_backtrace ()));
+	| "diagnostics" ->
+		com.report_mode <- RMDiagnostics []
+	| _ ->
+		let file, pos = try ExtString.String.split file_pos "@" with _ -> failwith ("Invalid format: " ^ file_pos) in
+		let file = Helper.unquote file in
+		let file_unique = com.file_keys#get file in
+		let pos, smode = try ExtString.String.split pos "@" with _ -> pos,"" in
+		let create mode =
+			Parser.display_mode := mode;
+			DisplayTypes.DisplayMode.create mode
+		in
+		let dm = match smode with
+			| "position" ->
+				create DMDefinition
+			| "usage" ->
+				create (DMUsage (false,false,false))
+			| "package" ->
+				create DMPackage
+			| "type" ->
+				create DMHover
+			| "toplevel" ->
+				create DMDefault
+			| "module-symbols" ->
+				create (DMModuleSymbols None)
+			| "diagnostics" ->
+				com.report_mode <- RMDiagnostics [file_unique];
+				let dm = create DMNone in
+				{dm with dms_display_file_policy = DFPAlso; dms_per_file = true}
+			| "statistics" ->
+				com.report_mode <- RMStatistics;
+				let dm = create DMNone in
+				{dm with dms_display_file_policy = DFPAlso; dms_error_policy = EPIgnore; dms_per_file = true}
+			| "signature" ->
+				create DMSignature
+			| "" ->
+				create DMDefault
+			| _ ->
+				let smode,arg = try ExtString.String.split smode "@" with _ -> pos,"" in
+				match smode with
+					| "workspace-symbols" ->
+						create (DMModuleSymbols (Some arg))
+					| _ ->
+						create DMDefault
+		in
+		let pos = try int_of_string pos with _ -> failwith ("Invalid format: "  ^ pos) in
+		com.display <- dm;
+		if not com.display.dms_full_typing then Common.define_value com Define.Display (if smode <> "" then smode else "1");
+		DisplayPosition.display_position#set {
+			pfile = Path.get_full_path file;
+			pmin = pos;
+			pmax = pos;
+		}
+
+let process_display_arg ctx actx =
+	match actx.display_arg with
+	| Some input ->
+		let input = String.trim input in
+		if String.length input > 0 && (input.[0] = '[' || input.[0] = '{') then begin
+			actx.did_something <- true;
+			actx.force_typing <- true;
+			DisplayJson.parse_input ctx.com input Timer.measure_times
+		end else
+			handle_display_argument_old ctx.com input actx;
+	| None ->
+		()
+
+(* 2. Compilation start, setup display configuration in context *)
+
+let process_display_configuration ctx =
+	let com = ctx.com in
+	if com.display.dms_kind <> DMNone then begin
+		com.warning <-
+			if is_diagnostics com then
+				(fun w options s p ->
+					match Warning.get_mode w (com.warning_options @ options) with
+					| WMEnable ->
+						add_diagnostics_message com s p DKCompilerError DisplayTypes.DiagnosticsSeverity.Warning
+					| WMDisable ->
+						()
+				)
+			else
+				(fun w options msg p ->
+					match Warning.get_mode w (com.warning_options @ options) with
+					| WMEnable ->
+						message ctx (CMWarning(msg,p))
+					| WMDisable ->
+						()
+				);
+		com.error <- error ctx;
+	end;
+	Lexer.old_format := Common.defined com Define.OldErrorFormat;
+	if !Lexer.old_format && !Parser.in_display then begin
+		let p = DisplayPosition.display_position#get in
+		(* convert byte position to utf8 position *)
+		try
+			let content = Std.input_file ~bin:true (Path.get_real_path p.pfile) in
+			let pos = Extlib_leftovers.UTF8.length (String.sub content 0 p.pmin) in
+			DisplayPosition.display_position#set { p with pmin = pos; pmax = pos }
+		with _ ->
+			() (* ignore *)
+	end
+
+let process_display_file com actx =
+	let get_module_path_from_file_path com spath =
+		let rec loop = function
+			| [] -> None
+			| cp :: l ->
+				let cp = (if cp = "" then "./" else cp) in
+				let c = Path.add_trailing_slash (Path.get_real_path cp) in
+				let clen = String.length c in
+				if clen < String.length spath && String.sub spath 0 clen = c then begin
+					let path = String.sub spath clen (String.length spath - clen) in
+					(try
+						let path = Path.parse_path path in
+						(match loop l with
+						| Some x as r when String.length (s_type_path x) < String.length (s_type_path path) -> r
+						| _ -> Some path)
+					with _ -> loop l)
+				end else
+					loop l
+		in
+		loop com.class_path
+	in
+	match com.display.dms_display_file_policy with
+		| DFPNo ->
+			DPKNone
+		| DFPOnly when (DisplayPosition.display_position#get).pfile = file_input_marker ->
+			actx.classes <- [];
+			com.main_class <- None;
+			begin match !TypeloadParse.current_stdin with
+			| Some input ->
+				TypeloadParse.current_stdin := None;
+				DPKInput input
+			| None ->
+				DPKNone
+			end
+		| dfp ->
+			if dfp = DFPOnly then begin
+				actx.classes <- [];
+				com.main_class <- None;
+			end;
+			let real = Path.get_real_path (DisplayPosition.display_position#get).pfile in
+			let path = match get_module_path_from_file_path com real with
+			| Some path ->
+				if com.display.dms_kind = DMPackage then DisplayException.raise_package (fst path);
+				let path = match ExtString.String.nsplit (snd path) "." with
+					| [name;"macro"] ->
+						(* If we have a .macro.hx path, don't add the file to classes because the compiler won't find it.
+						   This can happen if we're completing in such a file. *)
+						DPKMacro (fst path,name)
+					| [name] ->
+						actx.classes <- path :: actx.classes;
+						DPKNormal path
+					| [name;target] ->
+						let path = fst path, name in
+						actx.classes <- path :: actx.classes;
+						DPKNormal path
+					| e ->
+						die "" __LOC__
+				in
+				path
+			| None ->
+				if not (Sys.file_exists real) then failwith "Display file does not exist";
+				(match List.rev (ExtString.String.nsplit real Path.path_sep) with
+				| file :: _ when file.[0] >= 'a' && file.[0] <= 'z' -> failwith ("Display file '" ^ file ^ "' should not start with a lowercase letter")
+				| _ -> ());
+				DPKDirect real
+			in
+			Common.log com ("Display file : " ^ real);
+			Common.log com ("Classes found : ["  ^ (String.concat "," (List.map s_type_path actx.classes)) ^ "]");
+			path
+
+(* 3. Loaders for display file that might be called *)
+
+let load_display_module_in_macro tctx display_file_dot_path clear = match display_file_dot_path with
+	| Some cpath ->
+		let p = null_pos in
+		begin try
+			let open Typecore in
+			let _, mctx = MacroContext.get_macro_context tctx p in
+			(* Tricky stuff: We want to remove the module from our lookups and load it again in
+				display mode. This covers some cases like --macro typing it in non-display mode (issue #7017). *)
+			if clear then begin
+				begin try
+					let m = Hashtbl.find mctx.com.module_lut cpath in
+					Hashtbl.remove mctx.com.module_lut cpath;
+					Hashtbl.remove mctx.com.type_to_module cpath;
+					List.iter (fun mt ->
+						let ti = Type.t_infos mt in
+						Hashtbl.remove mctx.com.module_lut ti.mt_path;
+						Hashtbl.remove mctx.com.type_to_module ti.mt_path;
+					) m.m_types
+				with Not_found ->
+					()
+				end;
+			end;
+			let _ = MacroContext.load_macro_module tctx cpath true p in
+			Finalization.finalize mctx;
+			Some mctx
+		with DisplayException.DisplayException _ | Parser.TypePath _ as exc ->
+			raise exc
+		| _ ->
+			None
+		end
+	| None ->
+		None
+
+let load_display_file_standalone (ctx : Typecore.typer) file =
+	let com = ctx.com in
+	let pack,decls = TypeloadParse.parse_module_file com file null_pos in
+	let path = Path.FilePath.parse file in
+	let name = match path.file_name with
+		| None -> "?DISPLAY"
+		| Some name -> name
+	in
+	begin match path.directory with
+		| None -> ()
+		| Some dir ->
+			(* Chop off number of package parts from the dir and use that as class path. *)
+			let parts = ExtString.String.nsplit dir (if path.backslash then "\\" else "/") in
+			let parts = List.rev (ExtList.List.drop (List.length pack) (List.rev parts)) in
+			let dir = ExtString.String.join (if path.backslash then "\\" else "/") parts in
+			com.class_path <- dir :: com.class_path
+	end;
+	ignore(TypeloadModule.type_module ctx (pack,name) file ~dont_check_path:true decls null_pos)
+
+let load_display_content_standalone (ctx : Typecore.typer) input =
+	let com = ctx.com in
+	let file = file_input_marker in
+	let p = {pfile = file; pmin = 0; pmax = 0} in
+	let parsed = TypeloadParse.parse_file_from_string com file p input in
+	let pack,decls = TypeloadParse.handle_parser_result com p parsed in
+	ignore(TypeloadModule.type_module ctx (pack,"?DISPLAY") file ~dont_check_path:true decls p)
+
+(* 4. Display processing before typing *)
+
+let maybe_load_display_file_before_typing tctx display_file_dot_path = match display_file_dot_path with
+	| DPKMacro path ->
+		ignore(load_display_module_in_macro tctx (Some path) true);
+		Some path
+	| DPKNormal path ->
+		Some path
+	| DPKNone ->
+		None
+	| DPKDirect file ->
+		load_display_file_standalone tctx file;
+		None
+	| DPKInput input ->
+		load_display_content_standalone tctx input;
+		None
+
+(* 5. Display processing after typing *)
+
+let handle_display_after_typing ctx tctx display_file_dot_path =
+	let com = ctx.com in
+	if ctx.com.display.dms_kind = DMNone & ctx.has_error then raise Abort;
+	begin match ctx.com.display.dms_kind,!Parser.delayed_syntax_completion with
+		| DMDefault,Some(kind,subj) -> DisplayOutput.handle_syntax_completion com kind subj
+		| _ -> ()
+	end;
+	if ctx.com.display.dms_exit_during_typing then begin
+		if ctx.has_next || ctx.has_error then raise Abort;
+		(* If we didn't find a completion point, load the display file in macro mode. *)
+		if com.display_information.display_module_has_macro_defines then
+			ignore(load_display_module_in_macro tctx display_file_dot_path true);
+		let no_completion_point_found = "No completion point was found" in
+		match com.json_out with
+		| Some _ ->
+			raise (DisplayException.DisplayException DisplayNoResult)
+		| None ->
+			failwith no_completion_point_found;
+	end
+
+(* 6. Display processing after finalization *)
+
+let promote_type_hints (tctx : Typecore.typer) =
+	let open Type in
+	let rec explore_type_hint (md,p,t) =
+		match t with
+		| TMono r -> (match r.tm_type with None -> () | Some t -> explore_type_hint (md,p,t))
+		| TLazy f -> explore_type_hint (md,p,lazy_type f)
+		| TInst(({cl_name_pos = pn;cl_path = (_,name)}),_)
+		| TEnum(({e_name_pos = pn;e_path = (_,name)}),_)
+		| TType(({t_name_pos = pn;t_path = (_,name)}),_)
+		| TAbstract(({a_name_pos = pn;a_path = (_,name)}),_) ->
+			md.m_type_hints <- (p,pn) :: md.m_type_hints;
+		| TDynamic _ -> ()
+		| TFun _ | TAnon _ -> ()
+	in
+	List.iter explore_type_hint tctx.g.type_hints
+
+let process_global_display_mode com tctx =
+	promote_type_hints tctx;
+	match com.display.dms_kind with
+	| DMUsage (with_definition,_,_) ->
+		FindReferences.find_references tctx com with_definition
+	| DMImplementation ->
+		FindReferences.find_implementations tctx com
+	| DMModuleSymbols (Some "") -> ()
+	| DMModuleSymbols filter ->
+		let open CompilationCache in
+		let cs = com.cs in
+		let symbols =
+			let l = cs#get_context_files ((Define.get_signature com.defines) :: (match com.get_macros() with None -> [] | Some com -> [Define.get_signature com.defines])) in
+			List.fold_left (fun acc (file_key,cfile) ->
+				let file = cfile.c_file_path in
+				if (filter <> None || DisplayPosition.display_position#is_in_file (com.file_keys#get file)) then
+					(file,DocumentSymbols.collect_module_symbols (Some (file,get_module_name_of_cfile file cfile)) (filter = None) (cfile.c_package,cfile.c_decls)) :: acc
+				else
+					acc
+			) [] l
+		in
+		DisplayException.raise_module_symbols (DocumentSymbols.Printer.print_module_symbols com symbols filter)
+	| _ -> ()
+
+let handle_display_after_finalization ctx tctx display_file_dot_path =
+	let com = ctx.com in
+	(* Special case for diagnostics: We don't want to load the display file in macro mode because there's a chance it might not be
+		macro-compatible. This means that we might some macro-specific diagnostics, but I don't see what we could do about that. *)
+	let should_load_in_macro =
+		(* Special case for the special case: If the display file has a block which becomes active if `macro` is defined, we can safely
+			type the module in macro context. (#8682). *)
+		not (is_diagnostics com) || com.display_information.display_module_has_macro_defines
+	in
+	if ctx.com.display.dms_force_macro_typing && should_load_in_macro then begin
+		match load_display_module_in_macro tctx display_file_dot_path false with
+		| None -> ()
+		| Some mctx ->
+			(* We don't need a full macro flush here because we're not going to run any macros. *)
+			let _, types, modules = Finalization.generate mctx in
+			mctx.Typecore.com.types <- types;
+			mctx.Typecore.com.Common.modules <- modules
+	end;
+	process_global_display_mode com tctx;
+	begin match com.report_mode with
+	| RMDiagnostics _ ->
+		DisplayOutput.emit_diagnostics com
+	| RMStatistics ->
+		DisplayOutput.emit_statistics tctx
+	| RMNone ->
+		()
+	end

+ 3 - 0
src/compiler/displayProcessingGlobals.ml

@@ -0,0 +1,3 @@
+exception Completion of string
+
+let file_input_marker = Path.get_full_path "? input"

+ 1 - 1
src/compiler/server.ml

@@ -5,7 +5,7 @@ open Common
 open CompilationCache
 open Timer
 open Type
-open DisplayOutput
+open DisplayProcessingGlobals
 open Json
 open Compiler
 open CompilationContext

+ 3 - 2
src/context/display/displayJson.ml

@@ -8,6 +8,7 @@ open DisplayTypes.DisplayMode
 open Timer
 open Genjson
 open Type
+open DisplayProcessingGlobals
 
 (* Generate the JSON of our times. *)
 let json_of_times root =
@@ -39,7 +40,7 @@ let create_json_context jsonrpc may_resolve =
 	Genjson.create_context ~jsonrpc:jsonrpc (if may_resolve && !supports_resolve then GMMinimum else GMFull)
 
 let send_string j =
-	raise (DisplayOutput.Completion j)
+	raise (Completion j)
 
 let send_json json =
 	send_string (string_of_json json)
@@ -58,7 +59,7 @@ class display_handler (jsonrpc : jsonrpc_handler) com (cs : CompilationCache.t)
 		let file = jsonrpc#get_opt_param (fun () ->
 			let file = jsonrpc#get_string_param "file" in
 			Path.get_full_path file
-		) DisplayOutput.file_input_marker in
+		) file_input_marker in
 		let pos = if requires_offset then jsonrpc#get_int_param "offset" else (-1) in
 		TypeloadParse.current_stdin := jsonrpc#get_opt_param (fun () ->
 			let s = jsonrpc#get_string_param "contents" in