generalize

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.diagnostics <> None then
+			if is_diagnostics com then
 				(fun w options s p ->
 					match Warning.get_mode w (com.warning_options @ options) with
 					| WMEnable ->
@@ -194,6 +194,11 @@ let emit_diagnostics ctx =
 	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 =
@@ -201,7 +206,7 @@ let run_or_diagnose ctx f arg =
 		add_diagnostics_message com msg p kind DisplayTypes.DiagnosticsSeverity.Error;
 		emit_diagnostics ctx
 	in
-	if com.diagnostics <> None then begin try
+	if is_diagnostics com then begin try
 			f arg
 		with
 		| Error.Error(msg,p) ->
@@ -275,7 +280,7 @@ let filter ctx tctx display_file_dot_path =
 	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). *)
-		ctx.com.diagnostics = None || com.display_information.display_module_has_macro_defines
+		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
@@ -287,7 +292,14 @@ 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;
+	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()
@@ -683,7 +695,7 @@ with
 	| Parser.SyntaxCompletion(kind,subj) ->
 		DisplayOutput.handle_syntax_completion com kind subj;
 		error ctx ("Error: No completion point was found") null_pos
-	| DisplayException(ModuleSymbols s | Statistics s | Metadata s) ->
+	| DisplayException(ModuleSymbols s | Metadata s) ->
 		DisplayPosition.display_position#reset;
 		raise (DisplayOutput.Completion s)
 	| EvalExceptions.Sys_exit i | Hlinterp.Sys_exit i ->

src/compiler/displayOutput.ml

@@ -230,53 +230,53 @@ 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.diagnostics <- Some []
+		com.report_mode <- RMDiagnostics []
 	| _ ->
 		let file, pos = try ExtString.String.split file_pos "@" with _ -> failwith ("Invalid format: " ^ file_pos) in
 		let file = unquote file in
 		let file_unique = com.file_keys#get file in
 		let pos, smode = try ExtString.String.split pos "@" with _ -> pos,"" in
-		let mode = match smode with
+		let create mode =
+			Parser.display_mode := mode;
+			DisplayMode.create mode
+		in
+		let dm = match smode with
 			| "position" ->
-				DMDefinition
+				create DMDefinition
 			| "usage" ->
-				DMUsage (false,false,false)
-			(*| "rename" ->
-				DMUsage true*)
+				create (DMUsage (false,false,false))
 			| "package" ->
-				DMPackage
+				create DMPackage
 			| "type" ->
-				DMHover
+				create DMHover
 			| "toplevel" ->
-				DMDefault
+				create DMDefault
 			| "module-symbols" ->
-				DMModuleSymbols None;
+				create (DMModuleSymbols None)
 			| "diagnostics" ->
-				com.diagnostics <- Some [file_unique];
-				DMNone
+				com.report_mode <- RMDiagnostics [file_unique];
+				let dm = create DMNone in
+				{dm with dms_display_file_policy = DFPAlso}
 			| "statistics" ->
-				DMStatistics
+				com.report_mode <- RMStatistics;
+				let dm = create DMNone in
+				{dm with dms_display_file_policy = DFPAlso; dms_error_policy = EPIgnore}
 			| "signature" ->
-				DMSignature
+				create DMSignature
 			| "" ->
-				DMDefault
+				create DMDefault
 			| _ ->
 				let smode,arg = try ExtString.String.split smode "@" with _ -> pos,"" in
 				match smode with
 					| "resolve" ->
-						DMResolve arg
+						create (DMResolve arg)
 					| "workspace-symbols" ->
-						DMModuleSymbols (Some arg)
+						create (DMModuleSymbols (Some arg))
 					| _ ->
-						DMDefault
+						create DMDefault
 		in
 		let pos = try int_of_string pos with _ -> failwith ("Invalid format: "  ^ pos) in
