[compiler] unify compiler messages and diagnostics (#10658)

src/compiler/compilationContext.ml

@@ -36,7 +36,7 @@ type communication = {
 
 and compilation_context = {
 	com : Common.context;
-	mutable messages : Common.compiler_message list;
+	mutable messages : compiler_message list;
 	mutable has_next : bool;
 	mutable has_error : bool;
 	comm : communication;
@@ -65,5 +65,5 @@ let message ctx msg =
 	ctx.messages <- msg :: ctx.messages
 
 let error ctx msg p =
-	message ctx (CMError(msg,p));
+	message ctx (msg,p,DKCompilerMessage,Error);
 	ctx.has_error <- true

src/compiler/compiler.ml

@@ -6,18 +6,18 @@ 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;
+		add_diagnostics_message com msg p kind Error;
 		DisplayOutput.emit_diagnostics ctx.com
 	in
 	if is_diagnostics com then begin try
 			f arg
 		with
 		| Error.Error(msg,p) ->
-			handle_diagnostics (Error.error_msg msg) p DisplayTypes.DiagnosticsKind.DKCompilerError
+			handle_diagnostics (Error.error_msg msg) p DKCompilerMessage
 		| Parser.Error(msg,p) ->
-			handle_diagnostics (Parser.error_msg msg) p DisplayTypes.DiagnosticsKind.DKParserError
+			handle_diagnostics (Parser.error_msg msg) p DKParserError
 		| Lexer.Error(msg,p) ->
-			handle_diagnostics (Lexer.error_msg msg) p DisplayTypes.DiagnosticsKind.DKParserError
+			handle_diagnostics (Lexer.error_msg msg) p DKParserError
 		end
 	else
 		f arg
@@ -211,24 +211,24 @@ module Setup = struct
 		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.info <- (fun msg p -> message ctx (msg,p,DKCompilerMessage,Information));
 		com.warning <- (fun w options msg p ->
 			match Warning.get_mode w (com.warning_options @ options) with
 			| WMEnable ->
-				message ctx (CMWarning(msg,p))
+				message ctx (msg,p,DKCompilerMessage,Warning)
 			| 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;)
+		let filter_messages = (fun keep_errors predicate -> (List.filter (fun ((_,_,_,sev) as cm) ->
+			(match sev with
+			| MessageSeverity.Error -> keep_errors;
+			| Information | Warning | Hint -> predicate cm;)
 		) (List.rev ctx.messages))) in
-		com.get_messages <- (fun () -> (List.map (fun msg ->
-			(match msg with
-			| CMError(_,_) -> die "" __LOC__;
-			| CMInfo(_,_) | CMWarning(_,_) -> msg;)
+		com.get_messages <- (fun () -> (List.map (fun ((_,_,_,sev) as cm) ->
+			(match sev with
+			| MessageSeverity.Error -> die "" __LOC__;
+			| Information | Warning | Hint -> cm;)
 		) (filter_messages false (fun _ -> true))));
 		com.filter_messages <- (fun predicate -> (ctx.messages <- (List.rev (filter_messages true predicate))));
 		com.run_command <- run_command ctx;

src/compiler/displayProcessing.ml

@@ -95,7 +95,7 @@ let process_display_configuration ctx =
 		com.warning <- (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
+				add_diagnostics_message com s p DKCompilerMessage Warning
 			| WMDisable ->
 				()
 		);

src/compiler/server.ml

@@ -19,27 +19,17 @@ let has_error ctx =
 let check_display_flush ctx f_otherwise = match ctx.com.json_out with
 	| None ->
 		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
-					| CMWarning(msg,p) -> msg,p,DisplayTypes.DiagnosticsSeverity.Warning
-					| CMError(msg,p) -> msg,p,DisplayTypes.DiagnosticsSeverity.Error
-				in
-				add_diagnostics_message ctx.com msg p DisplayTypes.DiagnosticsKind.DKCompilerError kind
+			List.iter (fun (msg,p,kind,sev) ->
+				add_diagnostics_message ctx.com msg p kind sev
 			) (List.rev ctx.messages);
 			raise (Completion (Diagnostics.print ctx.com))
 		end else
 			f_otherwise ()
 	| Some api ->
 		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
-					| CMWarning(msg,p) -> msg,p,2
-					| CMError(msg,p) -> msg,p,1
-				in
+			let errors = List.map (fun (msg,p,_,sev) ->
 				JObject [
-					"severity",JInt i;
+					"severity",JInt (MessageSeverity.to_int sev);
 					"location",Genjson.generate_pos_as_location p;
 					"message",JString msg;
 				]
@@ -168,6 +158,28 @@ end
 open ServerCompilationContext
 
 module Communication = struct
+
+	let compiler_message_string (str,p,_,sev) =
+		let str = match sev with
+			| MessageSeverity.Warning -> "Warning : " ^ str
+			| Information | Error | Hint -> str
+		in
+		if p = null_pos then
+			str
+		else begin
+			let error_printer file line = Printf.sprintf "%s:%d:" file line in
+			let epos = Lexer.get_error_pos error_printer p in
+			let str =
+				let lines =
+					match (ExtString.String.nsplit str "\n") with
+					| first :: rest -> first :: List.map Error.compl_msg rest
+					| l -> l
+				in
+				String.concat ("\n" ^ epos ^ " : ") lines
+			in
+			Printf.sprintf "%s : %s" epos str
+		end
+
 	let create_stdio () = {
 		write_out = (fun s ->
 			print_string s;
@@ -177,9 +189,9 @@ module Communication = struct
 			prerr_string s;
 		);
 		flush = (fun ctx ->
-			List.iter (fun msg -> match msg with
-				| CMInfo _ -> print_endline (compiler_message_string msg)
-				| CMWarning _ | CMError _ -> prerr_endline (compiler_message_string msg)
+			List.iter (fun ((_,_,_,sev) as cm) -> match sev with
+				| MessageSeverity.Information -> print_endline (compiler_message_string cm)
+				| Warning | Error | Hint -> prerr_endline (compiler_message_string cm)
 			) (List.rev ctx.messages);
 			if has_error ctx && !Helper.prompt then begin
 				print_endline "Press enter to exit...";

src/context/common.ml

@@ -46,32 +46,6 @@ type stats = {
 	s_macros_called : int ref;
 }
 
-type compiler_message =
-	| CMInfo of string * pos
-	| CMWarning of string * pos
-	| CMError of string * pos
-
-let compiler_message_string msg =
-	let (str,p) = match msg with
-		| CMInfo(str,p) | CMError(str,p) -> (str,p)
-		| CMWarning(str,p) -> ("Warning : " ^ str, p)
-	in
-	if p = null_pos then
-		str
-	else begin
-		let error_printer file line = Printf.sprintf "%s:%d:" file line in
-		let epos = Lexer.get_error_pos error_printer p in
-		let str =
-			let lines =
-				match (ExtString.String.nsplit str "\n") with
-				| first :: rest -> first :: List.map Error.compl_msg rest
-				| l -> l
-			in
-			String.concat ("\n" ^ epos ^ " : ") lines
-		in
-		Printf.sprintf "%s : %s" epos str
-	end
-
 (**
 	The capture policy tells which handling we make of captured locals
 	(the locals which are referenced in local functions)
@@ -248,7 +222,7 @@ class file_keys = object(self)
 end
 
 type shared_display_information = {
-	mutable diagnostics_messages : (string * pos * DisplayTypes.DiagnosticsKind.t * DisplayTypes.DiagnosticsSeverity.t) list;
+	mutable diagnostics_messages : (string * pos * MessageKind.t * MessageSeverity.t) list;
 }
 
 type display_information = {
@@ -1164,13 +1138,13 @@ 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;
+	if sev = MessageSeverity.Error then com.has_error <- true;
 	let di = com.shared.shared_display_information in
 	di.diagnostics_messages <- (s,p,kind,sev) :: di.diagnostics_messages
 
 let display_error com msg p =
 	if is_diagnostics com then
-		add_diagnostics_message com msg p DisplayTypes.DiagnosticsKind.DKCompilerError DisplayTypes.DiagnosticsSeverity.Error
+		add_diagnostics_message com msg p MessageKind.DKCompilerMessage MessageSeverity.Error
 	else
 		com.error msg p
 

src/context/display/diagnostics.ml

@@ -43,10 +43,10 @@ let find_unused_variables com e =
 let check_other_things com e =
 	let had_effect = ref false in
 	let no_effect p =
-		add_diagnostics_message com "This code has no effect" p DKCompilerError DiagnosticsSeverity.Warning;
+		add_diagnostics_message com "This code has no effect" p DKCompilerMessage Warning;
 	in
 	let pointless_compound s p =
-		add_diagnostics_message com (Printf.sprintf "This %s has no effect, but some of its sub-expressions do" s) p DKCompilerError DiagnosticsSeverity.Warning;
+		add_diagnostics_message com (Printf.sprintf "This %s has no effect, but some of its sub-expressions do" s) p DKCompilerMessage Warning;
 	in
 	let rec compound s el p =
 		let old = !had_effect in
@@ -143,7 +143,7 @@ let prepare com =
 		unresolved_identifiers = [];
 		missing_fields = PMap.empty;
 	} in
-	if not (List.exists (fun (_,_,_,sev) -> sev = DiagnosticsSeverity.Error) com.shared.shared_display_information.diagnostics_messages) then
+	if not (List.exists (fun (_,_,_,sev) -> sev = MessageSeverity.Error) com.shared.shared_display_information.diagnostics_messages) then
 		collect_diagnostics dctx com;
 	let process_modules com =
 		List.iter (fun m ->

src/context/display/diagnosticsPrinter.ml

@@ -2,12 +2,12 @@ open Globals
 open Common
 open Json
 open DisplayTypes
-open DiagnosticsKind
 open DisplayTypes
 open Type
 open Genjson
+open MessageKind
 
-type t = DiagnosticsKind.t * pos
+(* type t = DiagnosticsKind.t * pos *)
 
 let is_diagnostics_file com file_key =
 	match com.report_mode with
@@ -52,7 +52,7 @@ let json_of_diagnostics com dctx =
 			| DKInactiveBlock ->
 				false
 			| DKUnresolvedIdentifier
-			| DKCompilerError
+			| DKCompilerMessage
 			| DKParserError
 			| DKMissingFields ->
 				true
@@ -77,7 +77,7 @@ let json_of_diagnostics com dctx =
 					"name",JString s;
 				])
 		) suggestions in
-		add DKUnresolvedIdentifier p DiagnosticsSeverity.Error (JArray suggestions);
+		add DKUnresolvedIdentifier p MessageSeverity.Error (JArray suggestions);
 	) dctx.unresolved_identifiers;
 	List.iter (fun (s,p,kind,sev) ->
 		add kind p sev (JString s)
@@ -143,22 +143,22 @@ let json_of_diagnostics com dctx =
 			"moduleFile",jstring (Path.UniqueKey.lazy_path (t_infos mt).mt_module.m_extra.m_file);
 			"entries",jarray l
 		] in
-		add DKMissingFields p DiagnosticsSeverity.Error j
+		add DKMissingFields p MessageSeverity.Error j
 	) dctx.missing_fields;
 	(* non-append from here *)
 	begin match Warning.get_mode WDeprecated com.warning_options with
 	| WMEnable ->
 		Hashtbl.iter (fun _ (s,p) ->
-			add DKDeprecationWarning p DiagnosticsSeverity.Warning (JString s);
+			add DKDeprecationWarning p MessageSeverity.Warning (JString s);
 		) DeprecationCheck.warned_positions;
 	| WMDisable ->
 		()
 	end;
 	PMap.iter (fun p r ->
-		if not !r then add DKUnusedImport p DiagnosticsSeverity.Warning (JArray [])
+		if not !r then add DKUnusedImport p MessageSeverity.Warning (JArray [])
 	) dctx.import_positions;
 	List.iter (fun (s,p,prange) ->
-		add DKRemovableCode p DiagnosticsSeverity.Warning (JObject ["description",JString s;"range",if prange = null_pos then JNull else Genjson.generate_pos_as_range prange])
+		add DKRemovableCode p MessageSeverity.Warning (JObject ["description",JString s;"range",if prange = null_pos then JNull else Genjson.generate_pos_as_range prange])
 	) dctx.removable_code;
 	Hashtbl.iter (fun file ranges ->
 		List.iter (fun (p,e) ->
@@ -167,14 +167,14 @@ let json_of_diagnostics com dctx =
 					"string",JString (Ast.Printer.s_expr e)
 				]
 			] in
-			add DKInactiveBlock p DiagnosticsSeverity.Hint jo
+			add DKInactiveBlock p MessageSeverity.Hint jo
 		) ranges
 	) dctx.dead_blocks;
 	let jl = Hashtbl.fold (fun file diag acc ->
 		let jl = Hashtbl.fold (fun _ (dk,p,sev,jargs) acc ->
 			(JObject [
-				"kind",JInt (DiagnosticsKind.to_int dk);
-				"severity",JInt (DiagnosticsSeverity.to_int sev);
+				"kind",JInt (MessageKind.to_int dk);
+				"severity",JInt (MessageSeverity.to_int sev);
 				"range",Genjson.generate_pos_as_range p;
 				"args",jargs
 			]) :: acc

src/core/displayTypes.ml

@@ -63,42 +63,6 @@ module SymbolInformation = struct
 	}
 end
 
-module DiagnosticsSeverity = struct
-	type t =
-		| Error
-		| Warning
-		| Information
-		| Hint
-
-	let to_int = function
-		| Error -> 1
-		| Warning -> 2
-		| Information -> 3
-		| Hint -> 4
-end
-
-module DiagnosticsKind = struct
-	type t =
-		| DKUnusedImport
-		| DKUnresolvedIdentifier
-		| DKCompilerError
-		| DKRemovableCode
-		| DKParserError
-		| DKDeprecationWarning
-		| DKInactiveBlock
-		| DKMissingFields
-
-	let to_int = function
-		| DKUnusedImport -> 0
-		| DKUnresolvedIdentifier -> 1
-		| DKCompilerError -> 2
-		| DKRemovableCode -> 3
-		| DKParserError -> 4
-		| DKDeprecationWarning -> 5
-		| DKInactiveBlock -> 6
-		| DKMissingFields -> 7
-end
-
 module CompletionResultKind = struct
 	type expected_type_completion = {
 		expected_type : CompletionItem.CompletionType.t;
@@ -368,7 +332,7 @@ type diagnostics_context = {
 	mutable import_positions : (pos,bool ref) PMap.t;
 	mutable dead_blocks : (Path.UniqueKey.t,(pos * expr) list) Hashtbl.t;
 	mutable unresolved_identifiers : (string * pos * (string * CompletionItem.t * int) list) list;
-	mutable diagnostics_messages : (string * pos * DiagnosticsKind.t * DiagnosticsSeverity.t) list;
+	mutable diagnostics_messages : (string * pos * MessageKind.t * MessageSeverity.t) list;
 	mutable missing_fields : (pos,(module_type * (missing_fields_diagnostics list ref))) PMap.t;
 }
 

src/core/globals.ml

@@ -115,3 +115,41 @@ let die ?p msg ml_loc =
 	and os_type = if Sys.unix then "unix" else "windows" in
 	Printf.eprintf "%s\nHaxe: %s; OS type: %s;\n%s\n%s" msg ver os_type ml_loc backtrace;
 	assert false
+
+module MessageSeverity = struct
+	type t =
+		| Error
+		| Warning
+		| Information
+		| Hint
+
+	let to_int = function
+		| Error -> 1
+		| Warning -> 2
+		| Information -> 3
+		| Hint -> 4
+end
+
+module MessageKind = struct
+	type t =
+		| DKUnusedImport
+		| DKUnresolvedIdentifier
+		| DKCompilerMessage
+		| DKRemovableCode
+		| DKParserError
+		| DKDeprecationWarning
+		| DKInactiveBlock
+		| DKMissingFields
+
+	let to_int = function
+		| DKUnusedImport -> 0
+		| DKUnresolvedIdentifier -> 1
+		| DKCompilerMessage -> 2
+		| DKRemovableCode -> 3
+		| DKParserError -> 4
+		| DKDeprecationWarning -> 5
+		| DKInactiveBlock -> 6
+		| DKMissingFields -> 7
+end
+
+type compiler_message = string * pos * MessageKind.t * MessageSeverity.t

src/macro/macroApi.ml

@@ -375,11 +375,11 @@ and encode_display_kind dk =
 	in
 	encode_enum ~pos:None IDisplayKind tag pl
 
-and encode_message msg =
-	let tag, pl = match msg with
-		| CMInfo(msg,p) -> 0, [(encode_string msg); (encode_pos p)]
-		| CMWarning(msg,p) -> 1, [(encode_string msg); (encode_pos p)]
-		| CMError(_,_) -> Globals.die "" __LOC__
+and encode_message (msg,p,_,sev) =
+	let tag, pl = match sev with
+		| Globals.MessageSeverity.Information -> 0, [(encode_string msg); (encode_pos p)]
+		| Warning | Hint -> 1, [(encode_string msg); (encode_pos p)]
+		| Error -> Globals.die "" __LOC__
 	in
 	encode_enum ~pos:None IMessage tag pl
 

src/typing/typeloadParse.ml

@@ -22,7 +22,6 @@
 open Globals
 open Ast
 open Parser
-open DisplayTypes.DiagnosticsSeverity
 open DisplayTypes.DisplayMode
 open Common
 open Type