remove some diagnostics stuff, add some other diagnostics stuff

src/compiler/compilationContext.ml

@@ -47,6 +47,7 @@ type server_accept = unit -> (bool * (bool -> string option) * (string -> unit)
 type server_api = {
 	before_anything : compilation_context -> unit;
 	after_arg_parsing : compilation_context -> unit;
+	after_compilation : compilation_context -> unit;
 	init_wait_socket : string -> int -> server_accept;
 	init_wait_connect : string -> int -> server_accept;
 	init_wait_stdio : unit -> server_accept;

src/compiler/compiler.ml

@@ -106,7 +106,7 @@ let process_display_configuration ctx =
 	let com = ctx.com in
 	if com.display.dms_kind <> DMNone then begin
 		com.warning <-
-			if com.display.dms_error_policy = EPCollect then
+			if com.diagnostics <> None then
 				(fun w options s p ->
 					match Warning.get_mode w (com.warning_options @ options) with
 					| WMEnable ->
@@ -188,14 +188,20 @@ let load_display_module_in_macro tctx display_file_dot_path clear = match displa
 	| None ->
 		None
 
-let run_or_diagnose com f arg =
+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 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;
-		Diagnostics.run com;
+		emit_diagnostics ctx
 	in
-	match com.display.dms_kind with
-	| DMDiagnostics _ ->
-		begin try
+	if com.diagnostics <> None then begin try
 			f arg
 		with
 		| Error.Error(msg,p) ->
@@ -205,11 +211,11 @@ let run_or_diagnose com f arg =
 		| Lexer.Error(msg,p) ->
 			handle_diagnostics (Lexer.error_msg msg) p DisplayTypes.DiagnosticsKind.DKParserError
 		end
-	| _ ->
+	else
 		f arg
 
 (** Creates the typer context and types [classes] into it. *)
-let do_type tctx actx =
+let do_type ctx tctx actx =
 	let com = tctx.Typecore.com in
 	let t = Timer.timer ["typing"] in
 	Option.may (fun cs -> CommonCache.maybe_add_context_sign cs com "before_init_macros") (CompilationServer.get ());
@@ -218,7 +224,7 @@ let do_type tctx actx =
 	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 com (fun () ->
+	run_or_diagnose ctx (fun () ->
 		if com.display.dms_kind <> DMNone then Option.may (DisplayTexpr.check_display_file tctx) (CompilationServer.get ());
 		List.iter (fun cpath -> ignore(tctx.Typecore.g.Typecore.do_load_module tctx cpath null_pos)) (List.rev actx.classes);
 		Finalization.finalize tctx;
@@ -260,17 +266,16 @@ 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 com Finalization.generate tctx 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 = match ctx.com.display.dms_kind with
+	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). *)
-		| DMDiagnostics _ -> com.display_information.display_module_has_macro_defines
-		| _ -> true
+		ctx.com.diagnostics = None || 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
@@ -282,6 +287,7 @@ let filter ctx tctx display_file_dot_path =
 			mctx.Typecore.com.Common.modules <- modules
 	end;
 	DisplayOutput.process_global_display_mode com tctx;
+	if com.diagnostics <> None then emit_diagnostics ctx;
 	DeprecationCheck.run com;
 	Filters.run com tctx main;
 	t()
@@ -521,7 +527,7 @@ let compile ctx actx =
 				None
 		in
 		begin try
-			do_type tctx actx
+			do_type ctx tctx actx
 		with TypeloadParse.DisplayInMacroBlock ->
 			ignore(load_display_module_in_macro tctx display_file_dot_path true);
 		end;
@@ -677,10 +683,6 @@ with
 	| Parser.SyntaxCompletion(kind,subj) ->
 		DisplayOutput.handle_syntax_completion com kind subj;
 		error ctx ("Error: No completion point was found") null_pos
-	| DisplayException(DisplayDiagnostics dctx) ->
-		let s = Json.string_of_json (DiagnosticsPrinter.json_of_diagnostics dctx) in
-		DisplayPosition.display_position#reset;
-		raise (DisplayOutput.Completion s)
 	| DisplayException(ModuleSymbols s | Statistics s | Metadata s) ->
 		DisplayPosition.display_position#reset;
 		raise (DisplayOutput.Completion s)
@@ -722,6 +724,7 @@ let compile_ctx server_api comm ctx =
 			compile ctx actx;
 		);
 		finalize ctx;
+		server_api.after_compilation ctx;
 	in
 	try
 		if ctx.has_error then begin
@@ -733,6 +736,7 @@ let compile_ctx server_api comm ctx =
 		end
 	with
 		| DisplayOutput.Completion str ->
+			server_api.after_compilation ctx;
 			ServerMessage.completion str;
 			comm.write_err str;
 			false

src/compiler/displayOutput.ml

@@ -230,8 +230,7 @@ let handle_display_argument com file_pos actx =
 		actx.did_something <- true;
 		(try Memory.display_memory com with e -> prerr_endline (Printexc.get_backtrace ()));
 	| "diagnostics" ->
-		com.display <- DisplayMode.create (DMDiagnostics []);
-		Parser.display_mode := DMDiagnostics [];
+		com.diagnostics <- Some []
 	| _ ->
 		let file, pos = try ExtString.String.split file_pos "@" with _ -> failwith ("Invalid format: " ^ file_pos) in
 		let file = unquote file in
@@ -253,7 +252,8 @@ let handle_display_argument com file_pos actx =
 			| "module-symbols" ->
 				DMModuleSymbols None;
 			| "diagnostics" ->
-				DMDiagnostics [file_unique];
+				com.diagnostics <- Some [file_unique];
+				DMNone
 			| "statistics" ->
 				DMStatistics
 			| "signature" ->
@@ -271,7 +271,11 @@ let handle_display_argument com file_pos actx =
 						DMDefault
 		in
 		let pos = try int_of_string pos with _ -> failwith ("Invalid format: "  ^ pos) in
-		com.display <- DisplayMode.create mode;
+		let dm = DisplayMode.create mode in
+		let dm = {dm with
+			dms_display_file_policy = if com.diagnostics <> None then DFPAlso else dm.dms_display_file_policy
+		} in
+		com.display <- dm;
 		Parser.display_mode := mode;
 		if not com.display.dms_full_typing then Common.define_value com Define.Display (if smode <> "" then smode else "1");
 		DisplayPosition.display_position#set {
@@ -408,8 +412,6 @@ let process_global_display_mode com tctx =
 		FindReferences.find_references tctx com with_definition
 	| DMImplementation ->
 		FindReferences.find_implementations tctx com
-	| DMDiagnostics _ ->
-		Diagnostics.run com
 	| DMStatistics ->
 		let stats = Statistics.collect_statistics tctx [SFFile (DisplayPosition.display_position#get).pfile] true in
 		raise_statistics (Statistics.Printer.print_statistics stats)

src/compiler/server.ml

@@ -13,10 +13,12 @@ open CompilationContext
 exception Dirty of path
 exception ServerError of string
 
+let has_error ctx =
+	ctx.has_error || ctx.com.Common.has_error
+
 let check_display_flush ctx f_otherwise = match ctx.com.json_out with
 	| None ->
-		begin match ctx.com.display.dms_kind with
-		| DMDiagnostics _->
+		if ctx.com.diagnostics <> None then begin
 			List.iter (fun msg ->
 				let msg,p,kind = match msg with
 					| CMInfo(msg,p) -> msg,p,DisplayTypes.DiagnosticsSeverity.Information
@@ -26,11 +28,10 @@ let check_display_flush ctx f_otherwise = match ctx.com.json_out with
 				add_diagnostics_message ctx.com msg p DisplayTypes.DiagnosticsKind.DKCompilerError kind
 			) (List.rev ctx.messages);
 			raise (Completion (Diagnostics.print ctx.com))
-		| _ ->
+		end else
 			f_otherwise ()
-		end
 	| Some api ->
-		if ctx.has_error then begin
+		if has_error ctx then begin
 			let errors = List.map (fun msg ->
 				let msg,p,i = match msg with
 					| CMInfo(msg,p) -> msg,p,3
@@ -46,7 +47,6 @@ let check_display_flush ctx f_otherwise = match ctx.com.json_out with
 			api.send_error errors
 		end
 
-
 let current_stdin = ref None
 
 let parse_file cs com file p =
@@ -189,12 +189,12 @@ module Communication = struct
 				| CMInfo _ -> print_endline (compiler_message_string msg)
 				| CMWarning _ | CMError _ -> prerr_endline (compiler_message_string msg)
 			) (List.rev ctx.messages);
-			if ctx.has_error && !Helper.prompt then begin
+			if has_error ctx && !Helper.prompt then begin
 				print_endline "Press enter to exit...";
 				ignore(read_line());
 			end;
 			flush stdout;
-			if ctx.has_error then exit 1
+			if has_error ctx then exit 1
 		);
 		is_server = false;
 	}
@@ -218,7 +218,7 @@ module Communication = struct
 					)
 					(List.rev ctx.messages);
 				sctx.was_compilation <- ctx.com.display.dms_full_typing;
-				if ctx.has_error then begin
+				if has_error ctx then begin
 					measure_times := false;
 					write "\x02\n"
 				end else
@@ -502,6 +502,12 @@ let after_arg_parsing sctx ctx =
 		Hashtbl.add sctx.class_paths sign com.class_path;
 		()
 
+let after_compilation sctx ctx =
+	(* if not (has_error ctx) then *)
+		(* maybe_cache_context sctx ctx.com *)
+	(* TODO: not yet, trying to get parity first *)
+	()
+
 let mk_length_prefixed_communication allow_nonblock chin chout =
 	let sin = Unix.descr_of_in_channel chin in
 	let chin = IO.input_channel chin in
@@ -631,6 +637,7 @@ let rec process sctx comm args =
 	let api = {
 		before_anything = before_anything sctx;
 		after_arg_parsing = after_arg_parsing sctx;
+		after_compilation = after_compilation sctx;
 		init_wait_socket = init_wait_socket;
 		init_wait_connect = init_wait_connect;
 		init_wait_stdio = init_wait_stdio;

src/context/common.ml

@@ -327,6 +327,8 @@ type context = {
 	mutable stored_typed_exprs : (int, texpr) PMap.t;
 	pass_debug_messages : string DynArray.t;
 	overload_cache : ((path * string),(Type.t * tclass_field) list) Hashtbl.t;
+	mutable has_error : bool;
+	mutable diagnostics : Path.UniqueKey.t list option;
 	(* output *)
 	mutable file : string;
 	mutable flash_version : float;
@@ -770,6 +772,8 @@ let create version args =
 		memory_marker = memory_marker;
 		parser_cache = Hashtbl.create 0;
 		json_out = None;
+		has_error = false;
+		diagnostics = None;
 	}
 
 let log com str =
@@ -1126,6 +1130,7 @@ let utf16_to_utf8 str =
 	Buffer.contents b
 
 let add_diagnostics_message com s p kind sev =
+	if sev = DisplayTypes.DiagnosticsSeverity.Error then com.has_error <- true;
 	let di = com.shared.shared_display_information in
 	di.diagnostics_messages <- (s,p,kind,sev) :: di.diagnostics_messages
 

src/context/display/deprecationCheck.ml

@@ -12,12 +12,10 @@ let warn_deprecation com s p_usage =
 	let pkey p = (p.pfile,p.pmin) in
 	if not (Hashtbl.mem warned_positions (pkey p_usage)) then begin
 		Hashtbl.add warned_positions (pkey p_usage) (s,p_usage);
-		match com.display.dms_kind with
-		| DMDiagnostics _ ->
-			()
-		| _ ->
+		if com.diagnostics = None then begin
 			let options = Warning.from_meta (!curclass.cl_meta @ !curfield.cf_meta) in
 			com.warning WDeprecated options s p_usage;
+		end
 	end
 
 let print_deprecation_message com meta s p_usage =

src/context/display/diagnostics.ml

@@ -11,7 +11,10 @@ open DisplayException
 let add_removable_code ctx s p prange =
 	ctx.removable_code <- (s,p,prange) :: ctx.removable_code
 
-let is_diagnostics_run com p = DiagnosticsPrinter.is_diagnostics_file (com.file_keys#get p.pfile)
+let is_diagnostics_run com p =
+	let b = DiagnosticsPrinter.is_diagnostics_file com (com.file_keys#get p.pfile) in
+	if b then com.has_error <- true;
+	b
 
 let find_unused_variables com e =
 	let vars = Hashtbl.create 0 in
@@ -99,7 +102,7 @@ let prepare_field dctx com cf = match cf.cf_expr with
 
 let collect_diagnostics dctx com =
 		List.iter (function
-		| TClassDecl c when DiagnosticsPrinter.is_diagnostics_file (com.file_keys#get c.cl_pos.pfile) ->
+		| TClassDecl c when DiagnosticsPrinter.is_diagnostics_file com (com.file_keys#get c.cl_pos.pfile) ->
 			List.iter (prepare_field dctx com) c.cl_ordered_fields;
 			List.iter (prepare_field dctx com) c.cl_ordered_statics;
 			(match c.cl_constructor with None -> () | Some cf -> prepare_field dctx com cf);
@@ -174,12 +177,12 @@ let prepare com =
 	dctx
 
 let secure_generated_code ctx e =
-	if is_diagnostics_run ctx.com e.epos then mk (TMeta((Meta.Extern,[],e.epos),e)) e.etype e.epos else e
+	mk (TMeta((Meta.Extern,[],e.epos),e)) e.etype e.epos
 
 let print com =
 	let dctx = prepare com in
-	Json.string_of_json (DiagnosticsPrinter.json_of_diagnostics dctx)
+	Json.string_of_json (DiagnosticsPrinter.json_of_diagnostics com dctx)
 
 let run com =
 	let dctx = prepare com in
-	DisplayException.raise_diagnostics dctx
+	dctx

src/context/display/diagnosticsPrinter.ml

@@ -9,11 +9,11 @@ open Genjson
 
 type t = DiagnosticsKind.t * pos
 
-let is_diagnostics_file file_key =
-	match (!Parser.display_mode) with
-	| DMDiagnostics [] -> true
-	| DMDiagnostics file_keys -> List.exists (fun key' -> file_key = key') file_keys
-	| _ -> false
+let is_diagnostics_file com file_key =
+	match com.diagnostics with
+	| Some [] -> true
+	| Some file_keys -> List.exists (fun key' -> file_key = key') file_keys
+	| None -> false
 
 module UnresolvedIdentifierSuggestion = struct
 	type t =
@@ -29,7 +29,7 @@ open UnresolvedIdentifierSuggestion
 open CompletionItem
 open CompletionModuleType
 
-let json_of_diagnostics dctx =
+let json_of_diagnostics com dctx =
 	let diag = Hashtbl.create 0 in
 	let add append dk p sev args =
 		let file = if p = null_pos then p.pfile else Path.get_real_path p.pfile in
@@ -57,7 +57,7 @@ let json_of_diagnostics dctx =
 			| DKMissingFields ->
 				true
 		in
-		if p = null_pos || is_diagnostics_file (file_keys#get p.pfile) then add append dk p sev args
+		if p = null_pos || is_diagnostics_file com (file_keys#get p.pfile) then add append dk p sev args
 	in
 	List.iter (fun (s,p,suggestions) ->
 		let suggestions = ExtList.List.filter_map (fun (s,item,r) ->

src/context/display/displayException.ml

@@ -7,7 +7,6 @@ open Genjson
 
 exception DisplayException of display_exception_kind
 
-let raise_diagnostics s = raise (DisplayException(DisplayDiagnostics s))
 let raise_statistics s = raise (DisplayException(Statistics s))
 let raise_module_symbols s = raise (DisplayException(ModuleSymbols s))
 let raise_metadata s = raise (DisplayException(Metadata s))
@@ -164,8 +163,6 @@ let to_json ctx de =
 	| Metadata _ -> die "" __LOC__
 	| DisplaySignatures None ->
 		jnull
-	| DisplayDiagnostics dctx ->
-		DiagnosticsPrinter.json_of_diagnostics dctx
 	| DisplaySignatures Some(sigs,isig,iarg,kind) ->
 		(* We always want full info for signatures *)
 		let ctx = Genjson.create_context GMFull in

src/context/typecore.ml

@@ -228,9 +228,9 @@ let pass_name = function
 	| PForce -> "force"
 	| PFinal -> "final"
 
-let display_error ctx msg p = match ctx.com.display.DisplayMode.dms_error_policy with
-	| DisplayMode.EPShow | DisplayMode.EPIgnore -> ctx.on_error ctx msg p
-	| DisplayMode.EPCollect -> add_diagnostics_message ctx.com msg p DisplayTypes.DiagnosticsKind.DKCompilerError DisplayTypes.DiagnosticsSeverity.Error
+let display_error ctx msg p = match ctx.com.diagnostics with
+	| None -> ctx.on_error ctx msg p
+	| Some _ -> add_diagnostics_message ctx.com msg p DisplayTypes.DiagnosticsKind.DKCompilerError DisplayTypes.DiagnosticsSeverity.Error
 
 let warning ctx w msg p =
 	let options = (Warning.from_meta ctx.curclass.cl_meta) @ (Warning.from_meta ctx.curfield.cf_meta) in

src/core/displayTypes.ml

@@ -215,13 +215,11 @@ module DisplayMode = struct
 		| DMPackage
 		| DMHover
 		| DMModuleSymbols of string option
-		| DMDiagnostics of Path.UniqueKey.t list
 		| DMStatistics
 		| DMSignature
 
 	type error_policy =
 		| EPIgnore
-		| EPCollect
 		| EPShow
 
 	type display_file_policy =
@@ -285,12 +283,6 @@ module DisplayMode = struct
 				dms_force_macro_typing = false;
 				dms_per_file = true;
 			}
-		| DMDiagnostics files -> { default_compilation_settings with
-				dms_kind = DMDiagnostics files;
-				dms_error_policy = EPCollect;
-				dms_display_file_policy = if files = [] then DFPNo else DFPAlso;
-				dms_per_file = true;
-			}
 		| DMStatistics -> { settings with
 				dms_full_typing = true;
 				dms_inline = false;
@@ -313,7 +305,6 @@ module DisplayMode = struct
 		| DMUsage (false,_,_) -> "references"
 		| DMModuleSymbols None -> "module-symbols"
 		| DMModuleSymbols (Some s) -> "workspace-symbols " ^ s
-		| DMDiagnostics _ -> "diagnostics"
 		| DMStatistics -> "statistics"
 		| DMSignature -> "signature"
 end
@@ -397,7 +388,6 @@ type diagnostics_context = {
 }
 
 type display_exception_kind =
-	| DisplayDiagnostics of diagnostics_context
 	| Statistics of string
 	| ModuleSymbols of string
 	| Metadata of string

src/syntax/parser.ml

@@ -399,7 +399,7 @@ let check_type_decl_completion mode pmax s =
 		if pmax <= p.pmin && pmin >= p.pmax then begin
 			let so,p = match Stream.peek s with
 			| Some((Const(Ident name),p)) when display_position#enclosed_in p -> (Some name),p
-			| Some(e,p) -> print_endline (s_token e); None,p
+			| Some(e,p) -> None,p
 			| _ -> None,p
 			in
 			delay_syntax_completion (SCTypeDecl mode) so p

src/typing/functionArguments.ml

@@ -31,7 +31,7 @@ let type_function_arg_value ctx t c do_display =
 				| TField({eexpr = TTypeExpr _},FStatic({cl_kind = KAbstractImpl a},cf)) when a.a_enum && has_class_field_flag cf CfEnum -> Some e
 				| TCast(e,None) -> loop e
 				| _ ->
-					if ctx.com.display.dms_kind = DMNone || ctx.com.display.dms_inline && ctx.com.display.dms_error_policy = EPCollect then
+					if ctx.com.display.dms_kind = DMNone || ctx.com.diagnostics <> None then
 						display_error ctx "Parameter default value should be constant" p;
 					None
 			in

src/typing/typeloadFields.ml

@@ -852,7 +852,7 @@ module TypeBinding = struct
 					| _ -> !analyzer_run_on_expr_ref ctx.com e
 				in
 				let require_constant_expression e msg =
-					if ctx.com.display.dms_kind <> DMNone && ctx.com.display.dms_error_policy <> EPCollect then
+					if ctx.com.display.dms_kind <> DMNone then
 						e
 					else match Optimizer.make_constant_expression ctx (maybe_run_analyzer e) with
 					| Some e -> e
@@ -871,7 +871,7 @@ module TypeBinding = struct
 					(* disallow initialization of non-physical fields (issue #1958) *)
 					display_error ctx "This field cannot be initialized because it is not a real variable" p; e
 				| Var v when not fctx.is_static ->
-					let e = if ctx.com.display.dms_display && ctx.com.display.dms_error_policy <> EPCollect then
+					let e = if ctx.com.display.dms_display then
 						e
 					else begin
 						let rec check_this e = match e.eexpr with

src/typing/typeloadParse.ml

@@ -270,9 +270,10 @@ let handle_parser_result com p result =
 	let handle_parser_error msg p =
 		let msg = Parser.error_msg msg in
 		match com.display.dms_error_policy with
-			| EPShow -> typing_error msg p
+			| EPShow ->
+				if com.diagnostics = None then typing_error msg p
+				else add_diagnostics_message com msg p DKParserError Error
 			| EPIgnore -> ()
-			| EPCollect -> add_diagnostics_message com msg p DKParserError Error
 	in
 	match result with
 		| ParseSuccess(data,is_display_file,pdi) ->

src/typing/typer.ml

@@ -456,14 +456,14 @@ and type_ident ctx i p mode with_type =
 					if ctx.in_display then begin
 						raise (Error (err,p))
 					end;
-					match ctx.com.display.dms_kind with
+					if Diagnostics.is_diagnostics_run ctx.com p then begin
+						DisplayToplevel.handle_unresolved_identifier ctx i p false;
+						DisplayFields.handle_missing_ident ctx i mode with_type p;
+						let t = mk_mono() in
+						AKExpr (mk (TIdent i) t p)
+					end else match ctx.com.display.dms_kind with
 						| DMNone ->
 							raise (Error(err,p))
-						| DMDiagnostics _ ->
-							DisplayToplevel.handle_unresolved_identifier ctx i p false;
-							DisplayFields.handle_missing_ident ctx i mode with_type p;
-							let t = mk_mono() in
-							AKExpr (mk (TIdent i) t p)
 						| _ ->
 							display_error ctx (error_msg err) p;
 							let t = mk_mono() in

src/typing/typerDisplay.ml

@@ -479,7 +479,7 @@ and display_expr ctx e_ast e dk mode with_type p =
 					raise_toplevel ctx dk with_type (name,p)
 				end
 		end
-	| DMDefault | DMNone | DMModuleSymbols _ | DMDiagnostics _ | DMStatistics ->
+	| DMDefault | DMNone | DMModuleSymbols _ | DMStatistics ->
 		let fields = DisplayFields.collect ctx e_ast e dk with_type p in
 		let item = completion_item_of_expr ctx e in
 		let iterator = try