-		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 {
 			pfile = Path.get_full_path file;
@@ -412,9 +412,6 @@ let process_global_display_mode com tctx =
 		FindReferences.find_references tctx com with_definition
 	| DMImplementation ->
 		FindReferences.find_implementations tctx com
-	| DMStatistics ->
-		let stats = Statistics.collect_statistics tctx [SFFile (DisplayPosition.display_position#get).pfile] true in
-		raise_statistics (Statistics.Printer.print_statistics stats)
 	| DMModuleSymbols (Some "") -> ()
 	| DMModuleSymbols filter ->
 		let symbols = match CompilationServer.get() with

src/compiler/server.ml

@@ -18,7 +18,7 @@ let has_error ctx =
 
 let check_display_flush ctx f_otherwise = match ctx.com.json_out with
 	| None ->
-		if ctx.com.diagnostics <> None then begin
+		if is_diagnostics ctx.com then begin
 			List.iter (fun msg ->
 				let msg,p,kind = match msg with
 					| CMInfo(msg,p) -> msg,p,DisplayTypes.DiagnosticsSeverity.Information

src/context/common.ml

@@ -287,6 +287,11 @@ type compiler_stage =
 	| CGenerationStart  (* Generation is about to begin. *)
 	| CGenerationDone   (* Generation just finished. *)
 
+type report_mode =
+	| RMNone
+	| RMDiagnostics of Path.UniqueKey.t list
+	| RMStatistics
+
 type context = {
 	mutable stage : compiler_stage;
 	mutable cache : context_cache option;
@@ -328,7 +333,7 @@ type context = {
 	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;
+	mutable report_mode : report_mode;
 	(* output *)
 	mutable file : string;
 	mutable flash_version : float;
@@ -773,9 +778,13 @@ let create version args =
 		parser_cache = Hashtbl.create 0;
 		json_out = None;
 		has_error = false;
-		diagnostics = None;
+		report_mode = RMNone;
 	}
 
+let is_diagnostics com = match com.report_mode with
+	| RMDiagnostics _ -> true
+	| _ -> false
+
 let log com str =
 	if com.verbose then com.print (str ^ "\n")
 

src/context/display/deprecationCheck.ml

@@ -12,7 +12,7 @@ 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);
-		if com.diagnostics = None then begin
+		if not (is_diagnostics com) then begin
 			let options = Warning.from_meta (!curclass.cl_meta @ !curfield.cf_meta) in
 			com.warning WDeprecated options s p_usage;
 		end

src/context/display/diagnosticsPrinter.ml

@@ -10,10 +10,10 @@ open Genjson
 type t = DiagnosticsKind.t * pos
 
 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
+	match com.report_mode with
+	| RMDiagnostics [] -> true
+	| RMDiagnostics file_keys -> List.exists (fun key' -> file_key = key') file_keys
+	| _ -> false
 
 module UnresolvedIdentifierSuggestion = struct
 	type t =

src/context/display/displayException.ml

@@ -7,7 +7,6 @@ open Genjson
 
 exception DisplayException of display_exception_kind
 
-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))
 let raise_signatures l isig iarg kind = raise (DisplayException(DisplaySignatures(Some(l,isig,iarg,kind))))
@@ -158,7 +157,6 @@ let arg_index signatures signature_index param_index =
 
 let to_json ctx de =
 	match de with
-	| Statistics _
 	| ModuleSymbols _
 	| Metadata _ -> die "" __LOC__
 	| DisplaySignatures None ->

src/context/typecore.ml

@@ -228,9 +228,11 @@ let pass_name = function
 	| PForce -> "force"
 	| PFinal -> "final"
 
-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 display_error ctx msg p =
+	if is_diagnostics ctx.com then
+		add_diagnostics_message ctx.com msg p DisplayTypes.DiagnosticsKind.DKCompilerError DisplayTypes.DiagnosticsSeverity.Error
+	else
+		ctx.on_error ctx msg p
 
 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,7 +215,6 @@ module DisplayMode = struct
 		| DMPackage
 		| DMHover
 		| DMModuleSymbols of string option
-		| DMStatistics
 		| DMSignature
 
 	type error_policy =
@@ -283,14 +282,6 @@ module DisplayMode = struct
 				dms_force_macro_typing = false;
 				dms_per_file = true;
 			}
-		| DMStatistics -> { settings with
-				dms_full_typing = true;
-				dms_inline = false;
-				dms_display_file_policy = DFPAlso;
-				dms_exit_during_typing = false;
-				dms_force_macro_typing = true;
-				dms_per_file = true;
-			}
 
 	let to_string = function
 		| DMNone -> "none"
@@ -305,7 +296,6 @@ module DisplayMode = struct
 		| DMUsage (false,_,_) -> "references"
 		| DMModuleSymbols None -> "module-symbols"
 		| DMModuleSymbols (Some s) -> "workspace-symbols " ^ s
-		| DMStatistics -> "statistics"
 		| DMSignature -> "signature"
 end
 
@@ -388,7 +378,6 @@ type diagnostics_context = {
 }
 
 type display_exception_kind =
-	| Statistics of string
 	| ModuleSymbols of string
 	| Metadata of string
 	| DisplaySignatures of (((tsignature * CompletionItem.CompletionType.ct_function) * documentation) list * int * int * signature_kind) option

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.diagnostics <> None then
+					if ctx.com.display.dms_kind = DMNone || Common.is_diagnostics ctx.com then
 						display_error ctx "Parameter default value should be constant" p;
 					None
 			in

src/typing/typeloadParse.ml

@@ -271,8 +271,8 @@ let handle_parser_result com p result =
 		let msg = Parser.error_msg msg in
 		match com.display.dms_error_policy with
 			| EPShow ->
-				if com.diagnostics = None then typing_error msg p
-				else add_diagnostics_message com msg p DKParserError Error
+				if is_diagnostics com then add_diagnostics_message com msg p DKParserError Error
+				else typing_error msg p
 			| EPIgnore -> ()
 	in
 	match result with

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 _ | DMStatistics ->
+	| DMDefault | DMNone | DMModuleSymbols _ ->
 		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