2
0
Эх сурвалжийг харах

[display] support loading display content without file

Simon Krajewski 6 жил өмнө
parent
commit
c296745f39

+ 21 - 0
src/compiler/displayOutput.ml

@@ -288,10 +288,13 @@ let handle_display_argument com file_pos pre_compilation did_something =
 			pmax = pos;
 		}
 
+let file_input_marker = Path.unique_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 classes =
@@ -318,6 +321,16 @@ let process_display_file com classes =
 	match com.display.dms_display_file_policy with
 		| DFPNo ->
 			DPKNone
+		| DFPOnly when (DisplayPosition.display_position#get).pfile = file_input_marker ->
+			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
 				classes := [];
@@ -369,6 +382,14 @@ let load_display_file_standalone ctx file =
 	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 file 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

+ 3 - 0
src/compiler/main.ml

@@ -1048,6 +1048,9 @@ try
 			| DPKDirect file ->
 				DisplayOutput.load_display_file_standalone tctx file;
 				None
+			| DPKInput input ->
+				DisplayOutput.load_display_content_standalone tctx input;
+				None
 		in
 		begin try
 			do_type tctx !config_macros !classes;

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

@@ -55,8 +55,10 @@ class display_handler (jsonrpc : jsonrpc_handler) com (cs : CompilationServer.t)
 		Common.define_value com Define.Display "1"
 
 	method set_display_file was_auto_triggered requires_offset =
-		let file = jsonrpc#get_string_param "file" in
-		let file = Path.unique_full_path file in
+		let file = jsonrpc#get_opt_param (fun () ->
+			let file = jsonrpc#get_string_param "file" in
+			Path.unique_full_path file
+		) DisplayOutput.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

+ 6 - 4
src/typing/typeloadParse.ml

@@ -21,6 +21,7 @@
 
 open Globals
 open Ast
+open Parser
 open DisplayTypes.DiagnosticsSeverity
 open DisplayTypes.DisplayMode
 open Common
@@ -274,7 +275,7 @@ module PdiHandler = struct
 		end;
 end
 
-let parse_module_file com file p =
+let handle_parser_result com file p result =
 	let handle_parser_error msg p =
 		let msg = Parser.error_msg msg in
 		match com.display.dms_error_policy with
@@ -282,7 +283,7 @@ let parse_module_file com file p =
 			| EPIgnore -> ()
 			| EPCollect -> add_diagnostics_message com msg p DKParserError Error
 	in
-	let pack,decls = match (!parse_hook) com file p with
+	match result with
 		| ParseSuccess data -> data
 		| ParseDisplayFile(data,pdi) ->
 			begin match pdi.pd_errors with
@@ -294,8 +295,9 @@ let parse_module_file com file p =
 		| ParseError(data,(msg,p),_) ->
 			handle_parser_error msg p;
 			data
-	in
-	pack,decls
+
+let parse_module_file com file p =
+	handle_parser_result com file p ((!parse_hook) com file p)
 
 let parse_module' com m p =
 	let remap = ref (fst m) in