Bläddra i källkod

Rework error handling (#11136)

* rewrite error handling

* [tests] update test for 6765

* remove old located stuff

* rename stuff, get rid of 'located' in names

* invert hierarchy between error and error_msg

* Revert "invert hierarchy between error and error_msg"

This reverts commit 6dee94f77d4837b8d14111643500bce839066a58.

* separate message reporting from server.ml

* handle (macro) in message reporting for info and warning

* use severity color for (macro) indicator

* cleanup

* [tests] update test for 8471

* [tests] add test for 11121

* rename error and error_ext

* rename display_error and display_error_ext

* rename raise_typing_error and raise_typing_error_ext
Rudy Ges 2 år sedan
förälder
incheckning
b0011d1d40
70 ändrade filer med 1291 tillägg och 1198 borttagningar
  1. 2 2
      src/codegen/gencommon/gencommon.ml
  2. 2 2
      src/codegen/java.ml
  3. 7 7
      src/compiler/compilationContext.ml
  4. 23 23
      src/compiler/compiler.ml
  5. 1 1
      src/compiler/displayOutput.ml
  6. 5 5
      src/compiler/displayProcessing.ml
  7. 1 1
      src/compiler/generate.ml
  8. 391 0
      src/compiler/messageReporting.ml
  9. 2 2
      src/compiler/retyper.ml
  10. 2 360
      src/compiler/server.ml
  11. 14 14
      src/context/abstractCast.ml
  12. 19 24
      src/context/common.ml
  13. 3 3
      src/context/display/diagnostics.ml
  14. 2 2
      src/context/display/displayFields.ml
  15. 8 8
      src/context/display/importHandling.ml
  16. 2 2
      src/context/purityState.ml
  17. 22 11
      src/context/typecore.ml
  18. 2 2
      src/core/abstract.ml
  19. 49 33
      src/core/error.ml
  20. 3 21
      src/core/globals.ml
  21. 2 2
      src/core/inheritDoc.ml
  22. 8 8
      src/core/texpr.ml
  23. 3 3
      src/core/warning.ml
  24. 18 18
      src/filters/exceptions.ml
  25. 13 13
      src/filters/filters.ml
  26. 11 11
      src/generators/genjvm.ml
  27. 15 15
      src/generators/genlua.ml
  28. 3 3
      src/generators/genpy.ml
  29. 2 2
      src/generators/genshared.ml
  30. 6 6
      src/macro/eval/evalContext.ml
  31. 9 8
      src/macro/eval/evalExceptions.ml
  32. 3 3
      src/macro/eval/evalJit.ml
  33. 13 14
      src/macro/eval/evalLuv.ml
  34. 37 34
      src/macro/eval/evalMain.ml
  35. 2 2
      src/macro/macroApi.ml
  36. 1 1
      src/optimization/analyzerTexpr.ml
  37. 2 2
      src/optimization/analyzerTexprTransformer.ml
  38. 11 11
      src/optimization/inline.ml
  39. 3 2
      src/optimization/inlineConstructors.ml
  40. 3 3
      src/optimization/optimizer.ml
  41. 2 2
      src/optimization/optimizerTexpr.ml
  42. 74 69
      src/typing/callUnification.ml
  43. 11 11
      src/typing/calls.ml
  44. 2 2
      src/typing/fieldAccess.ml
  45. 9 9
      src/typing/fields.ml
  46. 4 4
      src/typing/finalization.ml
  47. 9 10
      src/typing/forLoop.ml
  48. 3 3
      src/typing/functionArguments.ml
  49. 22 17
      src/typing/generic.ml
  50. 6 6
      src/typing/instanceBuilder.ml
  51. 46 45
      src/typing/macroContext.ml
  52. 6 6
      src/typing/magicTypes.ml
  53. 26 28
      src/typing/matcher.ml
  54. 31 31
      src/typing/operators.ml
  55. 2 2
      src/typing/strictMeta.ml
  56. 62 57
      src/typing/typeload.ml
  57. 25 21
      src/typing/typeloadCheck.ml
  58. 48 48
      src/typing/typeloadFields.ml
  59. 3 3
      src/typing/typeloadFunction.ml
  60. 28 30
      src/typing/typeloadModule.ml
  61. 5 5
      src/typing/typeloadParse.ml
  62. 82 81
      src/typing/typer.ml
  63. 8 8
      src/typing/typerBase.ml
  64. 14 14
      src/typing/typerDisplay.ml
  65. 1 1
      src/typing/typerDotPath.ml
  66. 14 0
      tests/misc/projects/Issue11121/Main.hx
  67. 3 0
      tests/misc/projects/Issue11121/compile-fail.hxml
  68. 18 0
      tests/misc/projects/Issue11121/compile-fail.hxml.stderr
  69. 1 0
      tests/misc/projects/Issue6765/compile-fail.hxml.stderr
  70. 1 1
      tests/misc/projects/Issue8471/compile2-pretty.hxml.stderr

+ 2 - 2
src/codegen/gencommon/gencommon.ml

@@ -730,9 +730,9 @@ let run_filters_from gen t filters =
 		()
 
 let run_filters gen =
-	let last_error = gen.gcon.located_error in
+	let last_error = gen.gcon.error_ext in
 	let has_errors = ref false in
-	gen.gcon.located_error <- (fun ?(depth=0) msg -> has_errors := true; last_error ~depth msg);
+	gen.gcon.error_ext <- (fun err -> has_errors := true; last_error err);
 	(* first of all, we have to make sure that the filters won't trigger a major Gc collection *)
 	let t = Timer.timer ["gencommon_filters"] in
 	(if Common.defined gen.gcon Define.GencommonDebug then debug_mode := true else debug_mode := false);

+ 2 - 2
src/codegen/java.ml

@@ -35,9 +35,9 @@ type java_lib_ctx = {
 	is_std : bool;
 }
 
-exception ConversionError of located
+exception ConversionError of string * pos
 
-let error s p = raise (ConversionError (located s p))
+let error s p = raise (ConversionError (s, p))
 
 let is_haxe_keyword = function
 	| "cast" | "extern" | "function" | "in" | "typedef" | "using" | "var" | "untyped" | "inline" -> true

+ 7 - 7
src/compiler/compilationContext.ml

@@ -64,12 +64,12 @@ type server_api = {
 let message ctx msg =
 	ctx.messages <- msg :: ctx.messages
 
-let error ctx ?(depth=0) msg p =
-	message ctx (make_compiler_message msg p depth DKCompilerMessage Error);
+let error ctx ?(depth=0) ?(from_macro = false) msg p =
+	message ctx (make_compiler_message ~from_macro msg p depth DKCompilerMessage Error);
 	ctx.has_error <- true
 
-let located_error ctx ?(depth=0) msg = match (extract_located msg) with
-	| [] -> ()
-	| (msg,p) :: tl ->
-		error ~depth ctx msg p;
-		List.iter (fun (msg,p) -> error ~depth:(depth+1) ctx msg p) tl
+let error_ext ctx (err : Error.error) =
+	Error.recurse_error (fun depth err ->
+		error ~depth ~from_macro:err.err_from_macro ctx (Error.error_msg err.err_message) err.err_pos
+	) err
+

+ 23 - 23
src/compiler/compiler.ml

@@ -4,20 +4,24 @@ open CompilationContext
 
 let run_or_diagnose ctx f arg =
 	let com = ctx.com in
-	let handle_diagnostics ?(depth = 0) msg kind =
+	let handle_diagnostics ?(depth = 0) msg p kind =
 		ctx.has_error <- true;
-		add_diagnostics_message ~depth com msg kind Error;
+		add_diagnostics_message ~depth 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,depth) ->
-			handle_diagnostics ~depth (Error.error_msg p msg) DKCompilerMessage
+		| Error.Error err ->
+			ctx.has_error <- true;
+			Error.recurse_error (fun depth err ->
+				add_diagnostics_message ~depth com (Error.error_msg err.err_message) err.err_pos DKCompilerMessage Error
+			) err;
+			DisplayOutput.emit_diagnostics ctx.com
 		| Parser.Error(msg,p) ->
-			handle_diagnostics (located (Parser.error_msg msg) p) DKParserError
+			handle_diagnostics (Parser.error_msg msg) p DKParserError
 		| Lexer.Error(msg,p) ->
-			handle_diagnostics (located (Lexer.error_msg msg) p) DKParserError
+			handle_diagnostics (Lexer.error_msg msg) p DKParserError
 		end
 	else
 		f arg
@@ -211,8 +215,10 @@ 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 ?(depth=0) msg p -> message ctx (make_compiler_message msg p depth DKCompilerMessage Information));
-		com.warning <- (fun ?(depth=0) w options msg p ->
+		com.info <- (fun ?(depth=0) ?(from_macro=false) msg p ->
+			message ctx (make_compiler_message ~from_macro msg p depth DKCompilerMessage Information)
+		);
+		com.warning <- (fun ?(depth=0) ?(from_macro=false) w options msg p ->
 			match Warning.get_mode w (com.warning_options @ options) with
 			| WMEnable ->
 				let wobj = Warning.warning_obj w in
@@ -221,12 +227,12 @@ module Setup = struct
 				else
 					Printf.sprintf "(%s) %s" wobj.w_name msg
 				in
-				message ctx (make_compiler_message msg p depth DKCompilerMessage Warning)
+				message ctx (make_compiler_message ~from_macro msg p depth DKCompilerMessage Warning)
 			| WMDisable ->
 				()
 		);
-		com.located_error <- located_error ctx;
-		com.error <- (fun ?(depth = 0) msg p -> com.located_error ~depth (located msg p));
+		com.error_ext <- error_ext ctx;
+		com.error <- (fun ?(depth = 0) msg p -> com.error_ext (Error.make_error ~depth (Custom msg) p));
 		let filter_messages = (fun keep_errors predicate -> (List.filter (fun cm ->
 			(match cm.cm_severity with
 			| MessageSeverity.Error -> keep_errors;
@@ -335,10 +341,10 @@ try
 with
 	| Abort ->
 		()
-	| Error.Fatal_error (m,depth) ->
-		located_error ~depth ctx m
-	| Common.Abort msg ->
-		located_error ctx msg
+	| Error.Fatal_error err ->
+		error_ext ctx err
+	| Common.Abort err ->
+		error_ext ctx err
 	| Lexer.Error (m,p) ->
 		error ctx (Lexer.error_msg m) p
 	| Parser.Error (m,p) ->
@@ -351,14 +357,8 @@ with
 			error ctx (Printf.sprintf "You cannot access the %s package while %s (for %s)" pack (if pf = "macro" then "in a macro" else "targeting " ^ pf) (s_type_path m) ) p;
 			List.iter (error ~depth:1 ctx (Error.compl_msg "referenced here")) (List.rev pl);
 		end
-	| Error.Error (Stack stack,_,depth) -> (match stack with
-		| [] -> ()
-		| (e,p) :: stack -> begin
-			located_error ~depth ctx (Error.error_msg p e);
-			List.iter (fun (e,p) -> located_error ~depth:(depth+1) ctx (Error.error_msg p e)) stack;
-		end)
-	| Error.Error (m,p,depth) ->
-		located_error ~depth ctx (Error.error_msg p m)
+	| Error.Error err ->
+		error_ext ctx err
 	| Generic.Generic_Exception(m,p) ->
 		error ctx m p
 	| Arg.Bad msg ->

+ 1 - 1
src/compiler/displayOutput.ml

@@ -351,7 +351,7 @@ let handle_type_path_exception ctx p c is_import pos =
 				let ctx = Typer.create com in
 				DisplayPath.TypePathHandler.complete_type_path_inner ctx p c cur_package is_import
 		end with Common.Abort msg ->
-			located_error ctx msg;
+			error_ext ctx msg;
 			None
 	in
 	begin match ctx.com.json_out,fields with

+ 5 - 5
src/compiler/displayProcessing.ml

@@ -92,13 +92,13 @@ let process_display_arg ctx actx =
 let process_display_configuration ctx =
 	let com = ctx.com in
 	if is_diagnostics com then begin
-		com.info <- (fun ?depth s p ->
-			add_diagnostics_message ?depth com (located s p) DKCompilerMessage Information
+		com.info <- (fun ?depth ?from_macro s p ->
+			add_diagnostics_message ?depth com s p DKCompilerMessage Information
 		);
-		com.warning <- (fun ?depth w options s p ->
+		com.warning <- (fun ?depth ?from_macro w options s p ->
 			match Warning.get_mode w (com.warning_options @ options) with
 			| WMEnable ->
-				add_diagnostics_message ?depth com (located s p) DKCompilerMessage Warning
+				add_diagnostics_message ?depth com s p DKCompilerMessage Warning
 			| WMDisable ->
 				()
 		);
@@ -354,4 +354,4 @@ let handle_display_after_finalization ctx tctx display_file_dot_path =
 		DisplayOutput.emit_statistics tctx
 	| RMNone ->
 		()
-	end
+	end

+ 1 - 1
src/compiler/generate.ml

@@ -98,4 +98,4 @@ let generate ctx tctx ext actx =
 		let t = Timer.timer ["generate";name] in
 		generate com;
 		t()
-	end
+	end

+ 391 - 0
src/compiler/messageReporting.ml

@@ -0,0 +1,391 @@
+open Extlib_leftovers
+open Globals
+open Common
+open CompilationContext
+
+let resolve_source file l1 p1 l2 p2 =
+	let ch = open_in_bin file in
+	let curline = ref 1 in
+	let lines = ref [] in
+	let rec loop p line =
+		let inc i line =
+			if (!curline >= l1) && (!curline <= l2) then lines := (!curline, line) :: !lines;
+			curline := !curline + 1;
+			(i, "")
+		in
+
+		let input_char_or_done ch line =
+			try input_char ch with End_of_file -> begin
+				ignore(inc 0 line);
+				raise End_of_file
+			end
+		in
+
+		try
+			let read_char line = match input_char_or_done ch line with
+				| '\n' -> inc 1 line
+				| '\r' ->
+					ignore(input_char_or_done ch line);
+					inc 2 line
+				| c -> begin
+					let line = ref (line ^ (String.make 1 c)) in
+					let rec skip n =
+						if n > 0 then begin
+							let c = input_char_or_done ch !line in
+							line := !line ^ (String.make 1 c);
+							skip (n - 1)
+						end
+					in
+
+					let code = int_of_char c in
+					if code < 0xC0 then ()
+					else if code < 0xE0 then skip 1
+					else if code < 0xF0 then skip 2
+					else skip 3;
+
+					(1, !line)
+				end
+			in
+
+			let (delta, line) = read_char line in
+			loop (p + delta) line
+		with End_of_file ->
+			close_in ch;
+	in
+
+	loop 0 "";
+	List.rev !lines
+
+let resolve_file ctx f =
+		let ext = Common.extension f in
+		let second_ext = Common.extension (Common.remove_extension f) in
+		let platform_ext = "." ^ (platform_name_macro ctx) in
+		if platform_ext = second_ext then
+			(Common.remove_extension (Common.remove_extension f)) ^ ext
+		else
+			f
+
+let error_printer file line = Printf.sprintf "%s:%d:" file line
+
+type error_context = {
+	mutable last_positions : pos IntMap.t;
+	mutable max_lines : int IntMap.t;
+	mutable gutter : int IntMap.t;
+	mutable previous : (pos * MessageSeverity.t * int) option;
+}
+
+let create_error_context () = {
+	last_positions = IntMap.empty;
+	max_lines = IntMap.empty;
+	gutter = IntMap.empty;
+	previous = None;
+}
+
+let compiler_pretty_message_string com ectx cm =
+	match cm.cm_message with
+	(* Filter some messages that don't add much when using this message renderer *)
+	| "End of overload failure reasons" -> None
+	| _ -> begin
+		ectx.last_positions <- (IntMap.add cm.cm_depth cm.cm_pos ectx.last_positions);
+		let is_null_pos = cm.cm_pos = null_pos || cm.cm_pos.pmin = -1 in
+		let is_unknown_file f = f = "" || f = "?" in
+
+		(* Extract informations from position *)
+		let l1, p1, l2, p2, epos, lines =
+			if is_null_pos then begin
+				let epos = if is_unknown_file cm.cm_pos.pfile then "(unknown position)" else cm.cm_pos.pfile in
+				(-1, -1, -1, -1, epos, [])
+			end else try begin
+				let f = resolve_file com cm.cm_pos.pfile in
+				let f = Common.find_file com f in
+				let l1, p1, l2, p2 = Lexer.get_pos_coords cm.cm_pos in
+				let lines = resolve_source f l1 p1 l2 p2 in
+				let epos = Lexer.get_error_pos error_printer cm.cm_pos in
+				(l1, p1, l2, p2, epos, lines)
+			end with Not_found ->
+				(1, 1, 1, 1, cm.cm_pos.pfile, [])
+			in
+
+		(* If 4 lines or less, display all; if more, crop the middle *)
+		let lines = match lines with
+			| _ :: (_ :: (_ :: (_ :: []))) -> lines
+			| hd :: (_ :: (_ :: (_ :: l))) ->
+				let _,line = hd in
+				let indent = ref 0 in
+				let found = ref false in
+
+				while (not !found) && (!indent < (String.length line - 1)) do
+					found := not (Lexer.is_whitespace (String.unsafe_get line !indent));
+					indent := !indent + 1
+				done;
+
+				[hd; (0, (String.make (!indent+1) ' ') ^ "[...]"); List.hd (List.rev l)]
+			| _ -> lines
+		in
+
+		let parent_pos =
+			if cm.cm_depth = 0 then null_pos
+			else (try IntMap.find (cm.cm_depth-1) ectx.last_positions with Not_found -> null_pos)
+		in
+
+		let prev_pos,prev_sev,prev_nl = match ectx.previous with
+			| None -> (None, None, 0)
+			| Some (p, sev, depth) -> (Some p, Some sev, depth)
+		in
+
+		let sev_changed = prev_sev = None || Some cm.cm_severity <> prev_sev in
+		let pos_changed = (prev_pos = None || cm.cm_pos <> Option.get prev_pos || (cm.cm_depth <> prev_nl && cm.cm_depth <> prev_nl + 1)) && (parent_pos = null_pos || cm.cm_pos <> parent_pos) in
+		let file_changed = prev_pos = None || (pos_changed && match (cm.cm_pos.pfile, (Option.get prev_pos).pfile) with
+			| (f1, f2) when (is_unknown_file f1) && (is_unknown_file f2) -> false
+			| (f1, f2) -> f1 <> f2
+		) in
+
+		let display_heading = cm.cm_depth = 0 || sev_changed || file_changed in
+		let has_source = match lines with | [] -> false | _ -> true in
+		let display_source = has_source && (cm.cm_depth = 0 || sev_changed || pos_changed) in
+		let display_pos_marker = (not is_null_pos) && has_source && (cm.cm_depth = 0 || sev_changed || pos_changed) in
+
+		let gutter_len = (try String.length (Printf.sprintf "%d" (IntMap.find cm.cm_depth ectx.max_lines)) with Not_found -> 0) + 2 in
+
+		let no_color = Define.defined com.defines Define.NoColor in
+		let c_reset = if no_color then "" else "\x1b[0m" in
+		let c_bold = if no_color then "" else "\x1b[1m" in
+		let c_dim = if no_color then "" else "\x1b[2m" in
+
+		let (c_sev, c_sev_bg) = if no_color then ("", "") else match cm.cm_severity with
+			| MessageSeverity.Warning -> ("\x1b[33m", "\x1b[30;43m")
+			| Information | Hint -> ("\x1b[34m", "\x1b[30;44m")
+			| Error -> ("\x1b[31m", "\x1b[30;41m")
+		in
+
+		let sev_label = if cm.cm_depth > 0 then " -> " else Printf.sprintf
+			(if no_color then "[%s]" else " %s ")
+			(match cm.cm_severity with
+				| MessageSeverity.Warning -> "WARNING"
+				| Information -> "INFO"
+				| Hint -> "HINT"
+				| Error -> "ERROR"
+			) in
+
+		let out = ref "" in
+
+		if display_heading then
+			out := Printf.sprintf "%s%s%s\n\n"
+				(* Severity heading *)
+				(c_sev_bg ^ sev_label ^ c_reset ^ " ")
+				(* Macro context indicator *)
+				(if cm.cm_from_macro then c_sev ^ "(macro) " ^ c_reset else "")
+				(* File + line pointer *)
+				epos;
+
+		(* Error source *)
+		if display_source then out := List.fold_left (fun out (l, line) ->
+			let nb_len = String.length (string_of_int l) in
+
+			(* Replace tabs with 1 space to avoid column misalignments *)
+			let line = String.concat " " (ExtString.String.nsplit line "\t") in
+			let len = String.length line in
+
+			out ^ Printf.sprintf "%s%s | %s\n"
+				(* left-padded line number *)
+				(String.make (gutter_len-nb_len-1) ' ')
+				(if l = 0 then "-" else Printf.sprintf "%d" l)
+				(* Source code at that line *)
+				(
+					if l = 0 then
+						c_dim ^ line ^ c_reset
+					else if l1 = l2 then
+						(if p1 > 1 then c_dim ^ (String.sub line 0 (p1-1)) else "")
+						^ c_reset ^ c_bold ^ (String.sub line (p1-1) (p2-p1))
+						^ c_reset ^ c_dim ^ (String.sub line (p2-1) (len - p2 + 1))
+						^ c_reset
+					else begin
+						(if (l = l1) then
+							(if p1 > 1 then c_dim ^ (String.sub line 0 (p1-1)) else "")
+							^ c_reset ^ c_bold ^ (String.sub line (p1-1) (len-p1+1))
+							^ c_reset
+						else if (l = l2) then
+							(if p2 > 1 then c_bold ^ (String.sub line 0 (p2-1)) else "")
+							^ c_reset ^ c_dim ^ (String.sub line (p2-1) (len-p2+1))
+							^ c_reset
+						else c_bold ^ line ^ c_reset)
+					end
+				)
+		) !out lines;
+
+		(* Error position marker *)
+		if display_pos_marker then
+			out := Printf.sprintf "%s%s|%s\n"
+				!out
+				(String.make gutter_len ' ')
+				(if l1 = l2 then String.make p1 ' ' ^ c_sev ^ String.make (if p1 = p2 then 1 else p2-p1) '^' ^ c_reset else "");
+
+		(* Error message *)
+		out := List.fold_left (fun out str -> Printf.sprintf "%s%s| %s\n"
+			out
+			(String.make gutter_len ' ')
+			(* Remove "... " prefix *)
+			(if (ExtString.String.starts_with str "... ") then String.sub str 4 ((String.length str) - 4) else str)
+		) !out (ExtString.String.nsplit cm.cm_message "\n");
+
+		ectx.previous <- Some ((if is_null_pos then null_pos else cm.cm_pos), cm.cm_severity, cm.cm_depth);
+		ectx.gutter <- (IntMap.add cm.cm_depth gutter_len ectx.gutter);
+
+		(* Indent sub errors *)
+		let rec indent ?(acc=0) depth =
+			if depth = 0 then acc
+			else indent ~acc:(acc + try IntMap.find (depth-1) ectx.gutter with Not_found -> 3) (depth-1)
+		in
+
+		Some (
+			if cm.cm_depth > 0 then String.concat "\n" (List.map (fun str -> match str with
+				| "" -> ""
+				| _ -> (String.make (indent cm.cm_depth) ' ') ^ str
+			) (ExtString.String.nsplit !out "\n"))
+			else !out
+		)
+	end
+
+let compiler_message_string cm =
+	let str = match cm.cm_severity with
+		| MessageSeverity.Warning -> "Warning : " ^ cm.cm_message
+		| Information | Error | Hint -> cm.cm_message
+	in
+
+	if cm.cm_pos = null_pos then
+		Some str
+	else begin
+		let epos = Lexer.get_error_pos error_printer cm.cm_pos 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
+		Some (Printf.sprintf "%s : %s" epos str)
+	end
+
+let compiler_indented_message_string cm =
+	match cm.cm_message with
+	(* Filter some messages that don't add much when using this message renderer *)
+	| "End of overload failure reasons" -> None
+	| _ ->
+		let str = match cm.cm_severity with
+			| MessageSeverity.Warning -> "Warning : " ^ cm.cm_message
+			| Information -> "Info : " ^ cm.cm_message
+			| Error | Hint -> cm.cm_message
+		in
+
+		if cm.cm_pos = null_pos then
+			Some str
+		else begin
+			let epos = Lexer.get_error_pos error_printer cm.cm_pos in
+			let lines =
+				match (ExtString.String.nsplit str "\n") with
+				| first :: rest -> (cm.cm_depth, first) :: List.map (fun msg -> (cm.cm_depth+1, msg)) rest
+				| l -> [(cm.cm_depth, List.hd l)]
+			in
+			let rm_prefix str = if (ExtString.String.starts_with str "... ") then String.sub str 4 ((String.length str) - 4) else str in
+			Some (String.concat "\n" (List.map (fun (depth, msg) -> (String.make (depth*2) ' ') ^ epos ^ " : " ^ (rm_prefix msg)) lines))
+		end
+
+let get_max_line max_lines messages =
+	List.fold_left (fun max_lines cm ->
+		let _,_,l2,_ = Lexer.get_pos_coords cm.cm_pos in
+		let old = try IntMap.find cm.cm_depth max_lines with Not_found -> 0 in
+
+		if l2 > old then IntMap.add cm.cm_depth l2 max_lines
+		else max_lines
+	) max_lines messages
+
+exception ConfigError of string
+
+let get_formatter com ectx def default =
+	let format_mode = Define.defined_value_safe ~default com.defines def in
+	match format_mode with
+		| "pretty" -> compiler_pretty_message_string com ectx
+		| "indent" -> compiler_indented_message_string
+		| "classic" -> compiler_message_string
+		| m -> begin
+			let def = Define.get_define_key def in
+			raise (ConfigError (Printf.sprintf "Invalid message reporting mode: \"%s\", expected classic | pretty | indent (for -D %s)." m def))
+		end
+
+let print_error (err : Error.error) =
+	let ret = ref "" in
+	Error.recurse_error (fun depth err ->
+		ret := !ret ^ (Lexer.get_error_pos (Printf.sprintf "%s:%d: ") err.err_pos) ^ (Error.error_msg err.err_message) ^ "\n"
+	) err;
+	!ret
+
+let format_messages com messages =
+	let ectx = create_error_context () in
+	ectx.max_lines <- get_max_line ectx.max_lines messages;
+	let message_formatter = get_formatter com ectx Define.MessageReporting "classic" in
+	let lines = List.rev (
+		List.fold_left (fun lines cm -> match (message_formatter cm) with
+			| None -> lines
+			| Some str -> str :: lines
+		) [] messages
+	) in
+	ExtLib.String.join "\n" lines
+
+let display_messages ctx on_message = begin
+	let ectx = create_error_context () in
+	ectx.max_lines <- get_max_line ectx.max_lines ctx.messages;
+
+	let get_formatter _ _ def default =
+		try get_formatter ctx.com ectx def default
+		with | ConfigError s ->
+			error ctx s null_pos;
+			compiler_message_string
+	in
+
+	let message_formatter = get_formatter ctx.com ectx Define.MessageReporting "classic" in
+	let log_formatter = get_formatter ctx.com ectx Define.MessagesLogFormat "indent" in
+
+	let log_messages = ref (Define.defined ctx.com.defines Define.MessagesLogFile) in
+	let log_message = ref None in
+	let close_logs = ref None in
+
+	if !log_messages then begin
+		try begin
+			let buf = Rbuffer.create 16000 in
+
+			let file = Define.defined_value ctx.com.defines Define.MessagesLogFile in
+			let chan =
+				Path.mkdir_from_path file;
+				open_out_bin file
+			in
+
+			log_message := (Some (fun msg ->
+				match (log_formatter msg) with
+					| None -> ()
+					| Some str -> Rbuffer.add_string buf (str ^ "\n")));
+
+			close_logs := (Some (fun () ->
+				Rbuffer.output_buffer chan buf;
+				Rbuffer.clear buf;
+				close_out chan
+			));
+		end with
+			| Failure e | Sys_error e -> begin
+				let def = Define.get_define_key Define.MessagesLogFile in
+				error ctx (Printf.sprintf "Error opening log file: %s. Logging to file disabled (-D %s)" e def) null_pos;
+				log_messages := false;
+			end
+	end;
+
+	List.iter (fun cm ->
+		if !log_messages then (Option.get !log_message) cm;
+
+		match (message_formatter cm) with
+			| None -> ()
+			| Some str -> on_message cm.cm_severity str
+	) (List.rev ctx.messages);
+
+	if !log_messages then (Option.get !close_logs) ();
+end
+

+ 2 - 2
src/compiler/retyper.ml

@@ -21,7 +21,7 @@ let disable_typeloading rctx ctx f =
 	ctx.g.load_only_cached_modules <- true;
 	try
 		Std.finally (fun () -> ctx.g.load_only_cached_modules <- old) f ()
-	with (Error.Error (Module_not_found path,_,_)) ->
+	with (Error.Error { err_message = Module_not_found path }) ->
 		fail rctx (Printf.sprintf "Could not load [Module %s]" (s_type_path path))
 
 let pair_type th t = match th with
@@ -276,4 +276,4 @@ let attempt_retyping ctx m p =
 		m.m_extra.m_time <- Common.file_time file;
 		None
 	with Fail s ->
-		Some s
+		Some s

+ 2 - 360
src/compiler/server.ml

@@ -1,4 +1,3 @@
-open Extlib_leftovers
 open Printf
 open Globals
 open Ast
@@ -10,6 +9,7 @@ open DisplayProcessingGlobals
 open Json
 open Compiler
 open CompilationContext
+open MessageReporting
 
 exception Dirty of module_skip_reason
 exception ServerError of string
@@ -21,7 +21,7 @@ let check_display_flush ctx f_otherwise = match ctx.com.json_out with
 	| None ->
 		if is_diagnostics ctx.com then begin
 			List.iter (fun cm ->
-				add_diagnostics_message ~depth:cm.cm_depth ctx.com (located cm.cm_message cm.cm_pos) cm.cm_kind cm.cm_severity
+				add_diagnostics_message ~depth:cm.cm_depth ctx.com cm.cm_message cm.cm_pos cm.cm_kind cm.cm_severity
 			) (List.rev ctx.messages);
 			raise (Completion (Diagnostics.print ctx.com))
 		end else
@@ -87,364 +87,6 @@ let parse_file cs com file p =
 open ServerCompilationContext
 
 module Communication = struct
-	type error_context = {
-		mutable last_positions : pos IntMap.t;
-		mutable max_lines : int IntMap.t;
-		mutable gutter : int IntMap.t;
-		mutable previous : (pos * MessageSeverity.t * int) option;
-	}
-
-	let create_error_context () = {
-		last_positions = IntMap.empty;
-		max_lines = IntMap.empty;
-		gutter = IntMap.empty;
-		previous = None;
-	}
-
-	let error_printer file line = Printf.sprintf "%s:%d:" file line
-
-	let resolve_source file l1 p1 l2 p2 =
-		let ch = open_in_bin file in
-		let curline = ref 1 in
-		let lines = ref [] in
-		let rec loop p line =
-			let inc i line =
-				if (!curline >= l1) && (!curline <= l2) then lines := (!curline, line) :: !lines;
-				curline := !curline + 1;
-				(i, "")
-			in
-
-			let input_char_or_done ch line =
-				try input_char ch with End_of_file -> begin
-					ignore(inc 0 line);
-					raise End_of_file
-				end
-			in
-
-			try
-				let read_char line = match input_char_or_done ch line with
-					| '\n' -> inc 1 line
-					| '\r' ->
-						ignore(input_char_or_done ch line);
-						inc 2 line
-					| c -> begin
-						let line = ref (line ^ (String.make 1 c)) in
-						let rec skip n =
-							if n > 0 then begin
-								let c = input_char_or_done ch !line in
-								line := !line ^ (String.make 1 c);
-								skip (n - 1)
-							end
-						in
-
-						let code = int_of_char c in
-						if code < 0xC0 then ()
-						else if code < 0xE0 then skip 1
-						else if code < 0xF0 then skip 2
-						else skip 3;
-
-						(1, !line)
-					end
-				in
-
-				let (delta, line) = read_char line in
-				loop (p + delta) line
-			with End_of_file ->
-				close_in ch;
-		in
-
-		loop 0 "";
-		List.rev !lines
-
-	let resolve_file ctx f =
-			let ext = Common.extension f in
-			let second_ext = Common.extension (Common.remove_extension f) in
-			let platform_ext = "." ^ (platform_name_macro ctx) in
-			if platform_ext = second_ext then
-				(Common.remove_extension (Common.remove_extension f)) ^ ext
-			else
-				f
-
-	let compiler_pretty_message_string ctx ectx cm =
-		match cm.cm_message with
-		(* Filter some messages that don't add much when using this message renderer *)
-		| "End of overload failure reasons" -> None
-		| _ -> begin
-			ectx.last_positions <- (IntMap.add cm.cm_depth cm.cm_pos ectx.last_positions);
-			let is_null_pos = cm.cm_pos = null_pos || cm.cm_pos.pmin = -1 in
-			let is_unknown_file f = f = "" || f = "?" in
-
-			(* Extract informations from position *)
-			let l1, p1, l2, p2, epos, lines =
-				if is_null_pos then begin
-					let epos = if is_unknown_file cm.cm_pos.pfile then "(unknown position)" else cm.cm_pos.pfile in
-					(-1, -1, -1, -1, epos, [])
-				end else try begin
-					let f = resolve_file ctx.com cm.cm_pos.pfile in
-					let f = Common.find_file ctx.com f in
-					let l1, p1, l2, p2 = Lexer.get_pos_coords cm.cm_pos in
-					let lines = resolve_source f l1 p1 l2 p2 in
-					let epos = Lexer.get_error_pos error_printer cm.cm_pos in
-					(l1, p1, l2, p2, epos, lines)
-				end with Not_found ->
-					(1, 1, 1, 1, cm.cm_pos.pfile, [])
-				in
-
-			(* If 4 lines or less, display all; if more, crop the middle *)
-			let lines = match lines with
-				| _ :: (_ :: (_ :: (_ :: []))) -> lines
-				| hd :: (_ :: (_ :: (_ :: l))) ->
-					let _,line = hd in
-					let indent = ref 0 in
-					let found = ref false in
-
-					while (not !found) && (!indent < (String.length line - 1)) do
-						found := not (Lexer.is_whitespace (String.unsafe_get line !indent));
-						indent := !indent + 1
-					done;
-
-					[hd; (0, (String.make (!indent+1) ' ') ^ "[...]"); List.hd (List.rev l)]
-				| _ -> lines
-			in
-
-			let parent_pos =
-				if cm.cm_depth = 0 then null_pos
-				else (try IntMap.find (cm.cm_depth-1) ectx.last_positions with Not_found -> null_pos)
-			in
-
-			let prev_pos,prev_sev,prev_nl = match ectx.previous with
-				| None -> (None, None, 0)
-				| Some (p, sev, depth) -> (Some p, Some sev, depth)
-			in
-
-			let sev_changed = prev_sev = None || Some cm.cm_severity <> prev_sev in
-			let pos_changed = (prev_pos = None || cm.cm_pos <> Option.get prev_pos || (cm.cm_depth <> prev_nl && cm.cm_depth <> prev_nl + 1)) && (parent_pos = null_pos || cm.cm_pos <> parent_pos) in
-			let file_changed = prev_pos = None || (pos_changed && match (cm.cm_pos.pfile, (Option.get prev_pos).pfile) with
-				| (f1, f2) when (is_unknown_file f1) && (is_unknown_file f2) -> false
-				| (f1, f2) -> f1 <> f2
-			) in
-
-			let display_heading = cm.cm_depth = 0 || sev_changed || file_changed in
-			let has_source = match lines with | [] -> false | _ -> true in
-			let display_source = has_source && (cm.cm_depth = 0 || sev_changed || pos_changed) in
-			let display_pos_marker = (not is_null_pos) && has_source && (cm.cm_depth = 0 || sev_changed || pos_changed) in
-
-			let gutter_len = (try String.length (Printf.sprintf "%d" (IntMap.find cm.cm_depth ectx.max_lines)) with Not_found -> 0) + 2 in
-
-			let no_color = Define.defined ctx.com.defines Define.NoColor in
-			let c_reset = if no_color then "" else "\x1b[0m" in
-			let c_bold = if no_color then "" else "\x1b[1m" in
-			let c_dim = if no_color then "" else "\x1b[2m" in
-
-			let (c_sev, c_sev_bg) = if no_color then ("", "") else match cm.cm_severity with
-				| MessageSeverity.Warning -> ("\x1b[33m", "\x1b[30;43m")
-				| Information | Hint -> ("\x1b[34m", "\x1b[30;44m")
-				| Error -> ("\x1b[31m", "\x1b[30;41m")
-			in
-
-			let sev_label = if cm.cm_depth > 0 then " -> " else Printf.sprintf
-				(if no_color then "[%s]" else " %s ")
-				(match cm.cm_severity with
-					| MessageSeverity.Warning -> "WARNING"
-					| Information -> "INFO"
-					| Hint -> "HINT"
-					| Error -> "ERROR"
-				) in
-
-			let out = ref "" in
-
-			if display_heading then
-				out := Printf.sprintf "%s%s\n\n"
-					(* Severity heading *)
-					(c_sev_bg ^ sev_label ^ c_reset ^ " ")
-					(* File + line pointer *)
-					epos;
-
-			(* Error source *)
-			if display_source then out := List.fold_left (fun out (l, line) ->
-				let nb_len = String.length (string_of_int l) in
-
-				(* Replace tabs with 1 space to avoid column misalignments *)
-				let line = String.concat " " (ExtString.String.nsplit line "\t") in
-				let len = String.length line in
-
-				out ^ Printf.sprintf "%s%s | %s\n"
-					(* left-padded line number *)
-					(String.make (gutter_len-nb_len-1) ' ')
-					(if l = 0 then "-" else Printf.sprintf "%d" l)
-					(* Source code at that line *)
-					(
-						if l = 0 then
-							c_dim ^ line ^ c_reset
-						else if l1 = l2 then
-							(if p1 > 1 then c_dim ^ (String.sub line 0 (p1-1)) else "")
-							^ c_reset ^ c_bold ^ (String.sub line (p1-1) (p2-p1))
-							^ c_reset ^ c_dim ^ (String.sub line (p2-1) (len - p2 + 1))
-							^ c_reset
-						else begin
-							(if (l = l1) then
-								(if p1 > 1 then c_dim ^ (String.sub line 0 (p1-1)) else "")
-								^ c_reset ^ c_bold ^ (String.sub line (p1-1) (len-p1+1))
-								^ c_reset
-							else if (l = l2) then
-								(if p2 > 1 then c_bold ^ (String.sub line 0 (p2-1)) else "")
-								^ c_reset ^ c_dim ^ (String.sub line (p2-1) (len-p2+1))
-								^ c_reset
-							else c_bold ^ line ^ c_reset)
-						end
-					)
-			) !out lines;
-
-			(* Error position marker *)
-			if display_pos_marker then
-				out := Printf.sprintf "%s%s|%s\n"
-					!out
-					(String.make gutter_len ' ')
-					(if l1 = l2 then String.make p1 ' ' ^ c_sev ^ String.make (if p1 = p2 then 1 else p2-p1) '^' ^ c_reset else "");
-
-			(* Error message *)
-			out := List.fold_left (fun out str -> Printf.sprintf "%s%s| %s\n"
-				out
-				(String.make gutter_len ' ')
-				(* Remove "... " prefix *)
-				(if (ExtString.String.starts_with str "... ") then String.sub str 4 ((String.length str) - 4) else str)
-			) !out (ExtString.String.nsplit cm.cm_message "\n");
-
-			ectx.previous <- Some ((if is_null_pos then null_pos else cm.cm_pos), cm.cm_severity, cm.cm_depth);
-			ectx.gutter <- (IntMap.add cm.cm_depth gutter_len ectx.gutter);
-
-			(* Indent sub errors *)
-			let rec indent ?(acc=0) depth =
-				if depth = 0 then acc
-				else indent ~acc:(acc + try IntMap.find (depth-1) ectx.gutter with Not_found -> 3) (depth-1)
-			in
-
-			Some (
-				if cm.cm_depth > 0 then String.concat "\n" (List.map (fun str -> match str with
-					| "" -> ""
-					| _ -> (String.make (indent cm.cm_depth) ' ') ^ str
-				) (ExtString.String.nsplit !out "\n"))
-				else !out
-			)
-		end
-
-	let compiler_message_string ctx ectx cm =
-		let str = match cm.cm_severity with
-			| MessageSeverity.Warning -> "Warning : " ^ cm.cm_message
-			| Information | Error | Hint -> cm.cm_message
-		in
-
-		if cm.cm_pos = null_pos then
-			Some str
-		else begin
-			let epos = Lexer.get_error_pos error_printer cm.cm_pos 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
-			Some (Printf.sprintf "%s : %s" epos str)
-		end
-
-	let compiler_indented_message_string ctx ectx cm =
-		match cm.cm_message with
-		(* Filter some messages that don't add much when using this message renderer *)
-		| "End of overload failure reasons" -> None
-		| _ ->
-			let str = match cm.cm_severity with
-				| MessageSeverity.Warning -> "Warning : " ^ cm.cm_message
-				| Information -> "Info : " ^ cm.cm_message
-				| Error | Hint -> cm.cm_message
-			in
-
-			if cm.cm_pos = null_pos then
-				Some str
-			else begin
-				let epos = Lexer.get_error_pos error_printer cm.cm_pos in
-				let lines =
-					match (ExtString.String.nsplit str "\n") with
-					| first :: rest -> (cm.cm_depth, first) :: List.map (fun msg -> (cm.cm_depth+1, msg)) rest
-					| l -> [(cm.cm_depth, List.hd l)]
-				in
-				let rm_prefix str = if (ExtString.String.starts_with str "... ") then String.sub str 4 ((String.length str) - 4) else str in
-				Some (String.concat "\n" (List.map (fun (depth, msg) -> (String.make (depth*2) ' ') ^ epos ^ " : " ^ (rm_prefix msg)) lines))
-			end
-
-	let get_max_line max_lines messages =
-		List.fold_left (fun max_lines cm ->
-			let _,_,l2,_ = Lexer.get_pos_coords cm.cm_pos in
-			let old = try IntMap.find cm.cm_depth max_lines with Not_found -> 0 in
-
-			if l2 > old then IntMap.add cm.cm_depth l2 max_lines
-			else max_lines
-		) max_lines messages
-
-	let display_messages ctx on_message = begin
-		let ectx = create_error_context () in
-		ectx.max_lines <- get_max_line ectx.max_lines ctx.messages;
-
-		let get_formatter def default =
-			let format_mode = Define.defined_value_safe ~default ctx.com.defines def in
-			match format_mode with
-				| "pretty" -> compiler_pretty_message_string ctx ectx
-				| "indent" -> compiler_indented_message_string ctx ectx
-				| "classic" -> compiler_message_string ctx ectx
-				| m -> begin
-					let def = Define.get_define_key def in
-					error ctx (Printf.sprintf "Invalid message reporting mode: \"%s\", expected classic | pretty | indent (for -D %s)." m def) null_pos;
-					compiler_message_string ctx ectx
-				end
-			in
-
-		let message_formatter = get_formatter Define.MessageReporting "classic" in
-		let log_formatter = get_formatter Define.MessagesLogFormat "indent" in
-
-		let log_messages = ref (Define.defined ctx.com.defines Define.MessagesLogFile) in
-		let log_message = ref None in
-		let close_logs = ref None in
-
-		if !log_messages then begin
-			try begin
-				let buf = Rbuffer.create 16000 in
-
-				let file = Define.defined_value ctx.com.defines Define.MessagesLogFile in
-				let chan =
-					Path.mkdir_from_path file;
-					open_out_bin file
-				in
-
-				log_message := (Some (fun msg ->
-					match (log_formatter msg) with
-						| None -> ()
-						| Some str -> Rbuffer.add_string buf (str ^ "\n")));
-
-				close_logs := (Some (fun () ->
-					Rbuffer.output_buffer chan buf;
-					Rbuffer.clear buf;
-					close_out chan
-				));
-			end with
-				| Failure e | Sys_error e -> begin
-					let def = Define.get_define_key Define.MessagesLogFile in
-					error ctx (Printf.sprintf "Error opening log file: %s. Logging to file disabled (-D %s)" e def) null_pos;
-					log_messages := false;
-				end
-		end;
-
-		List.iter (fun cm ->
-			if !log_messages then (Option.get !log_message) cm;
-
-			match (message_formatter cm) with
-				| None -> ()
-				| Some str -> on_message cm.cm_severity str
-		) (List.rev ctx.messages);
-
-		if !log_messages then (Option.get !close_logs) ();
-	end
-
 	let create_stdio () =
 		let rec self = {
 			write_out = (fun s ->

+ 14 - 14
src/context/abstractCast.ml

@@ -19,7 +19,7 @@ let rec make_static_call ctx c cf a pl args t p =
 					| None ->  type_expr ctx (EConst (Ident "null"),p) WithType.value
 				in
 				ctx.with_type_stack <- List.tl ctx.with_type_stack;
-				let e = try cast_or_unify_raise ctx t e p with Error(Unify _,_,_) -> raise Not_found in
+				let e = try cast_or_unify_raise ctx t e p with Error { err_message = Unify _ } -> raise Not_found in
 				f();
 				e
 			| _ -> die "" __LOC__
@@ -38,10 +38,10 @@ and do_check_cast ctx uctx tleft eright p =
 				(try
 					Type.unify_custom uctx eright.etype tleft;
 				with Unify_error l ->
-					raise (Error (Unify l, eright.epos,0)))
+					raise_error_msg (Unify l) eright.epos)
 			| _ -> ()
 		end;
-		if cf == ctx.curfield || rec_stack_memq cf cast_stack then typing_error "Recursive implicit cast" p;
+		if cf == ctx.curfield || rec_stack_memq cf cast_stack then raise_typing_error "Recursive implicit cast" p;
 		rec_stack_loop cast_stack cf f ()
 	in
 	let make (a,tl,(tcf,cf)) =
@@ -112,8 +112,8 @@ and cast_or_unify_raise ctx ?(uctx=None) tleft eright p =
 and cast_or_unify ctx tleft eright p =
 	try
 		cast_or_unify_raise ctx tleft eright p
-	with Error (Unify l,p,_) ->
-		raise_or_display ctx l p;
+	with Error ({ err_message = Unify _ } as err) ->
+		raise_or_display_error ctx err;
 		eright
 
 let prepare_array_access_field ctx a pl cf p =
@@ -146,7 +146,7 @@ let find_array_read_access_raise ctx a pl e1 p =
 					let e1 = cast_or_unify_raise ctx ta1 e1 p in
 					check_constraints();
 					cf,tf,r,e1
-				with Unify_error _ | Error (Unify _,_,_) ->
+				with Unify_error _ | Error { err_message = Unify _ } ->
 					loop cfl
 				end
 			| _ -> loop cfl
@@ -167,7 +167,7 @@ let find_array_write_access_raise ctx a pl e1 e2  p =
 					let e2 = cast_or_unify_raise ctx ta2 e2 p in
 					check_constraints();
 					cf,tf,r,e1,e2
-				with Unify_error _ | Error (Unify _,_,_) ->
+				with Unify_error _ | Error { err_message = Unify _ } ->
 					loop cfl
 				end
 			| _ -> loop cfl
@@ -179,14 +179,14 @@ let find_array_read_access ctx a tl e1 p =
 		find_array_read_access_raise ctx a tl e1 p
 	with Not_found ->
 		let s_type = s_type (print_context()) in
-		typing_error (Printf.sprintf "No @:arrayAccess function for %s accepts argument of %s" (s_type (TAbstract(a,tl))) (s_type e1.etype)) p
+		raise_typing_error (Printf.sprintf "No @:arrayAccess function for %s accepts argument of %s" (s_type (TAbstract(a,tl))) (s_type e1.etype)) p
 
 let find_array_write_access ctx a tl e1 e2 p =
 	try
 		find_array_write_access_raise ctx a tl e1 e2 p
 	with Not_found ->
 		let s_type = s_type (print_context()) in
-		typing_error (Printf.sprintf "No @:arrayAccess function for %s accepts arguments of %s and %s" (s_type (TAbstract(a,tl))) (s_type e1.etype) (s_type e2.etype)) p
+		raise_typing_error (Printf.sprintf "No @:arrayAccess function for %s accepts arguments of %s and %s" (s_type (TAbstract(a,tl))) (s_type e1.etype) (s_type e2.etype)) p
 
 let find_multitype_specialization com a pl p =
 	let uctx = default_unification_context in
@@ -202,7 +202,7 @@ let find_multitype_specialization com a pl p =
 					stack := t :: !stack;
 					match follow t with
 					| TAbstract ({ a_path = [],"Class" },_) ->
-						typing_error (Printf.sprintf "Cannot use %s as key type to Map because Class<T> is not comparable on JavaScript" (s_type (print_context()) t1)) p;
+						raise_typing_error (Printf.sprintf "Cannot use %s as key type to Map because Class<T> is not comparable on JavaScript" (s_type (print_context()) t1)) p;
 					| TEnum(en,tl) ->
 						PMap.iter (fun _ ef -> ignore(loop ef.ef_type)) en.e_constrs;
 						Type.map loop t
@@ -219,16 +219,16 @@ let find_multitype_specialization com a pl p =
 			if List.exists (fun t -> has_mono t) definitive_types then begin
 				let at = apply_params a.a_params pl a.a_this in
 				let st = s_type (print_context()) at in
-				typing_error ("Type parameters of multi type abstracts must be known (for " ^ st ^ ")") p
+				raise_typing_error ("Type parameters of multi type abstracts must be known (for " ^ st ^ ")") p
 			end;
 			t
 		with Not_found ->
 			let at = apply_params a.a_params pl a.a_this in
 			let st = s_type (print_context()) at in
 			if has_mono at then
-				typing_error ("Type parameters of multi type abstracts must be known (for " ^ st ^ ")") p
+				raise_typing_error ("Type parameters of multi type abstracts must be known (for " ^ st ^ ")") p
 			else
-				typing_error ("Abstract " ^ (s_type_path a.a_path) ^ " has no @:to function that accepts " ^ st) p;
+				raise_typing_error ("Abstract " ^ (s_type_path a.a_path) ^ " has no @:to function that accepts " ^ st) p;
 	in
 	cf, follow m
 
@@ -240,7 +240,7 @@ let handle_abstract_casts ctx e =
 					let's construct the underlying type. *)
 				match Abstract.get_underlying_type a pl with
 				| TInst(c,tl) as t -> {e with eexpr = TNew(c,tl,el); etype = t}
-				| _ -> typing_error ("Cannot construct " ^ (s_type (print_context()) (TAbstract(a,pl)))) e.epos
+				| _ -> raise_typing_error ("Cannot construct " ^ (s_type (print_context()) (TAbstract(a,pl)))) e.epos
 			end else begin
 				(* a TNew of an abstract implementation is only generated if it is a multi type abstract *)
 				let cf,m = find_multitype_specialization ctx.com a pl e.epos in

+ 19 - 24
src/context/common.ml

@@ -363,9 +363,9 @@ type context = {
 	(* communication *)
 	mutable print : string -> unit;
 	mutable error : ?depth:int -> string -> pos -> unit;
-	mutable located_error : ?depth:int -> located -> unit;
-	mutable info : ?depth:int -> string -> pos -> unit;
-	mutable warning : ?depth:int -> warning -> Warning.warning_option list list -> string -> pos -> unit;
+	mutable error_ext : Error.error -> unit;
+	mutable info : ?depth:int -> ?from_macro:bool -> string -> pos -> unit;
+	mutable warning : ?depth:int -> ?from_macro:bool -> warning -> Warning.warning_option list list -> string -> pos -> unit;
 	mutable warning_options : Warning.warning_option list list;
 	mutable get_messages : unit -> compiler_message list;
 	mutable filter_messages : (compiler_message -> bool) -> unit;
@@ -415,7 +415,7 @@ type context = {
 	memory_marker : float array;
 }
 
-exception Abort of located
+exception Abort of Error.error
 
 let ignore_error com =
 	let b = com.display.dms_error_policy = EPIgnore in
@@ -834,11 +834,11 @@ let create compilation_step cs version args =
 		user_defines = Hashtbl.create 0;
 		user_metas = Hashtbl.create 0;
 		get_macros = (fun() -> None);
-		info = (fun ?depth _ _ -> die "" __LOC__);
-		warning = (fun ?depth _ _ _ -> die "" __LOC__);
+		info = (fun ?depth ?from_macro _ _ -> die "" __LOC__);
+		warning = (fun ?depth ?from_macro _ _ _ -> die "" __LOC__);
 		warning_options = [];
 		error = (fun ?depth _ _ -> die "" __LOC__);
-		located_error = (fun ?depth _ -> die "" __LOC__);
+		error_ext = (fun _ -> die "" __LOC__);
 		get_messages = (fun() -> []);
 		filter_messages = (fun _ -> ());
 		pass_debug_messages = DynArray.create();
@@ -1026,8 +1026,7 @@ let allow_package ctx s =
 	with Not_found ->
 		()
 
-let abort_located ?depth msg = raise (Abort msg)
-let abort ?depth msg p = abort_located ~depth (located msg p)
+let abort ?(depth = 0) msg p = raise (Abort (Error.make_error ~depth (Custom msg) p))
 
 let platform ctx p = ctx.platform = p
 
@@ -1231,25 +1230,21 @@ let utf16_to_utf8 str =
 	loop 0;
 	Buffer.contents b
 
-let add_diagnostics_message ?(depth = 0) com msg kind sev =
+let add_diagnostics_message ?(depth = 0) com s p kind sev =
 	if sev = MessageSeverity.Error then com.has_error <- true;
 	let di = com.shared.shared_display_information in
-	match (extract_located msg) with
-	| [] -> ()
-	| (s,p) :: [] ->
-		di.diagnostics_messages <- (s,p,kind,sev,depth) :: di.diagnostics_messages
-	| (s,p) :: stack ->
-		let stack_diag = (List.map (fun (s,p) -> (s,p,kind,sev,depth+1)) (List.rev stack)) in
-		di.diagnostics_messages <- stack_diag @ ((s,p,kind,sev,depth) :: di.diagnostics_messages)
-
-let located_display_error com ?(depth = 0) msg =
-	if is_diagnostics com then
-		add_diagnostics_message ~depth com msg MessageKind.DKCompilerMessage MessageSeverity.Error
-	else
-		com.located_error msg ~depth
+	di.diagnostics_messages <- (s,p,kind,sev,depth) :: di.diagnostics_messages
+
+let display_error_ext com err =
+	if is_diagnostics com then begin
+		Error.recurse_error (fun depth err ->
+			add_diagnostics_message ~depth com (Error.error_msg err.err_message) err.err_pos MessageKind.DKCompilerMessage MessageSeverity.Error;
+		) err;
+	end else
+		com.error_ext err
 
 let display_error com ?(depth = 0) msg p =
-	located_display_error com ~depth (Globals.located msg p)
+	display_error_ext com (Error.make_error ~depth (Custom msg) p)
 
 open Printer
 

+ 3 - 3
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 (located "This code has no effect" p) DKCompilerMessage Warning;
+		add_diagnostics_message com "This code has no effect" p DKCompilerMessage Warning;
 	in
 	let pointless_compound s p =
-		add_diagnostics_message com (located (Printf.sprintf "This %s has no effect, but some of its sub-expressions do" s) p) DKCompilerMessage 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
@@ -190,4 +190,4 @@ let print com =
 
 let run com =
 	let dctx = prepare com in
-	dctx
+	dctx

+ 2 - 2
src/context/display/displayFields.ml

@@ -75,7 +75,7 @@ let collect_static_extensions ctx items e p =
 					let item = make_ci_class_field (CompletionClassField.make f CFSMember origin true) (f.cf_type,ct) in
 					PMap.add f.cf_name item acc
 				end
-			with Error (Unify _,_,_) | Unify_error _ ->
+			with Error { err_message = Unify _ } | Unify_error _ ->
 				acc
 			end
 		| _ ->
@@ -409,4 +409,4 @@ let handle_missing_ident ctx i mode with_type p =
 			handle_missing_field_raise ctx ctx.tthis i mode with_type p
 		with Exit ->
 			()
-		end
+		end

+ 8 - 8
src/context/display/importHandling.ml

@@ -76,14 +76,14 @@ let init_import ctx context_init path mode p =
 			(match List.rev path with
 			(* p spans `import |` (to the display position), so we take the pmax here *)
 			| [] -> DisplayException.raise_fields (DisplayToplevel.collect ctx TKType NoValue true) CRImport (DisplayTypes.make_subject None {p with pmin = p.pmax})
-			| (_,p) :: _ -> Error.typing_error "Module name must start with an uppercase letter" p))
+			| (_,p) :: _ -> Error.raise_typing_error "Module name must start with an uppercase letter" p))
 	| (tname,p2) :: rest ->
 		let p1 = (match pack with [] -> p2 | (_,p1) :: _ -> p1) in
 		let p_type = punion p1 p2 in
 		let md = ctx.g.do_load_module ctx (List.map fst pack,tname) p_type in
 		let types = md.m_types in
 		let no_private (t,_) = not (t_infos t).mt_private in
-		let error_private p = typing_error "Importing private declarations from a module is not allowed" p in
+		let error_private p = raise_typing_error "Importing private declarations from a module is not allowed" p in
 		let chk_private t p = if ctx.m.curmod != (t_infos t).mt_module && (t_infos t).mt_private then error_private p in
 		let has_name name t = snd (t_infos t).mt_path = name in
 
@@ -93,7 +93,7 @@ let init_import ctx context_init path mode p =
 				| 'a'..'z' -> "field", PMap.foldi (fun n _ acc -> n :: acc) (try (Option.get md.m_statics).cl_statics with | _ -> PMap.empty) []
 				| _ -> "type", List.map (fun mt -> snd (t_infos mt).mt_path) types
 			in
-			typing_error (StringError.string_error name
+			raise_typing_error (StringError.string_error name
 				candidates
 				("Module " ^ s_type_path md.m_path ^ " does not define " ^ target_kind ^ " " ^ name)
 			) p
@@ -111,7 +111,7 @@ let init_import ctx context_init path mode p =
 		in
 		let rebind t name p =
 			if not (name.[0] >= 'A' && name.[0] <= 'Z') then
-				typing_error "Type aliases must start with an uppercase letter" p;
+				raise_typing_error "Type aliases must start with an uppercase letter" p;
 			let _, _, f = ctx.g.do_build_instance ctx t p_type in
 			(* create a temp private typedef, does not register it in module *)
 			let t_path = (fst md.m_path @ ["_" ^ snd md.m_path],name) in
@@ -223,7 +223,7 @@ let init_import ctx context_init path mode p =
 			| (tsub,p2) :: (fname,p3) :: rest ->
 				(match rest with
 				| [] -> ()
-				| (n,p) :: _ -> typing_error ("Unexpected " ^ n) p);
+				| (n,p) :: _ -> raise_typing_error ("Unexpected " ^ n) p);
 				let tsub = get_type tsub in
 				context_init#add (fun() ->
 					try
@@ -236,7 +236,7 @@ let init_import ctx context_init path mode p =
 			let t = (match rest with
 				| [] -> get_type tname
 				| [tsub,_] -> get_type tsub
-				| _ :: (n,p) :: _ -> typing_error ("Unexpected " ^ n) p
+				| _ :: (n,p) :: _ -> raise_typing_error ("Unexpected " ^ n) p
 			) in
 			context_init#add (fun() ->
 				match resolve_typedef t with
@@ -247,7 +247,7 @@ let init_import ctx context_init path mode p =
 				| TEnumDecl e ->
 					PMap.iter (fun _ c -> if not (has_meta Meta.NoImportGlobal c.ef_meta) then ctx.m.module_globals <- PMap.add c.ef_name (TEnumDecl e,c.ef_name,p) ctx.m.module_globals) e.e_constrs
 				| _ ->
-					typing_error "No statics to import from this type" p
+					raise_typing_error "No statics to import from this type" p
 			)
 		))
 
@@ -290,4 +290,4 @@ let init_using ctx context_init path p =
 	let types,filter_classes = handle_using ctx path p in
 	(* do the import first *)
 	ctx.m.module_imports <- (List.map (fun t -> t,p) types) @ ctx.m.module_imports;
-	context_init#add (fun() -> ctx.m.module_using <- filter_classes types @ ctx.m.module_using)
+	context_init#add (fun() -> ctx.m.module_using <- filter_classes types @ ctx.m.module_using)

+ 2 - 2
src/context/purityState.ml

@@ -29,12 +29,12 @@ let get_purity_from_meta meta =
 			| "true" | "inferredPure" -> Pure
 			| "false" -> Impure
 			| "expect" -> ExpectPure p
-			| _ -> typing_error ("Unsupported purity value " ^ s ^ ", expected true or false") p
+			| _ -> raise_typing_error ("Unsupported purity value " ^ s ^ ", expected true or false") p
 			end
 		| (_,[],_) ->
 			Pure
 		| (_,_,p) ->
-			typing_error "Unsupported purity value" p
+			raise_typing_error "Unsupported purity value" p
 		end
 	with Not_found ->
 		MaybePure

+ 22 - 11
src/context/typecore.ml

@@ -198,7 +198,7 @@ type dot_path_part = {
 
 exception Forbid_package of (string * path * pos) * pos list * string
 
-exception WithTypeError of error_msg * pos * int (* depth *)
+exception WithTypeError of error
 
 let memory_marker = [|Unix.time()|]
 
@@ -257,13 +257,21 @@ let make_static_call ctx c cf map args t p =
 	let ef = make_static_field_access c cf (map cf.cf_type) p in
 	make_call ctx ef args (map t) p
 
+let raise_with_type_error ?(depth = 0) msg p =
+	raise (WithTypeError (make_error ~depth (Custom msg) p))
+
 let raise_or_display ctx l p =
 	if ctx.untyped then ()
-	else if ctx.in_call_args then raise (WithTypeError(Unify l,p,0))
-	else located_display_error ctx.com (error_msg p (Unify l))
+	else if ctx.in_call_args then raise (WithTypeError (make_error (Unify l) p))
+	else display_error_ext ctx.com (make_error (Unify l) p)
+
+let raise_or_display_error ctx err =
+	if ctx.untyped then ()
+	else if ctx.in_call_args then raise (WithTypeError err)
+	else display_error_ext ctx.com err
 
 let raise_or_display_message ctx msg p =
-	if ctx.in_call_args then raise (WithTypeError (Custom msg,p,0))
+	if ctx.in_call_args then raise_with_type_error msg p
 	else display_error ctx.com msg p
 
 let unify ctx t1 t2 p =
@@ -279,7 +287,7 @@ let unify_raise_custom uctx t1 t2 p =
 	with
 		Unify_error l ->
 			(* no untyped check *)
-			raise (Error (Unify l,p,0))
+			raise_error_msg (Unify l) p
 
 let unify_raise = unify_raise_custom default_unification_context
 
@@ -337,8 +345,11 @@ let check_module_path ctx (pack,name) p =
 	try
 		List.iter (fun part -> Path.check_package_name part) pack;
 	with Failure msg ->
-		display_error ctx.com ("\"" ^ (StringHelper.s_escape (String.concat "." pack)) ^ "\" is not a valid package name:") p;
-		display_error ctx.com msg p
+		display_error_ext ctx.com (make_error
+			~sub:[make_error (Custom msg) p]
+			(Custom ("\"" ^ (StringHelper.s_escape (String.concat "." pack)) ^ "\" is not a valid package name:"))
+			p
+		)
 
 let check_local_variable_name ctx name origin p =
 	match name with
@@ -423,8 +434,8 @@ let exc_protect ?(force=true) ctx f (where:string) =
 			r := lazy_available t;
 			t
 		with
-			| Error (m,p,depth) ->
-				raise (Fatal_error ((error_msg p m),depth))
+			| Error e ->
+				raise (Fatal_error e)
 	);
 	if force then delay ctx PForce (fun () -> ignore(lazy_type r));
 	r
@@ -804,9 +815,9 @@ let display_error ctx.com msg p =
 	debug ctx ("ERROR " ^ msg);
 	display_error ctx.com msg p
 
-let located_display_error ctx.com msg =
+let display_error_ext ctx.com msg =
 	debug ctx ("ERROR " ^ msg);
-	located_display_error ctx.com msg
+	display_error_ext ctx.com msg
 
 let make_pass ?inf ctx f =
 	let inf = (match inf with None -> pass_infos ctx ctx.pass | Some inf -> inf) in

+ 2 - 2
src/core/abstract.ml

@@ -83,7 +83,7 @@ let rec find_multitype_params a pl =
 				| EMeta((Meta.Custom ":followWithAbstracts",_,_),e1) ->
 					loop follow_with_abstracts e1;
 				| _ ->
-					typing_error "Type parameter expected" (pos e)
+					raise_typing_error "Type parameter expected" (pos e)
 			in
 			loop (fun t -> t) e
 		) el;
@@ -124,7 +124,7 @@ and get_underlying_type ?(return_first=false) a pl =
 				if rec_stack_exists (fast_eq t) underlying_type_stack then begin
 					let pctx = print_context() in
 					let s = String.concat " -> " (List.map (fun t -> s_type pctx t) (List.rev (t :: underlying_type_stack.rec_stack))) in
-					typing_error ("Abstract chain detected: " ^ s) a.a_pos
+					raise_typing_error ("Abstract chain detected: " ^ s) a.a_pos
 				end;
 				get_underlying_type a tl
 			| _ ->

+ 49 - 33
src/core/error.ml

@@ -17,7 +17,6 @@ and error_msg =
 	| Unify of unify_error list
 	| Custom of string
 	| Unknown_ident of string
-	| Stack of (error_msg * Globals.pos) list
 	| Call_error of call_error
 	| No_constructor of module_type
 	| Abstract_class of module_type
@@ -26,8 +25,31 @@ and type_not_found_reason =
 	| Private_type
 	| Not_defined
 
-exception Fatal_error of Globals.located * int (* depth *)
-exception Error of error_msg * Globals.pos * int (* depth *)
+type error = {
+	err_message : error_msg;
+	err_pos : pos;
+	(* TODO Should probably be deprecated at some point and be derived from err_sub *)
+	err_depth : int;
+	(* Reverse list of sub errors. Use Error.recurse_error to handle an error and its sub errors with depth. *)
+	err_sub : error list;
+	err_from_macro : bool;
+}
+
+let make_error ?(depth = 0) ?(from_macro = false) ?(sub = []) msg p = {
+	err_message = msg;
+	err_pos = p;
+	err_depth = depth;
+	err_from_macro = from_macro;
+	err_sub = sub;
+}
+
+let rec recurse_error ?(depth = 0) cb err =
+	let depth = if depth > 0 then depth else err.err_depth in
+	cb depth err;
+	List.iter (recurse_error ~depth:(depth+1) cb) (List.rev err.err_sub);
+
+exception Fatal_error of error
+exception Error of error
 
 let string_source t = match follow t with
 	| TInst(c,tl) -> PMap.foldi (fun s _ acc -> s :: acc) (TClass.get_all_fields c tl) []
@@ -43,9 +65,6 @@ let short_type ctx t =
 	Should be called for each complementary error message.
 *)
 let compl_msg s = "... " ^ s
-let rec compl_located_msg = function
-	 | Message (s,p) -> Message (compl_msg s,p)
-	 | Stack stack -> Stack (List.map compl_located_msg stack)
 
 let unify_error_msg ctx err = match err with
 	| Cannot_unify (t1,t2) ->
@@ -280,39 +299,36 @@ module BetterErrors = struct
 			Printf.sprintf "error: %s\nhave: %s\nwant: %s" (Buffer.contents message_buffer) slhs srhs
 end
 
-let rec error_msg p = function
-	| Module_not_found m -> located ("Type not found : " ^ s_type_path m) p
-	| Type_not_found (m,t,Private_type) -> located ("Cannot access private type " ^ t ^ " in module " ^ s_type_path m) p
-	| Type_not_found (m,t,Not_defined) -> located ("Module " ^ s_type_path m ^ " does not define type " ^ t) p
-	| Unify l -> located (BetterErrors.better_error_message l) p
-	| Unknown_ident s -> located ("Unknown identifier : " ^ s) p
-	| Custom s -> located s p
-	| Stack stack -> located_stack (List.map (fun (e,p) -> error_msg p e) stack)
-	| Call_error err -> s_call_error p err
-	| No_constructor mt -> located (s_type_path (t_infos mt).mt_path ^ " does not have a constructor") p
-	| Abstract_class mt -> located (s_type_path (t_infos mt).mt_path ^ " is abstract and cannot be constructed") p
+let rec error_msg = function
+	| Module_not_found m -> "Type not found : " ^ s_type_path m
+	| Type_not_found (m,t,Private_type) -> "Cannot access private type " ^ t ^ " in module " ^ s_type_path m
+	| Type_not_found (m,t,Not_defined) -> "Module " ^ s_type_path m ^ " does not define type " ^ t
+	| Unify l -> BetterErrors.better_error_message l
+	| Unknown_ident s -> "Unknown identifier : " ^ s
+	| Custom s -> s
+	| Call_error err -> s_call_error err
+	| No_constructor mt -> s_type_path (t_infos mt).mt_path ^ " does not have a constructor"
+	| Abstract_class mt -> s_type_path (t_infos mt).mt_path ^ " is abstract and cannot be constructed"
 
-and s_call_error p = function
+and s_call_error = function
 	| Not_enough_arguments tl ->
 		let pctx = print_context() in
-		located ("Not enough arguments, expected " ^ (String.concat ", " (List.map (fun (n,_,t) -> n ^ ":" ^ (short_type pctx t)) tl))) p
-	| Too_many_arguments -> located "Too many arguments" p
-	| Could_not_unify err -> error_msg p err
-	| Cannot_skip_non_nullable s -> located ("Cannot skip non-nullable argument " ^ s) p
+		"Not enough arguments, expected " ^ (String.concat ", " (List.map (fun (n,_,t) -> n ^ ":" ^ (short_type pctx t)) tl))
+	| Too_many_arguments -> "Too many arguments"
+	| Could_not_unify err -> error_msg err
+	| Cannot_skip_non_nullable s -> "Cannot skip non-nullable argument " ^ s
 
-let typing_error ?(depth=0) msg p = raise (Error (Custom msg,p,depth))
-let located_typing_error ?(depth=0) msg =
-	let err = match msg with
-		| Message (msg,p) -> Custom msg
-		| Stack _ -> Stack (List.map (fun (msg,p) -> (Custom msg,p)) (extract_located msg))
-	in
-	raise (Error (err,(extract_located_pos msg),depth))
+(* Global error helpers *)
+let raise_error err = raise (Error err)
+let raise_error_msg ?(depth = 0) msg p = raise_error (make_error ~depth msg p)
+let raise_msg ?(depth = 0) msg p = raise_error_msg ~depth (Custom msg) p
 
-let raise_typing_error ?(depth=0) err p = raise (Error(err,p,depth))
+let raise_typing_error ?(depth = 0) msg p = raise_msg ~depth msg p
+let raise_typing_error_ext err = raise_error err
 
 let error_require r p =
 	if r = "" then
-		typing_error "This field is not available with the current compilation flags" p
+		raise_typing_error "This field is not available with the current compilation flags" p
 	else
 	let r = if r = "sys" then
 		"a system platform (php,neko,cpp,etc.)"
@@ -323,6 +339,6 @@ let error_require r p =
 	with _ ->
 		"'" ^ r ^ "' to be enabled"
 	in
-	typing_error ("Accessing this field requires " ^ r) p
+	raise_typing_error ("Accessing this field requires " ^ r) p
 
-let invalid_assign p = typing_error "Invalid assign" p
+let invalid_assign p = raise_typing_error "Invalid assign" p

+ 3 - 21
src/core/globals.ml

@@ -5,9 +5,6 @@ type pos = {
 }
 
 type path = string list * string
-type located =
-	| Message of string * pos
-	| Stack of located list
 
 module IntMap = Ptmap
 module StringMap = Map.Make(struct type t = string let compare = String.compare end)
@@ -35,23 +32,6 @@ let version_pre = None
 
 let null_pos = { pfile = "?"; pmin = -1; pmax = -1 }
 
-let located msg p = Message (msg,p)
-let located_stack stack = Stack stack
-
-let rec extract_located = function
-	| Message (msg,p) -> [(msg, p)]
-	| Stack stack -> List.fold_left (fun acc s -> acc @ (extract_located s)) [] stack
-
-let rec relocate msg p = match msg with
-	| Message (msg,_) -> Message (msg,p)
-	| Stack [] -> Stack []
-	| Stack (hd :: tl) -> Stack ((relocate hd p) :: tl)
-
-let rec extract_located_pos = function
-	| Message (_,p) -> p
-	| Stack [] -> null_pos
-	| Stack (hd :: _) -> extract_located_pos hd
-
 let macro_platform = ref Neko
 
 let return_partial_type = ref false
@@ -195,14 +175,16 @@ type compiler_message = {
 	cm_message : string;
 	cm_pos : pos;
 	cm_depth : int;
+	cm_from_macro : bool;
 	cm_kind : MessageKind.t;
 	cm_severity : MessageSeverity.t;
 }
 
-let make_compiler_message msg p depth kind sev = {
+let make_compiler_message ?(from_macro = false) msg p depth kind sev = {
 		cm_message = msg;
 		cm_pos = p;
 		cm_depth = depth;
+		cm_from_macro = from_macro;
 		cm_kind = kind;
 		cm_severity = sev;
 }

+ 2 - 2
src/core/inheritDoc.ml

@@ -8,7 +8,7 @@ let expr_to_target e =
 		match e with
 		| EConst (Ident s) when s <> "" -> [s]
 		| EField (e,s,_) -> s :: loop e
-		| _ -> Error.typing_error "Invalid target expression for @:inheritDoc" p
+		| _ -> Error.raise_typing_error "Invalid target expression for @:inheritDoc" p
 	in
 	match loop e with
 	| sub_name :: type_name :: pack when not (is_lower_ident type_name) ->
@@ -16,7 +16,7 @@ let expr_to_target e =
 	| type_name :: pack ->
 		(List.rev pack, type_name), None
 	| [] ->
-		Error.typing_error "Invalid target path for @:inheritDoc" (snd e)
+		Error.raise_typing_error "Invalid target path for @:inheritDoc" (snd e)
 
 let rec get_constructor c =
 	match c.cl_constructor, c.cl_super with

+ 8 - 8
src/core/texpr.ml

@@ -505,7 +505,7 @@ module Builder = struct
 		| TFloat f -> mk (TConst (TFloat f)) basic.tfloat p
 		| TBool b -> mk (TConst (TBool b)) basic.tbool p
 		| TNull -> mk (TConst TNull) (basic.tnull (mk_mono())) p
-		| _ -> typing_error "Unsupported constant" p
+		| _ -> raise_typing_error "Unsupported constant" p
 
 	let field e name t p =
 		let f =
@@ -572,7 +572,7 @@ let replace_separators s c =
 let type_constant basic c p =
 	match c with
 	| Int (s,_) ->
-		if String.length s > 10 && String.sub s 0 2 = "0x" then typing_error "Invalid hexadecimal integer" p;
+		if String.length s > 10 && String.sub s 0 2 = "0x" then raise_typing_error "Invalid hexadecimal integer" p;
 		(try mk (TConst (TInt (Int32.of_string s))) basic.tint p
 		with _ -> mk (TConst (TFloat s)) basic.tfloat p)
 	| Float (f,_) -> mk (TConst (TFloat f)) basic.tfloat p
@@ -580,8 +580,8 @@ let type_constant basic c p =
 	| Ident "true" -> mk (TConst (TBool true)) basic.tbool p
 	| Ident "false" -> mk (TConst (TBool false)) basic.tbool p
 	| Ident "null" -> mk (TConst TNull) (basic.tnull (mk_mono())) p
-	| Ident t -> typing_error ("Invalid constant :  " ^ t) p
-	| Regexp _ -> typing_error "Invalid constant" p
+	| Ident t -> raise_typing_error ("Invalid constant :  " ^ t) p
+	| Regexp _ -> raise_typing_error "Invalid constant" p
 
 let rec type_constant_value basic (e,p) =
 	match e with
@@ -594,16 +594,16 @@ let rec type_constant_value basic (e,p) =
 	| EArrayDecl el ->
 		mk (TArrayDecl (List.map (type_constant_value basic) el)) (basic.tarray t_dynamic) p
 	| _ ->
-		typing_error "Constant value expected" p
+		raise_typing_error "Constant value expected" p
 
 let is_constant_value basic e =
-	try (ignore (type_constant_value basic e); true) with Error (Custom _,_,_) -> false
+	try (ignore (type_constant_value basic e); true) with Error {err_message = Custom _} -> false
 
 let for_remap basic v e1 e2 p =
 	let v' = alloc_var v.v_kind v.v_name e1.etype e1.epos in
 	let ev' = mk (TLocal v') e1.etype e1.epos in
 	let t1 = (Abstract.follow_with_abstracts e1.etype) in
-	let ehasnext = mk (TField(ev',try quick_field t1 "hasNext" with Not_found -> typing_error (s_type (print_context()) t1 ^ "has no field hasNext()") p)) (tfun [] basic.tbool) e1.epos in
+	let ehasnext = mk (TField(ev',try quick_field t1 "hasNext" with Not_found -> raise_typing_error (s_type (print_context()) t1 ^ "has no field hasNext()") p)) (tfun [] basic.tbool) e1.epos in
 	let ehasnext = mk (TCall(ehasnext,[])) basic.tbool ehasnext.epos in
 	let enext = mk (TField(ev',quick_field t1 "next")) (tfun [] v.v_type) e1.epos in
 	let enext = mk (TCall(enext,[])) v.v_type e1.epos in
@@ -638,7 +638,7 @@ let build_metadata api t =
 	let make_meta_field ml =
 		let h = Hashtbl.create 0 in
 		mk (TObjectDecl (List.map (fun (f,el,p) ->
-			if Hashtbl.mem h f then typing_error ("Duplicate metadata '" ^ f ^ "'") p;
+			if Hashtbl.mem h f then raise_typing_error ("Duplicate metadata '" ^ f ^ "'") p;
 			Hashtbl.add h f ();
 			(f,null_pos,NoQuotes), mk (match el with [] -> TConst TNull | _ -> TArrayDecl (List.map (type_constant_value api) el)) (api.tarray t_dynamic) p
 		) ml)) t_dynamic p

+ 3 - 3
src/core/warning.ml

@@ -13,7 +13,7 @@ type warning_option = {
 
 let parse_options s ps lexbuf =
 	let fail msg p =
-		Error.typing_error msg {p with pmin = ps.pmin + p.pmin; pmax = ps.pmin + p.pmax}
+		Error.raise_typing_error msg {p with pmin = ps.pmin + p.pmin; pmax = ps.pmin + p.pmax}
 	in
 	let parse_string s p =
 		begin try
@@ -58,7 +58,7 @@ let from_meta ml =
 			let p = snd e in
 			parse_options s {p with pmin = p.pmin + 1; pmax = p.pmax - 1} (* pmin is on the quote *)
 		| _ ->
-			Error.typing_error "String expected" (snd e)
+			Error.raise_typing_error "String expected" (snd e)
 	in
 	let rec loop acc ml = match ml with
 		| (Meta.HaxeWarning,args,_) :: ml ->
@@ -92,4 +92,4 @@ let get_mode w (l : warning_option list list) =
 			in
 			loop (loop2 mode l2) l
 	in
-	loop WMEnable (* ? *) l
+	loop WMEnable (* ? *) l

+ 18 - 18
src/filters/exceptions.ml

@@ -36,12 +36,12 @@ let is_dynamic t =
 let haxe_exception_static_call ctx method_name args p =
 	let method_field =
 		try PMap.find method_name ctx.haxe_exception_class.cl_statics
-		with Not_found -> typing_error ("haxe.Exception has no field " ^ method_name) p
+		with Not_found -> raise_typing_error ("haxe.Exception has no field " ^ method_name) p
 	in
 	let return_type =
 		match follow method_field.cf_type with
 		| TFun(_,t) -> t
-		| _ -> typing_error ("haxe.Exception." ^ method_name ^ " is not a function and cannot be called") p
+		| _ -> raise_typing_error ("haxe.Exception." ^ method_name ^ " is not a function and cannot be called") p
 	in
 	add_dependency ctx.typer.curclass.cl_module ctx.haxe_exception_class.cl_module;
 	make_static_call ctx.typer ctx.haxe_exception_class method_field (fun t -> t) args return_type p
@@ -57,10 +57,10 @@ let haxe_exception_instance_call ctx haxe_exception method_name args p =
 			match follow cf.cf_type with
 			| TFun(_,t) -> t
 			| _ ->
-				typing_error ((s_type (print_context()) haxe_exception.etype) ^ "." ^ method_name ^ " is not a function and cannot be called") p
+				raise_typing_error ((s_type (print_context()) haxe_exception.etype) ^ "." ^ method_name ^ " is not a function and cannot be called") p
 		in
 		make_call ctx.typer efield args rt p
-	| _ -> typing_error ((s_type (print_context()) haxe_exception.etype) ^ "." ^ method_name ^ " is expected to be an instance method") p
+	| _ -> raise_typing_error ((s_type (print_context()) haxe_exception.etype) ^ "." ^ method_name ^ " is expected to be an instance method") p
 
 (**
 	Generate `Std.isOfType(e, t)`
@@ -70,16 +70,16 @@ let std_is ctx e t p =
 	let std_cls =
 		match Typeload.load_type_raise ctx.typer ([],"Std") "Std" p with
 		| TClassDecl cls -> cls
-		| _ -> typing_error "Std is expected to be a class" p
+		| _ -> raise_typing_error "Std is expected to be a class" p
 	in
 	let isOfType_field =
 		try PMap.find "isOfType" std_cls.cl_statics
-		with Not_found -> typing_error ("Std has no field isOfType") p
+		with Not_found -> raise_typing_error ("Std has no field isOfType") p
 	in
 	let return_type =
 		match follow isOfType_field.cf_type with
 		| TFun(_,t) -> t
-		| _ -> typing_error ("Std.isOfType is not a function and cannot be called") p
+		| _ -> raise_typing_error ("Std.isOfType is not a function and cannot be called") p
 	in
 	let type_expr = { eexpr = TTypeExpr(module_type_of_type t); etype = t; epos = p } in
 	make_static_call ctx.typer std_cls isOfType_field (fun t -> t) [e; type_expr] return_type p
@@ -162,7 +162,7 @@ let rec contains_throw_or_try e =
 	Check if expression represents an exception wrapped with `haxe.Exception.thrown`
 *)
 let is_wrapped_exception e =
-	match e.eexpr with 
+	match e.eexpr with
 	| TMeta ((Meta.WrappedException, _, _), _) -> true
 	| _ -> false
 
@@ -196,7 +196,7 @@ let throw_native ctx e_thrown t p =
 	let e_native =
 		if requires_wrapped_throw ctx e_thrown then
 			let thrown = haxe_exception_static_call ctx "thrown" [e_thrown] p in
-			let wrapped = 
+			let wrapped =
 				if is_dynamic ctx.base_throw_type then thrown
 				else mk_cast thrown ctx.base_throw_type p
 			in
@@ -542,16 +542,16 @@ let filter tctx =
 		and haxe_exception_type, haxe_exception_class =
 			match Typeload.load_instance tctx (tp haxe_exception_type_path) true with
 			| TInst(cls,_) as t -> t,cls
-			| _ -> typing_error "haxe.Exception is expected to be a class" null_pos
+			| _ -> raise_typing_error "haxe.Exception is expected to be a class" null_pos
 		and value_exception_type, value_exception_class =
 			match Typeload.load_instance tctx (tp value_exception_type_path) true with
 			| TInst(cls,_) as t -> t,cls
-			| _ -> typing_error "haxe.ValueException is expected to be a class" null_pos
+			| _ -> raise_typing_error "haxe.ValueException is expected to be a class" null_pos
 		and haxe_native_stack_trace =
 			match Typeload.load_instance tctx (tp (["haxe"],"NativeStackTrace")) true with
 			| TInst(cls,_) -> cls
 			| TAbstract({ a_impl = Some cls },_) -> cls
-			| _ -> typing_error "haxe.NativeStackTrace is expected to be a class or an abstract" null_pos
+			| _ -> raise_typing_error "haxe.NativeStackTrace is expected to be a class or an abstract" null_pos
 		in
 		let is_path_of_dynamic (pack,name) =
 			name = "Dynamic" && (pack = [] || pack = ["StdTypes"])
@@ -601,7 +601,7 @@ let insert_save_stacks tctx =
 			match Typeload.load_type_def tctx null_pos tp with
 			| TClassDecl cls -> cls
 			| TAbstractDecl { a_impl = Some cls } -> cls
-			| _ -> typing_error "haxe.NativeStackTrace is expected to be a class or an abstract" null_pos
+			| _ -> raise_typing_error "haxe.NativeStackTrace is expected to be a class or an abstract" null_pos
 		in
 		let rec contains_insertion_points e =
 			match e.eexpr with
@@ -617,12 +617,12 @@ let insert_save_stacks tctx =
 			if has_feature tctx.com "haxe.NativeStackTrace.exceptionStack" then
 				let method_field =
 					try PMap.find "saveStack" native_stack_trace_cls.cl_statics
-					with Not_found -> typing_error ("haxe.NativeStackTrace has no field saveStack") null_pos
+					with Not_found -> raise_typing_error ("haxe.NativeStackTrace has no field saveStack") null_pos
 				in
 				let return_type =
 					match follow method_field.cf_type with
 					| TFun(_,t) -> t
-					| _ -> typing_error ("haxe.NativeStackTrace." ^ method_field.cf_name ^ " is not a function and cannot be called") null_pos
+					| _ -> raise_typing_error ("haxe.NativeStackTrace." ^ method_field.cf_name ^ " is not a function and cannot be called") null_pos
 				in
 				let catch_local = mk (TLocal catch_var) catch_var.v_type catch_var.v_pos in
 				begin
@@ -676,7 +676,7 @@ let patch_constructors tctx =
 					let this = { eexpr = TConst(TThis); etype = t; epos = p } in
 					let faccess =
 						try quick_field t "__shiftStack"
-						with Not_found -> typing_error "haxe.Exception has no field __shiftStack" p
+						with Not_found -> raise_typing_error "haxe.Exception has no field __shiftStack" p
 					in
 					match faccess with
 					| FInstance (_,_,cf) ->
@@ -685,10 +685,10 @@ let patch_constructors tctx =
 							match follow cf.cf_type with
 							| TFun(_,t) -> t
 							| _ ->
-								typing_error "haxe.Exception.__shiftStack is not a function and cannot be called" cf.cf_name_pos
+								raise_typing_error "haxe.Exception.__shiftStack is not a function and cannot be called" cf.cf_name_pos
 						in
 						make_call tctx efield [] rt p
-					| _ -> typing_error "haxe.Exception.__shiftStack is expected to be an instance method" p
+					| _ -> raise_typing_error "haxe.Exception.__shiftStack is expected to be an instance method" p
 				in
 				TypeloadFunction.add_constructor tctx cls true cls.cl_name_pos;
 				Option.may (fun cf -> ignore(follow cf.cf_type)) cls.cl_constructor;

+ 13 - 13
src/filters/filters.ml

@@ -72,7 +72,7 @@ module LocalStatic = struct
 		begin try
 			let cf = PMap.find name ctx.curclass.cl_statics in
 			display_error ctx.com (Printf.sprintf "The expanded name of this local (%s) conflicts with another static field" name) v.v_pos;
-			typing_error ~depth:1 "Conflicting field was found here" cf.cf_name_pos;
+			raise_typing_error ~depth:1 "Conflicting field was found here" cf.cf_name_pos;
 		with Not_found ->
 			let cf = mk_field name ~static:true v.v_type v.v_pos v.v_pos in
 			begin match eo with
@@ -81,11 +81,11 @@ module LocalStatic = struct
 			| Some e ->
 				let rec loop e = match e.eexpr with
 					| TLocal _ | TFunction _ ->
-						typing_error "Accessing local variables in static initialization is not allowed" e.epos
+						raise_typing_error "Accessing local variables in static initialization is not allowed" e.epos
 					| TConst (TThis | TSuper) ->
-						typing_error "Accessing `this` in static initialization is not allowed" e.epos
+						raise_typing_error "Accessing `this` in static initialization is not allowed" e.epos
 					| TReturn _ | TBreak | TContinue ->
-						typing_error "This kind of control flow in static initialization is not allowed" e.epos
+						raise_typing_error "This kind of control flow in static initialization is not allowed" e.epos
 					| _ ->
 						iter loop e
 				in
@@ -117,7 +117,7 @@ module LocalStatic = struct
 					let cf = find_local_static local_static_lut v in
 					Texpr.Builder.make_static_field c cf e.epos
 				with Not_found ->
-					typing_error (Printf.sprintf "Could not find local static %s (id %i)" v.v_name v.v_id) e.epos
+					raise_typing_error (Printf.sprintf "Could not find local static %s (id %i)" v.v_name v.v_id) e.epos
 				end
 			| _ ->
 				Type.map_expr run e
@@ -156,8 +156,8 @@ let check_local_vars_init ctx e =
 					if v.v_name = "this" then warning ctx WVarInit "this might be used before assigning a value to it" e.epos
 					else warning ctx WVarInit ("Local variable " ^ v.v_name ^ " might be used before being initialized") e.epos
 				else
-					if v.v_name = "this" then typing_error "Missing this = value" e.epos
-					else typing_error ("Local variable " ^ v.v_name ^ " used without being initialized") e.epos
+					if v.v_name = "this" then raise_typing_error "Missing this = value" e.epos
+					else raise_typing_error ("Local variable " ^ v.v_name ^ " used without being initialized") e.epos
 			end
 		| TVar (v,eo) ->
 			begin
@@ -345,7 +345,7 @@ let check_abstract_as_value e =
 		match e.eexpr with
 		| TField ({ eexpr = TTypeExpr _ }, _) -> ()
 		| TTypeExpr(TClassDecl {cl_kind = KAbstractImpl a}) when not (Meta.has Meta.RuntimeValue a.a_meta) ->
-			typing_error "Cannot use abstract as value" e.epos
+			raise_typing_error "Cannot use abstract as value" e.epos
 		| _ -> Type.iter loop e
 	in
 	loop e;
@@ -388,7 +388,7 @@ let remove_extern_fields com t = match t with
 let check_private_path ctx t = match t with
 	| TClassDecl c when c.cl_private ->
 		let rpath = (fst c.cl_module.m_path,"_" ^ snd c.cl_module.m_path) in
-		if ctx.com.type_to_module#mem rpath then typing_error ("This private class name will clash with " ^ s_type_path rpath) c.cl_pos;
+		if ctx.com.type_to_module#mem rpath then raise_typing_error ("This private class name will clash with " ^ s_type_path rpath) c.cl_pos;
 	| _ ->
 		()
 
@@ -575,7 +575,7 @@ let check_cs_events com t = match t with
 		let check fields f =
 			match f.cf_kind with
 			| Var { v_read = AccNormal; v_write = AccNormal } when Meta.has Meta.Event f.cf_meta && not (has_class_field_flag f CfPostProcessed) ->
-				if (has_class_field_flag f CfPublic) then typing_error "@:event fields must be private" f.cf_pos;
+				if (has_class_field_flag f CfPublic) then raise_typing_error "@:event fields must be private" f.cf_pos;
 
 				(* prevent generating reflect helpers for the event in gencommon *)
 				f.cf_meta <- (Meta.SkipReflection, [], f.cf_pos) :: f.cf_meta;
@@ -584,7 +584,7 @@ let check_cs_events com t = match t with
 				let tmeth = (tfun [f.cf_type] com.basic.tvoid) in
 
 				let process_event_method name =
-					let m = try PMap.find name fields with Not_found -> typing_error ("Missing event method: " ^ name) f.cf_pos in
+					let m = try PMap.find name fields with Not_found -> raise_typing_error ("Missing event method: " ^ name) f.cf_pos in
 
 					(* check method signature *)
 					begin
@@ -625,7 +625,7 @@ let check_remove_metadata t = match t with
 let check_void_field t = match t with
 	| TClassDecl c ->
 		let check f =
-			match follow f.cf_type with TAbstract({a_path=[],"Void"},_) -> typing_error "Fields of type Void are not allowed" f.cf_pos | _ -> ();
+			match follow f.cf_type with TAbstract({a_path=[],"Void"},_) -> raise_typing_error "Fields of type Void are not allowed" f.cf_pos | _ -> ();
 		in
 		List.iter check c.cl_ordered_fields;
 		List.iter check c.cl_ordered_statics;
@@ -1024,4 +1024,4 @@ let run com tctx main =
 	let t = filter_timer detail_times ["callbacks"] in
 	com.callbacks#run com.callbacks#get_after_save; (* macros onGenerate etc. *)
 	t();
-	destruction tctx detail_times main locals
+	destruction tctx detail_times main locals

+ 11 - 11
src/generators/genjvm.ml

@@ -244,10 +244,10 @@ let convert_fields gctx pfm =
 module AnnotationHandler = struct
 	let convert_annotations meta =
 		let parse_path e =
-			let sl = try string_list_of_expr_path_raise e with Exit -> Error.typing_error "Field expression expected" (pos e) in
+			let sl = try string_list_of_expr_path_raise e with Exit -> Error.raise_typing_error "Field expression expected" (pos e) in
 			let path = match sl with
 				| s :: sl -> List.rev sl,s
-				| _ -> Error.typing_error "Field expression expected" (pos e)
+				| _ -> Error.raise_typing_error "Field expression expected" (pos e)
 			in
 			path
 		in
@@ -268,12 +268,12 @@ module AnnotationHandler = struct
 				let values = List.map parse_value_pair el in
 				AAnnotation(TObject(path, []),values)
 
-			| _ -> Error.typing_error "Expected value expression" (pos e)
+			| _ -> Error.raise_typing_error "Expected value expression" (pos e)
 		and parse_value_pair e = match fst e with
 			| EBinop(OpAssign,(EConst(Ident s),_),e1) ->
 				s,parse_value e1
 			| _ ->
-				Error.typing_error "Assignment expression expected" (pos e)
+				Error.raise_typing_error "Assignment expression expected" (pos e)
 		in
 		let parse_expr e = match fst e with
 			| ECall(e1,el) ->
@@ -283,7 +283,7 @@ module AnnotationHandler = struct
 				let values = List.map parse_value_pair el in
 				path,values
 			| _ ->
-				Error.typing_error "Call expression expected" (pos e)
+				Error.raise_typing_error "Call expression expected" (pos e)
 		in
 		ExtList.List.filter_map (fun (m,el,_) -> match m,el with
 			| Meta.Meta,[e] ->
@@ -1516,11 +1516,11 @@ class texpr_to_jvm
 					self#expect_reference_type;
 					let path = match jsignature_of_type gctx (type_of_module_type mt) with
 						| TObject(path,_) -> path
-						| _ -> Error.typing_error "Class expected" pe
+						| _ -> Error.raise_typing_error "Class expected" pe
 					in
 					code#instanceof path;
 					Some TBool
-				| _ -> Error.typing_error "Type expression expected" e1.epos
+				| _ -> Error.raise_typing_error "Type expression expected" e1.epos
 			end;
 		| TField(_,FStatic({cl_path = (["java";"lang"],"Math")},{cf_name = ("isNaN" | "isFinite") as name})) ->
 			begin match el with
@@ -1579,7 +1579,7 @@ class texpr_to_jvm
 				self#new_native_array jsig el;
 				Some (array_sig jsig)
 			| _ ->
-				Error.typing_error (Printf.sprintf "Bad __array__ type: %s" (s_type (print_context()) tr)) e1.epos;
+				Error.raise_typing_error (Printf.sprintf "Bad __array__ type: %s" (s_type (print_context()) tr)) e1.epos;
 			end
 		| TField(_,FStatic({cl_path = (["haxe"],"EnumTools")}, {cf_name = "values"})) ->
 			begin match el with
@@ -1664,7 +1664,7 @@ class texpr_to_jvm
 					info.super_call_fields <- tl;
 					hd
 				| _ ->
-					Error.typing_error "Something went wrong" e1.epos
+					Error.raise_typing_error "Something went wrong" e1.epos
 			in
 			let kind = get_construction_mode c cf in
 			begin match kind with
@@ -1995,7 +1995,7 @@ class texpr_to_jvm
 			)
 		| TNew(c,tl,el) ->
 			begin match OverloadResolution.maybe_resolve_constructor_overload c tl el with
-			| None -> Error.typing_error "Could not find overload" e.epos
+			| None -> Error.raise_typing_error "Could not find overload" e.epos
 			| Some (c',cf,_) ->
 				let f () =
 					let tl,_ = self#call_arguments cf.cf_type el in
@@ -2163,7 +2163,7 @@ class texpr_to_jvm
 				) fl;
 			end
 		| TIdent _ ->
-			Error.typing_error (s_expr_ast false "" (s_type (print_context())) e) e.epos;
+			Error.raise_typing_error (s_expr_ast false "" (s_type (print_context())) e) e.epos;
 
 	(* api *)
 

+ 15 - 15
src/generators/genlua.ml

@@ -77,7 +77,7 @@ let get_exposed ctx path meta = try
         (match args with
          | [ EConst (String(s,_)), _ ] -> [s]
          | [] -> [path]
-         | _ -> typing_error "Invalid @:expose parameters" pos)
+         | _ -> raise_typing_error "Invalid @:expose parameters" pos)
     with Not_found -> []
 
 let dot_path = Globals.s_type_path
@@ -159,7 +159,7 @@ let println ctx =
             newline ctx
         end)
 
-let unsupported p = typing_error "This expression cannot be compiled to Lua" p
+let unsupported p = raise_typing_error "This expression cannot be compiled to Lua" p
 
 let basename path =
     try
@@ -384,7 +384,7 @@ and gen_call ctx e el =
     (match e.eexpr , el with
      | TConst TSuper , params ->
          (match ctx.current.cl_super with
-          | None -> typing_error "Missing api.setCurrentClass" e.epos
+          | None -> raise_typing_error "Missing api.setCurrentClass" e.epos
           | Some (c,_) ->
               print ctx "%s.super(%s" (ctx.type_accessor (TClassDecl c)) (this ctx);
               List.iter (fun p -> print ctx ","; gen_argument ctx p) params;
@@ -392,7 +392,7 @@ and gen_call ctx e el =
          );
      | TField ({ eexpr = TConst TSuper },f) , params ->
          (match ctx.current.cl_super with
-          | None -> typing_error "Missing api.setCurrentClass" e.epos
+          | None -> raise_typing_error "Missing api.setCurrentClass" e.epos
           | Some (c,_) ->
               let name = field_name f in
               print ctx "%s.prototype%s(%s" (ctx.type_accessor (TClassDecl c)) (field name) (this ctx);
@@ -445,7 +445,7 @@ and gen_call ctx e el =
                   if List.length(fields) > 0 then incr count;
               | { eexpr = TConst(TNull)} -> ()
               | _ ->
-                typing_error "__lua_table__ only accepts array or anonymous object arguments" e.epos;
+                raise_typing_error "__lua_table__ only accepts array or anonymous object arguments" e.epos;
              )) el;
          spr ctx "})";
      | TIdent "__lua__", [{ eexpr = TConst (TString code) }] ->
@@ -640,7 +640,7 @@ and check_multireturn_param ctx t pos =
    match t with
          TAbstract(_,p) | TInst(_,p) ->
             if List.exists ttype_multireturn p then
-				 typing_error "MultiReturns must not be type parameters" pos
+				 raise_typing_error "MultiReturns must not be type parameters" pos
             else
                 ()
         | _ ->
@@ -1519,20 +1519,20 @@ let check_multireturn ctx c =
     match c with
     | _ when Meta.has Meta.MultiReturn c.cl_meta ->
         if not (has_class_flag c CExtern) then
-            typing_error "MultiReturns must be externs" c.cl_pos
+            raise_typing_error "MultiReturns must be externs" c.cl_pos
         else if List.length c.cl_ordered_statics > 0 then
-            typing_error "MultiReturns must not contain static fields" c.cl_pos
+            raise_typing_error "MultiReturns must not contain static fields" c.cl_pos
         else if (List.exists (fun cf -> match cf.cf_kind with Method _ -> true | _-> false) c.cl_ordered_fields) then
-            typing_error "MultiReturns must not contain methods" c.cl_pos;
+            raise_typing_error "MultiReturns must not contain methods" c.cl_pos;
     | {cl_super = Some(csup,_)} when Meta.has Meta.MultiReturn csup.cl_meta ->
-        typing_error "Cannot extend a MultiReturn" c.cl_pos
+        raise_typing_error "Cannot extend a MultiReturn" c.cl_pos
     | _ -> ()
 
 
 let check_field_name c f =
     match f.cf_name with
     | "prototype" | "__proto__" | "constructor" ->
-        typing_error ("The field name '" ^ f.cf_name ^ "'  is not allowed in Lua") (match f.cf_expr with None -> c.cl_pos | Some e -> e.epos);
+        raise_typing_error ("The field name '" ^ f.cf_name ^ "'  is not allowed in Lua") (match f.cf_expr with None -> c.cl_pos | Some e -> e.epos);
     | _ -> ()
 
 (* convert a.b.c to ["a"]["b"]["c"] *)
@@ -1617,7 +1617,7 @@ let generate_class ctx c =
     ctx.current <- c;
     ctx.id_counter <- 0;
     (match c.cl_path with
-     | [],"Function" -> typing_error "This class redefines a native one" c.cl_pos
+     | [],"Function" -> raise_typing_error "This class redefines a native one" c.cl_pos
      | _ -> ());
     let p = s_path ctx c.cl_path in
     let hxClasses = has_feature ctx "Type.resolveClass" in
@@ -1815,7 +1815,7 @@ let generate_require ctx path meta =
      | [(EConst(String(module_name,_)),_) ; (EConst(String(object_path,_)),_)] ->
          print ctx "%s = _G.require(\"%s\").%s" p module_name object_path
      | _ ->
-		typing_error "Unsupported @:luaRequire format" mp);
+		raise_typing_error "Unsupported @:luaRequire format" mp);
 
     newline ctx
 
@@ -1830,7 +1830,7 @@ let generate_type ctx = function
         if p = "Std" && c.cl_ordered_statics = [] then
             ()
         else if (not (has_class_flag c CExtern)) && Meta.has Meta.LuaDotMethod c.cl_meta then
-            typing_error "LuaDotMethod is valid for externs only" c.cl_pos
+            raise_typing_error "LuaDotMethod is valid for externs only" c.cl_pos
         else if not (has_class_flag c CExtern) then
             generate_class ctx c;
         check_multireturn ctx c;
@@ -1943,7 +1943,7 @@ let transform_multireturn ctx = function
                         e
                     | TReturn Some(e2) ->
                         if is_multireturn e2.etype then
-                            typing_error "You cannot return a multireturn type from a haxe function" e2.epos
+                            raise_typing_error "You cannot return a multireturn type from a haxe function" e2.epos
                         else
                             Type.map_expr loop e;
      (*

+ 3 - 3
src/generators/genpy.ml

@@ -1492,9 +1492,9 @@ module Printer = struct
 				let interpolate () =
 					Codegen.interpolate_code pctx.pc_com code tl (Buffer.add_string buf) (fun e -> Buffer.add_string buf (print_expr pctx e)) ecode.epos
 				in
-				let old = pctx.pc_com.located_error in
-				pctx.pc_com.located_error <- abort_located;
-				Std.finally (fun() -> pctx.pc_com.located_error <- old) interpolate ();
+				let old = pctx.pc_com.error_ext in
+				pctx.pc_com.error_ext <- (fun err -> raise (Abort err));
+				Std.finally (fun() -> pctx.pc_com.error_ext <- old) interpolate ();
 				Buffer.contents buf
 			| ("python_Syntax._pythonCode"), [e] ->
 				print_expr pctx e

+ 2 - 2
src/generators/genshared.ml

@@ -278,7 +278,7 @@ object(self)
 				in
 				loop csup;
 				(c,cf)
-			| None -> Error.typing_error "Could not find overload constructor" e.epos
+			| None -> Error.raise_typing_error "Could not find overload constructor" e.epos
 		in
 		let find_super_ctor el =
 			let _,cf = find_super_ctor el in
@@ -470,4 +470,4 @@ class ['a] typedef_interfaces (infos : 'a info_context) (anon_identification : '
 				acc
 		) anon_identification#get_pfms [] in
 		info.typedef_implements <- Some l
-end
+end

+ 6 - 6
src/macro/eval/evalContext.ml

@@ -506,7 +506,7 @@ let get_static_prototype_raise ctx path =
 
 let get_static_prototype ctx path p =
 	try get_static_prototype_raise ctx path
-	with Not_found -> Error.typing_error (Printf.sprintf "[%i] Type not found: %s" ctx.ctx_id (rev_hash path)) p
+	with Not_found -> Error.raise_typing_error (Printf.sprintf "[%i] Type not found: %s" ctx.ctx_id (rev_hash path)) p
 
 let get_static_prototype_as_value ctx path p =
 	(get_static_prototype ctx path p).pvalue
@@ -516,14 +516,14 @@ let get_instance_prototype_raise ctx path =
 
 let get_instance_prototype ctx path p =
 	try get_instance_prototype_raise ctx path
-	with Not_found -> Error.typing_error (Printf.sprintf "[%i] Instance prototype not found: %s" ctx.ctx_id (rev_hash path)) p
+	with Not_found -> Error.raise_typing_error (Printf.sprintf "[%i] Instance prototype not found: %s" ctx.ctx_id (rev_hash path)) p
 
 let get_instance_constructor_raise ctx path =
 	IntMap.find path ctx.constructors
 
 let get_instance_constructor ctx path p =
 	try get_instance_constructor_raise ctx path
-	with Not_found -> Error.typing_error (Printf.sprintf "[%i] Instance constructor not found: %s" ctx.ctx_id (rev_hash path)) p
+	with Not_found -> Error.raise_typing_error (Printf.sprintf "[%i] Instance constructor not found: %s" ctx.ctx_id (rev_hash path)) p
 
 let get_special_instance_constructor_raise ctx path =
 	Hashtbl.find (get_ctx()).builtins.constructor_builtins path
@@ -533,14 +533,14 @@ let get_proto_field_index_raise proto name =
 
 let get_proto_field_index proto name =
 	try get_proto_field_index_raise proto name
-	with Not_found -> Error.typing_error (Printf.sprintf "Field index for %s not found on prototype %s" (rev_hash name) (rev_hash proto.ppath)) null_pos
+	with Not_found -> Error.raise_typing_error (Printf.sprintf "Field index for %s not found on prototype %s" (rev_hash name) (rev_hash proto.ppath)) null_pos
 
 let get_instance_field_index_raise proto name =
 	IntMap.find name proto.pinstance_names
 
 let get_instance_field_index proto name p =
 	try get_instance_field_index_raise proto name
-	with Not_found -> Error.typing_error (Printf.sprintf "Field index for %s not found on prototype %s" (rev_hash name) (rev_hash proto.ppath)) p
+	with Not_found -> Error.raise_typing_error (Printf.sprintf "Field index for %s not found on prototype %s" (rev_hash name) (rev_hash proto.ppath)) p
 
 let is v path =
 	if path = key_Dynamic then
@@ -571,4 +571,4 @@ let is v path =
 			end
 		in
 		loop vi.iproto
-	| _ -> false
+	| _ -> false

+ 9 - 8
src/macro/eval/evalExceptions.ml

@@ -138,7 +138,7 @@ let catch_exceptions ctx ?(final=(fun() -> ())) f p =
 								in
 								(Error.Custom (value_string v1), v2)
 							end else
-								Error.typing_error "Something went wrong" null_pos
+								Error.raise_typing_error "Something went wrong" null_pos
 						) (EvalArray.to_list sub)
 				| _ -> []
 			in
@@ -163,11 +163,11 @@ let catch_exceptions ctx ?(final=(fun() -> ())) f p =
 						| _ -> null_pos
 					in
 					(match stack with
-						| [] -> raise (Error.Error (Error.Custom s.sstring,p,0))
-						| _ -> raise (Error.Error (Stack ((Error.Custom (s.sstring),p) :: stack),p,0))
+						| [] -> Error.raise_msg s.sstring p
+						| _ -> Error.raise_error (Error.make_error ~sub:(List.map (fun (msg,p) -> Error.make_error msg p) stack) (Error.Custom s.sstring) p)
 					);
 				| _ ->
-					Error.typing_error "Something went wrong" null_pos
+					Error.raise_typing_error "Something went wrong" null_pos
 		end else begin
 			(* Careful: We have to get the message before resetting the context because toString() might access it. *)
 			let stack = match eval_stack with
@@ -179,10 +179,11 @@ let catch_exceptions ctx ?(final=(fun() -> ())) f p =
 			reset_ctx();
 			final();
 			let p = if p' = null_pos then p else p' in
-			raise (Error.Error (Stack (
-				(Error.Custom ("Uncaught exception " ^ (value_string v)),p)
-				:: (List.map (fun p -> ((Error.Custom "Called from here"),p)) stack)
-			),p,0))
+			Error.raise_error (Error.make_error
+				~sub:(List.map (fun p -> Error.make_error (Error.Custom "Called from here") p) (List.rev stack))
+				(Error.Custom ("Uncaught exception " ^ (value_string v)))
+				p
+			)
 		end
 	| MacroApi.Abort ->
 		final();

+ 3 - 3
src/macro/eval/evalJit.ml

@@ -235,7 +235,7 @@ and jit_expr jit return e =
 		List.iter (fun var -> ignore(get_capture_slot jit var)) jit_closure.captures_outside_scope;
 		let captures = ExtList.List.filter_map (fun (i,vid,declared) ->
 			if declared then None
-			else Some (i,fst (try Hashtbl.find jit.captures vid with Not_found -> Error.typing_error "Something went wrong" e.epos))
+			else Some (i,fst (try Hashtbl.find jit.captures vid with Not_found -> Error.raise_typing_error "Something went wrong" e.epos))
 		) captures in
 		let mapping = Array.of_list captures in
 		emit_closure ctx mapping eci hasret exec fl
@@ -637,7 +637,7 @@ and jit_expr jit return e =
 	| TParenthesis e1 | TMeta(_,e1) | TCast(e1,None) ->
 		loop e1
 	| TIdent s ->
-		Error.typing_error ("Unknown identifier: " ^ s) e.epos
+		Error.raise_typing_error ("Unknown identifier: " ^ s) e.epos
 	in
 	let f = loop e in
 	begin match ctx.debug.debug_socket with
@@ -723,4 +723,4 @@ let jit_expr ctx e =
 		let f = jit_expr jit false (mk_block e) in
 		jit,f
 	in
-	jit_timer ctx f
+	jit_timer ctx f

+ 13 - 14
src/macro/eval/evalLuv.ml

@@ -546,20 +546,19 @@ let uv_error_fields = [
 		Error.set_on_unhandled_exception (fun ex ->
 			let msg =
 				match ex with
-				| HaxeError.Error (Custom msg,_,_) ->
+				(* TODO beware of err_sub here *)
+				| HaxeError.Error { err_message = Custom msg } ->
 					(* Eval interpreter rethrows runtime exceptions as `Custom "Exception message\nException stack"` *)
-					(try fst (ExtString.String.split msg "\n")
-					with _ -> msg)
-				| HaxeError.Error (err,p,_) ->
-						(* TODO hook global error reporting *)
-						(match (extract_located (HaxeError.error_msg p err)) with
-						| [] -> ""
-						| (s,_) :: [] -> s
-						| (s,_) :: stack ->
-							List.fold_left (fun acc (s,p) ->
-								Printf.sprintf "%s%s\n" acc (Lexer.get_error_pos (Printf.sprintf "%s:%d: ") p)
-							) (s ^ "\n") stack
-						);
+					(try fst (ExtString.String.split msg "\n") with _ -> msg)
+				| HaxeError.Error err ->
+						let messages = ref [] in
+						HaxeError.recurse_error (fun depth err ->
+							let cm = make_compiler_message ~from_macro:err.err_from_macro (HaxeError.error_msg err.err_message) err.err_pos depth DKCompilerMessage Error in
+							match MessageReporting.compiler_message_string cm with
+								| None -> ()
+								| Some str -> messages := str :: !messages
+						) err;
+						ExtLib.String.join "\n" (List.rev !messages)
 				| _ -> Printexc.to_string ex
 			in
 			let e = create_haxe_exception ~stack:(get_ctx()).exception_stack msg in
@@ -2445,4 +2444,4 @@ let version_fields = [
 	"isRelease", vbool (Version.is_release);
 	"suffix", encode_string (Version.suffix);
 	"hex", vint (Version.hex);
-]
+]

+ 37 - 34
src/macro/eval/evalMain.ml

@@ -149,18 +149,13 @@ let create com api is_macro =
 		match ex with
 		| Sys_exit _ -> raise ex
 		| _ ->
-			let msg =
-				match ex with
-				| Error.Error (err,p,_) ->
-						(* TODO hook global error reporting *)
-						(match (extract_located (Error.error_msg p err)) with
-						| [] -> ""
-						| (s,_) :: [] -> s
-						| (s,_) :: stack ->
-							List.fold_left (fun acc (s,p) ->
-								Printf.sprintf "%s%s\n" acc (Lexer.get_error_pos (Printf.sprintf "%s:%d: ") p)
-							) (s ^ "\n") stack
-						);
+			let msg = match ex with
+				| Error.Error err ->
+						let messages = ref [] in
+						Error.recurse_error (fun depth err ->
+							make_compiler_message ~from_macro:err.err_from_macro (Error.error_msg err.err_message) err.err_pos depth DKCompilerMessage Error
+						) err;
+						MessageReporting.format_messages com !messages
 				| _ -> Printexc.to_string ex
 			in
 			Printf.eprintf "%s\n" msg;
@@ -422,30 +417,38 @@ let make_runtime_error msg pos =
 	| _ ->
 		die "" __LOC__
 
-let compiler_error msg =
-	let pos = extract_located_pos msg in
-	let items = extract_located msg in
-		let vi = make_runtime_error (fst (List.hd items)) pos in
-		match vi with
-		| VInstance i ->
-			(match items with
-			| [] | _ :: [] ->
-				let ctx = get_ctx() in
-				let eval = get_eval ctx in
-				(match eval.env with
-				| Some _ ->
-					let stack = EvalStackTrace.make_stack_value (call_stack eval) in
-					set_instance_field i key_native_stack stack;
-				| None -> ());
-
-			| (hd :: stack) ->
-				let stack = List.map (fun (s,p) -> make_runtime_error s p) stack in
-				set_instance_field i key_child_errors (encode_array stack);
-			);
+let compiler_error (err : Error.error) =
+	let vi = make_runtime_error (Error.error_msg err.err_message) err.err_pos in
+	match vi with
+	| VInstance i ->
+		(match err.err_sub with
+		| [] ->
+			let ctx = get_ctx() in
+			let eval = get_eval ctx in
+			(match eval.env with
+			| Some _ ->
+				let stack = EvalStackTrace.make_stack_value (call_stack eval) in
+				set_instance_field i key_native_stack stack;
+			| None -> ());
 
-			exc vi
 		| _ ->
-			die "" __LOC__
+			let stack = ref [] in
+			let depth = err.err_depth + 1 in
+
+			List.iter (fun err ->
+				Error.recurse_error ~depth (fun depth err ->
+					(* TODO indent child errors depending on depth *)
+					stack := make_runtime_error (Error.error_msg err.err_message) err.err_pos :: !stack;
+				) err;
+			(* TODO: not sure if we want rev or not here.. tests don't help atm *)
+			) (List.rev err.err_sub);
+
+			set_instance_field i key_child_errors (encode_array (List.rev !stack));
+		);
+
+		exc vi
+	| _ ->
+		die "" __LOC__
 
 let rec value_to_expr v p =
 	let path i =

+ 2 - 2
src/macro/macroApi.ml

@@ -155,7 +155,7 @@ module type InterpApi = sig
 	val encode_ref : 'a -> ('a -> value) -> (unit -> string) -> value
 	val decode_ref : value -> 'a
 
-	val compiler_error : Globals.located -> 'a
+	val compiler_error : Error.error -> 'a
 	val error_message : string -> 'a
 	val value_to_expr : value -> Globals.pos -> Ast.expr
 	val value_signature : value -> string
@@ -1710,7 +1710,7 @@ let macro_api ccom get_api =
 			let msg = decode_string msg in
 			let p = decode_pos p in
 			let depth = decode_int depth in
-			raise (Error.Fatal_error ((Globals.located msg p),depth))
+			raise (Error.Fatal_error (Error.make_error ~depth (Custom msg) p))
 		);
 		"report_error", vfun3 (fun msg p depth ->
 			let msg = decode_string msg in

+ 1 - 1
src/optimization/analyzerTexpr.ml

@@ -1242,7 +1242,7 @@ module Purity = struct
 					apply_to_class com c
 				with Purity_conflict(impure,p) ->
 					com.error "Impure field overrides/implements field which was explicitly marked as @:pure" impure.pn_field.cf_pos;
-					Error.typing_error ~depth:1 (Error.compl_msg "Pure field is here") p;
+					Error.raise_typing_error ~depth:1 (Error.compl_msg "Pure field is here") p;
 				end
 			| _ -> ()
 		) com.types;

+ 2 - 2
src/optimization/analyzerTexprTransformer.ml

@@ -85,7 +85,7 @@ let rec func ctx bb tf t p =
 		if is_unbound_call_that_might_have_side_effects s el then ctx.has_unbound <- true;
 	in
 	let no_void t p =
-		if ExtType.is_void (follow t) then Error.typing_error "Cannot use Void as value" p
+		if ExtType.is_void (follow t) then Error.raise_typing_error "Cannot use Void as value" p
 	in
 	let push_name s =
 		ctx.name_stack <- s :: ctx.name_stack;
@@ -179,7 +179,7 @@ let rec func ctx bb tf t p =
 			let bb = block_element bb e in
 			bb,mk (TConst TNull) t_dynamic e.epos
 		| TVar _ | TFor _ | TWhile _ ->
-			Error.typing_error "Cannot use this expression as value" e.epos
+			Error.raise_typing_error "Cannot use this expression as value" e.epos
 	and value bb e =
 		let bb,e = value' bb e in
 		no_void e.etype e.epos;

+ 11 - 11
src/optimization/inline.ml

@@ -254,7 +254,7 @@ let inline_config cls_opt cf call_args return_type =
 		let t = if cf.cf_name = "_new" then
 			return_type
 		else if call_args = [] then
-			typing_error "Invalid abstract implementation function" cf.cf_pos
+			raise_typing_error "Invalid abstract implementation function" cf.cf_pos
 		else
 			follow (List.hd call_args).etype
 		in
@@ -372,11 +372,11 @@ class inline_state ctx ethis params cf f p = object(self)
 		let rec check_write e =
 			match e.eexpr with
 			| TLocal v when has_var_flag v VFinal ->
-				typing_error "Cannot modify abstract value of final local" p
+				raise_typing_error "Cannot modify abstract value of final local" p
 			| TField(_,fa) ->
 				begin match extract_field fa with
 				| Some cf when has_class_field_flag cf CfFinal ->
-					typing_error "Cannot modify abstract value of final field" p
+					raise_typing_error "Cannot modify abstract value of final field" p
 				| _ ->
 					()
 				end
@@ -385,7 +385,7 @@ class inline_state ctx ethis params cf f p = object(self)
 			| TCast(e1,None) ->
 				check_write e1
 			| _  ->
-				typing_error "Cannot modify the abstract value, store it into a local first" p;
+				raise_typing_error "Cannot modify the abstract value, store it into a local first" p;
 		in
 		let vars = List.fold_left (fun acc (i,e) ->
 			let accept vik =
@@ -410,7 +410,7 @@ class inline_state ctx ethis params cf f p = object(self)
 					| TLocal _ | TConst _ ->
 						if not i.i_write then VIInline else VIDoNotInline
 					| TFunction _ ->
-						if i.i_write then typing_error "Cannot modify a closure parameter inside inline method" p;
+						if i.i_write then raise_typing_error "Cannot modify a closure parameter inside inline method" p;
 						if i.i_read <= 1 then VIInline else VIInlineIfCalled
 					| _ ->
 						if not i.i_write && (i.i_read + i.i_called) <= 1 then VIInline else VIDoNotInline
@@ -702,7 +702,7 @@ let rec type_inline ctx cf f ethis params tret config p ?(self_calling_closure=f
 				l.i_read <- l.i_read + (if !in_loop then 2 else 1);
 				{ e with eexpr = TLocal l.i_subst }
 			| None ->
-				typing_error "Could not inline `this` outside of an instance context" po
+				raise_typing_error "Could not inline `this` outside of an instance context" po
 			)
 		| TVar (v,eo) ->
 			{ e with eexpr = TVar ((state#declare v).i_subst,opt (map false false) eo)}
@@ -710,9 +710,9 @@ let rec type_inline ctx cf f ethis params tret config p ?(self_calling_closure=f
 			if not term then begin
 				match cf.cf_kind with
 				| Method MethInline ->
-					typing_error "Cannot inline a not final return" po
+					raise_typing_error "Cannot inline a not final return" po
 				| _ ->
-					typing_error ("Function " ^ cf.cf_name ^ " cannot be inlined because of a not final return") p
+					raise_typing_error ("Function " ^ cf.cf_name ^ " cannot be inlined because of a not final return") p
 			end;
 			(match eo with
 			| None -> mk (TConst TNull) f.tf_type p
@@ -829,9 +829,9 @@ let rec type_inline ctx cf f ethis params tret config p ?(self_calling_closure=f
 			| TInst({ cl_constructor = Some ({cf_kind = Method MethInline; cf_expr = Some ({eexpr = TFunction tf})} as cf)} as c,_) ->
 				begin match type_inline_ctor ctx c cf tf ethis el po with
 				| Some e -> map term false e
-				| None -> typing_error "Could not inline super constructor call" po
+				| None -> raise_typing_error "Could not inline super constructor call" po
 				end
-			| _ -> typing_error "Cannot inline function containing super" po
+			| _ -> raise_typing_error "Cannot inline function containing super" po
 			end
 		| TCall(e1,el) ->
 			state#set_side_effect;
@@ -839,7 +839,7 @@ let rec type_inline ctx cf f ethis params tret config p ?(self_calling_closure=f
 			let el = List.map (map false false) el in
 			{e with eexpr = TCall(e1,el)}
 		| TConst TSuper ->
-			typing_error "Cannot inline function containing super" po
+			raise_typing_error "Cannot inline function containing super" po
 		| TMeta((Meta.Ast,_,_) as m,e1) when term ->
 			(* Special case for @:ast-wrapped TSwitch nodes: If the recursion alters the type of the TSwitch node, we also want
 			   to alter the type of the TMeta node. *)

+ 3 - 2
src/optimization/inlineConstructors.ml

@@ -122,6 +122,7 @@ let inline_constructors ctx original_e =
 			| IOKCtor(ioc) ->
 				List.iter (fun v -> if v.v_id < 0 then cancel_v v p) io.io_dependent_vars;
 				if ioc.ioc_forced then begin
+					(* TODO construct error with sub *)
 					display_error ctx.com "Forced inline constructor could not be inlined" io.io_pos;
 					display_error ~depth:1 ctx.com (compl_msg "Cancellation happened here") p;
 				end
@@ -403,7 +404,7 @@ let inline_constructors ctx original_e =
 						None
 				end
 			| TNew({ cl_constructor = Some ({cf_kind = Method MethInline; cf_expr = Some _} as cf)} as c,_,pl),_ when is_extern_ctor c cf ->
-				typing_error "Extern constructor could not be inlined" e.epos;
+				raise_typing_error "Extern constructor could not be inlined" e.epos;
 			| TObjectDecl fl, _ when captured && fl <> [] && List.for_all (fun((s,_,_),_) -> Lexer.is_valid_identifier s) fl ->
 				let v = alloc_var VGenerated "inlobj" e.etype e.epos in
 				let ev = mk (TLocal v) v.v_type e.epos in
@@ -727,4 +728,4 @@ let inline_constructors ctx original_e =
 			end
 		) !vars;
 		e
-	end
+	end

+ 3 - 3
src/optimization/optimizer.ml

@@ -199,7 +199,7 @@ let reduce_expr com e =
 		List.iter (fun (cl,_) ->
 			List.iter (fun e ->
 				match e.eexpr with
-				| TCall ({ eexpr = TField (_,FEnum _) },_) -> typing_error "Not-constant enum in switch cannot be matched" e.epos
+				| TCall ({ eexpr = TField (_,FEnum _) },_) -> raise_typing_error "Not-constant enum in switch cannot be matched" e.epos
 				| _ -> ()
 			) cl
 		) cases;
@@ -345,7 +345,7 @@ let rec reduce_loop ctx e =
 				let cf = mk_field "" ef.etype e.epos null_pos in
 				let ethis = mk (TConst TThis) t_dynamic e.epos in
 				let rt = (match follow ef.etype with TFun (_,rt) -> rt | _ -> die "" __LOC__) in
-				let inl = (try type_inline ctx cf func ethis el rt None e.epos ~self_calling_closure:true false with Error (Custom _,_,_) -> None) in
+				let inl = (try type_inline ctx cf func ethis el rt None e.epos ~self_calling_closure:true false with Error { err_message = Custom _ } -> None) in
 				(match inl with
 				| None -> reduce_expr ctx e
 				| Some e -> reduce_loop ctx e)
@@ -354,7 +354,7 @@ let rec reduce_loop ctx e =
 				| Some {eexpr = TFunction tf} ->
 					let config = inline_config (Some cl) cf el e.etype in
 					let rt = (match follow e1.etype with TFun (_,rt) -> rt | _ -> die "" __LOC__) in
-					let inl = (try type_inline ctx cf tf ef el rt config e.epos false with Error (Custom _,_,_) -> None) in
+					let inl = (try type_inline ctx cf tf ef el rt config e.epos false with Error { err_message = Custom _ } -> None) in
 					(match inl with
 					| None -> reduce_expr ctx e
 					| Some e ->

+ 2 - 2
src/optimization/optimizerTexpr.ml

@@ -209,7 +209,7 @@ let optimize_binop e op e1 e2 =
 		| OpAssign,_ ->
 			e
 		| _ ->
-			typing_error "You cannot directly compare enums with arguments. Use either `switch`, `match` or `Type.enumEq`" e.epos
+			raise_typing_error "You cannot directly compare enums with arguments. Use either `switch`, `match` or `Type.enumEq`" e.epos
 		end
 	| _ ->
 		e)
@@ -247,4 +247,4 @@ let optimize_unop e op flag esub =
 				{ e with eexpr = TConst (TFloat vstr) }
 			else
 				e
-		| _ -> e
+		| _ -> e

+ 74 - 69
src/typing/callUnification.ml

@@ -14,19 +14,18 @@ let is_forced_inline c cf =
 	| _ -> false
 
 let rec unify_call_args ctx el args r callp inline force_inline in_overload =
-	let call_error err p =
-		raise (Error (Call_error err,p,0))
-	in
-	let arg_error ul name opt p =
+	let call_error err p = raise_error_msg (Call_error err) p in
+
+	let arg_error e name opt =
 		let msg = ("For " ^ (if opt then "optional " else "") ^ "function argument '" ^ name ^ "'") in
-		let err = match ul with
-			| Stack s -> Stack (s @ [(Custom msg,p)])
-			| Unify l -> Unify (l @ [(Unify_custom msg)])
-			| Custom parent -> Custom (parent ^ "\n" ^ msg)
-			| _ -> Stack [(ul,p); (Custom (compl_msg msg), p)]
+		let e = match e.err_message with
+			| Unify l -> { e with err_message = Unify (l @ [(Unify_custom msg)])}
+			| Custom parent -> { e with err_message = Custom (parent ^ "\n" ^ msg)}
+			| _ -> { e with err_sub = (make_error (Custom (compl_msg msg)) e.err_pos) :: e.err_sub }
 		in
-		call_error (Could_not_unify err) p
+		raise_error { e with err_message = (Call_error (Could_not_unify e.err_message)) }
 	in
+
 	let mk_pos_infos t =
 		let infos = mk_infos ctx callp [] in
 		type_expr ctx infos (WithType.with_type t)
@@ -39,17 +38,17 @@ let rec unify_call_args ctx el args r callp inline force_inline in_overload =
 	in
 	let skipped = ref [] in
 	let invalid_skips = ref [] in
-	let skip name ul t p =
+	let skip name ul t =
 		if not ctx.com.config.pf_can_skip_non_nullable_argument && not (is_nullable t) then
 			invalid_skips := name :: !invalid_skips;
-		skipped := (name,ul,p) :: !skipped;
+		skipped := (name,ul) :: !skipped;
 		default_value name t
 	in
 	let handle_errors fn =
 		try
 			fn()
-		with Error(l,p,nl) when (match l with Call_error _ | Module_not_found _ -> false | _ -> true) ->
-			raise (WithTypeError (l,p,nl))
+		with Error e when (match e.err_message with Call_error _ | Module_not_found _ -> false | _ -> true) ->
+			raise (WithTypeError e)
 	in
 	(* let force_inline, is_extern = match cf with Some(TInst(c,_),f) -> is_forced_inline (Some c) f, (has_class_flag c CExtern) | _ -> false, false in *)
 	let type_against name t e =
@@ -67,12 +66,12 @@ let rec unify_call_args ctx el args r callp inline force_inline in_overload =
 			[]
 		| _,[name,false,TAbstract({ a_path = ["cpp"],"Rest" },[t])] ->
 			(try List.map (fun e -> type_against name t e) el
-			with WithTypeError(ul,p,_) -> arg_error ul name false p)
+			with WithTypeError e -> arg_error e name false)
 		| _,[name,false,t] when ExtType.is_rest (follow t) ->
 			begin match follow t with
 				| TAbstract({a_path=(["haxe"],"Rest")},[arg_t]) ->
 					let unexpected_spread p =
-						arg_error (Custom "Cannot spread arguments with additional rest arguments") name false p
+						arg_error (make_error (Custom "Cannot spread arguments with additional rest arguments") p) name false
 					in
 					(* these platforms deal with rest args on their own *)
 					if ctx.com.config.pf_supports_rest_args then
@@ -86,28 +85,28 @@ let rec unify_call_args ctx el args r callp inline force_inline in_overload =
 						match el with
 						| [(EUnop (Spread,Prefix,e),p)] ->
 							(try [mk (TUnop (Spread, Prefix, type_against name t e)) t p]
-							with WithTypeError(ul,p,_) -> arg_error ul name false p)
+							with WithTypeError e -> arg_error e name false)
 						| _ when ExtType.is_mono (follow arg_t) ->
 							(try
 								let el = type_rest mk_mono in
 								unify ctx (unify_min ctx el) arg_t (punion_el callp el);
 								el
-							with WithTypeError(ul,p,_) ->
-								arg_error ul name false p)
+							with WithTypeError e ->
+								arg_error e name false)
 						| _ ->
 							(try
 								type_rest (fun() -> arg_t)
-							with WithTypeError(ul,p,_) ->
-								arg_error ul name false p)
+							with WithTypeError e ->
+								arg_error e name false)
 					(* for other platforms make sure rest arguments are wrapped in an array *)
 					else begin
 						match el with
 						| [(EUnop (Spread,Prefix,e),p)] ->
 							(try [type_against name t e]
-							with WithTypeError(ul,p,_) -> arg_error ul name false p)
+							with WithTypeError e -> arg_error e name false)
 						| [] ->
 							(try [type_against name t (EArrayDecl [],callp)]
-							with WithTypeError(ul,p,_) -> arg_error ul name false p)
+							with WithTypeError e -> arg_error e name false)
 						| (_,p1) :: _ ->
 							let p =
 								List.fold_left (fun p (e1,p2) ->
@@ -127,8 +126,8 @@ let rec unify_call_args ctx el args r callp inline force_inline in_overload =
 									do_type (ECheckType(e,(CTPath tp, p)),p) (* ([arg1, arg2...]:Array<Dynamic>) *)
 								end else
 									do_type e
-							with WithTypeError(ul,p,_) ->
-								arg_error ul name false p
+							with WithTypeError e ->
+								arg_error e name false
 							)
 					end
 				| _ ->
@@ -156,7 +155,7 @@ let rec unify_call_args ctx el args r callp inline force_inline in_overload =
 						ignore(loop el [])
 					end;
 					call_error Too_many_arguments p
-				| (s,ul,p) :: _ -> arg_error ul s true p
+				| (s,ul) :: _ -> arg_error ul s true
 			end
 		| e :: el,(name,opt,t) :: args ->
 			let might_skip = List.length el < List.length args in
@@ -164,14 +163,14 @@ let rec unify_call_args ctx el args r callp inline force_inline in_overload =
 				let e = type_against name t e in
 				e :: loop el args
 			with
-				WithTypeError (ul,p,_)->
-					if opt && might_skip then
-						let e_def = skip name ul t p in
+				WithTypeError ul ->
+					if opt && might_skip then begin
+						let e_def = skip name ul t in
 						e_def :: loop (e :: el) args
-					else
+					end else
 						match List.rev !skipped with
-						| [] -> arg_error ul name opt p
-						| (s,ul,p) :: _ -> arg_error ul s true p
+						| [] -> arg_error ul name opt
+						| (s,ul) :: _ -> arg_error ul s true
 			end
 	in
 	let restore =
@@ -205,15 +204,15 @@ let unify_typed_args ctx tmap args el_typed call_pos =
 		match args,el with
 		| [], _ :: _ ->
 			let call_error = Call_error(Too_many_arguments) in
-			raise(Error(call_error,call_pos,0))
+			raise_error_msg call_error call_pos
 		| _, [] ->
 			List.rev acc_args,args
 		| ((_,opt,t0) as arg) :: args,e :: el ->
 			begin try
 				unify_raise (tmap e.etype) t0 e.epos;
-			with Error(Unify _ as msg,p,nl) ->
-				let call_error = Call_error(Could_not_unify msg) in
-				raise(Error(call_error,p,nl))
+			with Error ({ err_message = Unify _ as msg } as e) ->
+				let call_error = Call_error (Could_not_unify msg) in
+				raise_error { e with err_message = call_error }
 			end;
 			loop (arg :: acc_args) (fun t -> t) args el
 	in
@@ -313,16 +312,15 @@ let unify_field_call ctx fa el_typed el p inline =
 			in
 			make_field_call_candidate el ret monos tf cf (mk_call,extract_delayed_display())
 		| t ->
-			typing_error (s_type (print_context()) t ^ " cannot be called") p
+			raise_typing_error (s_type (print_context()) t ^ " cannot be called") p
 	in
-	let maybe_raise_unknown_ident cerr p =
-		let rec loop err p =
-			match err with
-			| Unknown_ident _ -> located_typing_error (error_msg p err)
-			| Stack stack -> List.iter (fun (e,p) -> loop e p) stack
-			| _ -> ()
+	let maybe_raise_unknown_ident err =
+		let rec loop err =
+			match err.err_message with
+			| Call_error (Could_not_unify Unknown_ident _) | Unknown_ident _ -> raise_typing_error_ext err
+			| _ -> List.iter loop err.err_sub
 		in
-		match cerr with Could_not_unify err -> loop err p | _ -> ()
+		loop err
 	in
 	let attempt_calls candidates =
 		let rec loop candidates = match candidates with
@@ -340,15 +338,15 @@ let unify_field_call ctx fa el_typed el p inline =
 						candidate :: candidates,failures
 					end else
 						[candidate],[]
-				with Error ((Call_error cerr as err),p,_) ->
+				with Error ({ err_message = Call_error _ } as err) ->
 					List.iter (fun (m,t,constr) ->
 						if t != m.tm_type then m.tm_type <- t;
 						if constr != m.tm_down_constraints then m.tm_down_constraints <- constr;
 					) known_monos;
 					ctx.monomorphs.perfunction <- current_monos;
-					maybe_raise_unknown_ident cerr p;
+					maybe_raise_unknown_ident err;
 					let candidates,failures = loop candidates in
-					candidates,(cf,err,p,extract_delayed_display()) :: failures
+					candidates,(cf,err,extract_delayed_display()) :: failures
 				end
 		in
 		loop candidates
@@ -381,24 +379,29 @@ let unify_field_call ctx fa el_typed el p inline =
 	| _ ->
 		let candidates,failures = attempt_calls candidates in
 		let fail () =
-			let failures = List.map (fun (cf,err,p,delayed_display) ->
+			let failures = List.map (fun (cf,err,delayed_display) ->
 				(* If any resolution attempt had a delayed display result, we might as well raise it now. *)
 				Option.may (fun de ->
 					raise_augmented_display_exception cf de;
 				) delayed_display;
-				cf,error_msg p err
+				cf,err
 			) failures in
-			let failures = remove_duplicates (fun (_,msg1) (_,msg2) -> msg1 <> msg2) failures in
+			let failures = remove_duplicates (fun (_,e1) (_,e2) -> (MessageReporting.print_error e1) <> (MessageReporting.print_error e2)) failures in
 			begin match failures with
-			| [_,msg] ->
-				located_typing_error msg
+			| [_,err] ->
+				raise_typing_error_ext err
 			| _ ->
-				display_error ctx.com "Could not find a suitable overload, reasons follow" p;
-				List.iter (fun (cf,msg) ->
-					display_error ~depth:1 ctx.com ("Overload resolution failed for " ^ (s_type (print_context()) cf.cf_type)) p;
-					located_display_error ~depth:2 ctx.com msg;
-				) failures;
-				typing_error ~depth:1 "End of overload failure reasons" p
+				let sub = List.fold_left (fun acc (cf,err) ->
+					(make_error
+						~depth:1 (* pretty much optional here *)
+						~sub:[err]
+						(Custom ("Overload resolution failed for " ^ (s_type (print_context()) cf.cf_type)))
+						p
+					) :: acc
+				) [] failures in
+
+				display_error_ext ctx.com (make_error ~sub (Custom "Could not find a suitable overload, reasons follow") p);
+				raise_typing_error_ext (make_error ~depth:1 (Custom "End of overload failure reasons") p)
 			end
 		in
 		if overload_kind = OverloadProper then begin match Overloads.Resolution.reduce_compatible candidates with
@@ -407,6 +410,7 @@ let unify_field_call ctx fa el_typed el p inline =
 				maybe_check_access fcc.fc_field;
 				commit_delayed_display fcc
 			| fcc :: l ->
+				(* TODO construct error with sub *)
 				display_error ctx.com "Ambiguous overload, candidates follow" p;
 				let st = s_type (print_context()) in
 				List.iter (fun fcc ->
@@ -442,7 +446,7 @@ object(self)
 		end
 
 	method private macro_call (ethis : texpr) (cf : tclass_field) (el : expr list) =
-		if ctx.macro_depth > 300 then typing_error "Stack overflow" p;
+		if ctx.macro_depth > 300 then raise_typing_error "Stack overflow" p;
 		ctx.macro_depth <- ctx.macro_depth + 1;
 		ctx.with_type_stack <- with_type :: ctx.with_type_stack;
 		let ethis_f = ref (fun () -> ()) in
@@ -476,27 +480,28 @@ object(self)
 		in
 		ctx.macro_depth <- ctx.macro_depth - 1;
 		ctx.with_type_stack <- List.tl ctx.with_type_stack;
-		let old = ctx.com.located_error in
-		ctx.com.located_error <- (fun ?(depth = 0) msg ->
-			let ep = extract_located_pos msg in
+		let old = ctx.com.error_ext in
+		ctx.com.error_ext <- (fun err ->
+			let ep = err.err_pos in
 			(* display additional info in the case the error is not part of our original call *)
 			if ep.pfile <> p.pfile || ep.pmax < p.pmin || ep.pmin > p.pmax then begin
 				locate_macro_error := false;
-				old ~depth (if ep = null_pos then (relocate msg p) else msg);
+				old (if (ep = null_pos) then { err with err_pos = p } else err);
 				locate_macro_error := true;
-				if ep <> null_pos then old ~depth:(depth+1) (located (compl_msg "Called from macro here") p);
+				(* TODO add as sub for above error *)
+				if ep <> null_pos then old (make_error ~depth:(err.err_depth+1) (Custom (compl_msg "Called from macro here")) p);
 			end else
-				old ~depth msg;
+				old err;
 		);
 		let e = try
 			f()
 		with exc ->
-			ctx.com.located_error <- old;
+			ctx.com.error_ext <- old;
 			!ethis_f();
 			raise exc
 		in
 		let e = Diagnostics.secure_generated_code ctx e in
-		ctx.com.located_error <- old;
+		ctx.com.error_ext <- old;
 		!ethis_f();
 		e
 
@@ -511,7 +516,7 @@ object(self)
 			else if ctx.untyped then
 				mk_mono()
 			else
-				typing_error (s_type (print_context()) e.etype ^ " cannot be called") e.epos
+				raise_typing_error (s_type (print_context()) e.etype ^ " cannot be called") e.epos
 			in
 			mk (TCall (e,el)) t p
 		in
@@ -572,7 +577,7 @@ object(self)
 				let name = Printf.sprintf "%s_%s" (if is_set then "set" else "get") fa.fa_field.cf_name in
 				make_call ctx (mk (TField (e,quick_field_dynamic e.etype name)) tf p) el_typed t p
 			| _ ->
-				typing_error "Could not resolve accessor" p
+				raise_typing_error "Could not resolve accessor" p
 
 	(* Calls the field represented by `fa` with the typed arguments `el_typed` and the syntactic arguments `el`.
 

+ 11 - 11
src/typing/calls.ml

@@ -47,7 +47,7 @@ let make_call ctx e params t ?(force_inline=false) p =
 						PMap.mem f.cf_name c.cl_fields
 						|| List.exists has_override c.cl_descendants
 					in
-					if List.exists has_override c.cl_descendants then typing_error (Printf.sprintf "Cannot force inline-call to %s because it is overridden" f.cf_name) p
+					if List.exists has_override c.cl_descendants then raise_typing_error (Printf.sprintf "Cannot force inline-call to %s because it is overridden" f.cf_name) p
 				)
 		end;
 		let config = Inline.inline_config cl f params t in
@@ -63,7 +63,7 @@ let make_call ctx e params t ?(force_inline=false) p =
 						(* Current method needs to infer CfModifiesThis flag, since we are calling a method, which modifies `this` *)
 						add_class_field_flag ctx.curfield CfModifiesThis
 					else
-						typing_error ("Abstract 'this' value can only be modified inside an inline function. '" ^ f.cf_name ^ "' modifies 'this'") p;
+						raise_typing_error ("Abstract 'this' value can only be modified inside an inline function. '" ^ f.cf_name ^ "' modifies 'this'") p;
 			| _ -> ()
 		);
 		let params = List.map (Optimizer.reduce_expression ctx) params in
@@ -73,7 +73,7 @@ let make_call ctx e params t ?(force_inline=false) p =
 		| None,Some { eexpr = TFunction fd } ->
 			(match Inline.type_inline ctx f fd ethis params t config p force_inline with
 			| None ->
-				if force_inline then typing_error "Inline could not be done" p;
+				if force_inline then raise_typing_error "Inline could not be done" p;
 				raise Exit;
 			| Some e -> e)
 		| _ ->
@@ -186,12 +186,12 @@ let rec acc_get ctx g =
 			if not (type_iseq tf e.etype) then mk (TCast(e,None)) tf e.epos
 			else e
 		| Var _,None ->
-			typing_error "Recursive inline is not supported" p
+			raise_typing_error "Recursive inline is not supported" p
 		end
 	in
 	let dispatcher p = new call_dispatcher ctx MGet WithType.value p in
 	match g with
-	| AKNo(_,p) -> typing_error ("This expression cannot be accessed for reading") p
+	| AKNo(_,p) -> raise_typing_error ("This expression cannot be accessed for reading") p
 	| AKExpr e -> e
 	| AKSafeNav sn ->
 		(* generate null-check branching for the safe navigation chain *)
@@ -230,7 +230,7 @@ let rec acc_get ctx g =
 			if ctx.in_display then
 				FieldAccess.get_field_expr fa FRead
 			else
-				typing_error "Invalid macro access" fa.fa_pos
+				raise_typing_error "Invalid macro access" fa.fa_pos
 		| _ ->
 			if fa.fa_inline then
 				inline_read fa
@@ -305,9 +305,9 @@ let rec build_call_access ctx acc el mode with_type p =
 	| AKResolve(sea,name) ->
 		AKExpr (dispatch#expr_call (dispatch#resolve_call sea name) [] el)
 	| AKNo(_,p) ->
-		typing_error "This expression cannot be called" p
+		raise_typing_error "This expression cannot be called" p
 	| AKAccess _ ->
-		typing_error "This expression cannot be called" p
+		raise_typing_error "This expression cannot be called" p
 	| AKAccessor fa ->
 		let e = get_accessor_to_call fa [] in
 		AKExpr (dispatch#expr_call e [] el)
@@ -374,7 +374,7 @@ let type_bind ctx (e : texpr) (args,ret) params p =
 	in
 	let rec loop args params given_args missing_args ordered_args = match args, params with
 		| [], [] -> given_args,missing_args,ordered_args
-		| [], _ -> typing_error "Too many callback arguments" p
+		| [], _ -> raise_typing_error "Too many callback arguments" p
 		| (n,o,t) :: args , [] when o ->
 			let a = if is_pos_infos t then
 					let infos = mk_infos ctx p [] in
@@ -386,7 +386,7 @@ let type_bind ctx (e : texpr) (args,ret) params p =
 			in
 			loop args [] given_args missing_args a
 		| (n,o,t) :: _ , (EConst(Ident "_"),p) :: _ when not ctx.com.config.pf_can_skip_non_nullable_argument && o && not (is_nullable t) ->
-			typing_error "Usage of _ is not supported for optional non-nullable arguments" p
+			raise_typing_error "Usage of _ is not supported for optional non-nullable arguments" p
 		| (n,o,t) :: args , ([] as params)
 		| (n,o,t) :: args , (EConst(Ident "_"),_) :: params ->
 			let v = alloc_var VGenerated (alloc_name n) (if o then ctx.t.tnull t else t) p in
@@ -485,7 +485,7 @@ let array_access ctx e1 e2 mode p =
 				let t = ctx.t.tarray pt in
 				begin try
 					unify_raise et t p
-				with Error(Unify _,_,_) ->
+				with Error { err_message = Unify _ } ->
 					if not ctx.untyped then begin
 						let msg = if !has_abstract_array_access then
 							"No @:arrayAccess function accepts an argument of " ^ (s_type (print_context()) e2.etype)

+ 2 - 2
src/typing/fieldAccess.ml

@@ -168,10 +168,10 @@ let get_constructor_access c tl p =
 		in
 		create e_static cf fh false p
 	with Not_found ->
-		raise_typing_error (No_constructor (match c.cl_kind with
+		raise_typing_error_ext (make_error (No_constructor (match c.cl_kind with
 			| KAbstractImpl a -> TAbstractDecl a
 			| _ -> TClassDecl c
-		)) p
+		)) p)
 
 let make_static_extension_access c cf e_this inline p =
 	let e_static = Texpr.Builder.make_static_this c p in

+ 9 - 9
src/typing/fields.ml

@@ -73,10 +73,10 @@ let field_type ctx c pl f p =
 		apply_params l monos f.cf_type
 
 let no_abstract_constructor c p =
-	if has_class_flag c CAbstract then raise_typing_error (Abstract_class (TClassDecl c)) p
+	if has_class_flag c CAbstract then raise_typing_error_ext (make_error (Abstract_class (TClassDecl c)) p)
 
 let check_constructor_access ctx c f p =
-	if (Meta.has Meta.CompilerGenerated f.cf_meta) then located_display_error ctx.com (error_msg p (No_constructor (TClassDecl c)));
+	if (Meta.has Meta.CompilerGenerated f.cf_meta) then display_error ctx.com (error_msg (No_constructor (TClassDecl c))) p;
 	if not (can_access ctx c f true || extends ctx.curclass c) && not ctx.untyped then display_error ctx.com (Printf.sprintf "Cannot access private constructor of %s" (s_class_path c)) p
 
 let check_no_closure_meta ctx cf fa mode p =
@@ -89,7 +89,7 @@ let check_no_closure_meta ctx cf fa mode p =
 					Meta.has Meta.NoClosure cl_meta
 					|| Meta.has Meta.NoClosure f.cf_meta
 				then
-					typing_error ("Method " ^ f.cf_name ^ " cannot be used as a value") p
+					raise_typing_error ("Method " ^ f.cf_name ^ " cannot be used as a value") p
 			| _ -> ()
 		in
 		begin match cf.cf_kind with
@@ -114,7 +114,7 @@ let field_access ctx mode f fh e pfield =
 	match f.cf_kind with
 	| Method m ->
 		let normal () = AKField(make_access false) in
-		if is_set && m <> MethDynamic && not ctx.untyped then typing_error "Cannot rebind this method : please use 'dynamic' before method declaration" pfield;
+		if is_set && m <> MethDynamic && not ctx.untyped then raise_typing_error "Cannot rebind this method : please use 'dynamic' before method declaration" pfield;
 		let maybe_check_visibility c static =
 			(* For overloads we have to resolve the actual field before we can check accessibility. *)
 			begin match mode with
@@ -250,7 +250,7 @@ let field_access ctx mode f fh e pfield =
 		| AccRequire (r,msg) ->
 			match msg with
 			| None -> error_require r pfield
-			| Some msg -> typing_error msg pfield
+			| Some msg -> raise_typing_error msg pfield
 
 let class_field ctx c tl name p =
 	raw_class_field (fun f -> field_type ctx c tl f p) c tl name
@@ -285,7 +285,7 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) =
 		let _,el,_ = Meta.get meta a.a_meta in
 		if el <> [] && not (List.exists (fun e -> match fst e with
 			| EConst (Ident i' | String (i',_)) -> i' = i
-			| _ -> typing_error "Identifier or string expected as argument to @:forward" (pos e)
+			| _ -> raise_typing_error "Identifier or string expected as argument to @:forward" (pos e)
 		) el) then raise Not_found;
 		f()
 	in
@@ -438,7 +438,7 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) =
 							end
 						| _ ->
 							check()
-					with Unify_error el | Error (Unify el,_,_) ->
+					with Unify_error el | Error { err_message = Unify el } ->
 						check_constant_struct := !check_constant_struct || List.exists (function
 							| Has_extra_field _ -> true
 							| _ -> false
@@ -515,7 +515,7 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) =
 				in
 				loop c tl
 			with Not_found when PMap.mem i c.cl_statics ->
-				typing_error ("Cannot access static field " ^ i ^ " from a class instance") pfield;
+				raise_typing_error ("Cannot access static field " ^ i ^ " from a class instance") pfield;
 			)
 		| TDynamic t ->
 			AKExpr (mk (TField (e,FDynamic i)) (match t with None -> t_dynamic | Some t -> t) p)
@@ -529,7 +529,7 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) =
 			with Not_found -> try
 				type_field_by_forward_member type_field_by_fallback e a tl
 			with Not_found when not (has_class_field_flag (PMap.find i (find_some a.a_impl).cl_statics) CfImpl) ->
-				typing_error ("Invalid call to static function " ^ i ^ " through abstract instance") pfield
+				raise_typing_error ("Invalid call to static function " ^ i ^ " through abstract instance") pfield
 			)
 		| _ -> raise Not_found
 	in

+ 4 - 4
src/typing/finalization.ml

@@ -29,20 +29,20 @@ let get_main ctx types =
 				let t = Typeload.find_type_in_module_raise ctx m name null_pos in
 				match t with
 				| TEnumDecl _ | TTypeDecl _ | TAbstractDecl _ ->
-					typing_error ("Invalid -main : " ^ s_type_path path ^ " is not a class") null_pos
+					raise_typing_error ("Invalid -main : " ^ s_type_path path ^ " is not a class") null_pos
 				| TClassDecl c ->
 					p := c.cl_name_pos;
 					c, PMap.find "main" c.cl_statics
 			with Not_found ->
-				typing_error ("Invalid -main : " ^ s_type_path path ^ " does not have static function main") !p
+				raise_typing_error ("Invalid -main : " ^ s_type_path path ^ " does not have static function main") !p
 		in
 		let ft = Type.field_type f in
 		let fmode, r =
 			match follow ft with
 			| TFun ([],r) -> FStatic (c,f), r
-			| _ -> typing_error ("Invalid -main : " ^ s_type_path path ^ " has invalid main function") c.cl_pos
+			| _ -> raise_typing_error ("Invalid -main : " ^ s_type_path path ^ " has invalid main function") c.cl_pos
 		in
-		if not (ExtType.is_void (follow r)) then typing_error (Printf.sprintf "Return type of main function should be Void (found %s)" (s_type (print_context()) r)) f.cf_name_pos;
+		if not (ExtType.is_void (follow r)) then raise_typing_error (Printf.sprintf "Return type of main function should be Void (found %s)" (s_type (print_context()) r)) f.cf_name_pos;
 		f.cf_meta <- (Dce.mk_keep_meta f.cf_pos) :: f.cf_meta;
 		let emain = type_module_type ctx (TClassDecl c) None null_pos in
 		let main = mk (TCall (mk (TField (emain,fmode)) ft null_pos,[])) r null_pos in

+ 9 - 10
src/typing/forLoop.ml

@@ -92,9 +92,9 @@ module IterationKind = struct
 			| TDynamic _ | TMono _ ->
 				(* try to find something better than a dynamic value to iterate on *)
 				dynamic_iterator := Some e;
-				raise (Error (Unify [Unify_custom "Avoid iterating on a dynamic value"], p, 0))
+				raise_error_msg (Unify [Unify_custom "Avoid iterating on a dynamic value"]) p
 			| _ -> e
-		with Error (Unify _,_,depth) ->
+		with Error { err_message = Unify _ } ->
 			let try_last_resort after =
 				try
 					match last_resort with
@@ -108,14 +108,13 @@ module IterationKind = struct
 				try
 					unify_raise acc_expr.etype t acc_expr.epos;
 					acc_expr
-				with Error (Unify(l),p,n) ->
+				with Error ({ err_message = Unify _ } as err) ->
 					try_last_resort (fun () ->
 						match !dynamic_iterator with
 						| Some e -> e
 						| None ->
 							if resume then raise Not_found;
-							display_error ~depth ctx.com "Field iterator has an invalid type" acc_expr.epos;
-							located_display_error ~depth:(depth+1) ctx.com (error_msg p (Unify l));
+							display_error_ext ctx.com (make_error ~depth:err.err_depth ~sub:[err] (Custom "Field iterator has an invalid type") acc_expr.epos);
 							mk (TConst TNull) t_dynamic p
 					)
 			in
@@ -280,7 +279,7 @@ module IterationKind = struct
 				| TBinop (OpAssignOp _,{ eexpr = TLocal l },_)
 				| TUnop (Increment,_,{ eexpr = TLocal l })
 				| TUnop (Decrement,_,{ eexpr = TLocal l })  when List.memq l vl ->
-					typing_error "Loop variable cannot be modified" e.epos
+					raise_typing_error "Loop variable cannot be modified" e.epos
 				| _ ->
 					Type.iter loop e
 			in
@@ -319,7 +318,7 @@ module IterationKind = struct
 			mk (TFor(v,e1,e2)) t_void p
 		| IteratorIntUnroll(offset,length,ascending) ->
 			check_loop_var_modification [v] e2;
-			if not ascending then typing_error "Cannot iterate backwards" p;
+			if not ascending then raise_typing_error "Cannot iterate backwards" p;
 			let el = ExtList.List.init length (fun i ->
 				let ei = make_int ctx.t (if ascending then i + offset else offset - i) p in
 				let rec loop e = match e.eexpr with
@@ -332,7 +331,7 @@ module IterationKind = struct
 			mk (TBlock el) t_void p
 		| IteratorIntConst(a,b,ascending) ->
 			check_loop_var_modification [v] e2;
-			if not ascending then typing_error "Cannot iterate backwards" p;
+			if not ascending then raise_typing_error "Cannot iterate backwards" p;
 			let v_index = gen_local ctx t_int a.epos in
 			let evar_index = mk (TVar(v_index,Some a)) t_void a.epos in
 			let ev_index = make_local v_index v_index.v_pos in
@@ -462,7 +461,7 @@ let type_for_loop ctx handle_display it e2 p =
 	let rec loop_ident dko e1 = match e1 with
 		| EConst(Ident i),p -> i,p,dko
 		| EDisplay(e1,dk),_ -> loop_ident (Some dk) e1
-		| _ -> typing_error "Identifier expected" (pos e1)
+		| _ -> raise_typing_error "Identifier expected" (pos e1)
 	in
 	let rec loop dko e1 = match fst e1 with
 		| EBinop(OpIn,e1,e2) ->
@@ -477,7 +476,7 @@ let type_for_loop ctx handle_display it e2 p =
 			| Some dk -> ignore(handle_display ctx e1 dk MGet WithType.value);
 			| None -> ()
 			end;
-			typing_error "For expression should be 'v in expr'" (snd it)
+			raise_typing_error "For expression should be 'v in expr'" (snd it)
 	in
 	let ik,e1 = loop None it in
 	let e1 = type_expr ctx e1 WithType.value in

+ 3 - 3
src/typing/functionArguments.ml

@@ -76,9 +76,9 @@ object(self)
 
 	method private check_rest (is_last : bool) (eo : expr option) (opt : bool) (t : Type.t) (pn : pos) =
 		if ExtType.is_rest (follow t) then begin
-			if opt then typing_error "Rest argument cannot be optional" pn;
-			begin match eo with None -> () | Some (_,p) -> typing_error "Rest argument cannot have default value" p end;
-			if not is_last then typing_error "Rest should only be used for the last function argument" pn;
+			if opt then raise_typing_error "Rest argument cannot be optional" pn;
+			begin match eo with None -> () | Some (_,p) -> raise_typing_error "Rest argument cannot have default value" p end;
+			if not is_last then raise_typing_error "Rest should only be used for the last function argument" pn;
 		end
 
 	(* Returns the `(tvar * texpr option) list` for `tf_args`. Also checks the validity of argument names and whether or not

+ 22 - 17
src/typing/generic.ml

@@ -111,7 +111,7 @@ let generic_substitute_expr gctx e =
 				let fa = try
 					quick_field t cf.cf_name
 				with Not_found ->
-					typing_error (Printf.sprintf "Type %s has no field %s (possible typing order issue)" (s_type (print_context()) t) cf.cf_name) e.epos
+					raise_typing_error (Printf.sprintf "Type %s has no field %s (possible typing order issue)" (s_type (print_context()) t) cf.cf_name) e.epos
 				in
 				build_expr {e with eexpr = TField(e1,fa)}
 			end;
@@ -128,7 +128,7 @@ let generic_substitute_expr gctx e =
 				let eo = loop gctx.subst in
 				begin match eo with
 					| Some e -> e
-					| None -> typing_error "Only Const type parameters can be used as value" e.epos
+					| None -> raise_typing_error "Only Const type parameters can be used as value" e.epos
 				end
 			with Not_found ->
 				e
@@ -155,8 +155,8 @@ let static_method_container gctx c cf p =
 		let t = Typeload.load_instance ctx (mk_type_path (pack,name),p) true in
 		match t with
 		| TInst(cg,_) -> cg
-		| _ -> typing_error ("Cannot specialize @:generic static method because the generated type name is already used: " ^ name) p
-	with Error(Module_not_found path,_,_) when path = (pack,name) ->
+		| _ -> raise_typing_error ("Cannot specialize @:generic static method because the generated type name is already used: " ^ name) p
+	with Error { err_message = Module_not_found path } when path = (pack,name) ->
 		let m = (try ctx.com.module_lut#find (ctx.com.type_to_module#find c.cl_path) with Not_found -> die "" __LOC__) in
 		let mg = {
 			m_id = alloc_mid();
@@ -215,7 +215,7 @@ let rec build_generic_class ctx c p tl =
 			(match c2.cl_kind with
 			| KTypeParameter tl ->
 				if not (TypeloadCheck.is_generic_parameter ctx c2) && has_ctor_constraint c2 then
-					typing_error "Type parameters with a constructor cannot be used non-generically" p;
+					raise_typing_error "Type parameters with a constructor cannot be used non-generically" p;
 				recurse := true
 			| _ -> ());
 			List.iter check_recursive tl;
@@ -232,8 +232,8 @@ let rec build_generic_class ctx c p tl =
 		let t = Typeload.load_instance ctx (mk_type_path (pack,name),p) false in
 		match t with
 		| TInst({ cl_kind = KGenericInstance (csup,_) },_) when c == csup -> t
-		| _ -> typing_error ("Cannot specialize @:generic because the generated type name is already used: " ^ name) p
-	with Error(Module_not_found path,_,_) when path = (pack,name) ->
+		| _ -> raise_typing_error ("Cannot specialize @:generic because the generated type name is already used: " ^ name) p
+	with Error { err_message = Module_not_found path } when path = (pack,name) ->
 		let m = (try ctx.com.module_lut#find (ctx.com.type_to_module#find c.cl_path) with Not_found -> die "" __LOC__) in
 		ignore(c.cl_build()); (* make sure the super class is already setup *)
 		let mg = {
@@ -292,6 +292,7 @@ let rec build_generic_class ctx c p tl =
 					| None ->
 						begin match cf_old.cf_kind with
 							| Method _ when not (has_class_flag c CInterface) && not (has_class_flag c CExtern) && not (has_class_field_flag cf_old CfAbstract) ->
+								(* TODO use sub error *)
 								display_error ctx.com (Printf.sprintf "Field %s has no expression (possible typing order issue)" cf_new.cf_name) cf_new.cf_pos;
 								display_error ctx.com (Printf.sprintf "While building %s" (s_type_path cg.cl_path)) p;
 							| _ ->
@@ -300,7 +301,7 @@ let rec build_generic_class ctx c p tl =
 					| Some e ->
 						cf_new.cf_expr <- Some (generic_substitute_expr gctx e)
 				) with Unify_error l ->
-					located_typing_error (error_msg cf_new.cf_pos (Unify l))
+					raise_typing_error (error_msg (Unify l)) cf_new.cf_pos
 				end;
 				t
 			in
@@ -315,10 +316,10 @@ let rec build_generic_class ctx c p tl =
 			cf_new.cf_type <- TLazy r;
 			cf_new
 		in
-		if c.cl_init <> None then typing_error "This class can't be generic" p;
+		if c.cl_init <> None then raise_typing_error "This class can't be generic" p;
 		List.iter (fun cf -> match cf.cf_kind with
 			| Method MethMacro when not ctx.com.is_macro_context -> ()
-			| _ -> typing_error "A generic class can't have static fields" cf.cf_pos
+			| _ -> raise_typing_error "A generic class can't have static fields" cf.cf_pos
 		) c.cl_ordered_statics;
 		cg.cl_super <- (match c.cl_super with
 			| None -> None
@@ -340,7 +341,7 @@ let rec build_generic_class ctx c p tl =
 			| _, Some cf, _ -> Some (build_field cf)
 			| Some ctor, _, _ -> Some ctor
 			| None, None, None -> None
-			| _ -> typing_error "Please define a constructor for this class in order to use it as generic" c.cl_pos
+			| _ -> raise_typing_error "Please define a constructor for this class in order to use it as generic" c.cl_pos
 		);
 		cg.cl_implements <- List.map (fun (i,tl) ->
 			(match follow (generic_substitute_type gctx (TInst (i, List.map (generic_substitute_type gctx) tl))) with
@@ -368,7 +369,7 @@ let type_generic_function ctx fa fcc with_type p =
 		| _ -> die "" __LOC__
 	in
 	let cf = fcc.fc_field in
-	if cf.cf_params = [] then typing_error "Function has no type parameters and cannot be generic" p;
+	if cf.cf_params = [] then raise_typing_error "Function has no type parameters and cannot be generic" p;
 	begin match with_type with
 		| WithType.WithType(t,_) -> unify ctx fcc.fc_ret t p
 		| _ -> ()
@@ -384,10 +385,13 @@ let type_generic_function ctx fa fcc with_type p =
 		let name = cf.cf_name ^ "_" ^ gctx.name in
 		let unify_existing_field tcf pcf = try
 			unify_raise tcf fcc.fc_type p
-		with Error(Unify _,_,depth) as err ->
-			display_error ~depth ctx.com ("Cannot create field " ^ name ^ " due to type mismatch") p;
-			display_error ~depth:(depth+1) ctx.com (compl_msg "Conflicting field was defined here") pcf;
-			raise err
+		with Error ({ err_message = Unify _; err_depth = depth } as err) ->
+			raise (Error { err with err_sub = (make_error
+				~depth
+				~sub:[make_error ~depth:(depth+1) (Custom (compl_msg "Conflicting field was defined here")) pcf]
+				(Custom ("Cannot create field " ^ name ^ " due to type mismatch"))
+				p
+			) :: err.err_sub })
 		in
 		let fa = try
 			let cf2 = if stat then
@@ -413,6 +417,7 @@ let type_generic_function ctx fa fcc with_type p =
 				ignore(follow cf.cf_type);
 				let rec check e = match e.eexpr with
 					| TNew({cl_kind = KTypeParameter _} as c,_,_) when not (TypeloadCheck.is_generic_parameter ctx c) ->
+						(* TODO use sub error *)
 						display_error ctx.com "Only generic type parameters can be constructed" e.epos;
 						display_error ctx.com "While specializing this call" p;
 					| _ ->
@@ -470,7 +475,7 @@ let type_generic_function ctx fa fcc with_type p =
 		let dispatch = new CallUnification.call_dispatcher ctx (MCall []) with_type p in
 		dispatch#field_call fa el []
 	with Generic_Exception (msg,p) ->
-		typing_error msg p)
+		raise_typing_error msg p)
 
 ;;
 Typecore.type_generic_function_ref := type_generic_function

+ 6 - 6
src/typing/instanceBuilder.ml

@@ -9,7 +9,7 @@ let get_macro_path ctx e args p =
 		match fst e with
 		| EField (e,f,_) -> f :: loop e
 		| EConst (Ident i) -> [i]
-		| _ -> typing_error "Invalid macro call" p
+		| _ -> raise_typing_error "Invalid macro call" p
 	in
 	let path = match e with
 		| (EConst(Ident i)),_ ->
@@ -19,7 +19,7 @@ let get_macro_path ctx e args p =
 			with Not_found -> try
 				(t_infos (let path,_,_ = PMap.find i ctx.m.module_globals in path)).mt_path
 			with Not_found ->
-				typing_error "Invalid macro call" p
+				raise_typing_error "Invalid macro call" p
 			in
 			i :: (snd path) :: (fst path)
 		| _ ->
@@ -27,7 +27,7 @@ let get_macro_path ctx e args p =
 	in
 	(match path with
 	| meth :: cl :: path -> (List.rev path,cl), meth, args
-	| _ -> typing_error "Invalid macro call" p)
+	| _ -> raise_typing_error "Invalid macro call" p)
 
 let build_macro_type ctx pl p =
 	let path, field, args = (match pl with
@@ -35,7 +35,7 @@ let build_macro_type ctx pl p =
 		| [TInst ({ cl_kind = KExpr (EArrayDecl [ECall (e,args),_],_) },_)] ->
 			get_macro_path ctx e args p
 		| _ ->
-			typing_error "MacroType requires a single expression call parameter" p
+			raise_typing_error "MacroType requires a single expression call parameter" p
 	) in
 	let old = ctx.ret in
 	let t = (match ctx.g.do_macro ctx MMacroType path field args p with
@@ -49,11 +49,11 @@ let build_macro_build ctx c pl cfl p =
 	let path, field, args =
 		let build_expr =
 			try Meta.get Meta.GenericBuild c.cl_meta
-			with Not_found -> typing_error ((s_type_path c.cl_path) ^ " is missing @:genericBuild meta. Was it removed by a macro?") p
+			with Not_found -> raise_typing_error ((s_type_path c.cl_path) ^ " is missing @:genericBuild meta. Was it removed by a macro?") p
 		in
 		match build_expr with
 		| _,[ECall(e,args),_],_ -> get_macro_path ctx e args p
-		| _ -> typing_error "genericBuild requires a single expression call parameter" p
+		| _ -> raise_typing_error "genericBuild requires a single expression call parameter" p
 	in
 	let old = ctx.ret,ctx.get_build_infos in
 	ctx.get_build_infos <- (fun() -> Some (TClassDecl c, pl, cfl));

+ 46 - 45
src/typing/macroContext.ml

@@ -53,7 +53,7 @@ let safe_decode com v expected t p f =
 		let errors = Interp.handle_decoding_error (output_string ch) v t in
 		List.iter (fun (s,i) -> Printf.fprintf ch "\nline %i: %s" i s) (List.rev errors);
 		close_out ch;
-		typing_error (Printf.sprintf "Expected %s but got %s (see %s.txt for details)" expected (Interp.value_string v) (String.concat "/" path)) p
+		raise_typing_error (Printf.sprintf "Expected %s but got %s (see %s.txt for details)" expected (Interp.value_string v) (String.concat "/" path)) p
 
 let get_type_patch ctx t sub =
 	let new_patch() =
@@ -83,20 +83,13 @@ let macro_timer com l =
 
 let typing_timer ctx need_type f =
 	let t = Timer.timer ["typing"] in
-	let old = ctx.com.located_error and oldp = ctx.pass and oldlocals = ctx.locals in
+	let old = ctx.com.error_ext and oldp = ctx.pass and oldlocals = ctx.locals in
 	let restore_report_mode = disable_report_mode ctx.com in
 	(*
 		disable resumable errors... unless we are in display mode (we want to reach point of completion)
 	*)
-	(*if ctx.com.display = DMNone then ctx.com.located_error <- (fun e p -> raise (Error(Custom e,p)));*) (* TODO: review this... *)
-	let rec located_to_error = function
-		| Message (e,p) -> (Custom e,p)
-		| Stack stack -> (Stack (List.map located_to_error stack),null_pos)
-	in
-
-	ctx.com.located_error <- (fun ?(depth=0) msg ->
-		let (e,p) = located_to_error msg in
-		raise (Error (e,p,depth)));
+	(* if ctx.com.display.dms_kind = DMNone then ctx.com.error <- (fun e -> raise_error e); *) (* TODO: review this... *)
+	ctx.com.error_ext <- (fun err -> raise_error { err with err_from_macro = true });
 
 	if need_type && ctx.pass < PTypeField then begin
 		ctx.pass <- PTypeField;
@@ -104,7 +97,7 @@ let typing_timer ctx need_type f =
 	end;
 	let exit() =
 		t();
-		ctx.com.located_error <- old;
+		ctx.com.error_ext <- old;
 		ctx.pass <- oldp;
 		ctx.locals <- oldlocals;
 		restore_report_mode ();
@@ -113,15 +106,15 @@ let typing_timer ctx need_type f =
 		let r = f() in
 		exit();
 		r
-	with Error (ekind,p,_) ->
-			exit();
-			Interp.compiler_error (error_msg p ekind)
-		| WithTypeError (l,p,_) ->
-			exit();
-			Interp.compiler_error (error_msg p l)
-		| e ->
-			exit();
-			raise e
+	with Error err ->
+		exit();
+		Interp.compiler_error err
+	| WithTypeError err ->
+		exit();
+		Interp.compiler_error err
+	| e ->
+		exit();
+		raise e
 
 let make_macro_com_api com p =
 	{
@@ -188,7 +181,7 @@ let make_macro_com_api com p =
 			Interp.exc_string "unsupported"
 		);
 		parse = (fun entry s ->
-			match ParserEntry.parse_string entry com.defines s null_pos typing_error false with
+			match ParserEntry.parse_string entry com.defines s null_pos raise_typing_error false with
 			| ParseSuccess(r,_,_) -> r
 			| ParseError(_,(msg,p),_) -> Parser.error msg p
 		);
@@ -293,18 +286,18 @@ let make_macro_com_api com p =
 let make_macro_api ctx p =
 	let parse_expr_string s p inl =
 		typing_timer ctx false (fun() ->
-			match ParserEntry.parse_expr_string ctx.com.defines s p typing_error inl with
+			match ParserEntry.parse_expr_string ctx.com.defines s p raise_typing_error inl with
 				| ParseSuccess(data,true,_) when inl -> data (* ignore errors when inline-parsing in display file *)
 				| ParseSuccess(data,_,_) -> data
 				| ParseError _ -> raise MacroApi.Invalid_expr)
 	in
 	let parse_metadata s p =
 		try
-			match ParserEntry.parse_string Grammar.parse_meta ctx.com.defines s null_pos typing_error false with
+			match ParserEntry.parse_string Grammar.parse_meta ctx.com.defines s null_pos raise_typing_error false with
 			| ParseSuccess(meta,_,_) -> meta
-			| ParseError(_,_,_) -> typing_error "Malformed metadata string" p
+			| ParseError(_,_,_) -> raise_typing_error "Malformed metadata string" p
 		with _ ->
-			typing_error "Malformed metadata string" p
+			raise_typing_error "Malformed metadata string" p
 	in
 	let com_api = make_macro_com_api ctx.com p in
 	{
@@ -321,7 +314,7 @@ let make_macro_api ctx p =
 				try
 					let m = Some (Typeload.load_instance ctx (tp,p) true) in
 					m
-				with Error (Module_not_found _,p2,_) when p == p2 ->
+				with Error { err_message = Module_not_found _; err_pos = p2 } when p == p2 ->
 					None
 			)
 		);
@@ -345,7 +338,7 @@ let make_macro_api ctx p =
 		MacroApi.type_patch = (fun t f s v ->
 			typing_timer ctx false (fun() ->
 				let v = (match v with None -> None | Some s ->
-					match ParserEntry.parse_string Grammar.parse_complex_type ctx.com.defines s null_pos typing_error false with
+					match ParserEntry.parse_string Grammar.parse_complex_type ctx.com.defines s null_pos raise_typing_error false with
 					| ParseSuccess((ct,_),_,_) -> Some ct
 					| ParseError(_,(msg,p),_) -> Parser.error msg p (* p is null_pos, but we don't have anything else here... *)
 				) in
@@ -473,7 +466,7 @@ let make_macro_api ctx p =
 				try
 					ignore(AbstractCast.cast_or_unify_raise ctx t e p);
 					true
-				with Error (Unify _,_,_) ->
+				with Error { err_message = Unify _ } ->
 					false
 			)
 		);
@@ -608,7 +601,7 @@ and flush_macro_context mint mctx =
 		List.iter (fun f -> f t) type_filters
 	in
 	(try Interp.add_types mint types ready
-	with Error (e,p,n) -> t(); raise (Fatal_error(error_msg p e,n)));
+	with Error err -> t(); raise (Fatal_error err));
 	t()
 
 let create_macro_interp api mctx =
@@ -622,11 +615,19 @@ let create_macro_interp api mctx =
 			Interp.do_reuse mint api;
 			mint, (fun() -> ())
 	) in
-	let on_error = com2.located_error in
-	com2.located_error <- (fun ?(depth = 0) msg ->
+	let on_error = com2.error_ext in
+	com2.error_ext <- (fun err ->
 		Interp.set_error (Interp.get_ctx()) true;
 		macro_interp_cache := None;
-		on_error ~depth msg
+		on_error { err with err_from_macro = true }
+	);
+	let on_warning = com2.warning in
+	com2.warning <- (fun ?(depth=0) ?(from_macro=false) w options msg p ->
+		on_warning ~depth ~from_macro:true w options msg p
+	);
+	let on_info = com2.info in
+	com2.info <- (fun ?(depth=0) ?(from_macro=false) msg p ->
+		on_info ~depth ~from_macro:true msg p
 	);
 	(* mctx.g.core_api <- ctx.g.core_api; // causes some issues because of optional args and Null type in Flash9 *)
 	init();
@@ -702,14 +703,14 @@ let load_macro'' com mctx display cpath f p =
 			with Not_found ->
 				let name = Option.default (snd mpath) sub in
 				let path = fst mpath, name in
-				let mt = try List.find (fun t2 -> (t_infos t2).mt_path = path) mloaded.m_types with Not_found -> raise_typing_error (Type_not_found (mloaded.m_path,name,Not_defined)) p in
+				let mt = try List.find (fun t2 -> (t_infos t2).mt_path = path) mloaded.m_types with Not_found -> raise_typing_error_ext (make_error (Type_not_found (mloaded.m_path,name,Not_defined)) p) in
 				match mt with
 				| TClassDecl c ->
 					Finalization.finalize mctx;
-					c, (try PMap.find f c.cl_statics with Not_found -> typing_error ("Method " ^ f ^ " not found on class " ^ s_type_path cpath) p)
-				| _ -> typing_error "Macro should be called on a class" p
+					c, (try PMap.find f c.cl_statics with Not_found -> raise_typing_error ("Method " ^ f ^ " not found on class " ^ s_type_path cpath) p)
+				| _ -> raise_typing_error "Macro should be called on a class" p
 		in
-		let meth = (match follow meth.cf_type with TFun (args,ret) -> (args,ret,cl,meth),mloaded | _ -> typing_error "Macro call should be a method" p) in
+		let meth = (match follow meth.cf_type with TFun (args,ret) -> (args,ret,cl,meth),mloaded | _ -> raise_typing_error "Macro call should be a method" p) in
 		restore();
 		if not com.is_macro_context then flush_macro_context mint mctx;
 		mctx.com.cached_macros#add (cpath,f) meth;
@@ -786,7 +787,7 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
 			unify_raise mret ttype mpos;
 			(* TODO: enable this again in the future *)
 			(* warning ctx WDeprecated "Returning Type from @:genericBuild macros is deprecated, consider returning ComplexType instead" p; *)
-		with Error (Unify _,_,_) ->
+		with Error { err_message = Unify _ } ->
 			let cttype = mk_type_path ~sub:"ComplexType" (["haxe";"macro"],"Expr") in
 			let ttype = Typeload.load_instance mctx (cttype,p) false in
 			unify_raise mret ttype mpos;
@@ -821,7 +822,7 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
 		*)
 		let eargs = List.map (fun (n,o,t) ->
 			try unify_raise t expr p; (n, o, t_dynamic), MAExpr
-			with Error (Unify _,_,_) -> match follow t with
+			with Error { err_message = Unify _ } -> match follow t with
 				| TFun _ ->
 					(n,o,t), MAFunction
 				| _ ->
@@ -934,13 +935,13 @@ let call_macro ctx path meth args p =
 	let mctx, (margs,_,mclass,mfield), call = load_macro ctx false path meth p in
 	mctx.curclass <- null_class;
 	let el, _ = CallUnification.unify_call_args mctx args margs t_dynamic p false false false in
-	call (List.map (fun e -> try Interp.make_const e with Exit -> typing_error "Argument should be a constant" e.epos) el)
+	call (List.map (fun e -> try Interp.make_const e with Exit -> raise_typing_error "Argument should be a constant" e.epos) el)
 
 let call_init_macro ctx e =
 	let p = { pfile = "--macro " ^ e; pmin = -1; pmax = -1 } in
 	let e = try
-		if String.get e (String.length e - 1) = ';' then typing_error "Unexpected ;" p;
-		begin match ParserEntry.parse_expr_string ctx.com.defines e p typing_error false with
+		if String.get e (String.length e - 1) = ';' then raise_typing_error "Unexpected ;" p;
+		begin match ParserEntry.parse_expr_string ctx.com.defines e p raise_typing_error false with
 		| ParseSuccess(data,_,_) -> data
 		| ParseError(_,(msg,p),_) -> (Parser.error msg p)
 		end
@@ -954,16 +955,16 @@ let call_init_macro ctx e =
 			match fst e with
 			| EField (e,f,_) -> f :: loop e
 			| EConst (Ident i) -> [i]
-			| _ -> typing_error "Invalid macro call" p
+			| _ -> raise_typing_error "Invalid macro call" p
 		in
 		let path, meth = (match loop e with
 		| [meth] -> (["haxe";"macro"],"Compiler"), meth
 		| [meth;"server"] -> (["haxe";"macro"],"CompilationServer"), meth
 		| meth :: cl :: path -> (List.rev path,cl), meth
-		| _ -> typing_error "Invalid macro call" p) in
+		| _ -> raise_typing_error "Invalid macro call" p) in
 		ignore(call_macro ctx path meth args p);
 	| _ ->
-		typing_error "Invalid macro call" p
+		raise_typing_error "Invalid macro call" p
 
 let interpret ctx =
 	let mctx = Interp.create ctx.com (make_macro_api ctx null_pos) false in

+ 6 - 6
src/typing/magicTypes.ml

@@ -11,7 +11,7 @@ open Error
 (* REMOTING PROXYS *)
 
 let extend_remoting ctx c t p async prot =
-	if c.cl_super <> None then typing_error "Cannot extend several classes" p;
+	if c.cl_super <> None then raise_typing_error "Cannot extend several classes" p;
 	(* remove forbidden packages *)
 	let rules = ctx.com.package_rules in
 	ctx.com.package_rules <- PMap.foldi (fun key r acc -> match r with Forbidden -> acc | _ -> PMap.add key r acc) rules PMap.empty;
@@ -22,13 +22,13 @@ let extend_remoting ctx c t p async prot =
 	let t = (try
 		load_type_def ctx p (mk_type_path (fst path,new_name))
 	with
-		Error (Module_not_found _,p2,_) when p == p2 ->
+		Error { err_message = Module_not_found _; err_pos = p2 } when p == p2 ->
 	(* build it *)
 	Common.log ctx.com ("Building proxy for " ^ s_type_path path);
 	let file, decls = (try
 		TypeloadParse.parse_module ctx path p
 	with
-		| Not_found -> ctx.com.package_rules <- rules; typing_error ("Could not load proxy module " ^ s_type_path path ^ (if fst path = [] then " (try using absolute path)" else "")) p
+		| Not_found -> ctx.com.package_rules <- rules; raise_typing_error ("Could not load proxy module " ^ s_type_path path ^ (if fst path = [] then " (try using absolute path)" else "")) p
 		| e -> ctx.com.package_rules <- rules; raise e) in
 	ctx.com.package_rules <- rules;
 	let base_fields = [
@@ -41,7 +41,7 @@ let extend_remoting ctx c t p async prot =
 			acc
 		else match f.cff_kind with
 		| FFun fd when (is_public || List.mem_assoc APublic f.cff_access) && not (List.mem_assoc AStatic f.cff_access) ->
-			if List.exists (fun (_,_,_,t,_) -> t = None) fd.f_args then typing_error ("Field " ^ fst f.cff_name ^ " type is not complete and cannot be used by RemotingProxy") p;
+			if List.exists (fun (_,_,_,t,_) -> t = None) fd.f_args then raise_typing_error ("Field " ^ fst f.cff_name ^ " type is not complete and cannot be used by RemotingProxy") p;
 			let eargs = [EArrayDecl (List.map (fun ((a,_),_,_,_,_) -> (EConst (Ident a),p)) fd.f_args),p] in
 			let ftype = (match fd.f_type with Some (CTPath { tpackage = []; tname = "Void" },_) -> None | _ -> fd.f_type) in
 			let fargs, eargs = if async then match ftype with
@@ -81,11 +81,11 @@ let extend_remoting ctx c t p async prot =
 	try
 		List.find (fun tdecl -> snd (t_path tdecl) = new_name) m.m_types
 	with Not_found ->
-		typing_error ("Module " ^ s_type_path path ^ " does not define type " ^ t.tname) p
+		raise_typing_error ("Module " ^ s_type_path path ^ " does not define type " ^ t.tname) p
 	) in
 	match t with
 	| TClassDecl c2 when c2.cl_params = [] -> ignore(c2.cl_build()); c.cl_super <- Some (c2,[]);
-	| _ -> typing_error "Remoting proxy must be a class without parameters" p
+	| _ -> raise_typing_error "Remoting proxy must be a class without parameters" p
 
 let on_inherit ctx c p (is_extends,tp) =
 	if not is_extends then

+ 26 - 28
src/typing/matcher.ml

@@ -68,9 +68,9 @@ let get_general_module_type ctx mt p =
 				| TInst(c,_) -> loop (TClassDecl c)
 				| TEnum(en,_) -> loop (TEnumDecl en)
 				| TAbstract(a,_) -> loop (TAbstractDecl a)
-				| _ -> typing_error "Cannot use this type as a value" p
+				| _ -> raise_typing_error "Cannot use this type as a value" p
 			end
-		| _ -> typing_error "Cannot use this type as a value" p
+		| _ -> raise_typing_error "Cannot use this type as a value" p
 	in
 	Typeload.load_instance ctx ({tname=loop mt;tpackage=[];tsub=None;tparams=[]},p) true
 
@@ -132,7 +132,7 @@ module Constructor = struct
 		| ConArray i -> make_int ctx.com.basic i p
 		| ConTypeExpr mt -> TyperBase.type_module_type ctx mt None p
 		| ConStatic(c,cf) -> make_static_field c cf p
-		| ConFields _ -> typing_error "Something went wrong" p
+		| ConFields _ -> raise_typing_error "Something went wrong" p
 
 	let hash con = Hashtbl.hash (fst con)
 end
@@ -183,18 +183,18 @@ module Pattern = struct
 		let ctx = pctx.ctx in
 		let p = pos e in
 		let fail () =
-			typing_error ("Unrecognized pattern: " ^ (Ast.Printer.s_expr e)) p
+			raise_typing_error ("Unrecognized pattern: " ^ (Ast.Printer.s_expr e)) p
 		in
 		let unify_expected t' =
 			unify ctx t' t p
 		in
 		let verror name p =
-			typing_error (Printf.sprintf "Variable %s must appear exactly once in each sub-pattern" name) p
+			raise_typing_error (Printf.sprintf "Variable %s must appear exactly once in each sub-pattern" name) p
 		in
 		let add_local final name p =
 			let is_wildcard_local = name = "_" in
-			if not is_wildcard_local && pctx.is_postfix_match then typing_error "Pattern variables are not allowed in .match patterns" p;
-			if not is_wildcard_local && PMap.mem name pctx.current_locals then typing_error (Printf.sprintf "Variable %s is bound multiple times" name) p;
+			if not is_wildcard_local && pctx.is_postfix_match then raise_typing_error "Pattern variables are not allowed in .match patterns" p;
+			if not is_wildcard_local && PMap.mem name pctx.current_locals then raise_typing_error (Printf.sprintf "Variable %s is bound multiple times" name) p;
 			match pctx.or_locals with
 			| Some map when not is_wildcard_local ->
 				let v,p = try PMap.find name map with Not_found -> verror name p in
@@ -270,14 +270,12 @@ module Pattern = struct
 			if pctx.is_postfix_match then DKMarked else DKPattern toplevel
 		in
 		let catch_errors () =
-			let old = ctx.com.located_error in
+			let old = ctx.com.error_ext in
 			let restore_report_mode = disable_report_mode ctx.com in
-			ctx.com.located_error <- (fun ?depth _ ->
-				raise Exit
-			);
+			ctx.com.error_ext <- (fun _ -> raise Exit);
 			(fun () ->
 				restore_report_mode();
-				ctx.com.located_error <- old
+				ctx.com.error_ext <- old
 			)
 		in
 		let try_typing e =
@@ -342,7 +340,7 @@ module Pattern = struct
 					| String (value,kind) when kind = Ast.SSingleQuotes ->
 						let e = ctx.g.do_format_string ctx value p in
 						begin match e with
-							| EBinop _, p -> typing_error "String interpolation is not allowed in case patterns" p;
+							| EBinop _, p -> raise_typing_error "String interpolation is not allowed in case patterns" p;
 							| _ -> ()
 						end;
 					| _ -> ()
@@ -356,7 +354,7 @@ module Pattern = struct
 				begin match follow t with
 					| TFun(ta,tr) when tr == fake_tuple_type ->
 						if i = "_" then PatTuple(List.map (fun (_,_,t) -> (PatAny,pos e)) ta)
-						else typing_error "Cannot bind matched tuple to variable, use _ instead" p
+						else raise_typing_error "Cannot bind matched tuple to variable, use _ instead" p
 					| _ ->
 						if i = "_" then PatAny
 						else handle_ident i (pos e)
@@ -389,9 +387,9 @@ module Pattern = struct
 							| [],[] ->
 								[]
 							| [],_ ->
-								typing_error "Not enough arguments" p
+								raise_typing_error "Not enough arguments" p
 							| _,[] ->
-								typing_error "Too many arguments" p
+								raise_typing_error "Too many arguments" p
 						in
 						let patterns = loop el args in
 						ignore(unapply_type_parameters ef.ef_params monos);
@@ -404,7 +402,7 @@ module Pattern = struct
 					try_typing e
 				with
 					| Exit -> fail()
-					| Bad_pattern s -> typing_error s p
+					| Bad_pattern s -> raise_typing_error s p
 				end
 			| EArrayDecl el ->
 				let rec pattern seen t = match follow t with
@@ -414,8 +412,8 @@ module Pattern = struct
 								let pat = make pctx false t e in
 								pat :: loop el tl
 							| [],[] -> []
-							| [],_ -> typing_error "Not enough arguments" p
-							| (_,p) :: _,[] -> typing_error "Too many arguments" p
+							| [],_ -> raise_typing_error "Not enough arguments" p
+							| (_,p) :: _,[] -> raise_typing_error "Too many arguments" p
 						in
 						let patterns = loop el tl in
 						PatTuple patterns
@@ -470,7 +468,7 @@ module Pattern = struct
 								collect_field cf (apply_params a.a_params tl cf.cf_type) filter
 						) c.cl_ordered_statics;
 					| _ ->
-						typing_error (Printf.sprintf "Cannot field-match against %s" (s_type t)) (pos e)
+						raise_typing_error (Printf.sprintf "Cannot field-match against %s" (s_type t)) (pos e)
 				in
 				collect_fields t None;
 				let is_matchable cf =
@@ -487,7 +485,7 @@ module Pattern = struct
 						else
 							patterns,fields
 				) ([],[]) !known_fields in
-				List.iter (fun ((s,_,_),e) -> if not (List.mem s fields) then typing_error (Printf.sprintf "%s has no field %s" (s_type t) s) (pos e)) fl;
+				List.iter (fun ((s,_,_),e) -> if not (List.mem s fields) then raise_typing_error (Printf.sprintf "%s has no field %s" (s_type t) s) (pos e)) fl;
 				PatConstructor(con_fields fields (pos e),patterns)
 			| EBinop(OpOr,e1,e2) ->
 				let pctx1 = {pctx with current_locals = PMap.empty} in
@@ -575,7 +573,7 @@ module Case = struct
 				let e2 = collapse_case el in
 				EBinop(OpOr,e,e2),punion (pos e) (pos e2)
 			| [] ->
-				typing_error "case without pattern" p
+				raise_typing_error "case without pattern" p
 		in
 		let e = collapse_case el in
 		let monos = List.map (fun _ -> mk_mono()) ctx.type_params in
@@ -1161,9 +1159,9 @@ module Compile = struct
 			| [],[] ->
 				bindings
 			| [],e :: _ ->
-				typing_error "Invalid match: Not enough patterns" e.epos
+				raise_typing_error "Invalid match: Not enough patterns" e.epos
 			| (_,p) :: _,[] ->
-				typing_error "Invalid match: Too many patterns" p
+				raise_typing_error "Invalid match: Too many patterns" p
 		in
 		let bindings = loop patterns subjects bindings in
 		if bindings = [] then dt else bind mctx (List.rev bindings) dt
@@ -1188,7 +1186,7 @@ module Compile = struct
 					| PatBind(v,pat1) -> loop ((make_bind v (pos pat) subject) :: bindings) pat1
 					| PatVariable _ | PatAny -> ()
 					| PatExtractor _ -> raise Extractor
-					| _ -> typing_error ("Unexpected pattern: " ^ (Pattern.to_string pat)) case.case_pos;
+					| _ -> raise_typing_error ("Unexpected pattern: " ^ (Pattern.to_string pat)) case.case_pos;
 				in
 				loop bindings (List.hd patterns)
 			) cases;
@@ -1454,7 +1452,7 @@ module TexprConverter = struct
 			| _ -> kind = SKValue
 		in
 		List.iter (fun sc ->
-			if not (compatible_kind sc.sc_con) then typing_error "Incompatible pattern" sc.sc_dt.dt_pos;
+			if not (compatible_kind sc.sc_con) then raise_typing_error "Incompatible pattern" sc.sc_dt.dt_pos;
 			if sc.sc_unguarded then ConTable.remove h sc.sc_con
 		) cases;
 		let unmatched = ConTable.fold (fun con _ acc -> con :: acc) h [] in
@@ -1485,7 +1483,7 @@ module TexprConverter = struct
 			| [] -> "_"
 			| _ -> String.concat " | " (List.sort Pervasives.compare sl)
 		in
-		typing_error (Printf.sprintf "Unmatched patterns: %s" (s_subject v_lookup s e_subject)) e_subject.epos
+		raise_typing_error (Printf.sprintf "Unmatched patterns: %s" (s_subject v_lookup s e_subject)) e_subject.epos
 
 	type dt_recursion =
 		| Toplevel
@@ -1682,7 +1680,7 @@ module TexprConverter = struct
 		let e = loop Toplevel params dt in
 		match e with
 		| None ->
-			typing_error "Unmatched patterns: _" p;
+			raise_typing_error "Unmatched patterns: _" p;
 		| Some e ->
 			Texpr.duplicate_tvars e
 end

+ 31 - 31
src/typing/operators.ml

@@ -9,11 +9,11 @@ open Calls
 open Fields
 open FieldAccess
 
-let check_error ctx err p depth = match err with
-	| Module_not_found ([],name) when Diagnostics.error_in_diagnostics_run ctx.com p ->
-		DisplayToplevel.handle_unresolved_identifier ctx name p true
+let check_error ctx err = match err.err_message with
+	| Module_not_found ([],name) when Diagnostics.error_in_diagnostics_run ctx.com err.err_pos ->
+		DisplayToplevel.handle_unresolved_identifier ctx name err.err_pos true
 	| _ ->
-		Common.located_display_error ~depth ctx.com (error_msg p err)
+		Common.display_error_ext ctx.com err
 
 module BinopResult = struct
 
@@ -91,7 +91,7 @@ end
 let check_assign ctx e =
 	match e.eexpr with
 	| TLocal v when has_var_flag v VFinal && not (Common.ignore_error ctx.com) ->
-		typing_error "Cannot assign to final" e.epos
+		raise_typing_error "Cannot assign to final" e.epos
 	| TLocal {v_extra = None} | TArray _ | TField _ | TIdent _ ->
 		()
 	| TConst TThis | TTypeExpr _ when ctx.untyped ->
@@ -209,7 +209,7 @@ let make_binop ctx op e1 e2 is_assign_op with_type p =
 			| KAbstract (a,tl) ->
 				try
 					AbstractCast.cast_or_unify_raise ctx tstring e p
-				with Error (Unify _,_,_) ->
+				with Error { err_message = Unify _ } ->
 					loop (Abstract.get_underlying_type a tl)
 		in
 		loop e.etype
@@ -290,7 +290,7 @@ let make_binop ctx op e1 e2 is_assign_op with_type p =
 		| KOther, _
 		| _ , KOther ->
 			let pr = print_context() in
-			typing_error ("Cannot add " ^ s_type pr e1.etype ^ " and " ^ s_type pr e2.etype) p
+			raise_typing_error ("Cannot add " ^ s_type pr e1.etype ^ " and " ^ s_type pr e2.etype) p
 		)
 	| OpAnd
 	| OpOr
@@ -334,9 +334,9 @@ let make_binop ctx op e1 e2 is_assign_op with_type p =
 	| OpNotEq ->
 		let e1,e2 = try
 			(* we only have to check one type here, because unification fails if one is Void and the other is not *)
-			(match follow e2.etype with TAbstract({a_path=[],"Void"},_) -> typing_error "Cannot compare Void" p | _ -> ());
+			(match follow e2.etype with TAbstract({a_path=[],"Void"},_) -> raise_typing_error "Cannot compare Void" p | _ -> ());
 			AbstractCast.cast_or_unify_raise ctx e2.etype e1 p,e2
-		with Error (Unify _,_,_) ->
+		with Error { err_message = Unify _ } ->
 			e1,AbstractCast.cast_or_unify ctx e1.etype e2 p
 		in
 		if not ctx.com.config.pf_supports_function_equality then begin match e1.eexpr, e2.eexpr with
@@ -382,7 +382,7 @@ let make_binop ctx op e1 e2 is_assign_op with_type p =
 		| KOther , _
 		| _ , KOther ->
 			let pr = print_context() in
-			typing_error ("Cannot compare " ^ s_type pr e1.etype ^ " and " ^ s_type pr e2.etype) p
+			raise_typing_error ("Cannot compare " ^ s_type pr e1.etype ^ " and " ^ s_type pr e2.etype) p
 		);
 		mk_op e1 e2 ctx.t.tbool
 	| OpBoolAnd
@@ -397,9 +397,9 @@ let make_binop ctx op e1 e2 is_assign_op with_type p =
 		let e2 = AbstractCast.cast_or_unify_raise ctx tint e2 e2.epos in
 		BinopSpecial (mk (TNew ((match t with TInst (c,[]) -> c | _ -> die "" __LOC__),[],[e1;e2])) t p,false)
 	| OpArrow ->
-		typing_error "Unexpected =>" p
+		raise_typing_error "Unexpected =>" p
 	| OpIn ->
-		typing_error "Unexpected in" p
+		raise_typing_error "Unexpected in" p
 	| OpNullCoal
 	| OpAssign
 	| OpAssignOp _ ->
@@ -416,13 +416,13 @@ let find_abstract_binop_overload ctx op e1 e2 a c tl left is_assign_op with_type
 				let t_expected = BinopResult.get_type result in
 				begin try
 					unify_raise tret t_expected p
-				with Error (Unify _,_,depth) ->
+				with Error { err_message = Unify _; err_depth = depth } ->
 					match follow tret with
 						| TAbstract(a,tl) when type_iseq (Abstract.get_underlying_type a tl) t_expected ->
 							()
 						| _ ->
 							let st = s_type (print_context()) in
-							typing_error ~depth (Printf.sprintf "The result of this operation (%s) is not compatible with declared return type %s" (st t_expected) (st tret)) p
+							raise_typing_error ~depth (Printf.sprintf "The result of this operation (%s) is not compatible with declared return type %s" (st t_expected) (st tret)) p
 				end;
 			end;
 			(*
@@ -496,10 +496,10 @@ let find_abstract_binop_overload ctx op e1 e2 a c tl left is_assign_op with_type
 					in
 					begin try
 						check e1 e2 false
-					with Error (Unify _,_,_) | Unify_error _ -> try
+					with Error { err_message = Unify _ } | Unify_error _ -> try
 						if not (Meta.has Meta.Commutative cf.cf_meta) then raise Not_found;
 						check e2 e1 true
-					with Not_found | Error (Unify _,_,_) | Unify_error _ ->
+					with Not_found | Error { err_message = Unify _ } | Unify_error _ ->
 						loop find_op ol
 					end
 				| _ ->
@@ -555,8 +555,8 @@ let type_assign ctx e1 e2 with_type p =
 	let e1 = !type_access_ref ctx (fst e1) (snd e1) (MSet (Some e2)) with_type in
 	let type_rhs with_type = try
 		type_expr ctx e2 with_type
-	with Error(e,p,depth) ->
-		check_error ctx e p depth;
+	with Error e ->
+		check_error ctx e;
 		Texpr.Builder.make_null t_dynamic (pos e2)
 	in
 	let assign_to e1 =
@@ -564,19 +564,19 @@ let type_assign ctx e1 e2 with_type p =
 		let e2 = AbstractCast.cast_or_unify ctx e1.etype e2 p in
 		check_assign ctx e1;
 		(match e1.eexpr , e2.eexpr with
-		| TLocal i1 , TLocal i2 when i1 == i2 -> typing_error "Assigning a value to itself" p
+		| TLocal i1 , TLocal i2 when i1 == i2 -> raise_typing_error "Assigning a value to itself" p
 		| TField ({ eexpr = TConst TThis },FInstance (_,_,f1)) , TField ({ eexpr = TConst TThis },FInstance (_,_,f2)) when f1 == f2 ->
-			typing_error "Assigning a value to itself" p
+			raise_typing_error "Assigning a value to itself" p
 		| _ , _ -> ());
 		mk (TBinop (OpAssign,e1,e2)) e1.etype p
 	in
 	match e1 with
 	| AKNo(_,p) ->
-		typing_error "This expression cannot be accessed for writing" p
+		raise_typing_error "This expression cannot be accessed for writing" p
 	| AKUsingField _ | AKSafeNav _ ->
-		typing_error "Invalid operation" p
+		raise_typing_error "Invalid operation" p
 	| AKExpr { eexpr = TLocal { v_kind = VUser TVOLocalFunction; v_name = name } } ->
-		typing_error ("Cannot access function " ^ name ^ " for writing") p
+		raise_typing_error ("Cannot access function " ^ name ^ " for writing") p
 	| AKField fa ->
 		let ef = FieldAccess.get_field_expr fa FWrite in
 		assign_to ef
@@ -595,7 +595,7 @@ let type_assign ctx e1 e2 with_type p =
 	| AKUsingAccessor sea ->
 		let fa_set = match FieldAccess.resolve_accessor sea.se_access (MSet (Some e2)) with
 			| AccessorFound fa -> fa
-			| _ -> typing_error "Could not resolve accessor" p
+			| _ -> raise_typing_error "Could not resolve accessor" p
 		in
 		let dispatcher = new call_dispatcher ctx (MCall [e2]) with_type p in
 		dispatcher#field_call fa_set [sea.se_this] [e2]
@@ -670,10 +670,10 @@ let type_assign_op ctx op e1 e2 with_type p =
 		begin try
 			type_non_assign_op ctx op e1 e2 true true with_type p
 		with Not_found ->
-			typing_error "This expression cannot be accessed for writing" p
+			raise_typing_error "This expression cannot be accessed for writing" p
 		end
 	| AKUsingField _ | AKSafeNav _ ->
-		typing_error "Invalid operation" p
+		raise_typing_error "Invalid operation" p
 	| AKExpr e ->
 		let e,vr = process_lhs_expr ctx "lhs" e in
 		let e_rhs = type_binop2 ctx op e e2 true WithType.value p in
@@ -728,7 +728,7 @@ let type_assign_op ctx op e1 e2 with_type p =
 					| el -> mk (TBlock el) r_set p
 				end
 			| _ ->
-				typing_error "Invalid array access getter/setter combination" p
+				raise_typing_error "Invalid array access getter/setter combination" p
 		in
 		save();
 		vr#to_texpr	e
@@ -748,7 +748,7 @@ let type_binop ctx op e1 e2 is_assign_op with_type p =
 	| OpAssign ->
 		type_assign ctx e1 e2 with_type p
 	| OpAssignOp (OpBoolAnd | OpBoolOr) ->
-		typing_error "The operators ||= and &&= are not supported" p
+		raise_typing_error "The operators ||= and &&= are not supported" p
 	| OpAssignOp op ->
 		type_assign_op ctx op e1 e2 with_type p
 	| _ ->
@@ -791,7 +791,7 @@ let type_unop ctx op flag e with_type p =
 			raise Not_found
 	in
 	let unexpected_spread p =
-		typing_error "Spread unary operator is only allowed for unpacking the last argument in a call with rest arguments" p
+		raise_typing_error "Spread unary operator is only allowed for unpacking the last argument in a call with rest arguments" p
 	in
 	let make e =
 		let check_int () =
@@ -861,7 +861,7 @@ let type_unop ctx op flag e with_type p =
 			begin try
 				try_abstract_unop_overloads (acc_get ctx acc)
 			with Not_found ->
-				typing_error "This expression cannot be accessed for writing" p
+				raise_typing_error "This expression cannot be accessed for writing" p
 			end
 		| AKExpr e ->
 			find_overload_or_make e
@@ -920,4 +920,4 @@ let type_unop ctx op flag e with_type p =
 				find_overload_or_make e
 			end
 		| AKUsingField _ | AKResolve _ | AKSafeNav _ ->
-			typing_error "Invalid operation" p
+			raise_typing_error "Invalid operation" p

+ 2 - 2
src/typing/strictMeta.ml

@@ -113,7 +113,7 @@ let get_strict_meta ctx meta params pos =
 				in
 				ef, fields, CTPath tpath
 			| _ ->
-				Error.typing_error "@:strict is not supported on this target" p
+				Error.raise_typing_error "@:strict is not supported on this target" p
 			end
 		| [EConst(Ident i),p as expr] ->
 			let tpath = { tpackage=[]; tname=i; tparams=[]; tsub=None } in
@@ -151,4 +151,4 @@ let check_strict_meta ctx metas =
 				| _ -> ()
 			) metas;
 			!ret
-		| _ -> []
+		| _ -> []

+ 62 - 57
src/typing/typeload.ml

@@ -58,6 +58,7 @@ let check_field_access ctx cff =
 			try
 				let _,p2 = List.find (fun (access',_) -> access = access') acc in
 				if p1 <> null_pos && p2 <> null_pos then begin
+					(* TODO error with sub *)
 					display_error ctx.com (Printf.sprintf "Duplicate access modifier %s" (Ast.s_access access)) p1;
 					display_error ~depth:1 ctx.com (compl_msg "Previously defined here") p2;
 				end;
@@ -66,6 +67,7 @@ let check_field_access ctx cff =
 				| APublic | APrivate ->
 					begin try
 						let _,p2 = List.find (fun (access',_) -> match access' with APublic | APrivate -> true | _ -> false) acc in
+						(* TODO error with sub *)
 						display_error ctx.com (Printf.sprintf "Conflicting access modifier %s" (Ast.s_access access)) p1;
 						display_error ~depth:1 ctx.com (compl_msg "Conflicts with this") p2;
 						loop p1 acc l
@@ -92,14 +94,14 @@ let find_type_in_module_raise ctx m tname p =
 			let infos = t_infos mt in
 			if snd infos.mt_path = tname then
 				if ctx.m.curmod != infos.mt_module && infos.mt_private then
-					raise_typing_error (Type_not_found (m.m_path,tname,Private_type)) p
+					raise_typing_error_ext (make_error (Type_not_found (m.m_path,tname,Private_type)) p)
 				else
 					true
 			else
 				false
 		) m.m_types
 	with Not_found ->
-		raise_typing_error (Type_not_found (m.m_path,tname,Not_defined)) p
+		raise_typing_error_ext (make_error (Type_not_found (m.m_path,tname,Not_defined)) p)
 
 (* raises Module_not_found or Type_not_found *)
 let load_type_raise ctx mpath tname p =
@@ -109,7 +111,7 @@ let load_type_raise ctx mpath tname p =
 (* raises Not_found *)
 let load_type ctx mpath tname p = try
 	load_type_raise ctx mpath tname p
-with Error((Module_not_found _ | Type_not_found _),p2,_) when p = p2 ->
+with Error { err_message = (Module_not_found _ | Type_not_found _); err_pos = p2 } when p = p2 ->
 	raise Not_found
 
 (** since load_type_def and load_instance are used in PASS2, they should not access the structure of a type **)
@@ -142,7 +144,7 @@ let find_in_wildcard_imports ctx mname p f =
 				let m =
 					try
 						ctx.g.do_load_module ctx path p
-					with Error (Module_not_found mpath,_,_) when mpath = path ->
+					with Error { err_message = Module_not_found mpath } when mpath = path ->
 						raise Not_found
 				in
 				let r = f m ~resume:true in
@@ -163,7 +165,7 @@ let find_in_modules_starting_from_current_package ~resume ctx mname p f =
 			let m =
 				try
 					ctx.g.do_load_module ctx path p
-				with Error (Module_not_found mpath,_,_) when resume && mpath = path ->
+				with Error { err_message = Module_not_found mpath } when resume && mpath = path ->
 					raise Not_found
 			in
 			f m ~resume:resume
@@ -172,7 +174,7 @@ let find_in_modules_starting_from_current_package ~resume ctx mname p f =
 				let m =
 					try
 						ctx.g.do_load_module ctx path p
-					with Error (Module_not_found mpath,_,_) when mpath = path ->
+					with Error { err_message = Module_not_found mpath } when mpath = path ->
 						raise Not_found
 					in
 				f m ~resume:true;
@@ -200,7 +202,7 @@ let load_unqualified_type_def ctx mname tname p =
 let load_module ctx path p =
 	try
 		ctx.g.do_load_module ctx path p
-	with Error (Module_not_found mpath,_,_) as exc when mpath = path ->
+	with Error { err_message = Module_not_found mpath } as exc when mpath = path ->
 		match path with
 		| ("std" :: pack, name) ->
 			ctx.g.do_load_module ctx (pack,name) p
@@ -254,9 +256,10 @@ let is_redefined ctx cf1 fields p =
 		let cf2 = PMap.find cf1.cf_name fields in
 		let st = s_type (print_context()) in
 		if not (type_iseq cf1.cf_type cf2.cf_type) then begin
+			(* TODO construct error with sub? *)
 			display_error ctx.com ("Cannot redefine field " ^ cf1.cf_name ^ " with different type") p;
 			display_error ctx.com ("First type was " ^ (st cf1.cf_type)) cf1.cf_pos;
-			typing_error ("Second type was " ^ (st cf2.cf_type)) cf2.cf_pos
+			raise_typing_error ("Second type was " ^ (st cf2.cf_type)) cf2.cf_pos
 		end else
 			true
 	with Not_found ->
@@ -270,7 +273,7 @@ let make_extension_type ctx tl =
 				else fields
 			) a.a_fields fields
 		| _ ->
-			typing_error "Can only extend structures" p
+			raise_typing_error "Can only extend structures" p
 	in
 	let fields = List.fold_left mk_extension PMap.empty tl in
 	let tl = List.map (fun (t,_) -> t) tl in
@@ -286,15 +289,15 @@ let check_param_constraints ctx t map c p =
 			let ti = map ti in
 			try
 				unify_raise t ti p
-			with Error(Unify l,p,depth) ->
+			with Error ({ err_message = Unify l } as err) ->
 				let fail() =
-					if not ctx.untyped then located_display_error ~depth ctx.com (error_msg p (Unify (Constraint_failure (s_type_path c.cl_path) :: l)));
+					if not ctx.untyped then display_error_ext ctx.com { err with err_message = (Unify (Constraint_failure (s_type_path c.cl_path) :: l)) }
 				in
 				match follow t with
 				| TInst({cl_kind = KExpr e},_) ->
 					let e = type_expr {ctx with locals = PMap.empty} e (WithType.with_type ti) in
 					begin try unify_raise e.etype ti p
-					with Error (Unify _,_,_) -> fail() end
+					with Error { err_message = Unify _ } -> fail() end
 				| _ ->
 					fail()
 
@@ -305,7 +308,7 @@ let rec load_instance' ctx (t,p) allow_no_params =
 	let t = try
 		if t.tpackage <> [] || t.tsub <> None then raise Not_found;
 		let pt = lookup_param t.tname ctx.type_params in
-		if t.tparams <> [] then typing_error ("Class type parameter " ^ t.tname ^ " can't have parameters") p;
+		if t.tparams <> [] then raise_typing_error ("Class type parameter " ^ t.tname ^ " can't have parameters") p;
 		pt
 	with Not_found ->
 		let mt = load_type_def ctx p t in
@@ -335,7 +338,7 @@ let rec load_instance' ctx (t,p) allow_no_params =
 			match t.tparams with
 			| [] -> t_dynamic
 			| [TPType t] -> TDynamic (Some (load_complex_type ctx true t))
-			| _ -> typing_error "Too many parameters for Dynamic" p
+			| _ -> raise_typing_error "Too many parameters for Dynamic" p
 		else begin
 			let is_java_rest = ctx.com.platform = Java && is_extern in
 			let is_rest = is_rest || is_java_rest in
@@ -366,9 +369,9 @@ let rec load_instance' ctx (t,p) allow_no_params =
 						let accepts_expression = name = "Rest" in
 						if is_expression then begin
 							if not expects_expression && not accepts_expression then
-								typing_error "Constant value unexpected here" p
+								raise_typing_error "Constant value unexpected here" p
 						end else if expects_expression then
-							typing_error "Type parameter is expected to be a constant value" p
+							raise_typing_error "Type parameter is expected to be a constant value" p
 					in
 					let is_rest = is_rest || name = "Rest" && is_generic_build in
 					let t = match follow t2 with
@@ -394,7 +397,7 @@ let rec load_instance' ctx (t,p) allow_no_params =
 							if ignore_error ctx.com then
 								t :: loop [] tl is_rest
 							else
-								typing_error ("Not enough type parameters for " ^ s_type_path path) p
+								raise_typing_error ("Not enough type parameters for " ^ s_type_path path) p
 						| Some t ->
 							t :: loop [] tl is_rest
 					end
@@ -405,7 +408,7 @@ let rec load_instance' ctx (t,p) allow_no_params =
 					else if ignore_error ctx.com then
 						[]
 					else
-						typing_error ("Too many type parameters for " ^ s_type_path path) pt
+						raise_typing_error ("Too many type parameters for " ^ s_type_path path) pt
 			in
 			let params = loop t.tparams types false in
 			if not is_rest then begin
@@ -436,7 +439,7 @@ and load_instance ctx ?(allow_display=false) ((_,pn) as tp) allow_no_params =
 		let t = load_instance' ctx tp allow_no_params in
 		if allow_display then DisplayEmitter.check_display_type ctx t tp;
 		t
-	with Error (Module_not_found path,_,_) when ctx.macro_depth <= 0 && (ctx.com.display.dms_kind = DMDefault) && DisplayPosition.display_position#enclosed_in pn ->
+	with Error { err_message = Module_not_found path } when ctx.macro_depth <= 0 && (ctx.com.display.dms_kind = DMDefault) && DisplayPosition.display_position#enclosed_in pn ->
 		let s = s_type_path path in
 		DisplayToplevel.collect_and_raise ctx TKType NoValue CRTypeHint (s,pn) (patch_string_pos pn s)
 
@@ -448,8 +451,8 @@ and load_complex_type' ctx allow_display (t,p) =
 	| CTParent t -> load_complex_type ctx allow_display t
 	| CTPath { tpackage = ["$"]; tname = "_hx_mono" } -> spawn_monomorph ctx p
 	| CTPath t -> load_instance ~allow_display ctx (t,p) false
-	| CTOptional _ -> typing_error "Optional type not allowed here" p
-	| CTNamed _ -> typing_error "Named type not allowed here" p
+	| CTOptional _ -> raise_typing_error "Optional type not allowed here" p
+	| CTNamed _ -> raise_typing_error "Named type not allowed here" p
 	| CTIntersection tl ->
 		let tl = List.map (fun (t,pn) ->
 			try
@@ -476,13 +479,13 @@ and load_complex_type' ctx allow_display (t,p) =
 			let mk_extension (t,p) =
 				match follow t with
 				| TInst ({cl_kind = KTypeParameter _},_) ->
-					typing_error "Cannot structurally extend type parameters" p
+					raise_typing_error "Cannot structurally extend type parameters" p
 				| TMono _ ->
-					typing_error "Loop found in cascading signatures definitions. Please change order/import" p
+					raise_typing_error "Loop found in cascading signatures definitions. Please change order/import" p
 				| TAnon a2 ->
 					PMap.iter (fun _ cf -> ignore(is_redefined ctx cf a2.a_fields p)) a.a_fields;
 					mk_anon ~fields:(PMap.foldi PMap.add a.a_fields a2.a_fields) (ref (Extend [t]))
-				| _ -> typing_error "Can only extend structures" p
+				| _ -> raise_typing_error "Can only extend structures" p
 			in
 			let loop (t,p) = match follow t with
 				| TAnon a2 ->
@@ -491,7 +494,7 @@ and load_complex_type' ctx allow_display (t,p) =
 							a.a_fields <- PMap.add f cf a.a_fields
 					) a2.a_fields
 				| _ ->
-					typing_error "Can only extend structures" p
+					raise_typing_error "Can only extend structures" p
 			in
 			let il = List.map (fun (t,pn) ->
 				try
@@ -525,15 +528,15 @@ and load_complex_type' ctx allow_display (t,p) =
 			let n = fst f.cff_name in
 			let pf = snd f.cff_name in
 			let p = f.cff_pos in
-			if PMap.mem n acc then typing_error ("Duplicate field declaration : " ^ n) pf;
+			if PMap.mem n acc then raise_typing_error ("Duplicate field declaration : " ^ n) pf;
 			let topt = function
-				| None -> typing_error ("Explicit type required for field " ^ n) p
+				| None -> raise_typing_error ("Explicit type required for field " ^ n) p
 				| Some t -> load_complex_type ctx allow_display t
 			in
 			if n = "new" then warning ctx WDeprecated "Structures with new are deprecated, use haxe.Constraints.Constructible instead" p;
 			let no_expr = function
 				| None -> ()
-				| Some (_,p) -> typing_error "Expression not allowed here" p
+				| Some (_,p) -> raise_typing_error "Expression not allowed here" p
 			in
 			let pub = ref true in
 			let dyn = ref false in
@@ -550,15 +553,15 @@ and load_complex_type' ctx allow_display (t,p) =
 					pub := false;
 				| ADynamic when (match f.cff_kind with FFun _ -> true | _ -> false) -> dyn := true
 				| AFinal -> final := true
-				| AStatic | AOverride | AInline | ADynamic | AMacro | AExtern | AAbstract | AOverload as a -> typing_error ("Invalid access " ^ Ast.s_access a) p
+				| AStatic | AOverride | AInline | ADynamic | AMacro | AExtern | AAbstract | AOverload as a -> raise_typing_error ("Invalid access " ^ Ast.s_access a) p
 			) f.cff_access;
 			let t , access = (match f.cff_kind with
 				| FVar(t,e) when !final ->
 					no_expr e;
-					let t = (match t with None -> typing_error "Type required for structure property" p | Some t -> t) in
+					let t = (match t with None -> raise_typing_error "Type required for structure property" p | Some t -> t) in
 					load_complex_type ctx allow_display t, Var { v_read = AccNormal; v_write = AccNever }
 				| FVar (Some (CTPath({tpackage=[];tname="Void"}),_), _)  | FProp (_,_,Some (CTPath({tpackage=[];tname="Void"}),_),_) ->
-					typing_error "Fields of type Void are not allowed in structures" p
+					raise_typing_error "Fields of type Void are not allowed in structures" p
 				| FVar (t, e) ->
 					no_expr e;
 					topt t, Var { v_read = AccNormal; v_write = AccNormal }
@@ -584,9 +587,9 @@ and load_complex_type' ctx allow_display (t,p) =
 						| x when get && x = "get_" ^ n -> AccCall
 						| x when not get && x = "set_" ^ n -> AccCall
 						| _ ->
-							typing_error "Custom property access is no longer supported in Haxe 3" f.cff_pos;
+							raise_typing_error "Custom property access is no longer supported in Haxe 3" f.cff_pos;
 					in
-					let t = (match t with None -> typing_error "Type required for structure property" p | Some t -> t) in
+					let t = (match t with None -> raise_typing_error "Type required for structure property" p | Some t -> t) in
 					load_complex_type ctx allow_display t, Var { v_read = access i1 true; v_write = access i2 false }
 			) in
 			let t = if Meta.has Meta.Optional f.cff_meta then ctx.t.tnull t else t in
@@ -627,14 +630,14 @@ and load_complex_type' ctx allow_display (t,p) =
 and load_complex_type ctx allow_display (t,pn) =
 	try
 		load_complex_type' ctx allow_display (t,pn)
-	with Error(Module_not_found(([],name)),p,_) as exc ->
-		if Diagnostics.error_in_diagnostics_run ctx.com p then begin
-			delay ctx PForce (fun () -> DisplayToplevel.handle_unresolved_identifier ctx name p true);
+	with Error ({ err_message = Module_not_found(([],name)) } as err) ->
+		if Diagnostics.error_in_diagnostics_run ctx.com err.err_pos then begin
+			delay ctx PForce (fun () -> DisplayToplevel.handle_unresolved_identifier ctx name err.err_pos true);
 			t_dynamic
 		end else if ignore_error ctx.com && not (DisplayPosition.display_position#enclosed_in pn) then
 			t_dynamic
 		else
-			raise exc
+			raise (Error err)
 
 and init_meta_overloads ctx co cf =
 	let overloads = ref [] in
@@ -646,10 +649,10 @@ and init_meta_overloads ctx co cf =
 	cf.cf_meta <- List.filter (fun m ->
 		match m with
 		| (Meta.Overload,[(EFunction (kind,f),p)],_)  ->
-			(match kind with FKNamed _ -> typing_error "Function name must not be part of @:overload" p | _ -> ());
-			(match f.f_expr with Some (EBlock [], _) -> () | _ -> typing_error "Overload must only declare an empty method body {}" p);
+			(match kind with FKNamed _ -> raise_typing_error "Function name must not be part of @:overload" p | _ -> ());
+			(match f.f_expr with Some (EBlock [], _) -> () | _ -> raise_typing_error "Overload must only declare an empty method body {}" p);
 			(match cf.cf_kind with
-				| Method MethInline -> typing_error "Cannot @:overload inline function" p
+				| Method MethInline -> raise_typing_error "Cannot @:overload inline function" p
 				| _ -> ());
 			let old = ctx.type_params in
 			begin match cf.cf_params with
@@ -662,7 +665,7 @@ and init_meta_overloads ctx co cf =
 			end;
 			let params : type_params = (!type_function_params_rec) ctx f cf.cf_name p in
 			ctx.type_params <- params @ ctx.type_params;
-			let topt = function None -> typing_error "Explicit type required" p | Some t -> load_complex_type ctx true t in
+			let topt = function None -> raise_typing_error "Explicit type required" p | Some t -> load_complex_type ctx true t in
 			let args =
 				List.map
 					(fun ((a,_),opt,_,t,cto) ->
@@ -679,15 +682,15 @@ and init_meta_overloads ctx co cf =
 			false
 		| (Meta.Overload,[],_) when ctx.com.config.pf_overload ->
 			add_class_field_flag cf CfOverload;
-			let topt (n,_,t) = match t with | TMono t when t.tm_type = None -> typing_error ("Explicit type required for overload functions\n... For function argument '" ^ n ^ "'") cf.cf_pos | _ -> () in
+			let topt (n,_,t) = match t with | TMono t when t.tm_type = None -> raise_typing_error ("Explicit type required for overload functions\n... For function argument '" ^ n ^ "'") cf.cf_pos | _ -> () in
 			(match follow cf.cf_type with
 			| TFun (args,_) -> List.iter topt args
 			| _ -> () (* could be a variable *));
 			true
 		| (Meta.Overload,[],p) ->
-			typing_error "This platform does not support this kind of overload declaration. Try @:overload(function()... {}) instead" p
+			raise_typing_error "This platform does not support this kind of overload declaration. Try @:overload(function()... {}) instead" p
 		| (Meta.Overload,_,p) ->
-			typing_error "Invalid @:overload metadata format" p
+			raise_typing_error "Invalid @:overload metadata format" p
 		| _ ->
 			true
 	) cf.cf_meta;
@@ -785,7 +788,7 @@ let rec type_type_param ctx host path get_params p tp =
 			(* check against direct recursion *)
 			let rec loop t =
 				match follow t with
-				| TInst (c2,_) when c == c2 -> typing_error "Recursive constraint parameter is not allowed" p
+				| TInst (c2,_) when c == c2 -> raise_typing_error "Recursive constraint parameter is not allowed" p
 				| TInst ({ cl_kind = KTypeParameter cl },_) ->
 					List.iter loop cl
 				| _ ->
@@ -844,17 +847,18 @@ let init_core_api ctx c =
 					List.iter2 (fun t1 t2 -> type_eq EqCoreType t2 t1) l1 l2
 				with
 					| Invalid_argument _ ->
-						typing_error "Type parameters must have the same number of constraints as core type" c.cl_pos
+						raise_typing_error "Type parameters must have the same number of constraints as core type" c.cl_pos
 					| Unify_error l ->
+						(* TODO send as one call with sub errors *)
 						display_error ctx.com ("Type parameter " ^ tp2.ttp_name ^ " has different constraint than in core type") c.cl_pos;
-						located_display_error ctx.com (error_msg c.cl_pos (Unify l));
+						display_error ctx.com (error_msg (Unify l)) c.cl_pos;
 				end
 			| t1,t2 ->
 				Printf.printf "%s %s" (s_type (print_context()) t1) (s_type (print_context()) t2);
 				die "" __LOC__
 		) ccore.cl_params c.cl_params;
 	with Invalid_argument _ ->
-		typing_error "Class must have the same number of type parameters as core type" c.cl_pos
+		raise_typing_error "Class must have the same number of type parameters as core type" c.cl_pos
 	end;
 	(match c.cl_doc with
 	| None -> c.cl_doc <- ccore.cl_doc
@@ -864,9 +868,10 @@ let init_core_api ctx c =
 		(try
 			type_eq EqCoreType (apply_params ccore.cl_params (extract_param_types c.cl_params) f.cf_type) f2.cf_type
 		with Unify_error l ->
+			(* TODO send as one call with sub errors *)
 			display_error ctx.com ("Field " ^ f.cf_name ^ " has different type than in core type") p;
-			located_display_error ctx.com (error_msg p (Unify l)));
-		if (has_class_field_flag f2 CfPublic) <> (has_class_field_flag f CfPublic) then typing_error ("Field " ^ f.cf_name ^ " has different visibility than core type") p;
+			display_error ctx.com (error_msg (Unify l)) p);
+		if (has_class_field_flag f2 CfPublic) <> (has_class_field_flag f CfPublic) then raise_typing_error ("Field " ^ f.cf_name ^ " has different visibility than core type") p;
 		(match f2.cf_doc with
 		| None -> f2.cf_doc <- f.cf_doc
 		| Some _ -> ());
@@ -875,25 +880,25 @@ let init_core_api ctx c =
 			| Method MethInline, Method MethNormal -> () (* allow to add 'inline' *)
 			| Method MethNormal, Method MethInline -> () (* allow to disable 'inline' *)
 			| _ ->
-				typing_error ("Field " ^ f.cf_name ^ " has different property access than core type") p;
+				raise_typing_error ("Field " ^ f.cf_name ^ " has different property access than core type") p;
 		end;
 		(match follow f.cf_type, follow f2.cf_type with
 		| TFun (pl1,_), TFun (pl2,_) ->
-			if List.length pl1 != List.length pl2 then typing_error "Argument count mismatch" p;
+			if List.length pl1 != List.length pl2 then raise_typing_error "Argument count mismatch" p;
 			List.iter2 (fun (n1,_,_) (n2,_,_) ->
-				if n1 <> n2 then typing_error ("Method parameter name '" ^ n2 ^ "' should be '" ^ n1 ^ "'") p;
+				if n1 <> n2 then raise_typing_error ("Method parameter name '" ^ n2 ^ "' should be '" ^ n1 ^ "'") p;
 			) pl1 pl2;
 		| _ -> ());
 	in
 	let check_fields fcore fl =
 		PMap.iter (fun i f ->
 			if not (has_class_field_flag f CfPublic) then () else
-			let f2 = try PMap.find f.cf_name fl with Not_found -> typing_error ("Missing field " ^ i ^ " required by core type") c.cl_pos in
+			let f2 = try PMap.find f.cf_name fl with Not_found -> raise_typing_error ("Missing field " ^ i ^ " required by core type") c.cl_pos in
 			compare_fields f f2;
 		) fcore;
 		PMap.iter (fun i f ->
 			let p = (match f.cf_expr with None -> c.cl_pos | Some e -> e.epos) in
-			if (has_class_field_flag f CfPublic) && not (Meta.has Meta.Hack f.cf_meta) && not (PMap.mem f.cf_name fcore) && not (has_class_field_flag f CfOverride) then typing_error ("Public field " ^ i ^ " is not part of core type") p;
+			if (has_class_field_flag f CfPublic) && not (Meta.has Meta.Hack f.cf_meta) && not (PMap.mem f.cf_name fcore) && not (has_class_field_flag f CfOverride) then raise_typing_error ("Public field " ^ i ^ " is not part of core type") p;
 		) fl;
 	in
 	check_fields ccore.cl_fields c.cl_fields;
@@ -903,8 +908,8 @@ let init_core_api ctx c =
 	| Some cf, _ when not (has_class_field_flag cf CfPublic) -> ()
 	| Some f, Some f2 -> compare_fields f f2
 	| None, Some cf when not (has_class_field_flag cf CfPublic) -> ()
-	| _ -> typing_error "Constructor differs from core type" c.cl_pos)
+	| _ -> raise_typing_error "Constructor differs from core type" c.cl_pos)
 
 let string_list_of_expr_path (e,p) =
 	try string_list_of_expr_path_raise (e,p)
-	with Exit -> typing_error "Invalid path" p
+	with Exit -> raise_typing_error "Invalid path" p

+ 25 - 21
src/typing/typeloadCheck.ml

@@ -148,10 +148,11 @@ let get_native_name meta =
 	| [] ->
 		raise Not_found
 	| _ ->
-		typing_error "String expected" mp
+		raise_typing_error "String expected" mp
 
 let check_native_name_override ctx child base =
 	let error base_pos child_pos =
+		(* TODO construct error *)
 		display_error ctx.com ("Field " ^ child.cf_name ^ " has different @:native value than in superclass") child_pos;
 		display_error ~depth:1 ctx.com (compl_msg "Base field is defined here") base_pos
 	in
@@ -211,9 +212,10 @@ let check_overriding ctx c f =
 				valid_redefinition ctx map map f f.cf_type f2 t;
 			with
 				Unify_error l ->
+					(* TODO construct error with sub *)
 					display_error ctx.com ("Field " ^ i ^ " overrides parent class with different or incomplete type") p;
 					display_error ~depth:1 ctx.com (compl_msg "Base field is defined here") f2.cf_name_pos;
-					located_display_error ~depth:1 ctx.com (compl_located_msg (error_msg p (Unify l)));
+					display_error ~depth:1 ctx.com (compl_msg (error_msg (Unify l))) p;
 		with
 			Not_found ->
 				if has_class_field_flag f CfOverride then
@@ -318,12 +320,12 @@ let check_module_types ctx m p t =
 	let t = t_infos t in
 	try
 		let path2 = ctx.com.type_to_module#find t.mt_path in
-		if m.m_path <> path2 && String.lowercase (s_type_path path2) = String.lowercase (s_type_path m.m_path) then typing_error ("Module " ^ s_type_path path2 ^ " is loaded with a different case than " ^ s_type_path m.m_path) p;
+		if m.m_path <> path2 && String.lowercase (s_type_path path2) = String.lowercase (s_type_path m.m_path) then raise_typing_error ("Module " ^ s_type_path path2 ^ " is loaded with a different case than " ^ s_type_path m.m_path) p;
 		let m2 = ctx.com.module_lut#find path2 in
 		let hex1 = Digest.to_hex m.m_extra.m_sign in
 		let hex2 = Digest.to_hex m2.m_extra.m_sign in
 		let s = if hex1 = hex2 then hex1 else Printf.sprintf "was %s, is %s" hex2 hex1 in
-		typing_error (Printf.sprintf "Type name %s is redefined from module %s (%s)" (s_type_path t.mt_path)  (s_type_path path2) s) p
+		raise_typing_error (Printf.sprintf "Type name %s is redefined from module %s (%s)" (s_type_path t.mt_path)  (s_type_path path2) s) p
 	with
 		Not_found ->
 			ctx.com.type_to_module#add t.mt_path m.m_path
@@ -335,15 +337,15 @@ module Inheritance = struct
 
 	let check_extends ctx c t p = match follow t with
 		| TInst (csup,params) ->
-			if is_basic_class_path csup.cl_path && not ((has_class_flag c CExtern) && (has_class_flag csup CExtern)) then typing_error "Cannot extend basic class" p;
-			if extends csup c then typing_error "Recursive class" p;
+			if is_basic_class_path csup.cl_path && not ((has_class_flag c CExtern) && (has_class_flag csup CExtern)) then raise_typing_error "Cannot extend basic class" p;
+			if extends csup c then raise_typing_error "Recursive class" p;
 			begin match csup.cl_kind with
 				| KTypeParameter _ ->
-					if is_generic_parameter ctx csup then typing_error "Extending generic type parameters is no longer allowed in Haxe 4" p;
-					typing_error "Cannot extend type parameters" p
+					if is_generic_parameter ctx csup then raise_typing_error "Extending generic type parameters is no longer allowed in Haxe 4" p;
+					raise_typing_error "Cannot extend type parameters" p
 				| _ -> csup,params
 			end
-		| t -> typing_error (Printf.sprintf "Should extend by using a class, found %s" (s_type_kind t)) p
+		| t -> raise_typing_error (Printf.sprintf "Should extend by using a class, found %s" (s_type_kind t)) p
 
 	let rec check_interface ctx missing c intf params =
 		List.iter (fun (i2,p2) ->
@@ -396,9 +398,10 @@ module Inheritance = struct
 					with
 						Unify_error l ->
 							if not (Meta.has Meta.CsNative c.cl_meta && (has_class_flag c CExtern)) then begin
+								(* TODO construct error with sub *)
 								display_error ctx.com ("Field " ^ f.cf_name ^ " has different type than in " ^ s_type_path intf.cl_path) p;
 								display_error ~depth:1 ctx.com (compl_msg "Interface field is defined here") f.cf_pos;
-								located_display_error ~depth:1 ctx.com (compl_located_msg (error_msg p (Unify l)));
+								display_error ~depth:1 ctx.com (compl_msg (error_msg (Unify l))) p;
 							end
 				)
 			with Not_found ->
@@ -489,6 +492,7 @@ module Inheritance = struct
 		| l ->
 			let singular = match l with [_] -> true | _ -> false in
 			display_error ctx.com (Printf.sprintf "This class extends abstract class %s but doesn't implement the following method%s" (s_type_path csup.cl_path) (if singular then "" else "s")) c.cl_name_pos;
+			(* TODO sub error ? *)
 			display_error ctx.com (Printf.sprintf "Implement %s or make %s abstract as well" (if singular then "it" else "them") (s_type_path c.cl_path)) c.cl_name_pos;
 			let pctx = print_context() in
 			List.iter (fun (cf,_) ->
@@ -512,7 +516,7 @@ module Inheritance = struct
 				| _ -> ()
 			) csup.cl_meta;
 			if has_class_flag csup CFinal && not (((has_class_flag csup CExtern) && Meta.has Meta.Hack c.cl_meta) || (match c.cl_kind with KTypeParameter _ -> true | _ -> false)) then
-				typing_error ("Cannot extend a final " ^ if (has_class_flag c CInterface) then "interface" else "class") p;
+				raise_typing_error ("Cannot extend a final " ^ if (has_class_flag c CInterface) then "interface" else "class") p;
 		in
 		let check_cancel_build csup =
 			match csup.cl_build() with
@@ -565,17 +569,17 @@ module Inheritance = struct
 					check_interfaces ctx c
 			in
 			if is_extends then begin
-				if c.cl_super <> None then typing_error "Cannot extend several classes" p;
+				if c.cl_super <> None then raise_typing_error "Cannot extend several classes" p;
 				let csup,params = check_extends ctx c t p in
 				if (has_class_flag c CInterface) then begin
-					if not (has_class_flag csup CInterface) then typing_error "Cannot extend by using a class" p;
+					if not (has_class_flag csup CInterface) then raise_typing_error "Cannot extend by using a class" p;
 					c.cl_implements <- (csup,params) :: c.cl_implements;
 					if not !has_interf then begin
 						if not is_lib then delay ctx PConnectField check_interfaces_or_delay;
 						has_interf := true;
 					end
 				end else begin
-					if (has_class_flag csup CInterface) then typing_error "Cannot extend by using an interface" p;
+					if (has_class_flag csup CInterface) then raise_typing_error "Cannot extend by using an interface" p;
 					c.cl_super <- Some (csup,params)
 				end;
 				(fun () ->
@@ -584,13 +588,13 @@ module Inheritance = struct
 				)
 			end else begin match follow t with
 				| TInst ({ cl_path = [],"ArrayAccess" } as ca,[t]) when (has_class_flag ca CExtern) ->
-					if c.cl_array_access <> None then typing_error "Duplicate array access" p;
+					if c.cl_array_access <> None then raise_typing_error "Duplicate array access" p;
 					c.cl_array_access <- Some t;
 					(fun () -> ())
 				| TInst (intf,params) ->
-					if extends intf c then typing_error "Recursive class" p;
-					if (has_class_flag c CInterface) then typing_error "Interfaces cannot implement another interface (use extends instead)" p;
-					if not (has_class_flag intf CInterface) then typing_error "You can only implement an interface" p;
+					if extends intf c then raise_typing_error "Recursive class" p;
+					if (has_class_flag c CInterface) then raise_typing_error "Interfaces cannot implement another interface (use extends instead)" p;
+					if not (has_class_flag intf CInterface) then raise_typing_error "You can only implement an interface" p;
 					c.cl_implements <- (intf, params) :: c.cl_implements;
 					if not !has_interf && not is_lib && not (Meta.has (Meta.Custom "$do_not_check_interf") c.cl_meta) then begin
 						delay ctx PConnectField check_interfaces_or_delay;
@@ -601,12 +605,12 @@ module Inheritance = struct
 						process_meta intf;
 					)
 				| TDynamic t ->
-					if c.cl_dynamic <> None then typing_error "Cannot have several dynamics" p;
+					if c.cl_dynamic <> None then raise_typing_error "Cannot have several dynamics" p;
 					if not (has_class_flag c CExtern) then display_error ctx.com "In haxe 4, implements Dynamic is only supported on externs" p;
 					c.cl_dynamic <- Some (match t with None -> t_dynamic | Some t -> t);
 					(fun () -> ())
 				| _ ->
-					typing_error "Should implement by using an interface" p
+					raise_typing_error "Should implement by using an interface" p
 			end
 		in
 		let fl = ExtList.List.filter_map (fun (is_extends,(ct,p)) ->
@@ -627,7 +631,7 @@ module Inheritance = struct
 					raise_fields l (if is_extends then CRExtends else CRImplements) r.fsubject
 				in
 				Some (check_herit t is_extends p)
-			with Error(Module_not_found(([],name)),p,_) when ctx.com.display.dms_kind <> DMNone ->
+			with Error { err_message = Module_not_found(([],name)); err_pos = p } when ctx.com.display.dms_kind <> DMNone ->
 				if Diagnostics.error_in_diagnostics_run ctx.com p then DisplayToplevel.handle_unresolved_identifier ctx name p true;
 				None
 		) herits in

+ 48 - 48
src/typing/typeloadFields.ml

@@ -271,20 +271,20 @@ let transform_abstract_field com this_t a_t a f =
 	| FProp ((("get" | "never"),_),(("set" | "never"),_),_,_) when not stat ->
 		f
 	| FProp _ when not stat && not (Meta.has Meta.Enum f.cff_meta) ->
-		typing_error "Member property accessors must be get/set or never" p;
+		raise_typing_error "Member property accessors must be get/set or never" p;
 	| FFun fu when fst f.cff_name = "new" && not stat ->
 		let init p = (EVars [mk_evar ~t:this_t ~meta:([Meta.This,[],null_pos]) ("this",null_pos)],p) in
 		let cast e = (ECast(e,None)),pos e in
 		let ret p = (EReturn (Some (cast (EConst (Ident "this"),p))),p) in
 		let meta = (Meta.NoCompletion,[],null_pos) :: f.cff_meta in
 		if Meta.has Meta.MultiType a.a_meta then begin
-			if List.mem_assoc AInline f.cff_access then typing_error "inline on MultiType constructor" f.cff_pos;
+			if List.mem_assoc AInline f.cff_access then raise_typing_error "inline on MultiType constructor" f.cff_pos;
 			if fu.f_expr <> None then display_error com "MultiType constructors cannot have a body" f.cff_pos;
 			f.cff_access <- (AExtern,null_pos) :: f.cff_access;
 		end;
 		(try
 			let _, p = List.find (fun (acc, _) -> acc = AMacro) f.cff_access in
-			typing_error "Invalid modifier: macro on abstract constructor" p
+			raise_typing_error "Invalid modifier: macro on abstract constructor" p
 		with Not_found -> ());
 		(* We don't want the generated expression positions to shadow the real code. *)
 		let p = { p with pmax = p.pmin } in
@@ -299,7 +299,7 @@ let transform_abstract_field com this_t a_t a f =
 		} in
 		{ f with cff_name = "_new",pos f.cff_name; cff_kind = FFun fu; cff_meta = meta }
 	| FFun fu when not stat ->
-		if Meta.has Meta.From f.cff_meta then typing_error "@:from cast functions must be static" f.cff_pos;
+		if Meta.has Meta.From f.cff_meta then raise_typing_error "@:from cast functions must be static" f.cff_pos;
 		{ f with cff_kind = FFun fu }
 	| _ ->
 		f
@@ -474,7 +474,7 @@ let build_enum_abstract ctx c a fields p =
 let apply_macro ctx mode path el p =
 	let cpath, meth = (match List.rev (ExtString.String.nsplit path ".") with
 		| meth :: name :: pack -> (List.rev pack,name), meth
-		| _ -> typing_error "Invalid macro path" p
+		| _ -> raise_typing_error "Invalid macro path" p
 	) in
 	ctx.g.do_macro ctx mode cpath meth el p
 
@@ -484,17 +484,17 @@ let build_module_def ctx mt meta fvars context_init fbuild =
 		| Meta.Build,args,p when not is_typedef -> (fun () ->
 				let epath, el = (match args with
 					| [ECall (epath,el),p] -> epath, el
-					| _ -> typing_error "Invalid build parameters" p
+					| _ -> raise_typing_error "Invalid build parameters" p
 				) in
-				let s = try String.concat "." (List.rev (string_list_of_expr_path epath)) with Error (_,p,depth) -> typing_error ~depth "Build call parameter must be a class path" p in
-				if ctx.com.is_macro_context then typing_error "You cannot use @:build inside a macro : make sure that your type is not used in macro" p;
+				let s = try String.concat "." (List.rev (string_list_of_expr_path epath)) with Error { err_pos = p } -> raise_typing_error "Build call parameter must be a class path" p in
+				if ctx.com.is_macro_context then raise_typing_error "You cannot use @:build inside a macro : make sure that your type is not used in macro" p;
 				let old = ctx.get_build_infos in
 				ctx.get_build_infos <- (fun() -> Some (mt, extract_param_types (t_infos mt).mt_params, fvars()));
 				context_init#run;
 				let r = try apply_macro ctx MBuild s el p with e -> ctx.get_build_infos <- old; raise e in
 				ctx.get_build_infos <- old;
 				(match r with
-				| None -> typing_error "Build failure" p
+				| None -> raise_typing_error "Build failure" p
 				| Some e -> fbuild e)
 			) :: f_build
 		| Meta.Using,el,p -> (fun () ->
@@ -512,7 +512,7 @@ let build_module_def ctx mt meta fvars context_init fbuild =
 						ti.mt_using <- (filter_classes types) @ ti.mt_using
 					)
 				with Exit ->
-					typing_error "dot path expected" (pos e)
+					raise_typing_error "dot path expected" (pos e)
 			) el;
 		) :: f_build
 		| _ ->
@@ -718,7 +718,7 @@ let transform_field (ctx,cctx) c f fields p =
 		| Some (_,mctx) when mctx.com.type_to_module#mem c.cl_path ->
 			(* assume that if we had already a macro with the same name, it has not been changed during the @:build operation *)
 			if not (List.exists (fun f2 -> f2.cff_name = f.cff_name && List.mem_assoc AMacro f2.cff_access) (!fields)) then
-				typing_error "Class build macro cannot return a macro function when the class has already been compiled into the macro context" p
+				raise_typing_error "Class build macro cannot return a macro function when the class has already been compiled into the macro context" p
 		| _ -> ());
 	f
 
@@ -745,7 +745,7 @@ let build_fields (ctx,cctx) c fields =
 		| EVars [{ ev_type = Some (CTAnonymous f,p); ev_expr = None }] ->
 			let f = List.map (fun f -> transform_field (ctx,cctx) c f fields p) f in
 			fields := f
-		| _ -> typing_error "Class build macro must return a single variable with anonymous fields" p
+		| _ -> raise_typing_error "Class build macro must return a single variable with anonymous fields" p
 	);
 	c.cl_build <- (fun() -> Building [c]);
 	List.iter (fun f -> f()) !pending;
@@ -1015,7 +1015,7 @@ let load_variable_type_hint ctx fctx eo p = function
 
 let create_variable (ctx,cctx,fctx) c f t eo p =
 	let is_abstract_enum_field = Meta.has Meta.Enum f.cff_meta in
-	if fctx.is_abstract_member && not is_abstract_enum_field then typing_error "Cannot declare member variable in abstract" p;
+	if fctx.is_abstract_member && not is_abstract_enum_field then raise_typing_error "Cannot declare member variable in abstract" p;
 	if fctx.is_inline && not fctx.is_static then invalid_modifier ctx.com fctx "inline" "non-static variable" p;
 	if fctx.is_inline && eo = None then missing_expression ctx.com fctx "Inline variable must be initialized" p;
 	let missing_initialization =
@@ -1071,11 +1071,11 @@ let check_abstract (ctx,cctx,fctx) c cf fd t ret p =
 					let r = exc_protect ctx (fun r ->
 						r := lazy_processing (fun () -> t);
 						(* the return type of a from-function must be the abstract, not the underlying type *)
-						if not fctx.is_macro then (try type_eq EqStrict ret ta with Unify_error l -> located_typing_error (error_msg p (Unify l)));
+						if not fctx.is_macro then (try type_eq EqStrict ret ta with Unify_error l -> raise_typing_error_ext (make_error (Unify l) p));
 						match t with
 							| TFun([_,_,t],_) -> t
 							| TFun([(_,_,t1);(_,true,t2)],_) when is_pos_infos t2 -> t1
-							| _ -> typing_error ("@:from cast functions must accept exactly one argument") p
+							| _ -> raise_typing_error ("@:from cast functions must accept exactly one argument") p
 					) "@:from" in
 					a.a_from_field <- (TLazy r,cf) :: a.a_from_field;
 				| (Meta.To,_,_) :: _ ->
@@ -1088,19 +1088,19 @@ let check_abstract (ctx,cctx,fctx) c cf fd t ret p =
 					in
 					(match cf.cf_kind, cf.cf_type with
 					| Var _, _ ->
-						typing_error "Invalid metadata: @:to must be used on method of abstract" p
+						raise_typing_error "Invalid metadata: @:to must be used on method of abstract" p
 					| Method _, TFun(args, _) when not fctx.is_abstract_member && not (are_valid_args args) ->
 						if not (Meta.has Meta.MultiType a.a_meta) then (* TODO: get rid of this check once multitype is removed *)
-						typing_error "static @:to method should have one argument" p
+						raise_typing_error "static @:to method should have one argument" p
 					| Method _, TFun(args, _) when fctx.is_abstract_member && not (are_valid_args args) ->
 						if not (Meta.has Meta.MultiType a.a_meta) then (* TODO: get rid of this check once multitype is removed *)
-						typing_error "@:to method should have no arguments" p
+						raise_typing_error "@:to method should have no arguments" p
 					| _ -> ()
 					);
 					(* TODO: this doesn't seem quite right... *)
 					if not (has_class_field_flag cf CfImpl) then add_class_field_flag cf CfImpl;
 					let resolve_m args =
-						(try unify_raise t (tfun (tthis :: args) m) cf.cf_pos with Error (Unify l,p,depth) -> located_typing_error ~depth (error_msg p (Unify l)));
+						(try unify_raise t (tfun (tthis :: args) m) cf.cf_pos with Error ({ err_message = Unify l; } as err) -> raise_typing_error_ext err);
 						match follow m with
 							| TMono _ when (match t with TFun(_,r) -> r == t_dynamic | _ -> false) -> t_dynamic
 							| m -> m
@@ -1114,7 +1114,7 @@ let check_abstract (ctx,cctx,fctx) c cf fd t ret p =
 							let ctor = try
 								PMap.find "_new" c.cl_statics
 							with Not_found ->
-								typing_error "Constructor of multi-type abstract must be defined before the individual @:to-functions are" cf.cf_pos
+								raise_typing_error "Constructor of multi-type abstract must be defined before the individual @:to-functions are" cf.cf_pos
 							in
 							(* delay ctx PFinal (fun () -> unify ctx m tthis f.cff_pos); *)
 							let args = match follow (monomorphs a.a_params ctor.cf_type) with
@@ -1136,12 +1136,12 @@ let check_abstract (ctx,cctx,fctx) c cf fd t ret p =
 					a.a_array <- cf :: a.a_array;
 					allow_no_expr();
 				| (Meta.Op,[EBinop(OpAssign,_,_),_],_) :: _ ->
-					typing_error "Assignment overloading is not supported" p;
+					raise_typing_error "Assignment overloading is not supported" p;
 				| (Meta.Op,[EBinop(OpAssignOp OpNullCoal,_,_),_],_) :: _
 				| (Meta.Op,[EBinop(OpNullCoal,_,_),_],_) :: _ ->
-					typing_error "Null coalescing overloading is not supported" p;
+					raise_typing_error "Null coalescing overloading is not supported" p;
 				| (Meta.Op,[ETernary(_,_,_),_],_) :: _ ->
-					typing_error "Ternary overloading is not supported" p;
+					raise_typing_error "Ternary overloading is not supported" p;
 				| (Meta.Op,[EBinop(op,_,_),_],_) :: _ ->
 					if fctx.is_macro then invalid_modifier ctx.com fctx "macro" "operator function" p;
 					let targ = if fctx.is_abstract_member then tthis else ta in
@@ -1153,18 +1153,18 @@ let check_abstract (ctx,cctx,fctx) c cf fd t ret p =
 							type_iseq targ t1,type_iseq targ t2
 						| _ ->
 							if fctx.is_abstract_member then
-								typing_error ("Member @:op functions must accept exactly one argument") cf.cf_pos
+								raise_typing_error ("Member @:op functions must accept exactly one argument") cf.cf_pos
 							else
-								typing_error ("Static @:op functions must accept exactly two arguments") cf.cf_pos
+								raise_typing_error ("Static @:op functions must accept exactly two arguments") cf.cf_pos
 					in
-					if not (left_eq || right_eq) then typing_error ("The left or right argument type must be " ^ (s_type (print_context()) targ)) cf.cf_pos;
-					if right_eq && Meta.has Meta.Commutative cf.cf_meta then typing_error ("Invalid metadata: @:commutative is only allowed if the right argument is not " ^ (s_type (print_context()) targ)) cf.cf_pos;
+					if not (left_eq || right_eq) then raise_typing_error ("The left or right argument type must be " ^ (s_type (print_context()) targ)) cf.cf_pos;
+					if right_eq && Meta.has Meta.Commutative cf.cf_meta then raise_typing_error ("Invalid metadata: @:commutative is only allowed if the right argument is not " ^ (s_type (print_context()) targ)) cf.cf_pos;
 					a.a_ops <- (op,cf) :: a.a_ops;
 					allow_no_expr();
 				| (Meta.Op,[EUnop(op,flag,_),_],_) :: _ ->
 					if fctx.is_macro then invalid_modifier ctx.com fctx "macro" "operator function" p;
 					let targ = if fctx.is_abstract_member then tthis else ta in
-					(try type_eq EqStrict t (tfun [targ] (mk_mono())) with Unify_error l -> raise (Error ((Unify l),cf.cf_pos,0)));
+					(try type_eq EqStrict t (tfun [targ] (mk_mono())) with Unify_error l -> raise_error_msg (Unify l) cf.cf_pos);
 					a.a_unops <- (op,flag,cf) :: a.a_unops;
 					allow_no_expr();
 				| (Meta.Op,[ECall _,_],_) :: _ ->
@@ -1179,21 +1179,21 @@ let check_abstract (ctx,cctx,fctx) c cf fd t ret p =
 					let targ = if fctx.is_abstract_member then tthis else ta in
 					let check_fun t1 t2 =
 						if not fctx.is_macro then begin
-							if not (type_iseq targ t1) then typing_error ("First argument type must be " ^ (s_type (print_context()) targ)) cf.cf_pos;
-							if not (type_iseq ctx.t.tstring t2) then typing_error ("Second argument type must be String") cf.cf_pos
+							if not (type_iseq targ t1) then raise_typing_error ("First argument type must be " ^ (s_type (print_context()) targ)) cf.cf_pos;
+							if not (type_iseq ctx.t.tstring t2) then raise_typing_error ("Second argument type must be String") cf.cf_pos
 						end
 					in
 					begin match follow t with
 						| TFun((_,_,t1) :: (_,_,t2) :: args,_) when is_empty_or_pos_infos args ->
-							if a.a_read <> None then typing_error "Multiple resolve-read methods are not supported" cf.cf_pos;
+							if a.a_read <> None then raise_typing_error "Multiple resolve-read methods are not supported" cf.cf_pos;
 							check_fun t1 t2;
 							a.a_read <- Some cf;
 						| TFun((_,_,t1) :: (_,_,t2) :: (_,_,t3) :: args,_) when is_empty_or_pos_infos args ->
-							if a.a_write <> None then typing_error "Multiple resolve-write methods are not supported" cf.cf_pos;
+							if a.a_write <> None then raise_typing_error "Multiple resolve-write methods are not supported" cf.cf_pos;
 							check_fun t1 t2;
 							a.a_write <- Some cf;
 						| _ ->
-							typing_error ("Field type of resolve must be " ^ (s_type (print_context()) targ) ^ " -> String -> T") cf.cf_pos
+							raise_typing_error ("Field type of resolve must be " ^ (s_type (print_context()) targ) ^ " -> String -> T") cf.cf_pos
 					end;
 				| _ -> ());
 				match ml with
@@ -1204,7 +1204,7 @@ let check_abstract (ctx,cctx,fctx) c cf fd t ret p =
 			if cf.cf_name = "_new" && Meta.has Meta.MultiType a.a_meta then fctx.do_bind <- false;
 			if fd.f_expr = None then begin
 				if fctx.is_inline then missing_expression ctx.com fctx "Inline functions must have an expression" cf.cf_pos;
-				if fd.f_type = None then typing_error ("Functions without expressions must have an explicit return type") cf.cf_pos;
+				if fd.f_type = None then raise_typing_error ("Functions without expressions must have an explicit return type") cf.cf_pos;
 				if !allows_no_expr then begin
 					cf.cf_meta <- (Meta.NoExpr,[],null_pos) :: cf.cf_meta;
 					fctx.do_bind <- false;
@@ -1296,7 +1296,7 @@ let create_method (ctx,cctx,fctx) c f fd p =
 	let name = fst f.cff_name in
 	let params = TypeloadFunction.type_function_params ctx fd name p in
 	if fctx.is_generic then begin
-		if params = [] then typing_error "Generic functions must have type parameters" p;
+		if params = [] then raise_typing_error "Generic functions must have type parameters" p;
 	end;
 	let fd = if fctx.is_macro && not ctx.com.is_macro_context && not fctx.is_static then
 		(* remove display of first argument which will contain the "this" expression *)
@@ -1328,7 +1328,7 @@ let create_method (ctx,cctx,fctx) c f fd p =
 			let to_dyn p t = match t with
 				| { tpackage = ["haxe";"macro"]; tname = "Expr"; tsub = Some ("ExprOf"); tparams = [TPType t] } -> Some t
 				| { tpackage = []; tname = ("ExprOf"); tsub = None; tparams = [TPType t] } -> Some t
-				| { tpackage = ["haxe"]; tname = ("PosInfos"); tsub = None; tparams = [] } -> typing_error "haxe.PosInfos is not allowed on macro functions, use Context.currentPos() instead" p
+				| { tpackage = ["haxe"]; tname = ("PosInfos"); tsub = None; tparams = [] } -> raise_typing_error "haxe.PosInfos is not allowed on macro functions, use Context.currentPos() instead" p
 				| _ -> tdyn
 			in
 			{
@@ -1340,7 +1340,7 @@ let create_method (ctx,cctx,fctx) c f fd p =
 	end in
 	begin match (has_class_flag c CInterface),fctx.field_kind with
 		| true,FKConstructor ->
-			typing_error "An interface cannot have a constructor" p;
+			raise_typing_error "An interface cannot have a constructor" p;
 		| true,_ ->
 			if not fctx.is_static && fd.f_expr <> None then unexpected_expression ctx.com fctx ("An interface method cannot have a body") p;
 			if fctx.is_inline && (has_class_flag c CInterface) then invalid_modifier ctx.com fctx "inline" "method of interface" p;
@@ -1351,7 +1351,7 @@ let create_method (ctx,cctx,fctx) c f fd p =
 				| Some (CTPath ({ tpackage = []; tname = "Void" } as tp),p) ->
 					if ctx.is_display_file && DisplayPosition.display_position#enclosed_in p then
 						ignore(load_instance ~allow_display:true ctx (tp,p) false);
-				| _ -> typing_error "A class constructor can't have a return type" p;
+				| _ -> raise_typing_error "A class constructor can't have a return type" p;
 			end
 		| false,_ ->
 			()
@@ -1455,13 +1455,13 @@ let create_property (ctx,cctx,fctx) c f (get,set,t,eo) p =
 	let name = fst f.cff_name in
 	(* TODO is_lib: lazify load_complex_type *)
 	let ret = (match t, eo with
-		| None, None -> typing_error "Property requires type-hint or initialization" p;
+		| None, None -> raise_typing_error "Property requires type-hint or initialization" p;
 		| None, _ -> mk_mono()
 		| Some t, _ -> lazy_display_type ctx (fun () -> load_type_hint ctx p (Some t))
 	) in
 	let t_get,t_set = match cctx.abstract with
 		| Some a when fctx.is_abstract_member ->
-			if Meta.has Meta.IsVar f.cff_meta then typing_error "Abstract properties cannot be real variables" f.cff_pos;
+			if Meta.has Meta.IsVar f.cff_meta then raise_typing_error "Abstract properties cannot be real variables" f.cff_pos;
 			let ta = apply_params a.a_params (extract_param_types a.a_params) a.a_this in
 			tfun [ta] ret, tfun [ta;ret] ret
 		| _ -> tfun [] ret, TFun(["value",false,ret],ret)
@@ -1511,8 +1511,8 @@ let create_property (ctx,cctx,fctx) c f (get,set,t,eo) p =
 					unify_raise t2 t f2.cf_pos;
 					if (fctx.is_abstract_member && not (has_class_field_flag f2 CfImpl)) || (has_class_field_flag f2 CfImpl && not (fctx.is_abstract_member)) then
 						display_error ctx.com "Mixing abstract implementation and static properties/accessors is not allowed" f2.cf_pos;
-				with Error (Unify l,p,depth) ->
-					raise (Error (Stack [(Custom ("In method " ^ m ^ " required by property " ^ name),p);(Unify l,p)],p,depth+1))
+				with Error ({ err_message = Unify _ } as err) ->
+					raise_error (make_error ~sub:[err] (Custom ("In method " ^ m ^ " required by property " ^ name)) err.err_pos)
 			)
 		with
 			| Not_found ->
@@ -1587,7 +1587,7 @@ let create_property (ctx,cctx,fctx) c f (get,set,t,eo) p =
 			display_error ctx.com (name ^ ": Custom property accessor is no longer supported, please use `set`") pset;
 			AccCall
 	) in
-	if (set = AccNever && get = AccNever)  then typing_error (name ^ ": Unsupported property combination") p;
+	if (set = AccNever && get = AccNever)  then raise_typing_error (name ^ ": Unsupported property combination") p;
 	cf.cf_kind <- Var { v_read = get; v_write = set };
 	if fctx.is_extern then add_class_field_flag cf CfExtern;
 	if Meta.has Meta.Enum cf.cf_meta then add_class_field_flag cf CfEnum;
@@ -1777,7 +1777,7 @@ let init_class ctx c p context_init herits fields =
 	in
 	let rec check_if_feature = function
 		| [] -> []
-		| (Meta.IfFeature,el,_) :: _ -> List.map (fun (e,p) -> match e with EConst (String(s,_)) -> s | _ -> typing_error "String expected" p) el
+		| (Meta.IfFeature,el,_) :: _ -> List.map (fun (e,p) -> match e with EConst (String(s,_)) -> s | _ -> raise_typing_error "String expected" p) el
 		| _ :: l -> check_if_feature l
 	in
 	let cl_if_feature = check_if_feature c.cl_meta in
@@ -1799,7 +1799,7 @@ let init_class ctx c p context_init herits fields =
 			end;
 			if fctx.is_field_debug then print_endline ("Created field: " ^ Printer.s_tclass_field "" cf);
 			if fctx.is_static && (has_class_flag c CInterface) && fctx.field_kind <> FKInit && not cctx.is_lib && not ((has_class_flag c CExtern)) then
-				typing_error "You can only declare static fields in extern interfaces" p;
+				raise_typing_error "You can only declare static fields in extern interfaces" p;
 			let set_feature s =
 				ctx.m.curmod.m_extra.m_if_feature <- (s,(c,cf,fctx.is_static)) :: ctx.m.curmod.m_extra.m_if_feature
 			in
@@ -1832,7 +1832,7 @@ let init_class ctx c p context_init herits fields =
 				()
 			| FKNormal ->
 				let dup = if fctx.is_static then PMap.exists cf.cf_name c.cl_fields || has_field cf.cf_name c.cl_super else PMap.exists cf.cf_name c.cl_statics in
-				if not cctx.is_native && not (has_class_flag c CExtern) && dup then typing_error ("Same field name can't be used for both static and instance : " ^ cf.cf_name) p;
+				if not cctx.is_native && not (has_class_flag c CExtern) && dup then raise_typing_error ("Same field name can't be used for both static and instance : " ^ cf.cf_name) p;
 				if fctx.override <> None then
 					add_class_field_flag cf CfOverride;
 				let is_var cf = match cf.cf_kind with
@@ -1856,8 +1856,8 @@ let init_class ctx c p context_init herits fields =
 				else
 				if fctx.do_add then TClass.add_field c cf
 			end
-		with Error (Custom str,p2,depth) when p = p2 ->
-			display_error ~depth ctx.com str p
+		with Error ({ err_message = Custom _; err_pos = p2 } as err) when p = p2 ->
+			display_error_ext ctx.com err
 	) fields;
 		begin match cctx.abstract with
 		| Some a ->

+ 3 - 3
src/typing/typeloadFunction.ml

@@ -67,9 +67,9 @@ let type_function ctx (args : function_arguments) ret fmode e do_display p =
 				EBlock [],p
 			else
 				if fmode = FunMember && has_class_flag ctx.curclass CAbstract then
-					typing_error "Function body or abstract modifier required" p
+					raise_typing_error "Function body or abstract modifier required" p
 				else
-					typing_error "Function body required" p
+					raise_typing_error "Function body required" p
 		| Some e -> e
 	in
 	let is_position_debug = Meta.has (Meta.Custom ":debug.position") ctx.curfield.cf_meta in
@@ -259,4 +259,4 @@ let add_constructor ctx c force_constructor p =
 		(* nothing to do *)
 		()
 ;;
-Typeload.type_function_params_rec := type_function_params
+Typeload.type_function_params_rec := type_function_params

+ 28 - 30
src/typing/typeloadModule.ml

@@ -70,7 +70,7 @@ module ModuleLevel = struct
 			DeprecationCheck.check_is com meta [] name meta p;
 			let error prev_pos =
 				display_error ctx.com ("Name " ^ name ^ " is already defined in this module") p;
-				typing_error ~depth:1 (compl_msg "Previous declaration here") prev_pos;
+				raise_typing_error ~depth:1 (compl_msg "Previous declaration here") prev_pos;
 			in
 			List.iter (fun (t2,(_,p2)) ->
 				if snd (t_path t2) = name then error (t_infos t2).mt_name_pos
@@ -93,7 +93,7 @@ module ModuleLevel = struct
 			in
 			let acc = (match fst decl with
 			| EImport _ | EUsing _ ->
-				if !has_declaration then typing_error "import and using may not appear after a declaration" p;
+				if !has_declaration then raise_typing_error "import and using may not appear after a declaration" p;
 				acc
 			| EStatic d ->
 				check_name (fst d.d_name) d.d_meta false (snd d.d_name);
@@ -107,7 +107,7 @@ module ModuleLevel = struct
 				let path = make_path name priv d.d_meta (snd d.d_name) in
 				let c = mk_class m path p (pos d.d_name) in
 				(* we shouldn't load any other type until we propertly set cl_build *)
-				c.cl_build <- (fun() -> typing_error (s_type_path c.cl_path ^ " is not ready to be accessed, separate your type declarations in several files") p);
+				c.cl_build <- (fun() -> raise_typing_error (s_type_path c.cl_path ^ " is not ready to be accessed, separate your type declarations in several files") p);
 				c.cl_module <- m;
 				c.cl_private <- priv;
 				c.cl_doc <- d.d_doc;
@@ -131,7 +131,7 @@ module ModuleLevel = struct
 				has_declaration := true;
 				let priv = List.mem EPrivate d.d_flags in
 				let path = make_path name priv d.d_meta p in
-				if Meta.has (Meta.Custom ":fakeEnum") d.d_meta then typing_error "@:fakeEnum enums is no longer supported in Haxe 4, use extern enum abstract instead" p;
+				if Meta.has (Meta.Custom ":fakeEnum") d.d_meta then raise_typing_error "@:fakeEnum enums is no longer supported in Haxe 4, use extern enum abstract instead" p;
 				let e = {
 					e_path = path;
 					e_module = m;
@@ -304,7 +304,7 @@ module ModuleLevel = struct
 						| ParseSuccess(data,_,_) -> data
 						| ParseError(_,(msg,p),_) -> Parser.error msg p
 					in
-					List.iter (fun (d,p) -> match d with EImport _ | EUsing _ -> () | _ -> typing_error "Only import and using is allowed in import.hx files" p) r;
+					List.iter (fun (d,p) -> match d with EImport _ | EUsing _ -> () | _ -> raise_typing_error "Only import and using is allowed in import.hx files" p) r;
 					add_dependency m (make_import_module path r);
 					r
 				end else begin
@@ -326,7 +326,7 @@ module ModuleLevel = struct
 				c.cl_params <- type_type_params ctx TPHType c.cl_path (fun() -> c.cl_params) p d.d_params;
 				if Meta.has Meta.Generic c.cl_meta && c.cl_params <> [] then c.cl_kind <- KGeneric;
 				if Meta.has Meta.GenericBuild c.cl_meta then begin
-					if ctx.com.is_macro_context then typing_error "@:genericBuild cannot be used in macros" c.cl_pos;
+					if ctx.com.is_macro_context then raise_typing_error "@:genericBuild cannot be used in macros" c.cl_pos;
 					c.cl_kind <- KGenericBuild d.d_data;
 				end;
 				if c.cl_path = (["haxe";"macro"],"MacroType") then c.cl_kind <- KMacroType;
@@ -356,7 +356,7 @@ module TypeLevel = struct
 				| TEnum (te,_) when te == e ->
 					()
 				| _ ->
-					typing_error "Explicit enum type must be of the same enum type" pt);
+					raise_typing_error "Explicit enum type must be of the same enum type" pt);
 				t
 		) in
 		let t = (match c.ec_args with
@@ -365,8 +365,8 @@ module TypeLevel = struct
 				is_flat := false;
 				let pnames = ref PMap.empty in
 				TFun (List.map (fun (s,opt,(t,tp)) ->
-					(match t with CTPath({tpackage=[];tname="Void"}) -> typing_error "Arguments of type Void are not allowed in enum constructors" tp | _ -> ());
-					if PMap.mem s (!pnames) then typing_error ("Duplicate argument `" ^ s ^ "` in enum constructor " ^ fst c.ec_name) p;
+					(match t with CTPath({tpackage=[];tname="Void"}) -> raise_typing_error "Arguments of type Void are not allowed in enum constructors" tp | _ -> ());
+					if PMap.mem s (!pnames) then raise_typing_error ("Duplicate argument `" ^ s ^ "` in enum constructor " ^ fst c.ec_name) p;
 					pnames := PMap.add s () (!pnames);
 					s, opt, load_type_hint ~opt ctx p (Some (t,tp))
 				) l, rt)
@@ -426,7 +426,7 @@ module TypeLevel = struct
 					(match state with
 					| Built -> die "" __LOC__
 					| Building cl ->
-						if !build_count = !prev_build_count then typing_error ("Loop in class building prevent compiler termination (" ^ String.concat "," (List.map (fun c -> s_type_path c.cl_path) cl) ^ ")") c.cl_pos;
+						if !build_count = !prev_build_count then raise_typing_error ("Loop in class building prevent compiler termination (" ^ String.concat "," (List.map (fun c -> s_type_path c.cl_path) cl) ^ ")") c.cl_pos;
 						prev_build_count := !build_count;
 						rebuild();
 						Building (c :: cl)
@@ -472,7 +472,7 @@ module TypeLevel = struct
 		(match h with
 		| None -> ()
 		| Some (h,hcl) ->
-			Hashtbl.iter (fun _ _ -> typing_error "Field type patch not supported for enums" e.e_pos) h;
+			Hashtbl.iter (fun _ _ -> raise_typing_error "Field type patch not supported for enums" e.e_pos) h;
 			e.e_meta <- e.e_meta @ hcl.tp_meta);
 		let constructs = ref d.d_data in
 		let get_constructs() =
@@ -496,10 +496,10 @@ module TypeLevel = struct
 					let args, params, t = (match f.cff_kind with
 					| FVar (t,None) -> [], [], t
 					| FFun { f_params = pl; f_type = t; f_expr = (None|Some (EBlock [],_)); f_args = al } ->
-						let al = List.map (fun ((n,_),o,_,t,_) -> match t with None -> typing_error "Missing function parameter type" f.cff_pos | Some t -> n,o,t) al in
+						let al = List.map (fun ((n,_),o,_,t,_) -> match t with None -> raise_typing_error "Missing function parameter type" f.cff_pos | Some t -> n,o,t) al in
 						al, pl, t
 					| _ ->
-						typing_error "Invalid enum constructor in @:build result" p
+						raise_typing_error "Invalid enum constructor in @:build result" p
 					) in
 					{
 						ec_name = f.cff_name;
@@ -511,7 +511,7 @@ module TypeLevel = struct
 						ec_type = t;
 					}
 				) fields
-			| _ -> typing_error "Enum build macro must return a single variable with anonymous object fields" p
+			| _ -> raise_typing_error "Enum build macro must return a single variable with anonymous object fields" p
 		);
 		let et = TEnum (e,extract_param_types e.e_params) in
 		let names = ref [] in
@@ -519,7 +519,7 @@ module TypeLevel = struct
 		let is_flat = ref true in
 		let fields = ref PMap.empty in
 		List.iter (fun c ->
-			if PMap.mem (fst c.ec_name) e.e_constrs then typing_error ("Duplicate constructor " ^ fst c.ec_name) (pos c.ec_name);
+			if PMap.mem (fst c.ec_name) e.e_constrs then raise_typing_error ("Duplicate constructor " ^ fst c.ec_name) (pos c.ec_name);
 			let f,cf = load_enum_field ctx e et is_flat index c in
 			e.e_constrs <- PMap.add f.ef_name f e.e_constrs;
 			fields := PMap.add cf.cf_name cf !fields;
@@ -555,14 +555,14 @@ module TypeLevel = struct
 		| CTExtend _ -> tt
 		| CTPath { tpackage = ["haxe";"macro"]; tname = "MacroType" } ->
 			(* we need to follow MacroType immediately since it might define other module types that we will load afterwards *)
-			if t.t_type == follow tt then typing_error "Recursive typedef is not allowed" p;
+			if t.t_type == follow tt then raise_typing_error "Recursive typedef is not allowed" p;
 			tt
 		| _ ->
 			if (Meta.has Meta.Eager d.d_meta) then
 				follow tt
 			else begin
 				let rec check_rec tt =
-					if tt == t.t_type then typing_error "Recursive typedef is not allowed" p;
+					if tt == t.t_type then raise_typing_error "Recursive typedef is not allowed" p;
 					match tt with
 					| TMono r ->
 						(match r.tm_type with
@@ -571,7 +571,7 @@ module TypeLevel = struct
 					| TLazy f ->
 						check_rec (lazy_type f);
 					| TType (td,tl) ->
-						if td == t then typing_error "Recursive typedef is not allowed" p;
+						if td == t then raise_typing_error "Recursive typedef is not allowed" p;
 						check_rec (apply_typedef td tl)
 					| _ ->
 						()
@@ -610,15 +610,15 @@ module TypeLevel = struct
 				if !is_type then begin
 					let r = exc_protect ctx (fun r ->
 						r := lazy_processing (fun() -> t);
-						(try (if from then Type.unify t a.a_this else Type.unify a.a_this t) with Unify_error _ -> typing_error "You can only declare from/to with compatible types" pos);
+						(try (if from then Type.unify t a.a_this else Type.unify a.a_this t) with Unify_error _ -> raise_typing_error "You can only declare from/to with compatible types" pos);
 						t
 					) "constraint" in
 					TLazy r
 				end else
-					typing_error "Missing underlying type declaration or @:coreType declaration" p;
+					raise_typing_error "Missing underlying type declaration or @:coreType declaration" p;
 			end else begin
 				if Meta.has Meta.Callable a.a_meta then
-					typing_error "@:coreType abstracts cannot be @:callable" p;
+					raise_typing_error "@:coreType abstracts cannot be @:callable" p;
 				t
 			end in
 			t
@@ -627,15 +627,15 @@ module TypeLevel = struct
 			| AbFrom t -> a.a_from <- (load_type t true) :: a.a_from
 			| AbTo t -> a.a_to <- (load_type t false) :: a.a_to
 			| AbOver t ->
-				if a.a_impl = None then typing_error "Abstracts with underlying type must have an implementation" a.a_pos;
-				if Meta.has Meta.CoreType a.a_meta then typing_error "@:coreType abstracts cannot have an underlying type" p;
+				if a.a_impl = None then raise_typing_error "Abstracts with underlying type must have an implementation" a.a_pos;
+				if Meta.has Meta.CoreType a.a_meta then raise_typing_error "@:coreType abstracts cannot have an underlying type" p;
 				let at = load_complex_type ctx true t in
 				delay ctx PForce (fun () ->
 					let rec loop stack t =
 						match follow t with
 						| TAbstract(a,_) when not (Meta.has Meta.CoreType a.a_meta) ->
 							if List.memq a stack then
-								typing_error "Abstract underlying type cannot be recursive" a.a_pos
+								raise_typing_error "Abstract underlying type cannot be recursive" a.a_pos
 							else
 								loop (a :: stack) a.a_this
 						| _ -> ()
@@ -654,7 +654,7 @@ module TypeLevel = struct
 			if Meta.has Meta.CoreType a.a_meta then
 				a.a_this <- TAbstract(a,extract_param_types a.a_params)
 			else
-				typing_error "Abstract is missing underlying type declaration" a.a_pos
+				raise_typing_error "Abstract is missing underlying type declaration" a.a_pos
 		end;
 		if Meta.has Meta.InheritDoc a.a_meta then
 			delay ctx PConnectField (fun() -> InheritDoc.build_abstract_doc ctx a)
@@ -677,8 +677,8 @@ module TypeLevel = struct
 				check_path_display path p;
 				ImportHandling.init_import ctx context_init path mode p;
 				ImportHandling.commit_import ctx path mode p;
-			with Error(err,p,depth) ->
-				located_display_error ~depth ctx.com (Error.error_msg p err)
+			with Error err ->
+				display_error_ext ctx.com err
 			end
 		| EUsing path ->
 			check_path_display path p;
@@ -796,9 +796,7 @@ let load_module' ctx g m p =
 		| Some m ->
 			m
 		| None ->
-			let raise_not_found () =
-				raise (Error (Module_not_found m,p,0))
-			in
+			let raise_not_found () = raise_error_msg (Module_not_found m) p in
 			if ctx.com.module_nonexistent_lut#mem m then raise_not_found();
 			if ctx.g.load_only_cached_modules then raise_not_found();
 			let is_extern = ref false in

+ 5 - 5
src/typing/typeloadParse.ml

@@ -39,7 +39,7 @@ let parse_file_from_lexbuf com file p lexbuf =
 	with
 		| Sedlexing.MalFormed ->
 			t();
-			typing_error "Malformed file. Source files must be encoded with UTF-8." {pfile = file; pmin = 0; pmax = 0}
+			raise_typing_error "Malformed file. Source files must be encoded with UTF-8." {pfile = file; pmin = 0; pmax = 0}
 		| e ->
 			t();
 			raise e
@@ -76,7 +76,7 @@ let parse_file com file p =
 		in
 		parse_file_from_string com file p s
 	else
-		let ch = try open_in_bin file with _ -> typing_error ("Could not open " ^ file) p in
+		let ch = try open_in_bin file with _ -> raise_typing_error ("Could not open " ^ file) p in
 		Std.finally (fun() -> close_in ch) (parse_file_from_lexbuf com file p) (Sedlexing.Utf8.from_channel ch)
 
 let parse_hook = ref parse_file
@@ -270,8 +270,8 @@ let handle_parser_result com p result =
 		let msg = Parser.error_msg msg in
 		match com.display.dms_error_policy with
 			| EPShow ->
-				if is_diagnostics com then add_diagnostics_message com (located msg p) DKParserError Error
-				else typing_error msg p
+				if is_diagnostics com then add_diagnostics_message com msg p DKParserError Error
+				else raise_typing_error msg p
 			| EPIgnore ->
 				com.has_error <- true
 	in
@@ -347,4 +347,4 @@ let parse_module ctx m p =
 
 (* let parse_module ctx m p =
 	let timer = Timer.timer ["typing";"parse_module"] in
-	Std.finally timer (parse_module ctx m) p *)
+	Std.finally timer (parse_module ctx m) p *)

+ 82 - 81
src/typing/typer.ml

@@ -97,7 +97,7 @@ let maybe_type_against_enum ctx f with_type iscall p =
 			let e = try
 				f()
 			with
-			| Error (Unknown_ident n,_,_) ->
+			| Error { err_message = Unknown_ident n; err_sub = sub } ->
 				restore();
 				raise_or_display_message ctx (StringError.string_error n fields ("Identifier '" ^ n ^ "' is not part of " ^ s_type_path path)) p;
 				AKExpr (mk (TConst TNull) (mk_mono()) p)
@@ -243,13 +243,13 @@ let rec unify_min_raise ctx (el:texpr list) : t =
 			| UnifyMinOk t ->
 				t
 			| UnifyMinError(l,index) ->
-				raise_typing_error (Unify l) (List.nth el index).epos
+				raise_typing_error_ext (make_error (Unify l) (List.nth el index).epos)
 			end
 
 let unify_min ctx el =
 	try unify_min_raise ctx el
-	with Error (Unify l,p,depth) ->
-		if not ctx.untyped then located_display_error ~depth ctx.com (error_msg p (Unify l));
+	with Error ({ err_message = Unify l } as err) ->
+		if not ctx.untyped then display_error_ext ctx.com err;
 		(List.hd el).etype
 
 let unify_min_for_type_source ctx el src =
@@ -282,7 +282,7 @@ let rec type_ident_raise ctx i p mode with_type =
 			begin match ctx.curclass.cl_kind with
 			| KAbstractImpl _ ->
 				if not (assign_to_this_is_allowed ctx) then
-					typing_error "Abstract 'this' value can only be modified inside an inline function" p;
+					raise_typing_error "Abstract 'this' value can only be modified inside an inline function" p;
 				acc
 			| _ ->
 				AKNo(acc,p)
@@ -299,7 +299,7 @@ let rec type_ident_raise ctx i p mode with_type =
 		end;
 	| "abstract" ->
 		begin match mode, ctx.curclass.cl_kind with
-			| MSet _, KAbstractImpl ab -> typing_error "Property 'abstract' is read-only" p;
+			| MSet _, KAbstractImpl ab -> raise_typing_error "Property 'abstract' is read-only" p;
 			| (MGet, KAbstractImpl ab)
 			| (MCall _, KAbstractImpl ab) ->
 				let tl = extract_param_types ab.a_params in
@@ -307,18 +307,18 @@ let rec type_ident_raise ctx i p mode with_type =
 				let e = {e with etype = TAbstract (ab,tl)} in
 				AKExpr e
 			| _ ->
-				typing_error "Property 'abstract' is reserved and only available in abstracts" p
+				raise_typing_error "Property 'abstract' is reserved and only available in abstracts" p
 		end
 	| "super" ->
 		let t = (match ctx.curclass.cl_super with
-			| None -> typing_error "Current class does not have a superclass" p
+			| None -> raise_typing_error "Current class does not have a superclass" p
 			| Some (c,params) -> TInst(c,params)
 		) in
 		(match ctx.curfun with
 		| FunMember | FunConstructor -> ()
-		| FunMemberAbstract -> typing_error "Cannot access super inside an abstract function" p
-		| FunStatic -> typing_error "Cannot access super inside a static function" p;
-		| FunMemberClassLocal | FunMemberAbstractLocal -> typing_error "Cannot access super inside a local function" p);
+		| FunMemberAbstract -> raise_typing_error "Cannot access super inside an abstract function" p
+		| FunStatic -> raise_typing_error "Cannot access super inside a static function" p;
+		| FunMemberClassLocal | FunMemberAbstractLocal -> raise_typing_error "Cannot access super inside a local function" p);
 		AKExpr (mk (TConst TSuper) t p)
 	| "null" ->
 		let acc =
@@ -356,8 +356,8 @@ let rec type_ident_raise ctx i p mode with_type =
 			(match e with
 			| Some ({ eexpr = TFunction f } as e) when ctx.com.display.dms_inline ->
 				begin match mode with
-					| MSet _ -> typing_error "Cannot set inline closure" p
-					| MGet -> typing_error "Cannot create closure on inline closure" p
+					| MSet _ -> raise_typing_error "Cannot set inline closure" p
+					| MGet -> raise_typing_error "Cannot create closure on inline closure" p
 					| MCall _ ->
 						(* create a fake class with a fake field to emulate inlining *)
 						let c = mk_class ctx.m.curmod (["local"],v.v_name) e.epos null_pos in
@@ -382,7 +382,7 @@ let rec type_ident_raise ctx i p mode with_type =
 		let is_impl = has_class_field_flag f CfImpl in
 		let is_enum = has_class_field_flag f CfEnum in
 		if is_impl && not (has_class_field_flag ctx.curfield CfImpl) && not is_enum then
-			typing_error (Printf.sprintf "Cannot access non-static field %s from static method" f.cf_name) p;
+			raise_typing_error (Printf.sprintf "Cannot access non-static field %s from static method" f.cf_name) p;
 		let e,fa = match ctx.curclass.cl_kind with
 			| KAbstractImpl a when is_impl && not is_enum ->
 				let tl = extract_param_types a.a_params in
@@ -465,7 +465,7 @@ and type_ident ctx i p mode with_type =
 	with Not_found -> try
 		(* lookup type *)
 		if is_lower_ident i p then raise Not_found;
-		let e = (try type_type ctx ([],i) p with Error (Module_not_found ([],name),_,_) when name = i -> raise Not_found) in
+		let e = (try type_type ctx ([],i) p with Error { err_message = Module_not_found ([],name) } when name = i -> raise Not_found) in
 		AKExpr e
 	with Not_found ->
 		let resolved_to_type_parameter = ref false in
@@ -486,14 +486,14 @@ and type_ident ctx i p mode with_type =
 					let t = mk_mono() in
 					AKExpr ((mk (TIdent i)) t p)
 			end else begin
-				if ctx.curfun = FunStatic && PMap.mem i ctx.curclass.cl_fields then typing_error ("Cannot access " ^ i ^ " in static function") p;
+				if ctx.curfun = FunStatic && PMap.mem i ctx.curclass.cl_fields then raise_typing_error ("Cannot access " ^ i ^ " in static function") p;
 				if !resolved_to_type_parameter then begin
 					display_error ctx.com ("Only @:const type parameters on @:generic classes can be used as value") p;
 					AKExpr (mk (TConst TNull) t_dynamic p)
 				end else begin
 					let err = Unknown_ident i in
 					if ctx.in_display then begin
-						raise (Error (err,p,0))
+						raise_error_msg err p
 					end;
 					if Diagnostics.error_in_diagnostics_run ctx.com p then begin
 						DisplayToplevel.handle_unresolved_identifier ctx i p false;
@@ -502,9 +502,9 @@ and type_ident ctx i p mode with_type =
 						AKExpr (mk (TIdent i) t p)
 					end else match ctx.com.display.dms_kind with
 						| DMNone ->
-							raise (Error(err,p,0))
+							raise_error_msg err p
 						| _ ->
-							located_display_error ctx.com (error_msg p err);
+							display_error ctx.com (error_msg err) p;
 							let t = mk_mono() in
 							(* Add a fake local for #8751. *)
 							if !ServerConfig.legacy_completion then
@@ -533,7 +533,7 @@ and handle_efield ctx e p0 mode with_type =
 				try
 					(* TODO: we don't really want to do full type_ident again, just the second part of it *)
 					field_chain ctx pnext (type_ident ctx name p MGet WithType.value)
-				with Error (Unknown_ident _,p2,_) as e when p = p2 ->
+				with Error ({ err_message = Unknown_ident _; err_pos = p2 } as e) when p = p2 ->
 					try
 						(* try raising a more sensible error if there was an uppercase-first (module name) part *)
 						begin
@@ -557,9 +557,9 @@ and handle_efield ctx e p0 mode with_type =
 							let mpath = (pack,name) in
 							if ctx.com.module_lut#mem mpath then
 								let tname = Option.default name sub in
-								raise (Error (Type_not_found (mpath,tname,Not_defined),p,0))
+								raise_error_msg (Type_not_found (mpath,tname,Not_defined)) p
 							else
-								raise (Error (Module_not_found mpath,p,0))
+								raise_error_msg (Module_not_found mpath) p
 						end
 					with Not_found ->
 						(* if there was no module name part, last guess is that we're trying to get package completion *)
@@ -570,7 +570,7 @@ and handle_efield ctx e p0 mode with_type =
 							else
 								DisplayToplevel.collect_and_raise ctx TKType WithType.no_value (CRToplevel None) (String.concat "." sl,p0) p0
 						end;
-						raise e
+						raise_error e
 	in
 
 	(* loop through the given EField expression to figure out whether it's a dot-path that we have to resolve,
@@ -626,8 +626,8 @@ and type_access ctx e p mode with_type =
 		begin match e1.eexpr with
 			| TTypeExpr (TClassDecl c) ->
 				begin match mode with
-				| MSet _ -> typing_error "Cannot set constructor" p;
-				| MCall _ -> typing_error ("Cannot call constructor like this, use 'new " ^ (s_type_path c.cl_path) ^ "()' instead") p;
+				| MSet _ -> raise_typing_error "Cannot set constructor" p;
+				| MCall _ -> raise_typing_error ("Cannot call constructor like this, use 'new " ^ (s_type_path c.cl_path) ^ "()' instead") p;
 				| MGet -> ()
 				end;
 				let monos = Monomorph.spawn_constrained_monos (fun t -> t) (match c.cl_kind with KAbstractImpl a -> a.a_params | _ -> c.cl_params) in
@@ -656,7 +656,7 @@ and type_access ctx e p mode with_type =
 					tf_type = t;
 					tf_expr = mk (TReturn (Some ec)) t p;
 				}) (TFun ((List.map (fun v -> v.v_name,false,v.v_type) vl),t)) p)
-			| _ -> typing_error "Binding new is only allowed on class types" p
+			| _ -> raise_typing_error "Binding new is only allowed on class types" p
 		end;
 	| EField _ ->
 		handle_efield ctx e p mode with_type
@@ -711,14 +711,14 @@ and type_vars ctx vl p =
 				DisplayEmitter.display_variable ctx v pv;
 			v,e
 		with
-			Error (e,p,depth) ->
-				check_error ctx e p depth;
+			Error err ->
+				check_error ctx err;
 				add_local ctx VGenerated n t_dynamic pv, None (* TODO: What to do with this... *)
 	) vl in
 	List.iter (fun (v,_) ->
 		delay_if_mono ctx PTypeField v.v_type (fun() ->
 			if ExtType.is_void (follow v.v_type) then
-				typing_error "Variables of type Void are not allowed" v.v_pos
+				raise_typing_error "Variables of type Void are not allowed" v.v_pos
 		)
 	) vl;
 	match vl with
@@ -792,7 +792,7 @@ and format_string ctx s p =
 			if i = len then
 				match groups with
 				| [] -> die "" __LOC__
-				| g :: _ -> typing_error ("Unclosed " ^ gname) { p with pmin = !pmin + g + 1; pmax = !pmin + g + 2 }
+				| g :: _ -> raise_typing_error ("Unclosed " ^ gname) { p with pmin = !pmin + g + 1; pmax = !pmin + g + 2 }
 			else
 				let c = String.unsafe_get s i in
 				if c = gopen then
@@ -811,8 +811,8 @@ and format_string ctx s p =
 			let e =
 				let ep = { p with pmin = !pmin + pos + 2; pmax = !pmin + send + 1 } in
 				let error msg pos =
-					if Lexer.string_is_whitespace scode then typing_error "Expression cannot be empty" ep
-					else typing_error msg pos
+					if Lexer.string_is_whitespace scode then raise_typing_error "Expression cannot be empty" ep
+					else raise_typing_error msg pos
 				in
 				match ParserEntry.parse_expr_string ctx.com.defines scode ep error true with
 					| ParseSuccess(data,_,_) -> data
@@ -838,7 +838,7 @@ and type_block ctx el with_type p =
 	let rec loop acc = function
 		| [] -> List.rev acc
 		| e :: l ->
-			let acc = try merge acc (type_expr ctx e (if l = [] then with_type else WithType.no_value)) with Error (e,p,depth) -> check_error ctx e p depth; acc in
+			let acc = try merge acc (type_expr ctx e (if l = [] then with_type else WithType.no_value)) with Error err -> check_error ctx err; acc in
 			loop acc l
 	in
 	let l = loop [] el in
@@ -886,7 +886,7 @@ and type_object_decl ctx fl with_type p =
 		let extra_fields = ref [] in
 		let fl = List.map (fun ((n,pn,qs),e) ->
 			let is_valid = Lexer.is_valid_identifier n in
-			if PMap.mem n !fields then typing_error ("Duplicate field in object declaration : " ^ n) pn;
+			if PMap.mem n !fields then raise_typing_error ("Duplicate field in object declaration : " ^ n) pn;
 			let is_final = ref false in
 			let e = try
 				let t = match !dynamic_parameter with
@@ -907,7 +907,7 @@ and type_object_decl ctx fl with_type p =
 				type_expr ctx e WithType.value
 			in
 			if is_valid then begin
-				if starts_with n '$' then typing_error "Field names starting with a dollar are not allowed" p;
+				if starts_with n '$' then raise_typing_error "Field names starting with a dollar are not allowed" p;
 				let cf = mk_field n e.etype (punion pn e.epos) pn in
 				if !is_final then add_class_field_flag cf CfFinal;
 				fields := PMap.add n cf !fields;
@@ -929,13 +929,13 @@ and type_object_decl ctx fl with_type p =
 	let type_plain_fields () =
 		let rec loop (l,acc) ((f,pf,qs),e) =
 			let is_valid = Lexer.is_valid_identifier f in
-			if PMap.mem f acc then typing_error ("Duplicate field in object declaration : " ^ f) pf;
+			if PMap.mem f acc then raise_typing_error ("Duplicate field in object declaration : " ^ f) pf;
 			let e = type_expr ctx e (WithType.named_structure_field f) in
-			(match follow e.etype with TAbstract({a_path=[],"Void"},_) -> typing_error "Fields of type Void are not allowed in structures" e.epos | _ -> ());
+			(match follow e.etype with TAbstract({a_path=[],"Void"},_) -> raise_typing_error "Fields of type Void are not allowed in structures" e.epos | _ -> ());
 			let cf = mk_field f e.etype (punion pf e.epos) pf in
 			if ctx.in_display && DisplayPosition.display_position#enclosed_in pf then DisplayEmitter.display_field ctx Unknown CFSMember cf pf;
 			(((f,pf,qs),e) :: l, if is_valid then begin
-				if starts_with f '$' then typing_error "Field names starting with a dollar are not allowed" p;
+				if starts_with f '$' then raise_typing_error "Field names starting with a dollar are not allowed" p;
 				PMap.add f cf acc
 			end else acc)
 		in
@@ -1037,8 +1037,8 @@ and type_new ctx path el with_type force_inline p =
 			let fcc = unify_field_call ctx fa [] el p fa.fa_inline in
 			check_constructor_access ctx c fcc.fc_field p;
 			fcc
-		with Error (e,p,depth) ->
-			located_typing_error ~depth (error_msg p e);
+		with Error err ->
+			raise_typing_error_ext err
 	in
 	let display_position_in_el () =
 		List.exists (fun e -> DisplayPosition.display_position#enclosed_in (pos e)) el
@@ -1084,7 +1084,7 @@ and type_new ctx path el with_type force_inline p =
 				end
 			end
 		| mt ->
-			typing_error ((s_type_path (t_infos mt).mt_path) ^ " cannot be constructed") p
+			raise_typing_error ((s_type_path (t_infos mt).mt_path) ^ " cannot be constructed") p
 		end
 	| Error _ as exc when display_position_in_el() ->
 		List.iter (fun e -> ignore(type_expr ctx e WithType.value)) el;
@@ -1098,17 +1098,17 @@ and type_new ctx path el with_type force_inline p =
 		let cf = fa.fa_field in
 		no_abstract_constructor c p;
 		begin match cf.cf_kind with
-			| Var { v_read = AccRequire (r,msg) } -> (match msg with Some msg -> typing_error msg p | None -> error_require r p)
+			| Var { v_read = AccRequire (r,msg) } -> (match msg with Some msg -> raise_typing_error msg p | None -> error_require r p)
 			| _ -> ()
 		end;
 		unify_constructor_call c fa
 	in
 	try begin match Abstract.follow_with_forward_ctor t with
 	| TInst ({cl_kind = KTypeParameter tl} as c,params) ->
-		if not (TypeloadCheck.is_generic_parameter ctx c) then typing_error "Only generic type parameters can be constructed" p;
+		if not (TypeloadCheck.is_generic_parameter ctx c) then raise_typing_error "Only generic type parameters can be constructed" p;
  		begin match get_constructible_constraint ctx tl p with
 		| None ->
-			raise_typing_error (No_constructor (TClassDecl c)) p
+			raise_typing_error_ext (make_error (No_constructor (TClassDecl c)) p)
 		| Some(tl,tr) ->
 			let el,_ = unify_call_args ctx el tl tr p false false false in
 			mk (TNew (c,params,el)) t p
@@ -1121,9 +1121,9 @@ and type_new ctx path el with_type force_inline p =
 		let el = fcc.fc_args in
 		mk (TNew (c,params,el)) t p
 	| _ ->
-		typing_error (s_type (print_context()) t ^ " cannot be constructed") p
-	end with Error(No_constructor _ as err,p,depth) when ctx.com.display.dms_kind <> DMNone ->
-		located_display_error ~depth ctx.com (error_msg p err);
+		raise_typing_error (s_type (print_context()) t ^ " cannot be constructed") p
+	end with Error ({ err_message = No_constructor _ } as err) when ctx.com.display.dms_kind <> DMNone ->
+		display_error_ext ctx.com err;
 		Diagnostics.secure_generated_code ctx (mk (TConst TNull) t p)
 
 and type_try ctx e1 catches with_type p =
@@ -1156,7 +1156,7 @@ and type_try ctx e1 catches with_type p =
 	in
 	let check_catch_type_params params p =
 		List.iter (fun pt ->
-			if Abstract.follow_with_abstracts pt != t_dynamic then typing_error "Catch class parameter must be Dynamic" p;
+			if Abstract.follow_with_abstracts pt != t_dynamic then raise_typing_error "Catch class parameter must be Dynamic" p;
 		) params
 	in
 	let catches,el = List.fold_left (fun (acc1,acc2) ((v,pv),t,e_ast,pc) ->
@@ -1164,7 +1164,7 @@ and type_try ctx e1 catches with_type p =
 		let t = Typeload.load_complex_type ctx true th in
 		let rec loop t = match follow t with
 			| TInst ({ cl_kind = KTypeParameter _} as c,_) when not (TypeloadCheck.is_generic_parameter ctx c) ->
-				typing_error "Cannot catch non-generic type parameter" p
+				raise_typing_error "Cannot catch non-generic type parameter" p
 			| TInst (_,params) | TEnum (_,params) ->
 				check_catch_type_params params (snd th);
 				t
@@ -1174,7 +1174,7 @@ and type_try ctx e1 catches with_type p =
 			| TAbstract(a,tl) when not (Meta.has Meta.CoreType a.a_meta) ->
 				loop (Abstract.get_underlying_type a tl)
 			| TDynamic _ -> t
-			| _ -> typing_error "Catch type must be a class, an enum or Dynamic" (pos e_ast)
+			| _ -> raise_typing_error "Catch type must be a class, an enum or Dynamic" (pos e_ast)
 		in
 		let t2 = loop t in
 		check_unreachable acc1 t2 (pos e_ast);
@@ -1222,7 +1222,7 @@ and type_map_declaration ctx e1 el with_type p =
 		try
 			let p = Hashtbl.find keys e_key.eexpr in
 			display_error ctx.com "Duplicate key" e_key.epos;
-			typing_error ~depth:1 (compl_msg "Previously defined here") p
+			raise_typing_error ~depth:1 (compl_msg "Previously defined here") p
 		with Not_found ->
 			begin match e_key.eexpr with
 			| TConst _ -> Hashtbl.add keys e_key.eexpr e_key.epos;
@@ -1234,8 +1234,8 @@ and type_map_declaration ctx e1 el with_type p =
 		| EBinop(OpArrow,e1,e2) -> e1,e2
 		| EDisplay _ ->
 			ignore(type_expr ctx e (WithType.with_type tkey));
-			typing_error "Expected a => b" (pos e)
-		| _ -> typing_error "Expected a => b" (pos e)
+			raise_typing_error "Expected a => b" (pos e)
+		| _ -> raise_typing_error "Expected a => b" (pos e)
 	) el in
 	let el_k,el_v,tkey,tval = if has_type then begin
 		let el_k,el_v = List.fold_left (fun (el_k,el_v) (e1,e2) ->
@@ -1279,7 +1279,7 @@ and type_local_function ctx kind f with_type p =
 	let params = TypeloadFunction.type_function_params ctx f (match name with None -> "localfun" | Some (n,_) -> n) p in
 	if params <> [] then begin
 		if name = None then display_error ctx.com "Type parameters not supported in unnamed local functions" p;
-		if with_type <> WithType.NoValue then typing_error "Type parameters are not supported for rvalue functions" p
+		if with_type <> WithType.NoValue then raise_typing_error "Type parameters are not supported for rvalue functions" p
 	end;
 	let v,pname = (match name with
 		| None -> None,p
@@ -1485,12 +1485,12 @@ and type_array_decl ctx el with_type p =
 		let el = List.map (fun e -> type_expr ctx e WithType.value) el in
 		let t = try
 			unify_min_raise ctx el
-		with Error (Unify l,p,n) ->
+		with Error ({ err_message = Unify _ } as err) ->
 			if !allow_array_dynamic || ctx.untyped || ignore_error ctx.com then
 				t_dynamic
 			else begin
-				display_error ctx.com "Arrays of mixed types are only allowed if the type is forced to Array<Dynamic>" p;
-				raise (Error (Unify l, p,n))
+				display_error ctx.com "Arrays of mixed types are only allowed if the type is forced to Array<Dynamic>" err.err_pos;
+				raise_error err
 			end
 		in
 		mk (TArrayDecl el) (ctx.t.tarray t) p
@@ -1573,7 +1573,7 @@ and type_return ?(implicit=false) ctx e with_type p =
 				match follow e.etype with
 				| TAbstract({a_path=[],"Void"},_) ->
 					begin match (Texpr.skip e).eexpr with
-					| TConst TNull -> typing_error "Cannot return `null` from Void-function" p
+					| TConst TNull -> raise_typing_error "Cannot return `null` from Void-function" p
 					| _ -> ()
 					end;
 					(* if we get a Void expression (e.g. from inlining) we don't want to return it (issue #4323) *)
@@ -1584,8 +1584,9 @@ and type_return ?(implicit=false) ctx e with_type p =
 					]) t e.epos;
 				| _ ->
 					mk (TReturn (Some e)) (mono_or_dynamic ctx with_type p) p
-		with Error(err,p,depth) ->
-			check_error ctx err p depth;
+		with Error err ->
+			let p = err.err_pos in
+			check_error ctx err;
 			(* If we have a bad return, let's generate a return null expression at least. This surpresses various
 				follow-up errors that come from the fact that the function no longer has a return expression (issue #6445). *)
 			let e_null = mk (TConst TNull) (mk_mono()) p in
@@ -1597,14 +1598,14 @@ and type_cast ctx e t p =
 	let check_param pt = match follow pt with
 		| TMono _ -> () (* This probably means that Dynamic wasn't bound (issue #4675). *)
 		| t when t == t_dynamic -> ()
-		| _ -> typing_error "Cast type parameters must be Dynamic" tpos
+		| _ -> raise_typing_error "Cast type parameters must be Dynamic" tpos
 	in
 	let rec loop t = match follow t with
 		| TInst (_,params) | TEnum (_,params) ->
 			List.iter check_param params;
 			(match follow t with
 			| TInst (c,_) ->
-				(match c.cl_kind with KTypeParameter _ -> typing_error "Can't cast to a type parameter" tpos | _ -> ());
+				(match c.cl_kind with KTypeParameter _ -> raise_typing_error "Can't cast to a type parameter" tpos | _ -> ());
 				TClassDecl c
 			| TEnum (e,_) -> TEnumDecl e
 			| _ -> die "" __LOC__);
@@ -1614,7 +1615,7 @@ and type_cast ctx e t p =
 		| TAbstract (a,params) ->
 			loop (Abstract.get_underlying_type a params)
 		| _ ->
-			typing_error "Cast type must be a class or an enum" tpos
+			raise_typing_error "Cast type must be a class or an enum" tpos
 	in
 	let texpr = loop t in
 	mk (TCast (type_expr ctx e WithType.value,Some texpr)) t p
@@ -1635,7 +1636,7 @@ and make_if_then_else ctx e0 e1 e2 with_type p =
 and type_if ctx e e1 e2 with_type is_ternary p =
 	let e = type_expr ctx e WithType.value in
 	if is_ternary then begin match e.eexpr with
-		| TConst TNull -> typing_error "Cannot use null as ternary condition" e.epos
+		| TConst TNull -> raise_typing_error "Cannot use null as ternary condition" e.epos
 		| _ -> ()
 	end;
 	let e = AbstractCast.cast_or_unify ctx ctx.t.tbool e p in
@@ -1659,7 +1660,7 @@ and type_meta ?(mode=MGet) ctx m e1 with_type p =
 				| TAbstract({a_impl = Some c},_) when PMap.mem "toString" c.cl_statics -> call_to_string ctx e
 				| _ -> e)
 		| (Meta.Markup,_,_) ->
-			typing_error "Markup literals must be processed by a macro" p
+			raise_typing_error "Markup literals must be processed by a macro" p
 		| (Meta.Analyzer,_,_) ->
 			let e = e() in
 			{e with eexpr = TMeta(m,e)}
@@ -1818,15 +1819,15 @@ and type_call_builtin ctx e el mode with_type p =
 	| (EDisplay((EConst (Ident "super"),_ as e1),dk),_),_ ->
 		TyperDisplay.handle_display ctx (ECall(e1,el),p) dk mode with_type
 	| (EConst (Ident "super"),sp) , el ->
-		if ctx.curfun <> FunConstructor then typing_error "Cannot call super constructor outside class constructor" p;
+		if ctx.curfun <> FunConstructor then raise_typing_error "Cannot call super constructor outside class constructor" p;
 		let el, t = (match ctx.curclass.cl_super with
-		| None -> typing_error "Current class does not have a super" p
+		| None -> raise_typing_error "Current class does not have a super" p
 		| Some (c,params) ->
 			let fa = FieldAccess.get_constructor_access c params p in
 			let cf = fa.fa_field in
 			let t = TInst (c,params) in
 			let e = mk (TConst TSuper) t sp in
-			if (Meta.has Meta.CompilerGenerated cf.cf_meta) then located_display_error ctx.com (error_msg p (No_constructor (TClassDecl c)));
+			if (Meta.has Meta.CompilerGenerated cf.cf_meta) then display_error ctx.com (error_msg (No_constructor (TClassDecl c))) p;
 			let fa = FieldAccess.create e cf (FHInstance(c,params)) false p in
 			let fcc = unify_field_call ctx fa [] el p false in
 			let el = fcc.fc_args in
@@ -1839,12 +1840,12 @@ and type_call_builtin ctx e el mode with_type p =
 and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
 	match e with
 	| EField ((EConst (String(s,_)),ps),"code",EFNormal) ->
-		if UTF8.length s <> 1 then typing_error "String must be a single UTF8 char" ps;
+		if UTF8.length s <> 1 then raise_typing_error "String must be a single UTF8 char" ps;
 		mk (TConst (TInt (Int32.of_int (UCharExt.code (UTF8.get s 0))))) ctx.t.tint p
 	| EField(_,n,_) when starts_with n '$' ->
-		typing_error "Field names starting with $ are not allowed" p
+		raise_typing_error "Field names starting with $ are not allowed" p
 	| EConst (Ident s) ->
-		if s = "super" && with_type <> WithType.NoValue && not ctx.in_display then typing_error "Cannot use super as value" p;
+		if s = "super" && with_type <> WithType.NoValue && not ctx.in_display then raise_typing_error "Cannot use super as value" p;
 		let e = maybe_type_against_enum ctx (fun () -> type_ident ctx s p mode with_type) with_type false p in
 		acc_get ctx e
 	| EField _
@@ -1862,9 +1863,9 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
 		(match suffix with
 		| "i32" ->
 			(try mk (TConst (TInt (Int32.of_string s))) ctx.com.basic.tint p
-			with _ -> typing_error ("Cannot represent " ^ s ^ " with a 32 bit integer") p)
+			with _ -> raise_typing_error ("Cannot represent " ^ s ^ " with a 32 bit integer") p)
 		| "i64" ->
-			if String.length s > 18 && String.sub s 0 2 = "0x" then typing_error "Invalid hexadecimal integer" p;
+			if String.length s > 18 && String.sub s 0 2 = "0x" then raise_typing_error "Invalid hexadecimal integer" p;
 
 			let i64  = Int64.of_string s in
 			let high = Int64.to_int32 (Int64.shift_right i64 32) in
@@ -1880,11 +1881,11 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
 		| "u32" ->
 			let check = ECheckType ((EConst (Int (s, None)), p), (CTPath (mk_type_path ([],"UInt")), p)), p in
 			type_expr ctx check with_type
-		| other -> typing_error (other ^ " is not a valid integer suffix") p)
+		| other -> raise_typing_error (other ^ " is not a valid integer suffix") p)
 	| EConst (Float (s, Some suffix) as c) ->
 		(match suffix with
 		| "f64" -> Texpr.type_constant ctx.com.basic c p
-		| other -> typing_error (other ^ " is not a valid float suffix") p)
+		| other -> raise_typing_error (other ^ " is not a valid float suffix") p)
 	| EConst c ->
 		Texpr.type_constant ctx.com.basic c p
 	| EBinop (OpNullCoal,e1,e2) ->
@@ -2011,8 +2012,8 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
 	| EThrow e ->
 		let e = try
 			type_expr ctx e WithType.value
-		with Error(e,p',depth) ->
-			check_error ctx e p' depth;
+		with Error err ->
+			check_error ctx err;
 			Texpr.Builder.make_null t_dynamic p
 		in
 		mk (TThrow e) (mono_or_dynamic ctx with_type p) p
@@ -2145,12 +2146,12 @@ let rec create com =
 	ctx.g.std <- (try
 		TypeloadModule.load_module ctx ([],"StdTypes") null_pos
 	with
-		Error (Module_not_found ([],"StdTypes"),_,_) ->
+		Error { err_message = Module_not_found ([],"StdTypes") } ->
 			try
 				let std_path = Sys.getenv "HAXE_STD_PATH" in
-				typing_error ("Standard library not found. Please check your `HAXE_STD_PATH` environment variable (current value: \"" ^ std_path ^ "\")") null_pos
+				raise_typing_error ("Standard library not found. Please check your `HAXE_STD_PATH` environment variable (current value: \"" ^ std_path ^ "\")") null_pos
 			with Not_found ->
-				typing_error "Standard library not found. You may need to set your `HAXE_STD_PATH` environment variable" null_pos
+				raise_typing_error "Standard library not found. You may need to set your `HAXE_STD_PATH` environment variable" null_pos
 	);
 	(* We always want core types to be available so we add them as default imports (issue #1904 and #3131). *)
 	ctx.m.module_imports <- List.map (fun t -> t,null_pos) ctx.g.std.m_types;
@@ -2218,4 +2219,4 @@ make_call_ref := make_call;
 type_call_target_ref := type_call_target;
 type_access_ref := type_access;
 type_block_ref := type_block;
-create_context_ref := create
+create_context_ref := create

+ 8 - 8
src/typing/typerBase.ml

@@ -146,12 +146,12 @@ end
 
 let is_lower_ident s p =
 	try Ast.is_lower_ident s
-	with Invalid_argument msg -> typing_error msg p
+	with Invalid_argument msg -> raise_typing_error msg p
 
 let get_this ctx p =
 	match ctx.curfun with
 	| FunStatic ->
-		typing_error "Cannot access this from a static function" p
+		raise_typing_error "Cannot access this from a static function" p
 	| FunMemberClassLocal | FunMemberAbstractLocal ->
 		let v = match ctx.vthis with
 			| None ->
@@ -168,7 +168,7 @@ let get_this ctx p =
 		in
 		mk (TLocal v) ctx.tthis p
 	| FunMemberAbstract ->
-		let v = (try PMap.find "this" ctx.locals with Not_found -> typing_error "Cannot reference this abstract here" p) in
+		let v = (try PMap.find "this" ctx.locals with Not_found -> raise_typing_error "Cannot reference this abstract here" p) in
 		mk (TLocal v) v.v_type p
 	| FunConstructor | FunMember ->
 		mk (TConst TThis) ctx.tthis p
@@ -192,7 +192,7 @@ let rec type_module_type ctx t tparams p =
 			module_type_of_type t
 		with Exit ->
 			if follow t == t_dynamic then Typeload.load_type_def ctx p (mk_type_path ([],"Dynamic"))
-			else typing_error "Invalid module type" p
+			else raise_typing_error "Invalid module type" p
 		in
 		type_module_type ctx mt None p
 	| TClassDecl c ->
@@ -212,11 +212,11 @@ let rec type_module_type ctx t tparams p =
 		| TAbstract (a,params) ->
 			type_module_type ctx (TAbstractDecl a) (Some params) p
 		| _ ->
-			typing_error (s_type_path s.t_path ^ " is not a value") p)
+			raise_typing_error (s_type_path s.t_path ^ " is not a value") p)
 	| TAbstractDecl { a_impl = Some c } ->
 		type_module_type ctx (TClassDecl c) tparams p
 	| TAbstractDecl a ->
-		if not (Meta.has Meta.RuntimeValue a.a_meta) then typing_error (s_type_path a.a_path ^ " is not a value") p;
+		if not (Meta.has Meta.RuntimeValue a.a_meta) then raise_typing_error (s_type_path a.a_path ^ " is not a value") p;
 		let t_tmp = abstract_module_type a [] in
 		mk (TTypeExpr (TAbstractDecl a)) (TType (t_tmp,[])) p
 
@@ -282,7 +282,7 @@ let s_dot_path_part part =
 let get_constructible_constraint ctx tl p =
 	let extract_function t = match follow t with
 		| TFun(tl,tr) -> tl,tr
-		| _ -> typing_error "Constructible type parameter should be function" p
+		| _ -> raise_typing_error "Constructible type parameter should be function" p
 	in
 	let rec loop tl = match tl with
 		| [] -> None
@@ -339,4 +339,4 @@ let get_abstract_froms ctx a pl =
 				acc)
 		| _ ->
 			acc
-	) l a.a_from_field
+	) l a.a_from_field

+ 14 - 14
src/typing/typerDisplay.ml

@@ -190,7 +190,7 @@ let display_dollar_type ctx p make_type =
 	| DMDefinition | DMTypeDefinition ->
 		raise_positions []
 	| _ ->
-		typing_error "Unsupported method" p
+		raise_typing_error "Unsupported method" p
 	end
 
 let rec handle_signature_display ctx e_ast with_type =
@@ -200,7 +200,7 @@ let rec handle_signature_display ctx e_ast with_type =
 		let rec follow_with_callable (t,doc,values) = match follow t with
 			| TAbstract(a,tl) when Meta.has Meta.Callable a.a_meta -> follow_with_callable (Abstract.get_underlying_type a tl,doc,values)
 			| TFun(args,ret) -> ((args,ret),doc,values)
-			| _ -> typing_error ("Not a callable type: " ^ (s_type (print_context()) t)) p
+			| _ -> raise_typing_error ("Not a callable type: " ^ (s_type (print_context()) t)) p
 		in
 		let tl = List.map follow_with_callable tl in
 		let rec loop i acc el = match el with
@@ -223,7 +223,7 @@ let rec handle_signature_display ctx e_ast with_type =
 						let _ = unify_call_args ctx el args r p false false false in
 						true
 					with
-					| Error(Call_error (Not_enough_arguments _),_,_) -> true
+					| Error { err_message = Call_error (Not_enough_arguments _) } -> true
 					| _ -> false
 					end
 				in
@@ -253,7 +253,7 @@ let rec handle_signature_display ctx e_ast with_type =
 	let find_constructor_types t = match follow t with
 		| TInst ({cl_kind = KTypeParameter tl} as c,_) ->
 			let rec loop tl = match tl with
-				| [] -> raise_typing_error (No_constructor (TClassDecl c)) p
+				| [] -> raise_typing_error_ext (make_error (No_constructor (TClassDecl c)) p)
 				| t :: tl -> match follow t with
 					| TAbstract({a_path = ["haxe"],"Constructible"},[t]) -> t
 					| _ -> loop tl
@@ -274,10 +274,10 @@ let rec handle_signature_display ctx e_ast with_type =
 				try
 					acc_get ctx (!type_call_target_ref ctx e1 el with_type None)
 				with
-				| Error (Unknown_ident "trace",_,_) ->
+				| Error { err_message = Unknown_ident "trace" } ->
 					let e = expr_of_type_path (["haxe";"Log"],"trace") p in
 					type_expr ctx e WithType.value
-				| Error (Unknown_ident "$type",p,_) ->
+				| Error { err_message = Unknown_ident "$type"; err_pos = p } ->
 					display_dollar_type ctx p (fun t -> t,(CompletionType.from_type (get_import_status ctx) t))
 			in
 			let e1 = match e1 with
@@ -337,11 +337,11 @@ let rec handle_signature_display ctx e_ast with_type =
 			| _ ->
 				raise_signatures [] 0 0 SKArrayAccess
 			end
-		| _ -> typing_error "Call expected" p
+		| _ -> raise_typing_error "Call expected" p
 
 and display_expr ctx e_ast e dk mode with_type p =
 	let get_super_constructor () = match ctx.curclass.cl_super with
-		| None -> typing_error "Current class does not have a super" p
+		| None -> raise_typing_error "Current class does not have a super" p
 		| Some (c,params) ->
 			let fa = get_constructor_access c params p in
 			fa.fa_field,c
@@ -541,20 +541,20 @@ let handle_display ctx e_ast dk mode with_type =
 		| DMDefinition | DMTypeDefinition ->
 			raise_positions []
 		| _ ->
-			typing_error "Unsupported method" p
+			raise_typing_error "Unsupported method" p
 		end
 	| (EConst (Ident "_"),p),WithType.WithType(t,_) ->
 		mk (TConst TNull) t p (* This is "probably" a bind skip, let's just use the expected type *)
 	| (_,p),_ -> try
 		type_expr ~mode ctx e_ast with_type
-	with Error (Unknown_ident n,_,_) when ctx.com.display.dms_kind = DMDefault ->
+	with Error { err_message = Unknown_ident n } when ctx.com.display.dms_kind = DMDefault ->
         if dk = DKDot && is_legacy_completion ctx.com then raise (Parser.TypePath ([n],None,false,p))
 		else raise_toplevel ctx dk with_type (n,p)
-	| Error ((Type_not_found (path,_,_) | Module_not_found path),_,_) as err when ctx.com.display.dms_kind = DMDefault ->
+	| Error ({ err_message = Type_not_found (path,_,_) | Module_not_found path } as err) when ctx.com.display.dms_kind = DMDefault ->
 		if is_legacy_completion ctx.com then begin try
 			raise_fields (DisplayFields.get_submodule_fields ctx path) (CRField((make_ci_module path),p,None,None)) (make_subject None (pos e_ast))
 		with Not_found ->
-			raise err
+			raise_error err
 		end else
 			raise_toplevel ctx dk with_type (s_type_path path,p)
 	| DisplayException(DisplayFields ({fkind = CRTypeHint} as r)) when (match fst e_ast with ENew _ -> true | _ -> false) ->
@@ -626,7 +626,7 @@ let handle_display ctx e_ast dk mode with_type =
 		| WithType.WithType(t,_) ->
 			(* We don't want to actually use the transformed expression which may have inserted implicit cast calls.
 			   It only matters that unification takes place. *)
-			(try ignore(AbstractCast.cast_or_unify_raise ctx t e e.epos) with Error (Unify l,p,_) -> ());
+			(try ignore(AbstractCast.cast_or_unify_raise ctx t e e.epos) with Error { err_message = Unify _ } -> ());
 		| _ ->
 			()
 	end;
@@ -700,7 +700,7 @@ let handle_structure_display ctx e fields origin =
 		let pinsert = DisplayPosition.display_position#with_pos (pos e) in
 		raise_fields fields CRStructureField (make_subject None pinsert)
 	| _ ->
-		typing_error "Expected object expression" p
+		raise_typing_error "Expected object expression" p
 
 let handle_edisplay ctx e dk mode with_type =
 	let handle_display ctx e dk with_type =

+ 1 - 1
src/typing/typerDotPath.ml

@@ -74,7 +74,7 @@ let resolve_qualified ctx pack name next_path p mode with_type =
 	try
 		let m = Typeload.load_module ctx (pack,name) p in
 		resolve_in_module ctx m next_path p mode with_type
-	with Error (Module_not_found mpath,_,_) when mpath = (pack,name) ->
+	with Error { err_message = Module_not_found mpath } when mpath = (pack,name) ->
 		(* might be an instance of https://github.com/HaxeFoundation/haxe/issues/9150
 		   so let's also check (pack,name) of a TYPE in the current module context ¯\_(ツ)_/¯ *)
 		let t = Typeload.find_type_in_current_module_context ctx pack name in (* raises Not_found *)

+ 14 - 0
tests/misc/projects/Issue11121/Main.hx

@@ -0,0 +1,14 @@
+class Main {
+	static function main() {
+		test();
+		#if !macro
+		$type(42);
+		#end
+	}
+
+	static macro function test() {
+		1 = 0;
+		$type(42);
+		return macro {};
+	}
+}

+ 3 - 0
tests/misc/projects/Issue11121/compile-fail.hxml

@@ -0,0 +1,3 @@
+--main Main
+-D message-reporting=pretty
+-D no-color

+ 18 - 0
tests/misc/projects/Issue11121/compile-fail.hxml.stderr

@@ -0,0 +1,18 @@
+[ERROR] (macro) Main.hx:10: characters 3-4
+
+ 10 |   1 = 0;
+    |   ^
+    | Invalid assign
+
+[WARNING] (macro) Main.hx:11: characters 9-11
+
+ 11 |   $type(42);
+    |         ^^
+    | Int
+
+[WARNING] Main.hx:5: characters 9-11
+
+  5 |   $type(42);
+    |         ^^
+    | Int
+

+ 1 - 0
tests/misc/projects/Issue6765/compile-fail.hxml.stderr

@@ -1 +1,2 @@
 Main.hx:8: characters 9-16 : Unknown identifier : my_typo
+Main.hx:8: characters 9-16 : ... For function argument 's'

+ 1 - 1
tests/misc/projects/Issue8471/compile2-pretty.hxml.stderr

@@ -1,4 +1,4 @@
-[WARNING] Macro2.hx:12: characters 25-39
+[WARNING] (macro) Macro2.hx:12: characters 25-39
 
  12 |   Context.warning(("1" :DeprecatedType), Context.currentPos());
     |                         ^^^^^^^^^^^^^^