[display] get rid of TypeloadParse.current_stdin

src/compiler/displayProcessing.ml

@@ -143,11 +143,11 @@ let process_display_file com actx =
 		| 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;
+			begin match com.file_contents with
+			| Some [_, Some input] ->
+				com.file_contents <- None;
 				DPKInput input
-			| None ->
+			| _ ->
 				DPKNone
 			end
 		| dfp ->

src/compiler/server.ml

@@ -47,7 +47,7 @@ let parse_file cs com file p =
 	and fkey = com.file_keys#get file in
 	let is_display_file = DisplayPosition.display_position#is_in_file (com.file_keys#get ffile) in
 	match is_display_file, !current_stdin with
-	| true, Some stdin when Common.defined com Define.DisplayStdin ->
+	| true, Some stdin when (com.file_contents <> None || Common.defined com Define.DisplayStdin) ->
 		TypeloadParse.parse_file_from_string com file p stdin
 	| _ ->
 		let ftime = file_time ffile in

src/context/common.ml

@@ -290,7 +290,7 @@ let s_compiler_stage = function
 type report_mode =
 	| RMNone
 	| RMLegacyDiagnostics of (Path.UniqueKey.t list)
-	| RMDiagnostics of (Path.UniqueKey.t * string option (* file contents *)) list
+	| RMDiagnostics of (Path.UniqueKey.t list)
 	| RMStatistics
 
 class virtual ['key,'value] lookup = object(self)
@@ -401,6 +401,7 @@ type context = {
 	display_information : display_information;
 	file_lookup_cache : (string,string option) lookup;
 	file_keys : file_keys;
+	mutable file_contents : (Path.UniqueKey.t * string option) list option;
 	readdir_cache : (string * string,(string array) option) lookup;
 	parser_cache : (string,(type_def * pos) list) lookup;
 	module_to_file : (path,string) lookup;
@@ -876,6 +877,7 @@ let create compilation_step cs version args =
 		};
 		file_lookup_cache = new hashtbl_lookup;
 		file_keys = new file_keys;
+		file_contents = None;
 		readdir_cache = new hashtbl_lookup;
 		module_to_file = new hashtbl_lookup;
 		stored_typed_exprs = new hashtbl_lookup;

src/context/display/diagnosticsPrinter.ml

@@ -27,8 +27,7 @@ let make_diagnostic kd p sev code args = {
 let is_diagnostics_file com file_key =
 	match com.report_mode with
 	| RMLegacyDiagnostics [] | RMDiagnostics [] -> true
-	| RMLegacyDiagnostics file_keys -> List.exists (fun key' -> file_key = key') file_keys
-	| RMDiagnostics file_keys -> List.exists (fun (key',_) -> file_key = key') file_keys
+	| RMLegacyDiagnostics file_keys | RMDiagnostics file_keys -> List.mem file_key file_keys
 	| _ -> false
 
 module UnresolvedIdentifierSuggestion = struct

src/context/display/displayJson.ml

@@ -60,11 +60,12 @@ class display_handler (jsonrpc : jsonrpc_handler) com (cs : CompilationCache.t)
 			Path.get_full_path file
 		) 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 () ->
+		ignore(jsonrpc#get_opt_param (fun () ->
 			let s = jsonrpc#get_string_param "contents" in
-			Common.define com Define.DisplayStdin; (* TODO: awkward *)
+			let file_unique = com.file_keys#get file in
+			com.file_contents <- Some [file_unique, Some s];
 			Some s
-		) None;
+		) None);
 		Parser.was_auto_triggered := was_auto_triggered;
 		DisplayPosition.display_position#set {
 			pfile = file;
@@ -147,7 +148,8 @@ let handler =
 					pmax = -1;
 				};
 
-				hctx.com.report_mode <- RMDiagnostics [file_unique, contents];
+				hctx.com.file_contents <- Some [file_unique, contents];
+				hctx.com.report_mode <- RMDiagnostics [file_unique];
 				hctx.com.display <- { hctx.com.display with dms_display_file_policy = DFPAlso; dms_per_file = true; dms_populate_cache = !ServerConfig.populate_cache_from_display};
 			end else begin
 				let file_contents = hctx.jsonrpc#get_opt_param (fun () ->
@@ -170,8 +172,10 @@ let handler =
 						| _ -> invalid_arg "fileContents"
 					) file_contents in
 
-					DisplayPosition.display_position#set_files (List.map (fun (k, _) -> k) file_contents);
-					hctx.com.report_mode <- RMDiagnostics file_contents
+					let files = (List.map (fun (k, _) -> k) file_contents) in
+					DisplayPosition.display_position#set_files files;
+					hctx.com.file_contents <- Some file_contents;
+					hctx.com.report_mode <- RMDiagnostics files
 			end
 		);
 		"display/implementation", (fun hctx ->

src/typing/typeloadParse.ml

@@ -58,23 +58,11 @@ let parse_file_from_lexbuf com file p lexbuf =
 let parse_file_from_string com file p string =
 	parse_file_from_lexbuf com file p (Sedlexing.Utf8.from_string string)
 
-let current_stdin = ref None (* TODO: we're supposed to clear this at some point *)
-
 let parse_file com file p =
-	let contents = match com.report_mode with
-		| RMDiagnostics files ->
+	let contents = match com.file_contents with
+		| Some files ->
 			(try List.assoc (com.file_keys#get file) files with Not_found -> None)
-		| _ when (Common.defined com Define.DisplayStdin) && DisplayPosition.display_position#is_in_file (com.file_keys#get file) ->
-			Some (match !current_stdin with
-				| Some s ->
-					s
-				| None ->
-					let s = Std.input_all stdin in
-					close_in stdin;
-					current_stdin := Some s;
-					s
-			)
-		| _ -> None
+		| None -> None
 	in
 
 	match contents with