소스 검색

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 년 전
부모
커밋
b0011d1d40
70개의 변경된 파일1291개의 추가작업 그리고 1198개의 파일을 삭제
  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 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
 	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 *)
 	(* 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
 	let t = Timer.timer ["gencommon_filters"] in
 	(if Common.defined gen.gcon Define.GencommonDebug then debug_mode := true else debug_mode := false);
 	(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;
 	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
 let is_haxe_keyword = function
 	| "cast" | "extern" | "function" | "in" | "typedef" | "using" | "var" | "untyped" | "inline" -> true
 	| "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 =
 let message ctx msg =
 	ctx.messages <- msg :: ctx.messages
 	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
 	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 run_or_diagnose ctx f arg =
 	let com = ctx.com in
 	let com = ctx.com in
-	let handle_diagnostics ?(depth = 0) msg kind =
+	let handle_diagnostics ?(depth = 0) msg p kind =
 		ctx.has_error <- true;
 		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
 		DisplayOutput.emit_diagnostics ctx.com
 	in
 	in
 	if is_diagnostics com then begin try
 	if is_diagnostics com then begin try
 			f arg
 			f arg
 		with
 		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) ->
 		| 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) ->
 		| Lexer.Error(msg,p) ->
-			handle_diagnostics (located (Lexer.error_msg msg) p) DKParserError
+			handle_diagnostics (Lexer.error_msg msg) p DKParserError
 		end
 		end
 	else
 	else
 		f arg
 		f arg
@@ -211,8 +215,10 @@ module Setup = struct
 		Common.define_value com Define.Haxe s_version;
 		Common.define_value com Define.Haxe s_version;
 		Common.raw_define com "true";
 		Common.raw_define com "true";
 		Common.define_value com Define.Dce "std";
 		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
 			match Warning.get_mode w (com.warning_options @ options) with
 			| WMEnable ->
 			| WMEnable ->
 				let wobj = Warning.warning_obj w in
 				let wobj = Warning.warning_obj w in
@@ -221,12 +227,12 @@ module Setup = struct
 				else
 				else
 					Printf.sprintf "(%s) %s" wobj.w_name msg
 					Printf.sprintf "(%s) %s" wobj.w_name msg
 				in
 				in
-				message ctx (make_compiler_message msg p depth DKCompilerMessage Warning)
+				message ctx (make_compiler_message ~from_macro msg p depth DKCompilerMessage Warning)
 			| WMDisable ->
 			| 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 ->
 		let filter_messages = (fun keep_errors predicate -> (List.filter (fun cm ->
 			(match cm.cm_severity with
 			(match cm.cm_severity with
 			| MessageSeverity.Error -> keep_errors;
 			| MessageSeverity.Error -> keep_errors;
@@ -335,10 +341,10 @@ try
 with
 with
 	| Abort ->
 	| 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) ->
 	| Lexer.Error (m,p) ->
 		error ctx (Lexer.error_msg m) p
 		error ctx (Lexer.error_msg m) p
 	| Parser.Error (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;
 			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);
 			List.iter (error ~depth:1 ctx (Error.compl_msg "referenced here")) (List.rev pl);
 		end
 		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) ->
 	| Generic.Generic_Exception(m,p) ->
 		error ctx m p
 		error ctx m p
 	| Arg.Bad msg ->
 	| 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
 				let ctx = Typer.create com in
 				DisplayPath.TypePathHandler.complete_type_path_inner ctx p c cur_package is_import
 				DisplayPath.TypePathHandler.complete_type_path_inner ctx p c cur_package is_import
 		end with Common.Abort msg ->
 		end with Common.Abort msg ->
-			located_error ctx msg;
+			error_ext ctx msg;
 			None
 			None
 	in
 	in
 	begin match ctx.com.json_out,fields with
 	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 process_display_configuration ctx =
 	let com = ctx.com in
 	let com = ctx.com in
 	if is_diagnostics com then begin
 	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
 			match Warning.get_mode w (com.warning_options @ options) with
 			| WMEnable ->
 			| WMEnable ->
-				add_diagnostics_message ?depth com (located s p) DKCompilerMessage Warning
+				add_diagnostics_message ?depth com s p DKCompilerMessage Warning
 			| WMDisable ->
 			| WMDisable ->
 				()
 				()
 		);
 		);
@@ -354,4 +354,4 @@ let handle_display_after_finalization ctx tctx display_file_dot_path =
 		DisplayOutput.emit_statistics tctx
 		DisplayOutput.emit_statistics tctx
 	| RMNone ->
 	| 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
 		let t = Timer.timer ["generate";name] in
 		generate com;
 		generate com;
 		t()
 		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;
 	ctx.g.load_only_cached_modules <- true;
 	try
 	try
 		Std.finally (fun () -> ctx.g.load_only_cached_modules <- old) f ()
 		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))
 		fail rctx (Printf.sprintf "Could not load [Module %s]" (s_type_path path))
 
 
 let pair_type th t = match th with
 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;
 		m.m_extra.m_time <- Common.file_time file;
 		None
 		None
 	with Fail s ->
 	with Fail s ->
-		Some s
+		Some s

+ 2 - 360
src/compiler/server.ml

@@ -1,4 +1,3 @@
-open Extlib_leftovers
 open Printf
 open Printf
 open Globals
 open Globals
 open Ast
 open Ast
@@ -10,6 +9,7 @@ open DisplayProcessingGlobals
 open Json
 open Json
 open Compiler
 open Compiler
 open CompilationContext
 open CompilationContext
+open MessageReporting
 
 
 exception Dirty of module_skip_reason
 exception Dirty of module_skip_reason
 exception ServerError of string
 exception ServerError of string
@@ -21,7 +21,7 @@ let check_display_flush ctx f_otherwise = match ctx.com.json_out with
 	| None ->
 	| None ->
 		if is_diagnostics ctx.com then begin
 		if is_diagnostics ctx.com then begin
 			List.iter (fun cm ->
 			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);
 			) (List.rev ctx.messages);
 			raise (Completion (Diagnostics.print ctx.com))
 			raise (Completion (Diagnostics.print ctx.com))
 		end else
 		end else
@@ -87,364 +87,6 @@ let parse_file cs com file p =
 open ServerCompilationContext
 open ServerCompilationContext
 
 
 module Communication = struct
 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 create_stdio () =
 		let rec self = {
 		let rec self = {
 			write_out = (fun s ->
 			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
 					| None ->  type_expr ctx (EConst (Ident "null"),p) WithType.value
 				in
 				in
 				ctx.with_type_stack <- List.tl ctx.with_type_stack;
 				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();
 				f();
 				e
 				e
 			| _ -> die "" __LOC__
 			| _ -> die "" __LOC__
@@ -38,10 +38,10 @@ and do_check_cast ctx uctx tleft eright p =
 				(try
 				(try
 					Type.unify_custom uctx eright.etype tleft;
 					Type.unify_custom uctx eright.etype tleft;
 				with Unify_error l ->
 				with Unify_error l ->
-					raise (Error (Unify l, eright.epos,0)))
+					raise_error_msg (Unify l) eright.epos)
 			| _ -> ()
 			| _ -> ()
 		end;
 		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 ()
 		rec_stack_loop cast_stack cf f ()
 	in
 	in
 	let make (a,tl,(tcf,cf)) =
 	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 =
 and cast_or_unify ctx tleft eright p =
 	try
 	try
 		cast_or_unify_raise ctx tleft eright p
 		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
 		eright
 
 
 let prepare_array_access_field ctx a pl cf p =
 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
 					let e1 = cast_or_unify_raise ctx ta1 e1 p in
 					check_constraints();
 					check_constraints();
 					cf,tf,r,e1
 					cf,tf,r,e1
-				with Unify_error _ | Error (Unify _,_,_) ->
+				with Unify_error _ | Error { err_message = Unify _ } ->
 					loop cfl
 					loop cfl
 				end
 				end
 			| _ -> loop cfl
 			| _ -> 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
 					let e2 = cast_or_unify_raise ctx ta2 e2 p in
 					check_constraints();
 					check_constraints();
 					cf,tf,r,e1,e2
 					cf,tf,r,e1,e2
-				with Unify_error _ | Error (Unify _,_,_) ->
+				with Unify_error _ | Error { err_message = Unify _ } ->
 					loop cfl
 					loop cfl
 				end
 				end
 			| _ -> loop cfl
 			| _ -> 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
 		find_array_read_access_raise ctx a tl e1 p
 	with Not_found ->
 	with Not_found ->
 		let s_type = s_type (print_context()) in
 		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 =
 let find_array_write_access ctx a tl e1 e2 p =
 	try
 	try
 		find_array_write_access_raise ctx a tl e1 e2 p
 		find_array_write_access_raise ctx a tl e1 e2 p
 	with Not_found ->
 	with Not_found ->
 		let s_type = s_type (print_context()) in
 		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 find_multitype_specialization com a pl p =
 	let uctx = default_unification_context in
 	let uctx = default_unification_context in
@@ -202,7 +202,7 @@ let find_multitype_specialization com a pl p =
 					stack := t :: !stack;
 					stack := t :: !stack;
 					match follow t with
 					match follow t with
 					| TAbstract ({ a_path = [],"Class" },_) ->
 					| 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) ->
 					| TEnum(en,tl) ->
 						PMap.iter (fun _ ef -> ignore(loop ef.ef_type)) en.e_constrs;
 						PMap.iter (fun _ ef -> ignore(loop ef.ef_type)) en.e_constrs;
 						Type.map loop t
 						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
 			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 at = apply_params a.a_params pl a.a_this in
 				let st = s_type (print_context()) at 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;
 			end;
 			t
 			t
 		with Not_found ->
 		with Not_found ->
 			let at = apply_params a.a_params pl a.a_this in
 			let at = apply_params a.a_params pl a.a_this in
 			let st = s_type (print_context()) at in
 			let st = s_type (print_context()) at in
 			if has_mono at then
 			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
 			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
 	in
 	cf, follow m
 	cf, follow m
 
 
@@ -240,7 +240,7 @@ let handle_abstract_casts ctx e =
 					let's construct the underlying type. *)
 					let's construct the underlying type. *)
 				match Abstract.get_underlying_type a pl with
 				match Abstract.get_underlying_type a pl with
 				| TInst(c,tl) as t -> {e with eexpr = TNew(c,tl,el); etype = t}
 				| 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
 			end else begin
 				(* a TNew of an abstract implementation is only generated if it is a multi type abstract *)
 				(* 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
 				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 *)
 	(* communication *)
 	mutable print : string -> unit;
 	mutable print : string -> unit;
 	mutable error : ?depth:int -> string -> pos -> 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 warning_options : Warning.warning_option list list;
 	mutable get_messages : unit -> compiler_message list;
 	mutable get_messages : unit -> compiler_message list;
 	mutable filter_messages : (compiler_message -> bool) -> unit;
 	mutable filter_messages : (compiler_message -> bool) -> unit;
@@ -415,7 +415,7 @@ type context = {
 	memory_marker : float array;
 	memory_marker : float array;
 }
 }
 
 
-exception Abort of located
+exception Abort of Error.error
 
 
 let ignore_error com =
 let ignore_error com =
 	let b = com.display.dms_error_policy = EPIgnore in
 	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_defines = Hashtbl.create 0;
 		user_metas = Hashtbl.create 0;
 		user_metas = Hashtbl.create 0;
 		get_macros = (fun() -> None);
 		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 = [];
 		warning_options = [];
 		error = (fun ?depth _ _ -> die "" __LOC__);
 		error = (fun ?depth _ _ -> die "" __LOC__);
-		located_error = (fun ?depth _ -> die "" __LOC__);
+		error_ext = (fun _ -> die "" __LOC__);
 		get_messages = (fun() -> []);
 		get_messages = (fun() -> []);
 		filter_messages = (fun _ -> ());
 		filter_messages = (fun _ -> ());
 		pass_debug_messages = DynArray.create();
 		pass_debug_messages = DynArray.create();
@@ -1026,8 +1026,7 @@ let allow_package ctx s =
 	with Not_found ->
 	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
 let platform ctx p = ctx.platform = p
 
 
@@ -1231,25 +1230,21 @@ let utf16_to_utf8 str =
 	loop 0;
 	loop 0;
 	Buffer.contents b
 	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;
 	if sev = MessageSeverity.Error then com.has_error <- true;
 	let di = com.shared.shared_display_information in
 	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 =
 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
 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 check_other_things com e =
 	let had_effect = ref false in
 	let had_effect = ref false in
 	let no_effect p =
 	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
 	in
 	let pointless_compound s p =
 	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
 	in
 	let rec compound s el p =
 	let rec compound s el p =
 		let old = !had_effect in
 		let old = !had_effect in
@@ -190,4 +190,4 @@ let print com =
 
 
 let run com =
 let run com =
 	let dctx = prepare com in
 	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
 					let item = make_ci_class_field (CompletionClassField.make f CFSMember origin true) (f.cf_type,ct) in
 					PMap.add f.cf_name item acc
 					PMap.add f.cf_name item acc
 				end
 				end
-			with Error (Unify _,_,_) | Unify_error _ ->
+			with Error { err_message = Unify _ } | Unify_error _ ->
 				acc
 				acc
 			end
 			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
 			handle_missing_field_raise ctx ctx.tthis i mode with_type p
 		with Exit ->
 		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
 			(match List.rev path with
 			(* p spans `import |` (to the display position), so we take the pmax here *)
 			(* 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})
 			| [] -> 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 ->
 	| (tname,p2) :: rest ->
 		let p1 = (match pack with [] -> p2 | (_,p1) :: _ -> p1) in
 		let p1 = (match pack with [] -> p2 | (_,p1) :: _ -> p1) in
 		let p_type = punion p1 p2 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 md = ctx.g.do_load_module ctx (List.map fst pack,tname) p_type in
 		let types = md.m_types in
 		let types = md.m_types in
 		let no_private (t,_) = not (t_infos t).mt_private 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 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
 		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) []
 				| '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
 				| _ -> "type", List.map (fun mt -> snd (t_infos mt).mt_path) types
 			in
 			in
-			typing_error (StringError.string_error name
+			raise_typing_error (StringError.string_error name
 				candidates
 				candidates
 				("Module " ^ s_type_path md.m_path ^ " does not define " ^ target_kind ^ " " ^ name)
 				("Module " ^ s_type_path md.m_path ^ " does not define " ^ target_kind ^ " " ^ name)
 			) p
 			) p
@@ -111,7 +111,7 @@ let init_import ctx context_init path mode p =
 		in
 		in
 		let rebind t name p =
 		let rebind t name p =
 			if not (name.[0] >= 'A' && name.[0] <= 'Z') then
 			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
 			let _, _, f = ctx.g.do_build_instance ctx t p_type in
 			(* create a temp private typedef, does not register it in module *)
 			(* create a temp private typedef, does not register it in module *)
 			let t_path = (fst md.m_path @ ["_" ^ snd md.m_path],name) in
 			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 ->
 			| (tsub,p2) :: (fname,p3) :: rest ->
 				(match rest with
 				(match rest with
 				| [] -> ()
 				| [] -> ()
-				| (n,p) :: _ -> typing_error ("Unexpected " ^ n) p);
+				| (n,p) :: _ -> raise_typing_error ("Unexpected " ^ n) p);
 				let tsub = get_type tsub in
 				let tsub = get_type tsub in
 				context_init#add (fun() ->
 				context_init#add (fun() ->
 					try
 					try
@@ -236,7 +236,7 @@ let init_import ctx context_init path mode p =
 			let t = (match rest with
 			let t = (match rest with
 				| [] -> get_type tname
 				| [] -> get_type tname
 				| [tsub,_] -> get_type tsub
 				| [tsub,_] -> get_type tsub
-				| _ :: (n,p) :: _ -> typing_error ("Unexpected " ^ n) p
+				| _ :: (n,p) :: _ -> raise_typing_error ("Unexpected " ^ n) p
 			) in
 			) in
 			context_init#add (fun() ->
 			context_init#add (fun() ->
 				match resolve_typedef t with
 				match resolve_typedef t with
@@ -247,7 +247,7 @@ let init_import ctx context_init path mode p =
 				| TEnumDecl e ->
 				| 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
 					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
 	let types,filter_classes = handle_using ctx path p in
 	(* do the import first *)
 	(* do the import first *)
 	ctx.m.module_imports <- (List.map (fun t -> t,p) types) @ ctx.m.module_imports;
 	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
 			| "true" | "inferredPure" -> Pure
 			| "false" -> Impure
 			| "false" -> Impure
 			| "expect" -> ExpectPure p
 			| "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
 			end
 		| (_,[],_) ->
 		| (_,[],_) ->
 			Pure
 			Pure
 		| (_,_,p) ->
 		| (_,_,p) ->
-			typing_error "Unsupported purity value" p
+			raise_typing_error "Unsupported purity value" p
 		end
 		end
 	with Not_found ->
 	with Not_found ->
 		MaybePure
 		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 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()|]
 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
 	let ef = make_static_field_access c cf (map cf.cf_type) p in
 	make_call ctx ef args (map t) p
 	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 =
 let raise_or_display ctx l p =
 	if ctx.untyped then ()
 	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 =
 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
 	else display_error ctx.com msg p
 
 
 let unify ctx t1 t2 p =
 let unify ctx t1 t2 p =
@@ -279,7 +287,7 @@ let unify_raise_custom uctx t1 t2 p =
 	with
 	with
 		Unify_error l ->
 		Unify_error l ->
 			(* no untyped check *)
 			(* no untyped check *)
-			raise (Error (Unify l,p,0))
+			raise_error_msg (Unify l) p
 
 
 let unify_raise = unify_raise_custom default_unification_context
 let unify_raise = unify_raise_custom default_unification_context
 
 
@@ -337,8 +345,11 @@ let check_module_path ctx (pack,name) p =
 	try
 	try
 		List.iter (fun part -> Path.check_package_name part) pack;
 		List.iter (fun part -> Path.check_package_name part) pack;
 	with Failure msg ->
 	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 =
 let check_local_variable_name ctx name origin p =
 	match name with
 	match name with
@@ -423,8 +434,8 @@ let exc_protect ?(force=true) ctx f (where:string) =
 			r := lazy_available t;
 			r := lazy_available t;
 			t
 			t
 		with
 		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));
 	if force then delay ctx PForce (fun () -> ignore(lazy_type r));
 	r
 	r
@@ -804,9 +815,9 @@ let display_error ctx.com msg p =
 	debug ctx ("ERROR " ^ msg);
 	debug ctx ("ERROR " ^ msg);
 	display_error ctx.com msg p
 	display_error ctx.com msg p
 
 
-let located_display_error ctx.com msg =
+let display_error_ext ctx.com msg =
 	debug ctx ("ERROR " ^ msg);
 	debug ctx ("ERROR " ^ msg);
-	located_display_error ctx.com msg
+	display_error_ext ctx.com msg
 
 
 let make_pass ?inf ctx f =
 let make_pass ?inf ctx f =
 	let inf = (match inf with None -> pass_infos ctx ctx.pass | Some inf -> inf) in
 	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) ->
 				| EMeta((Meta.Custom ":followWithAbstracts",_,_),e1) ->
 					loop follow_with_abstracts e1;
 					loop follow_with_abstracts e1;
 				| _ ->
 				| _ ->
-					typing_error "Type parameter expected" (pos e)
+					raise_typing_error "Type parameter expected" (pos e)
 			in
 			in
 			loop (fun t -> t) e
 			loop (fun t -> t) e
 		) el;
 		) 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
 				if rec_stack_exists (fast_eq t) underlying_type_stack then begin
 					let pctx = print_context() in
 					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
 					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;
 				end;
 				get_underlying_type a tl
 				get_underlying_type a tl
 			| _ ->
 			| _ ->

+ 49 - 33
src/core/error.ml

@@ -17,7 +17,6 @@ and error_msg =
 	| Unify of unify_error list
 	| Unify of unify_error list
 	| Custom of string
 	| Custom of string
 	| Unknown_ident of string
 	| Unknown_ident of string
-	| Stack of (error_msg * Globals.pos) list
 	| Call_error of call_error
 	| Call_error of call_error
 	| No_constructor of module_type
 	| No_constructor of module_type
 	| Abstract_class of module_type
 	| Abstract_class of module_type
@@ -26,8 +25,31 @@ and type_not_found_reason =
 	| Private_type
 	| Private_type
 	| Not_defined
 	| 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
 let string_source t = match follow t with
 	| TInst(c,tl) -> PMap.foldi (fun s _ acc -> s :: acc) (TClass.get_all_fields c tl) []
 	| 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.
 	Should be called for each complementary error message.
 *)
 *)
 let compl_msg s = "... " ^ s
 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
 let unify_error_msg ctx err = match err with
 	| Cannot_unify (t1,t2) ->
 	| 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
 			Printf.sprintf "error: %s\nhave: %s\nwant: %s" (Buffer.contents message_buffer) slhs srhs
 end
 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 ->
 	| Not_enough_arguments tl ->
 		let pctx = print_context() in
 		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 =
 let error_require r p =
 	if r = "" then
 	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
 	else
 	let r = if r = "sys" then
 	let r = if r = "sys" then
 		"a system platform (php,neko,cpp,etc.)"
 		"a system platform (php,neko,cpp,etc.)"
@@ -323,6 +339,6 @@ let error_require r p =
 	with _ ->
 	with _ ->
 		"'" ^ r ^ "' to be enabled"
 		"'" ^ r ^ "' to be enabled"
 	in
 	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 path = string list * string
-type located =
-	| Message of string * pos
-	| Stack of located list
 
 
 module IntMap = Ptmap
 module IntMap = Ptmap
 module StringMap = Map.Make(struct type t = string let compare = String.compare end)
 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 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 macro_platform = ref Neko
 
 
 let return_partial_type = ref false
 let return_partial_type = ref false
@@ -195,14 +175,16 @@ type compiler_message = {
 	cm_message : string;
 	cm_message : string;
 	cm_pos : pos;
 	cm_pos : pos;
 	cm_depth : int;
 	cm_depth : int;
+	cm_from_macro : bool;
 	cm_kind : MessageKind.t;
 	cm_kind : MessageKind.t;
 	cm_severity : MessageSeverity.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_message = msg;
 		cm_pos = p;
 		cm_pos = p;
 		cm_depth = depth;
 		cm_depth = depth;
+		cm_from_macro = from_macro;
 		cm_kind = kind;
 		cm_kind = kind;
 		cm_severity = sev;
 		cm_severity = sev;
 }
 }

+ 2 - 2
src/core/inheritDoc.ml

@@ -8,7 +8,7 @@ let expr_to_target e =
 		match e with
 		match e with
 		| EConst (Ident s) when s <> "" -> [s]
 		| EConst (Ident s) when s <> "" -> [s]
 		| EField (e,s,_) -> s :: loop e
 		| 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
 	in
 	match loop e with
 	match loop e with
 	| sub_name :: type_name :: pack when not (is_lower_ident type_name) ->
 	| sub_name :: type_name :: pack when not (is_lower_ident type_name) ->
@@ -16,7 +16,7 @@ let expr_to_target e =
 	| type_name :: pack ->
 	| type_name :: pack ->
 		(List.rev pack, type_name), None
 		(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 =
 let rec get_constructor c =
 	match c.cl_constructor, c.cl_super with
 	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
 		| TFloat f -> mk (TConst (TFloat f)) basic.tfloat p
 		| TBool b -> mk (TConst (TBool b)) basic.tbool p
 		| TBool b -> mk (TConst (TBool b)) basic.tbool p
 		| TNull -> mk (TConst TNull) (basic.tnull (mk_mono())) 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 field e name t p =
 		let f =
 		let f =
@@ -572,7 +572,7 @@ let replace_separators s c =
 let type_constant basic c p =
 let type_constant basic c p =
 	match c with
 	match c with
 	| Int (s,_) ->
 	| 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
 		(try mk (TConst (TInt (Int32.of_string s))) basic.tint p
 		with _ -> mk (TConst (TFloat s)) basic.tfloat p)
 		with _ -> mk (TConst (TFloat s)) basic.tfloat p)
 	| Float (f,_) -> mk (TConst (TFloat f)) 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 "true" -> mk (TConst (TBool true)) basic.tbool p
 	| Ident "false" -> mk (TConst (TBool false)) basic.tbool p
 	| Ident "false" -> mk (TConst (TBool false)) basic.tbool p
 	| Ident "null" -> mk (TConst TNull) (basic.tnull (mk_mono())) 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) =
 let rec type_constant_value basic (e,p) =
 	match e with
 	match e with
@@ -594,16 +594,16 @@ let rec type_constant_value basic (e,p) =
 	| EArrayDecl el ->
 	| EArrayDecl el ->
 		mk (TArrayDecl (List.map (type_constant_value basic) el)) (basic.tarray t_dynamic) p
 		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 =
 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 for_remap basic v e1 e2 p =
 	let v' = alloc_var v.v_kind v.v_name e1.etype e1.epos in
 	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 ev' = mk (TLocal v') e1.etype e1.epos in
 	let t1 = (Abstract.follow_with_abstracts e1.etype) 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 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 (TField(ev',quick_field t1 "next")) (tfun [] v.v_type) e1.epos in
 	let enext = mk (TCall(enext,[])) 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 make_meta_field ml =
 		let h = Hashtbl.create 0 in
 		let h = Hashtbl.create 0 in
 		mk (TObjectDecl (List.map (fun (f,el,p) ->
 		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 ();
 			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
 			(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
 		) ml)) t_dynamic p

+ 3 - 3
src/core/warning.ml

@@ -13,7 +13,7 @@ type warning_option = {
 
 
 let parse_options s ps lexbuf =
 let parse_options s ps lexbuf =
 	let fail msg p =
 	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
 	in
 	let parse_string s p =
 	let parse_string s p =
 		begin try
 		begin try
@@ -58,7 +58,7 @@ let from_meta ml =
 			let p = snd e in
 			let p = snd e in
 			parse_options s {p with pmin = p.pmin + 1; pmax = p.pmax - 1} (* pmin is on the quote *)
 			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
 	in
 	let rec loop acc ml = match ml with
 	let rec loop acc ml = match ml with
 		| (Meta.HaxeWarning,args,_) :: ml ->
 		| (Meta.HaxeWarning,args,_) :: ml ->
@@ -92,4 +92,4 @@ let get_mode w (l : warning_option list list) =
 			in
 			in
 			loop (loop2 mode l2) l
 			loop (loop2 mode l2) l
 	in
 	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 haxe_exception_static_call ctx method_name args p =
 	let method_field =
 	let method_field =
 		try PMap.find method_name ctx.haxe_exception_class.cl_statics
 		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
 	in
 	let return_type =
 	let return_type =
 		match follow method_field.cf_type with
 		match follow method_field.cf_type with
 		| TFun(_,t) -> t
 		| 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
 	in
 	add_dependency ctx.typer.curclass.cl_module ctx.haxe_exception_class.cl_module;
 	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
 	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
 			match follow cf.cf_type with
 			| TFun(_,t) -> t
 			| 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
 		in
 		make_call ctx.typer efield args rt p
 		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)`
 	Generate `Std.isOfType(e, t)`
@@ -70,16 +70,16 @@ let std_is ctx e t p =
 	let std_cls =
 	let std_cls =
 		match Typeload.load_type_raise ctx.typer ([],"Std") "Std" p with
 		match Typeload.load_type_raise ctx.typer ([],"Std") "Std" p with
 		| TClassDecl cls -> cls
 		| 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
 	in
 	let isOfType_field =
 	let isOfType_field =
 		try PMap.find "isOfType" std_cls.cl_statics
 		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
 	in
 	let return_type =
 	let return_type =
 		match follow isOfType_field.cf_type with
 		match follow isOfType_field.cf_type with
 		| TFun(_,t) -> t
 		| 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
 	in
 	let type_expr = { eexpr = TTypeExpr(module_type_of_type t); etype = t; epos = 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
 	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`
 	Check if expression represents an exception wrapped with `haxe.Exception.thrown`
 *)
 *)
 let is_wrapped_exception e =
 let is_wrapped_exception e =
-	match e.eexpr with 
+	match e.eexpr with
 	| TMeta ((Meta.WrappedException, _, _), _) -> true
 	| TMeta ((Meta.WrappedException, _, _), _) -> true
 	| _ -> false
 	| _ -> false
 
 
@@ -196,7 +196,7 @@ let throw_native ctx e_thrown t p =
 	let e_native =
 	let e_native =
 		if requires_wrapped_throw ctx e_thrown then
 		if requires_wrapped_throw ctx e_thrown then
 			let thrown = haxe_exception_static_call ctx "thrown" [e_thrown] p in
 			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
 				if is_dynamic ctx.base_throw_type then thrown
 				else mk_cast thrown ctx.base_throw_type p
 				else mk_cast thrown ctx.base_throw_type p
 			in
 			in
@@ -542,16 +542,16 @@ let filter tctx =
 		and haxe_exception_type, haxe_exception_class =
 		and haxe_exception_type, haxe_exception_class =
 			match Typeload.load_instance tctx (tp haxe_exception_type_path) true with
 			match Typeload.load_instance tctx (tp haxe_exception_type_path) true with
 			| TInst(cls,_) as t -> t,cls
 			| 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 =
 		and value_exception_type, value_exception_class =
 			match Typeload.load_instance tctx (tp value_exception_type_path) true with
 			match Typeload.load_instance tctx (tp value_exception_type_path) true with
 			| TInst(cls,_) as t -> t,cls
 			| 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 =
 		and haxe_native_stack_trace =
 			match Typeload.load_instance tctx (tp (["haxe"],"NativeStackTrace")) true with
 			match Typeload.load_instance tctx (tp (["haxe"],"NativeStackTrace")) true with
 			| TInst(cls,_) -> cls
 			| TInst(cls,_) -> cls
 			| TAbstract({ a_impl = Some 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
 		in
 		let is_path_of_dynamic (pack,name) =
 		let is_path_of_dynamic (pack,name) =
 			name = "Dynamic" && (pack = [] || pack = ["StdTypes"])
 			name = "Dynamic" && (pack = [] || pack = ["StdTypes"])
@@ -601,7 +601,7 @@ let insert_save_stacks tctx =
 			match Typeload.load_type_def tctx null_pos tp with
 			match Typeload.load_type_def tctx null_pos tp with
 			| TClassDecl cls -> cls
 			| TClassDecl cls -> cls
 			| TAbstractDecl { a_impl = Some 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
 		in
 		let rec contains_insertion_points e =
 		let rec contains_insertion_points e =
 			match e.eexpr with
 			match e.eexpr with
@@ -617,12 +617,12 @@ let insert_save_stacks tctx =
 			if has_feature tctx.com "haxe.NativeStackTrace.exceptionStack" then
 			if has_feature tctx.com "haxe.NativeStackTrace.exceptionStack" then
 				let method_field =
 				let method_field =
 					try PMap.find "saveStack" native_stack_trace_cls.cl_statics
 					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
 				in
 				let return_type =
 				let return_type =
 					match follow method_field.cf_type with
 					match follow method_field.cf_type with
 					| TFun(_,t) -> t
 					| 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
 				in
 				let catch_local = mk (TLocal catch_var) catch_var.v_type catch_var.v_pos in
 				let catch_local = mk (TLocal catch_var) catch_var.v_type catch_var.v_pos in
 				begin
 				begin
@@ -676,7 +676,7 @@ let patch_constructors tctx =
 					let this = { eexpr = TConst(TThis); etype = t; epos = p } in
 					let this = { eexpr = TConst(TThis); etype = t; epos = p } in
 					let faccess =
 					let faccess =
 						try quick_field t "__shiftStack"
 						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
 					in
 					match faccess with
 					match faccess with
 					| FInstance (_,_,cf) ->
 					| FInstance (_,_,cf) ->
@@ -685,10 +685,10 @@ let patch_constructors tctx =
 							match follow cf.cf_type with
 							match follow cf.cf_type with
 							| TFun(_,t) -> t
 							| 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
 						in
 						make_call tctx efield [] rt p
 						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
 				in
 				TypeloadFunction.add_constructor tctx cls true cls.cl_name_pos;
 				TypeloadFunction.add_constructor tctx cls true cls.cl_name_pos;
 				Option.may (fun cf -> ignore(follow cf.cf_type)) cls.cl_constructor;
 				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
 		begin try
 			let cf = PMap.find name ctx.curclass.cl_statics in
 			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;
 			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 ->
 		with Not_found ->
 			let cf = mk_field name ~static:true v.v_type v.v_pos v.v_pos in
 			let cf = mk_field name ~static:true v.v_type v.v_pos v.v_pos in
 			begin match eo with
 			begin match eo with
@@ -81,11 +81,11 @@ module LocalStatic = struct
 			| Some e ->
 			| Some e ->
 				let rec loop e = match e.eexpr with
 				let rec loop e = match e.eexpr with
 					| TLocal _ | TFunction _ ->
 					| 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) ->
 					| 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 ->
 					| 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
 						iter loop e
 				in
 				in
@@ -117,7 +117,7 @@ module LocalStatic = struct
 					let cf = find_local_static local_static_lut v in
 					let cf = find_local_static local_static_lut v in
 					Texpr.Builder.make_static_field c cf e.epos
 					Texpr.Builder.make_static_field c cf e.epos
 				with Not_found ->
 				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
 				end
 			| _ ->
 			| _ ->
 				Type.map_expr run e
 				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
 					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 warning ctx WVarInit ("Local variable " ^ v.v_name ^ " might be used before being initialized") e.epos
 				else
 				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
 			end
 		| TVar (v,eo) ->
 		| TVar (v,eo) ->
 			begin
 			begin
@@ -345,7 +345,7 @@ let check_abstract_as_value e =
 		match e.eexpr with
 		match e.eexpr with
 		| TField ({ eexpr = TTypeExpr _ }, _) -> ()
 		| TField ({ eexpr = TTypeExpr _ }, _) -> ()
 		| TTypeExpr(TClassDecl {cl_kind = KAbstractImpl a}) when not (Meta.has Meta.RuntimeValue a.a_meta) ->
 		| 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
 		| _ -> Type.iter loop e
 	in
 	in
 	loop e;
 	loop e;
@@ -388,7 +388,7 @@ let remove_extern_fields com t = match t with
 let check_private_path ctx t = match t with
 let check_private_path ctx t = match t with
 	| TClassDecl c when c.cl_private ->
 	| TClassDecl c when c.cl_private ->
 		let rpath = (fst c.cl_module.m_path,"_" ^ snd c.cl_module.m_path) in
 		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 =
 		let check fields f =
 			match f.cf_kind with
 			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) ->
 			| 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 *)
 				(* prevent generating reflect helpers for the event in gencommon *)
 				f.cf_meta <- (Meta.SkipReflection, [], f.cf_pos) :: f.cf_meta;
 				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 tmeth = (tfun [f.cf_type] com.basic.tvoid) in
 
 
 				let process_event_method name =
 				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 *)
 					(* check method signature *)
 					begin
 					begin
@@ -625,7 +625,7 @@ let check_remove_metadata t = match t with
 let check_void_field t = match t with
 let check_void_field t = match t with
 	| TClassDecl c ->
 	| TClassDecl c ->
 		let check f =
 		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
 		in
 		List.iter check c.cl_ordered_fields;
 		List.iter check c.cl_ordered_fields;
 		List.iter check c.cl_ordered_statics;
 		List.iter check c.cl_ordered_statics;
@@ -1024,4 +1024,4 @@ let run com tctx main =
 	let t = filter_timer detail_times ["callbacks"] in
 	let t = filter_timer detail_times ["callbacks"] in
 	com.callbacks#run com.callbacks#get_after_save; (* macros onGenerate etc. *)
 	com.callbacks#run com.callbacks#get_after_save; (* macros onGenerate etc. *)
 	t();
 	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
 module AnnotationHandler = struct
 	let convert_annotations meta =
 	let convert_annotations meta =
 		let parse_path e =
 		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
 			let path = match sl with
 				| s :: sl -> List.rev sl,s
 				| s :: sl -> List.rev sl,s
-				| _ -> Error.typing_error "Field expression expected" (pos e)
+				| _ -> Error.raise_typing_error "Field expression expected" (pos e)
 			in
 			in
 			path
 			path
 		in
 		in
@@ -268,12 +268,12 @@ module AnnotationHandler = struct
 				let values = List.map parse_value_pair el in
 				let values = List.map parse_value_pair el in
 				AAnnotation(TObject(path, []),values)
 				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
 		and parse_value_pair e = match fst e with
 			| EBinop(OpAssign,(EConst(Ident s),_),e1) ->
 			| EBinop(OpAssign,(EConst(Ident s),_),e1) ->
 				s,parse_value e1
 				s,parse_value e1
 			| _ ->
 			| _ ->
-				Error.typing_error "Assignment expression expected" (pos e)
+				Error.raise_typing_error "Assignment expression expected" (pos e)
 		in
 		in
 		let parse_expr e = match fst e with
 		let parse_expr e = match fst e with
 			| ECall(e1,el) ->
 			| ECall(e1,el) ->
@@ -283,7 +283,7 @@ module AnnotationHandler = struct
 				let values = List.map parse_value_pair el in
 				let values = List.map parse_value_pair el in
 				path,values
 				path,values
 			| _ ->
 			| _ ->
-				Error.typing_error "Call expression expected" (pos e)
+				Error.raise_typing_error "Call expression expected" (pos e)
 		in
 		in
 		ExtList.List.filter_map (fun (m,el,_) -> match m,el with
 		ExtList.List.filter_map (fun (m,el,_) -> match m,el with
 			| Meta.Meta,[e] ->
 			| Meta.Meta,[e] ->
@@ -1516,11 +1516,11 @@ class texpr_to_jvm
 					self#expect_reference_type;
 					self#expect_reference_type;
 					let path = match jsignature_of_type gctx (type_of_module_type mt) with
 					let path = match jsignature_of_type gctx (type_of_module_type mt) with
 						| TObject(path,_) -> path
 						| TObject(path,_) -> path
-						| _ -> Error.typing_error "Class expected" pe
+						| _ -> Error.raise_typing_error "Class expected" pe
 					in
 					in
 					code#instanceof path;
 					code#instanceof path;
 					Some TBool
 					Some TBool
-				| _ -> Error.typing_error "Type expression expected" e1.epos
+				| _ -> Error.raise_typing_error "Type expression expected" e1.epos
 			end;
 			end;
 		| TField(_,FStatic({cl_path = (["java";"lang"],"Math")},{cf_name = ("isNaN" | "isFinite") as name})) ->
 		| TField(_,FStatic({cl_path = (["java";"lang"],"Math")},{cf_name = ("isNaN" | "isFinite") as name})) ->
 			begin match el with
 			begin match el with
@@ -1579,7 +1579,7 @@ class texpr_to_jvm
 				self#new_native_array jsig el;
 				self#new_native_array jsig el;
 				Some (array_sig jsig)
 				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
 			end
 		| TField(_,FStatic({cl_path = (["haxe"],"EnumTools")}, {cf_name = "values"})) ->
 		| TField(_,FStatic({cl_path = (["haxe"],"EnumTools")}, {cf_name = "values"})) ->
 			begin match el with
 			begin match el with
@@ -1664,7 +1664,7 @@ class texpr_to_jvm
 					info.super_call_fields <- tl;
 					info.super_call_fields <- tl;
 					hd
 					hd
 				| _ ->
 				| _ ->
-					Error.typing_error "Something went wrong" e1.epos
+					Error.raise_typing_error "Something went wrong" e1.epos
 			in
 			in
 			let kind = get_construction_mode c cf in
 			let kind = get_construction_mode c cf in
 			begin match kind with
 			begin match kind with
@@ -1995,7 +1995,7 @@ class texpr_to_jvm
 			)
 			)
 		| TNew(c,tl,el) ->
 		| TNew(c,tl,el) ->
 			begin match OverloadResolution.maybe_resolve_constructor_overload c tl el with
 			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,_) ->
 			| Some (c',cf,_) ->
 				let f () =
 				let f () =
 					let tl,_ = self#call_arguments cf.cf_type el in
 					let tl,_ = self#call_arguments cf.cf_type el in
@@ -2163,7 +2163,7 @@ class texpr_to_jvm
 				) fl;
 				) fl;
 			end
 			end
 		| TIdent _ ->
 		| 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 *)
 	(* api *)
 
 

+ 15 - 15
src/generators/genlua.ml

@@ -77,7 +77,7 @@ let get_exposed ctx path meta = try
         (match args with
         (match args with
          | [ EConst (String(s,_)), _ ] -> [s]
          | [ EConst (String(s,_)), _ ] -> [s]
          | [] -> [path]
          | [] -> [path]
-         | _ -> typing_error "Invalid @:expose parameters" pos)
+         | _ -> raise_typing_error "Invalid @:expose parameters" pos)
     with Not_found -> []
     with Not_found -> []
 
 
 let dot_path = Globals.s_type_path
 let dot_path = Globals.s_type_path
@@ -159,7 +159,7 @@ let println ctx =
             newline ctx
             newline ctx
         end)
         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 =
 let basename path =
     try
     try
@@ -384,7 +384,7 @@ and gen_call ctx e el =
     (match e.eexpr , el with
     (match e.eexpr , el with
      | TConst TSuper , params ->
      | TConst TSuper , params ->
          (match ctx.current.cl_super with
          (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,_) ->
           | Some (c,_) ->
               print ctx "%s.super(%s" (ctx.type_accessor (TClassDecl c)) (this ctx);
               print ctx "%s.super(%s" (ctx.type_accessor (TClassDecl c)) (this ctx);
               List.iter (fun p -> print ctx ","; gen_argument ctx p) params;
               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 ->
      | TField ({ eexpr = TConst TSuper },f) , params ->
          (match ctx.current.cl_super with
          (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,_) ->
           | Some (c,_) ->
               let name = field_name f in
               let name = field_name f in
               print ctx "%s.prototype%s(%s" (ctx.type_accessor (TClassDecl c)) (field name) (this ctx);
               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;
                   if List.length(fields) > 0 then incr count;
               | { eexpr = TConst(TNull)} -> ()
               | { 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;
              )) el;
          spr ctx "})";
          spr ctx "})";
      | TIdent "__lua__", [{ eexpr = TConst (TString code) }] ->
      | TIdent "__lua__", [{ eexpr = TConst (TString code) }] ->
@@ -640,7 +640,7 @@ and check_multireturn_param ctx t pos =
    match t with
    match t with
          TAbstract(_,p) | TInst(_,p) ->
          TAbstract(_,p) | TInst(_,p) ->
             if List.exists ttype_multireturn p then
             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
             else
                 ()
                 ()
         | _ ->
         | _ ->
@@ -1519,20 +1519,20 @@ let check_multireturn ctx c =
     match c with
     match c with
     | _ when Meta.has Meta.MultiReturn c.cl_meta ->
     | _ when Meta.has Meta.MultiReturn c.cl_meta ->
         if not (has_class_flag c CExtern) then
         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
         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
         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 ->
     | {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 =
 let check_field_name c f =
     match f.cf_name with
     match f.cf_name with
     | "prototype" | "__proto__" | "constructor" ->
     | "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"] *)
 (* convert a.b.c to ["a"]["b"]["c"] *)
@@ -1617,7 +1617,7 @@ let generate_class ctx c =
     ctx.current <- c;
     ctx.current <- c;
     ctx.id_counter <- 0;
     ctx.id_counter <- 0;
     (match c.cl_path with
     (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 p = s_path ctx c.cl_path in
     let hxClasses = has_feature ctx "Type.resolveClass" 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,_)),_)] ->
      | [(EConst(String(module_name,_)),_) ; (EConst(String(object_path,_)),_)] ->
          print ctx "%s = _G.require(\"%s\").%s" p module_name 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
     newline ctx
 
 
@@ -1830,7 +1830,7 @@ let generate_type ctx = function
         if p = "Std" && c.cl_ordered_statics = [] then
         if p = "Std" && c.cl_ordered_statics = [] then
             ()
             ()
         else if (not (has_class_flag c CExtern)) && Meta.has Meta.LuaDotMethod c.cl_meta 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
         else if not (has_class_flag c CExtern) then
             generate_class ctx c;
             generate_class ctx c;
         check_multireturn ctx c;
         check_multireturn ctx c;
@@ -1943,7 +1943,7 @@ let transform_multireturn ctx = function
                         e
                         e
                     | TReturn Some(e2) ->
                     | TReturn Some(e2) ->
                         if is_multireturn e2.etype then
                         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
                         else
                             Type.map_expr loop e;
                             Type.map_expr loop e;
      (*
      (*

+ 3 - 3
src/generators/genpy.ml

@@ -1492,9 +1492,9 @@ module Printer = struct
 				let interpolate () =
 				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
 					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
 				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
 				Buffer.contents buf
 			| ("python_Syntax._pythonCode"), [e] ->
 			| ("python_Syntax._pythonCode"), [e] ->
 				print_expr pctx e
 				print_expr pctx e

+ 2 - 2
src/generators/genshared.ml

@@ -278,7 +278,7 @@ object(self)
 				in
 				in
 				loop csup;
 				loop csup;
 				(c,cf)
 				(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
 		in
 		let find_super_ctor el =
 		let find_super_ctor el =
 			let _,cf = find_super_ctor el in
 			let _,cf = find_super_ctor el in
@@ -470,4 +470,4 @@ class ['a] typedef_interfaces (infos : 'a info_context) (anon_identification : '
 				acc
 				acc
 		) anon_identification#get_pfms [] in
 		) anon_identification#get_pfms [] in
 		info.typedef_implements <- Some l
 		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 =
 let get_static_prototype ctx path p =
 	try get_static_prototype_raise ctx path
 	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 =
 let get_static_prototype_as_value ctx path p =
 	(get_static_prototype ctx path p).pvalue
 	(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 =
 let get_instance_prototype ctx path p =
 	try get_instance_prototype_raise ctx path
 	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 =
 let get_instance_constructor_raise ctx path =
 	IntMap.find path ctx.constructors
 	IntMap.find path ctx.constructors
 
 
 let get_instance_constructor ctx path p =
 let get_instance_constructor ctx path p =
 	try get_instance_constructor_raise ctx path
 	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 =
 let get_special_instance_constructor_raise ctx path =
 	Hashtbl.find (get_ctx()).builtins.constructor_builtins 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 =
 let get_proto_field_index proto name =
 	try get_proto_field_index_raise 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 =
 let get_instance_field_index_raise proto name =
 	IntMap.find name proto.pinstance_names
 	IntMap.find name proto.pinstance_names
 
 
 let get_instance_field_index proto name p =
 let get_instance_field_index proto name p =
 	try get_instance_field_index_raise proto name
 	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 =
 let is v path =
 	if path = key_Dynamic then
 	if path = key_Dynamic then
@@ -571,4 +571,4 @@ let is v path =
 			end
 			end
 		in
 		in
 		loop vi.iproto
 		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
 								in
 								(Error.Custom (value_string v1), v2)
 								(Error.Custom (value_string v1), v2)
 							end else
 							end else
-								Error.typing_error "Something went wrong" null_pos
+								Error.raise_typing_error "Something went wrong" null_pos
 						) (EvalArray.to_list sub)
 						) (EvalArray.to_list sub)
 				| _ -> []
 				| _ -> []
 			in
 			in
@@ -163,11 +163,11 @@ let catch_exceptions ctx ?(final=(fun() -> ())) f p =
 						| _ -> null_pos
 						| _ -> null_pos
 					in
 					in
 					(match stack with
 					(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
 		end else begin
 			(* Careful: We have to get the message before resetting the context because toString() might access it. *)
 			(* Careful: We have to get the message before resetting the context because toString() might access it. *)
 			let stack = match eval_stack with
 			let stack = match eval_stack with
@@ -179,10 +179,11 @@ let catch_exceptions ctx ?(final=(fun() -> ())) f p =
 			reset_ctx();
 			reset_ctx();
 			final();
 			final();
 			let p = if p' = null_pos then p else p' in
 			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
 		end
 	| MacroApi.Abort ->
 	| MacroApi.Abort ->
 		final();
 		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;
 		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) ->
 		let captures = ExtList.List.filter_map (fun (i,vid,declared) ->
 			if declared then None
 			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
 		) captures in
 		let mapping = Array.of_list captures in
 		let mapping = Array.of_list captures in
 		emit_closure ctx mapping eci hasret exec fl
 		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) ->
 	| TParenthesis e1 | TMeta(_,e1) | TCast(e1,None) ->
 		loop e1
 		loop e1
 	| TIdent s ->
 	| TIdent s ->
-		Error.typing_error ("Unknown identifier: " ^ s) e.epos
+		Error.raise_typing_error ("Unknown identifier: " ^ s) e.epos
 	in
 	in
 	let f = loop e in
 	let f = loop e in
 	begin match ctx.debug.debug_socket with
 	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
 		let f = jit_expr jit false (mk_block e) in
 		jit,f
 		jit,f
 	in
 	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 ->
 		Error.set_on_unhandled_exception (fun ex ->
 			let msg =
 			let msg =
 				match ex with
 				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"` *)
 					(* 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
 				| _ -> Printexc.to_string ex
 			in
 			in
 			let e = create_haxe_exception ~stack:(get_ctx()).exception_stack msg 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);
 	"isRelease", vbool (Version.is_release);
 	"suffix", encode_string (Version.suffix);
 	"suffix", encode_string (Version.suffix);
 	"hex", vint (Version.hex);
 	"hex", vint (Version.hex);
-]
+]

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

@@ -149,18 +149,13 @@ let create com api is_macro =
 		match ex with
 		match ex with
 		| Sys_exit _ -> raise ex
 		| 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
 				| _ -> Printexc.to_string ex
 			in
 			in
 			Printf.eprintf "%s\n" msg;
 			Printf.eprintf "%s\n" msg;
@@ -422,30 +417,38 @@ let make_runtime_error msg pos =
 	| _ ->
 	| _ ->
 		die "" __LOC__
 		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 rec value_to_expr v p =
 	let path i =
 	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 encode_ref : 'a -> ('a -> value) -> (unit -> string) -> value
 	val decode_ref : value -> 'a
 	val decode_ref : value -> 'a
 
 
-	val compiler_error : Globals.located -> 'a
+	val compiler_error : Error.error -> 'a
 	val error_message : string -> 'a
 	val error_message : string -> 'a
 	val value_to_expr : value -> Globals.pos -> Ast.expr
 	val value_to_expr : value -> Globals.pos -> Ast.expr
 	val value_signature : value -> string
 	val value_signature : value -> string
@@ -1710,7 +1710,7 @@ let macro_api ccom get_api =
 			let msg = decode_string msg in
 			let msg = decode_string msg in
 			let p = decode_pos p in
 			let p = decode_pos p in
 			let depth = decode_int depth 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 ->
 		"report_error", vfun3 (fun msg p depth ->
 			let msg = decode_string msg in
 			let msg = decode_string msg in

+ 1 - 1
src/optimization/analyzerTexpr.ml

@@ -1242,7 +1242,7 @@ module Purity = struct
 					apply_to_class com c
 					apply_to_class com c
 				with Purity_conflict(impure,p) ->
 				with Purity_conflict(impure,p) ->
 					com.error "Impure field overrides/implements field which was explicitly marked as @:pure" impure.pn_field.cf_pos;
 					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
 				end
 			| _ -> ()
 			| _ -> ()
 		) com.types;
 		) 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;
 		if is_unbound_call_that_might_have_side_effects s el then ctx.has_unbound <- true;
 	in
 	in
 	let no_void t p =
 	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
 	in
 	let push_name s =
 	let push_name s =
 		ctx.name_stack <- s :: ctx.name_stack;
 		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
 			let bb = block_element bb e in
 			bb,mk (TConst TNull) t_dynamic e.epos
 			bb,mk (TConst TNull) t_dynamic e.epos
 		| TVar _ | TFor _ | TWhile _ ->
 		| 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 =
 	and value bb e =
 		let bb,e = value' bb e in
 		let bb,e = value' bb e in
 		no_void e.etype e.epos;
 		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
 		let t = if cf.cf_name = "_new" then
 			return_type
 			return_type
 		else if call_args = [] then
 		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
 		else
 			follow (List.hd call_args).etype
 			follow (List.hd call_args).etype
 		in
 		in
@@ -372,11 +372,11 @@ class inline_state ctx ethis params cf f p = object(self)
 		let rec check_write e =
 		let rec check_write e =
 			match e.eexpr with
 			match e.eexpr with
 			| TLocal v when has_var_flag v VFinal ->
 			| 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) ->
 			| TField(_,fa) ->
 				begin match extract_field fa with
 				begin match extract_field fa with
 				| Some cf when has_class_field_flag cf CfFinal ->
 				| 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
 				end
@@ -385,7 +385,7 @@ class inline_state ctx ethis params cf f p = object(self)
 			| TCast(e1,None) ->
 			| TCast(e1,None) ->
 				check_write e1
 				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
 		in
 		let vars = List.fold_left (fun acc (i,e) ->
 		let vars = List.fold_left (fun acc (i,e) ->
 			let accept vik =
 			let accept vik =
@@ -410,7 +410,7 @@ class inline_state ctx ethis params cf f p = object(self)
 					| TLocal _ | TConst _ ->
 					| TLocal _ | TConst _ ->
 						if not i.i_write then VIInline else VIDoNotInline
 						if not i.i_write then VIInline else VIDoNotInline
 					| TFunction _ ->
 					| 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 i.i_read <= 1 then VIInline else VIInlineIfCalled
 					| _ ->
 					| _ ->
 						if not i.i_write && (i.i_read + i.i_called) <= 1 then VIInline else VIDoNotInline
 						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);
 				l.i_read <- l.i_read + (if !in_loop then 2 else 1);
 				{ e with eexpr = TLocal l.i_subst }
 				{ e with eexpr = TLocal l.i_subst }
 			| None ->
 			| 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) ->
 		| TVar (v,eo) ->
 			{ e with eexpr = TVar ((state#declare v).i_subst,opt (map false false) 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
 			if not term then begin
 				match cf.cf_kind with
 				match cf.cf_kind with
 				| Method MethInline ->
 				| 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;
 			end;
 			(match eo with
 			(match eo with
 			| None -> mk (TConst TNull) f.tf_type p
 			| 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,_) ->
 			| 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
 				begin match type_inline_ctor ctx c cf tf ethis el po with
 				| Some e -> map term false e
 				| 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
 				end
-			| _ -> typing_error "Cannot inline function containing super" po
+			| _ -> raise_typing_error "Cannot inline function containing super" po
 			end
 			end
 		| TCall(e1,el) ->
 		| TCall(e1,el) ->
 			state#set_side_effect;
 			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
 			let el = List.map (map false false) el in
 			{e with eexpr = TCall(e1,el)}
 			{e with eexpr = TCall(e1,el)}
 		| TConst TSuper ->
 		| 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 ->
 		| 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
 			(* 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. *)
 			   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) ->
 			| IOKCtor(ioc) ->
 				List.iter (fun v -> if v.v_id < 0 then cancel_v v p) io.io_dependent_vars;
 				List.iter (fun v -> if v.v_id < 0 then cancel_v v p) io.io_dependent_vars;
 				if ioc.ioc_forced then begin
 				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 ctx.com "Forced inline constructor could not be inlined" io.io_pos;
 					display_error ~depth:1 ctx.com (compl_msg "Cancellation happened here") p;
 					display_error ~depth:1 ctx.com (compl_msg "Cancellation happened here") p;
 				end
 				end
@@ -403,7 +404,7 @@ let inline_constructors ctx original_e =
 						None
 						None
 				end
 				end
 			| TNew({ cl_constructor = Some ({cf_kind = Method MethInline; cf_expr = Some _} as cf)} as c,_,pl),_ when is_extern_ctor c cf ->
 			| 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 ->
 			| 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 v = alloc_var VGenerated "inlobj" e.etype e.epos in
 				let ev = mk (TLocal v) v.v_type 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
 			end
 		) !vars;
 		) !vars;
 		e
 		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 (cl,_) ->
 			List.iter (fun e ->
 			List.iter (fun e ->
 				match e.eexpr with
 				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
 			) cl
 		) cases;
 		) cases;
@@ -345,7 +345,7 @@ let rec reduce_loop ctx e =
 				let cf = mk_field "" ef.etype e.epos null_pos in
 				let cf = mk_field "" ef.etype e.epos null_pos in
 				let ethis = mk (TConst TThis) t_dynamic e.epos 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 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
 				(match inl with
 				| None -> reduce_expr ctx e
 				| None -> reduce_expr ctx e
 				| Some e -> reduce_loop ctx e)
 				| Some e -> reduce_loop ctx e)
@@ -354,7 +354,7 @@ let rec reduce_loop ctx e =
 				| Some {eexpr = TFunction tf} ->
 				| Some {eexpr = TFunction tf} ->
 					let config = inline_config (Some cl) cf el e.etype in
 					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 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
 					(match inl with
 					| None -> reduce_expr ctx e
 					| None -> reduce_expr ctx e
 					| Some e ->
 					| Some e ->

+ 2 - 2
src/optimization/optimizerTexpr.ml

@@ -209,7 +209,7 @@ let optimize_binop e op e1 e2 =
 		| OpAssign,_ ->
 		| OpAssign,_ ->
 			e
 			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
 		end
 	| _ ->
 	| _ ->
 		e)
 		e)
@@ -247,4 +247,4 @@ let optimize_unop e op flag esub =
 				{ e with eexpr = TConst (TFloat vstr) }
 				{ e with eexpr = TConst (TFloat vstr) }
 			else
 			else
 				e
 				e
-		| _ -> e
+		| _ -> e

+ 74 - 69
src/typing/callUnification.ml

@@ -14,19 +14,18 @@ let is_forced_inline c cf =
 	| _ -> false
 	| _ -> false
 
 
 let rec unify_call_args ctx el args r callp inline force_inline in_overload =
 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 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
 		in
-		call_error (Could_not_unify err) p
+		raise_error { e with err_message = (Call_error (Could_not_unify e.err_message)) }
 	in
 	in
+
 	let mk_pos_infos t =
 	let mk_pos_infos t =
 		let infos = mk_infos ctx callp [] in
 		let infos = mk_infos ctx callp [] in
 		type_expr ctx infos (WithType.with_type t)
 		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
 	in
 	let skipped = ref [] in
 	let skipped = ref [] in
 	let invalid_skips = 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
 		if not ctx.com.config.pf_can_skip_non_nullable_argument && not (is_nullable t) then
 			invalid_skips := name :: !invalid_skips;
 			invalid_skips := name :: !invalid_skips;
-		skipped := (name,ul,p) :: !skipped;
+		skipped := (name,ul) :: !skipped;
 		default_value name t
 		default_value name t
 	in
 	in
 	let handle_errors fn =
 	let handle_errors fn =
 		try
 		try
 			fn()
 			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
 	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 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 =
 	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])] ->
 		| _,[name,false,TAbstract({ a_path = ["cpp"],"Rest" },[t])] ->
 			(try List.map (fun e -> type_against name t e) el
 			(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) ->
 		| _,[name,false,t] when ExtType.is_rest (follow t) ->
 			begin match follow t with
 			begin match follow t with
 				| TAbstract({a_path=(["haxe"],"Rest")},[arg_t]) ->
 				| TAbstract({a_path=(["haxe"],"Rest")},[arg_t]) ->
 					let unexpected_spread p =
 					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
 					in
 					(* these platforms deal with rest args on their own *)
 					(* these platforms deal with rest args on their own *)
 					if ctx.com.config.pf_supports_rest_args then
 					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
 						match el with
 						| [(EUnop (Spread,Prefix,e),p)] ->
 						| [(EUnop (Spread,Prefix,e),p)] ->
 							(try [mk (TUnop (Spread, Prefix, type_against name t e)) t 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) ->
 						| _ when ExtType.is_mono (follow arg_t) ->
 							(try
 							(try
 								let el = type_rest mk_mono in
 								let el = type_rest mk_mono in
 								unify ctx (unify_min ctx el) arg_t (punion_el callp el);
 								unify ctx (unify_min ctx el) arg_t (punion_el callp el);
 								el
 								el
-							with WithTypeError(ul,p,_) ->
-								arg_error ul name false p)
+							with WithTypeError e ->
+								arg_error e name false)
 						| _ ->
 						| _ ->
 							(try
 							(try
 								type_rest (fun() -> arg_t)
 								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 *)
 					(* for other platforms make sure rest arguments are wrapped in an array *)
 					else begin
 					else begin
 						match el with
 						match el with
 						| [(EUnop (Spread,Prefix,e),p)] ->
 						| [(EUnop (Spread,Prefix,e),p)] ->
 							(try [type_against name t e]
 							(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)]
 							(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) :: _ ->
 						| (_,p1) :: _ ->
 							let p =
 							let p =
 								List.fold_left (fun p (e1,p2) ->
 								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>) *)
 									do_type (ECheckType(e,(CTPath tp, p)),p) (* ([arg1, arg2...]:Array<Dynamic>) *)
 								end else
 								end else
 									do_type e
 									do_type e
-							with WithTypeError(ul,p,_) ->
-								arg_error ul name false p
+							with WithTypeError e ->
+								arg_error e name false
 							)
 							)
 					end
 					end
 				| _ ->
 				| _ ->
@@ -156,7 +155,7 @@ let rec unify_call_args ctx el args r callp inline force_inline in_overload =
 						ignore(loop el [])
 						ignore(loop el [])
 					end;
 					end;
 					call_error Too_many_arguments p
 					call_error Too_many_arguments p
-				| (s,ul,p) :: _ -> arg_error ul s true p
+				| (s,ul) :: _ -> arg_error ul s true
 			end
 			end
 		| e :: el,(name,opt,t) :: args ->
 		| e :: el,(name,opt,t) :: args ->
 			let might_skip = List.length el < List.length args in
 			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
 				let e = type_against name t e in
 				e :: loop el args
 				e :: loop el args
 			with
 			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
 						e_def :: loop (e :: el) args
-					else
+					end else
 						match List.rev !skipped with
 						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
 			end
 	in
 	in
 	let restore =
 	let restore =
@@ -205,15 +204,15 @@ let unify_typed_args ctx tmap args el_typed call_pos =
 		match args,el with
 		match args,el with
 		| [], _ :: _ ->
 		| [], _ :: _ ->
 			let call_error = Call_error(Too_many_arguments) in
 			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
 			List.rev acc_args,args
 		| ((_,opt,t0) as arg) :: args,e :: el ->
 		| ((_,opt,t0) as arg) :: args,e :: el ->
 			begin try
 			begin try
 				unify_raise (tmap e.etype) t0 e.epos;
 				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;
 			end;
 			loop (arg :: acc_args) (fun t -> t) args el
 			loop (arg :: acc_args) (fun t -> t) args el
 	in
 	in
@@ -313,16 +312,15 @@ let unify_field_call ctx fa el_typed el p inline =
 			in
 			in
 			make_field_call_candidate el ret monos tf cf (mk_call,extract_delayed_display())
 			make_field_call_candidate el ret monos tf cf (mk_call,extract_delayed_display())
 		| t ->
 		| 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
 	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
 		in
-		match cerr with Could_not_unify err -> loop err p | _ -> ()
+		loop err
 	in
 	in
 	let attempt_calls candidates =
 	let attempt_calls candidates =
 		let rec loop candidates = match candidates with
 		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
 						candidate :: candidates,failures
 					end else
 					end else
 						[candidate],[]
 						[candidate],[]
-				with Error ((Call_error cerr as err),p,_) ->
+				with Error ({ err_message = Call_error _ } as err) ->
 					List.iter (fun (m,t,constr) ->
 					List.iter (fun (m,t,constr) ->
 						if t != m.tm_type then m.tm_type <- t;
 						if t != m.tm_type then m.tm_type <- t;
 						if constr != m.tm_down_constraints then m.tm_down_constraints <- constr;
 						if constr != m.tm_down_constraints then m.tm_down_constraints <- constr;
 					) known_monos;
 					) known_monos;
 					ctx.monomorphs.perfunction <- current_monos;
 					ctx.monomorphs.perfunction <- current_monos;
-					maybe_raise_unknown_ident cerr p;
+					maybe_raise_unknown_ident err;
 					let candidates,failures = loop candidates in
 					let candidates,failures = loop candidates in
-					candidates,(cf,err,p,extract_delayed_display()) :: failures
+					candidates,(cf,err,extract_delayed_display()) :: failures
 				end
 				end
 		in
 		in
 		loop candidates
 		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 candidates,failures = attempt_calls candidates in
 		let fail () =
 		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. *)
 				(* If any resolution attempt had a delayed display result, we might as well raise it now. *)
 				Option.may (fun de ->
 				Option.may (fun de ->
 					raise_augmented_display_exception cf de;
 					raise_augmented_display_exception cf de;
 				) delayed_display;
 				) delayed_display;
-				cf,error_msg p err
+				cf,err
 			) failures in
 			) 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
 			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
 			end
 		in
 		in
 		if overload_kind = OverloadProper then begin match Overloads.Resolution.reduce_compatible candidates with
 		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;
 				maybe_check_access fcc.fc_field;
 				commit_delayed_display fcc
 				commit_delayed_display fcc
 			| fcc :: l ->
 			| fcc :: l ->
+				(* TODO construct error with sub *)
 				display_error ctx.com "Ambiguous overload, candidates follow" p;
 				display_error ctx.com "Ambiguous overload, candidates follow" p;
 				let st = s_type (print_context()) in
 				let st = s_type (print_context()) in
 				List.iter (fun fcc ->
 				List.iter (fun fcc ->
@@ -442,7 +446,7 @@ object(self)
 		end
 		end
 
 
 	method private macro_call (ethis : texpr) (cf : tclass_field) (el : expr list) =
 	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.macro_depth <- ctx.macro_depth + 1;
 		ctx.with_type_stack <- with_type :: ctx.with_type_stack;
 		ctx.with_type_stack <- with_type :: ctx.with_type_stack;
 		let ethis_f = ref (fun () -> ()) in
 		let ethis_f = ref (fun () -> ()) in
@@ -476,27 +480,28 @@ object(self)
 		in
 		in
 		ctx.macro_depth <- ctx.macro_depth - 1;
 		ctx.macro_depth <- ctx.macro_depth - 1;
 		ctx.with_type_stack <- List.tl ctx.with_type_stack;
 		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 *)
 			(* 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
 			if ep.pfile <> p.pfile || ep.pmax < p.pmin || ep.pmin > p.pmax then begin
 				locate_macro_error := false;
 				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;
 				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
 			end else
-				old ~depth msg;
+				old err;
 		);
 		);
 		let e = try
 		let e = try
 			f()
 			f()
 		with exc ->
 		with exc ->
-			ctx.com.located_error <- old;
+			ctx.com.error_ext <- old;
 			!ethis_f();
 			!ethis_f();
 			raise exc
 			raise exc
 		in
 		in
 		let e = Diagnostics.secure_generated_code ctx e in
 		let e = Diagnostics.secure_generated_code ctx e in
-		ctx.com.located_error <- old;
+		ctx.com.error_ext <- old;
 		!ethis_f();
 		!ethis_f();
 		e
 		e
 
 
@@ -511,7 +516,7 @@ object(self)
 			else if ctx.untyped then
 			else if ctx.untyped then
 				mk_mono()
 				mk_mono()
 			else
 			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
 			in
 			mk (TCall (e,el)) t p
 			mk (TCall (e,el)) t p
 		in
 		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
 				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
 				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`.
 	(* 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
 						PMap.mem f.cf_name c.cl_fields
 						|| List.exists has_override c.cl_descendants
 						|| List.exists has_override c.cl_descendants
 					in
 					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;
 		end;
 		let config = Inline.inline_config cl f params t in
 		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` *)
 						(* Current method needs to infer CfModifiesThis flag, since we are calling a method, which modifies `this` *)
 						add_class_field_flag ctx.curfield CfModifiesThis
 						add_class_field_flag ctx.curfield CfModifiesThis
 					else
 					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
 		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 } ->
 		| None,Some { eexpr = TFunction fd } ->
 			(match Inline.type_inline ctx f fd ethis params t config p force_inline with
 			(match Inline.type_inline ctx f fd ethis params t config p force_inline with
 			| None ->
 			| 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;
 				raise Exit;
 			| Some e -> e)
 			| 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
 			if not (type_iseq tf e.etype) then mk (TCast(e,None)) tf e.epos
 			else e
 			else e
 		| Var _,None ->
 		| Var _,None ->
-			typing_error "Recursive inline is not supported" p
+			raise_typing_error "Recursive inline is not supported" p
 		end
 		end
 	in
 	in
 	let dispatcher p = new call_dispatcher ctx MGet WithType.value p in
 	let dispatcher p = new call_dispatcher ctx MGet WithType.value p in
 	match g with
 	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
 	| AKExpr e -> e
 	| AKSafeNav sn ->
 	| AKSafeNav sn ->
 		(* generate null-check branching for the safe navigation chain *)
 		(* generate null-check branching for the safe navigation chain *)
@@ -230,7 +230,7 @@ let rec acc_get ctx g =
 			if ctx.in_display then
 			if ctx.in_display then
 				FieldAccess.get_field_expr fa FRead
 				FieldAccess.get_field_expr fa FRead
 			else
 			else
-				typing_error "Invalid macro access" fa.fa_pos
+				raise_typing_error "Invalid macro access" fa.fa_pos
 		| _ ->
 		| _ ->
 			if fa.fa_inline then
 			if fa.fa_inline then
 				inline_read fa
 				inline_read fa
@@ -305,9 +305,9 @@ let rec build_call_access ctx acc el mode with_type p =
 	| AKResolve(sea,name) ->
 	| AKResolve(sea,name) ->
 		AKExpr (dispatch#expr_call (dispatch#resolve_call sea name) [] el)
 		AKExpr (dispatch#expr_call (dispatch#resolve_call sea name) [] el)
 	| AKNo(_,p) ->
 	| AKNo(_,p) ->
-		typing_error "This expression cannot be called" p
+		raise_typing_error "This expression cannot be called" p
 	| AKAccess _ ->
 	| AKAccess _ ->
-		typing_error "This expression cannot be called" p
+		raise_typing_error "This expression cannot be called" p
 	| AKAccessor fa ->
 	| AKAccessor fa ->
 		let e = get_accessor_to_call fa [] in
 		let e = get_accessor_to_call fa [] in
 		AKExpr (dispatch#expr_call e [] el)
 		AKExpr (dispatch#expr_call e [] el)
@@ -374,7 +374,7 @@ let type_bind ctx (e : texpr) (args,ret) params p =
 	in
 	in
 	let rec loop args params given_args missing_args ordered_args = match args, params with
 	let rec loop args params given_args missing_args ordered_args = match args, params with
 		| [], [] -> given_args,missing_args,ordered_args
 		| [], [] -> 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 ->
 		| (n,o,t) :: args , [] when o ->
 			let a = if is_pos_infos t then
 			let a = if is_pos_infos t then
 					let infos = mk_infos ctx p [] in
 					let infos = mk_infos ctx p [] in
@@ -386,7 +386,7 @@ let type_bind ctx (e : texpr) (args,ret) params p =
 			in
 			in
 			loop args [] given_args missing_args a
 			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) ->
 		| (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 , ([] as params)
 		| (n,o,t) :: args , (EConst(Ident "_"),_) :: 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
 			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
 				let t = ctx.t.tarray pt in
 				begin try
 				begin try
 					unify_raise et t p
 					unify_raise et t p
-				with Error(Unify _,_,_) ->
+				with Error { err_message = Unify _ } ->
 					if not ctx.untyped then begin
 					if not ctx.untyped then begin
 						let msg = if !has_abstract_array_access then
 						let msg = if !has_abstract_array_access then
 							"No @:arrayAccess function accepts an argument of " ^ (s_type (print_context()) e2.etype)
 							"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
 		in
 		create e_static cf fh false p
 		create e_static cf fh false p
 	with Not_found ->
 	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
 			| KAbstractImpl a -> TAbstractDecl a
 			| _ -> TClassDecl c
 			| _ -> TClassDecl c
-		)) p
+		)) p)
 
 
 let make_static_extension_access c cf e_this inline p =
 let make_static_extension_access c cf e_this inline p =
 	let e_static = Texpr.Builder.make_static_this c p in
 	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
 		apply_params l monos f.cf_type
 
 
 let no_abstract_constructor c p =
 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 =
 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
 	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 =
 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 cl_meta
 					|| Meta.has Meta.NoClosure f.cf_meta
 					|| Meta.has Meta.NoClosure f.cf_meta
 				then
 				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
 		in
 		begin match cf.cf_kind with
 		begin match cf.cf_kind with
@@ -114,7 +114,7 @@ let field_access ctx mode f fh e pfield =
 	match f.cf_kind with
 	match f.cf_kind with
 	| Method m ->
 	| Method m ->
 		let normal () = AKField(make_access false) in
 		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 =
 		let maybe_check_visibility c static =
 			(* For overloads we have to resolve the actual field before we can check accessibility. *)
 			(* For overloads we have to resolve the actual field before we can check accessibility. *)
 			begin match mode with
 			begin match mode with
@@ -250,7 +250,7 @@ let field_access ctx mode f fh e pfield =
 		| AccRequire (r,msg) ->
 		| AccRequire (r,msg) ->
 			match msg with
 			match msg with
 			| None -> error_require r pfield
 			| 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 =
 let class_field ctx c tl name p =
 	raw_class_field (fun f -> field_type ctx c tl f p) c tl name
 	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
 		let _,el,_ = Meta.get meta a.a_meta in
 		if el <> [] && not (List.exists (fun e -> match fst e with
 		if el <> [] && not (List.exists (fun e -> match fst e with
 			| EConst (Ident i' | String (i',_)) -> i' = i
 			| 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;
 		) el) then raise Not_found;
 		f()
 		f()
 	in
 	in
@@ -438,7 +438,7 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) =
 							end
 							end
 						| _ ->
 						| _ ->
 							check()
 							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
 						check_constant_struct := !check_constant_struct || List.exists (function
 							| Has_extra_field _ -> true
 							| Has_extra_field _ -> true
 							| _ -> false
 							| _ -> false
@@ -515,7 +515,7 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) =
 				in
 				in
 				loop c tl
 				loop c tl
 			with Not_found when PMap.mem i c.cl_statics ->
 			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 ->
 		| TDynamic t ->
 			AKExpr (mk (TField (e,FDynamic i)) (match t with None -> t_dynamic | Some t -> t) p)
 			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
 			with Not_found -> try
 				type_field_by_forward_member type_field_by_fallback e a tl
 				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) ->
 			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
 		| _ -> raise Not_found
 	in
 	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
 				let t = Typeload.find_type_in_module_raise ctx m name null_pos in
 				match t with
 				match t with
 				| TEnumDecl _ | TTypeDecl _ | TAbstractDecl _ ->
 				| 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 ->
 				| TClassDecl c ->
 					p := c.cl_name_pos;
 					p := c.cl_name_pos;
 					c, PMap.find "main" c.cl_statics
 					c, PMap.find "main" c.cl_statics
 			with Not_found ->
 			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
 		in
 		let ft = Type.field_type f in
 		let ft = Type.field_type f in
 		let fmode, r =
 		let fmode, r =
 			match follow ft with
 			match follow ft with
 			| TFun ([],r) -> FStatic (c,f), r
 			| 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
 		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;
 		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 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
 		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 _ ->
 			| TDynamic _ | TMono _ ->
 				(* try to find something better than a dynamic value to iterate on *)
 				(* try to find something better than a dynamic value to iterate on *)
 				dynamic_iterator := Some e;
 				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
 			| _ -> e
-		with Error (Unify _,_,depth) ->
+		with Error { err_message = Unify _ } ->
 			let try_last_resort after =
 			let try_last_resort after =
 				try
 				try
 					match last_resort with
 					match last_resort with
@@ -108,14 +108,13 @@ module IterationKind = struct
 				try
 				try
 					unify_raise acc_expr.etype t acc_expr.epos;
 					unify_raise acc_expr.etype t acc_expr.epos;
 					acc_expr
 					acc_expr
-				with Error (Unify(l),p,n) ->
+				with Error ({ err_message = Unify _ } as err) ->
 					try_last_resort (fun () ->
 					try_last_resort (fun () ->
 						match !dynamic_iterator with
 						match !dynamic_iterator with
 						| Some e -> e
 						| Some e -> e
 						| None ->
 						| None ->
 							if resume then raise Not_found;
 							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
 							mk (TConst TNull) t_dynamic p
 					)
 					)
 			in
 			in
@@ -280,7 +279,7 @@ module IterationKind = struct
 				| TBinop (OpAssignOp _,{ eexpr = TLocal l },_)
 				| TBinop (OpAssignOp _,{ eexpr = TLocal l },_)
 				| TUnop (Increment,_,{ eexpr = TLocal l })
 				| TUnop (Increment,_,{ eexpr = TLocal l })
 				| TUnop (Decrement,_,{ eexpr = TLocal l })  when List.memq l vl ->
 				| 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
 					Type.iter loop e
 			in
 			in
@@ -319,7 +318,7 @@ module IterationKind = struct
 			mk (TFor(v,e1,e2)) t_void p
 			mk (TFor(v,e1,e2)) t_void p
 		| IteratorIntUnroll(offset,length,ascending) ->
 		| IteratorIntUnroll(offset,length,ascending) ->
 			check_loop_var_modification [v] e2;
 			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 el = ExtList.List.init length (fun i ->
 				let ei = make_int ctx.t (if ascending then i + offset else offset - i) p in
 				let ei = make_int ctx.t (if ascending then i + offset else offset - i) p in
 				let rec loop e = match e.eexpr with
 				let rec loop e = match e.eexpr with
@@ -332,7 +331,7 @@ module IterationKind = struct
 			mk (TBlock el) t_void p
 			mk (TBlock el) t_void p
 		| IteratorIntConst(a,b,ascending) ->
 		| IteratorIntConst(a,b,ascending) ->
 			check_loop_var_modification [v] e2;
 			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 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 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
 			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
 	let rec loop_ident dko e1 = match e1 with
 		| EConst(Ident i),p -> i,p,dko
 		| EConst(Ident i),p -> i,p,dko
 		| EDisplay(e1,dk),_ -> loop_ident (Some dk) e1
 		| EDisplay(e1,dk),_ -> loop_ident (Some dk) e1
-		| _ -> typing_error "Identifier expected" (pos e1)
+		| _ -> raise_typing_error "Identifier expected" (pos e1)
 	in
 	in
 	let rec loop dko e1 = match fst e1 with
 	let rec loop dko e1 = match fst e1 with
 		| EBinop(OpIn,e1,e2) ->
 		| 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);
 			| Some dk -> ignore(handle_display ctx e1 dk MGet WithType.value);
 			| None -> ()
 			| None -> ()
 			end;
 			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
 	in
 	let ik,e1 = loop None it in
 	let ik,e1 = loop None it in
 	let e1 = type_expr ctx e1 WithType.value 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) =
 	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 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
 		end
 
 
 	(* Returns the `(tvar * texpr option) list` for `tf_args`. Also checks the validity of argument names and whether or not
 	(* 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
 				let fa = try
 					quick_field t cf.cf_name
 					quick_field t cf.cf_name
 				with Not_found ->
 				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
 				in
 				build_expr {e with eexpr = TField(e1,fa)}
 				build_expr {e with eexpr = TField(e1,fa)}
 			end;
 			end;
@@ -128,7 +128,7 @@ let generic_substitute_expr gctx e =
 				let eo = loop gctx.subst in
 				let eo = loop gctx.subst in
 				begin match eo with
 				begin match eo with
 					| Some e -> e
 					| 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
 				end
 			with Not_found ->
 			with Not_found ->
 				e
 				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
 		let t = Typeload.load_instance ctx (mk_type_path (pack,name),p) true in
 		match t with
 		match t with
 		| TInst(cg,_) -> cg
 		| 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 m = (try ctx.com.module_lut#find (ctx.com.type_to_module#find c.cl_path) with Not_found -> die "" __LOC__) in
 		let mg = {
 		let mg = {
 			m_id = alloc_mid();
 			m_id = alloc_mid();
@@ -215,7 +215,7 @@ let rec build_generic_class ctx c p tl =
 			(match c2.cl_kind with
 			(match c2.cl_kind with
 			| KTypeParameter tl ->
 			| KTypeParameter tl ->
 				if not (TypeloadCheck.is_generic_parameter ctx c2) && has_ctor_constraint c2 then
 				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
 				recurse := true
 			| _ -> ());
 			| _ -> ());
 			List.iter check_recursive tl;
 			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
 		let t = Typeload.load_instance ctx (mk_type_path (pack,name),p) false in
 		match t with
 		match t with
 		| TInst({ cl_kind = KGenericInstance (csup,_) },_) when c == csup -> t
 		| 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
 		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 *)
 		ignore(c.cl_build()); (* make sure the super class is already setup *)
 		let mg = {
 		let mg = {
@@ -292,6 +292,7 @@ let rec build_generic_class ctx c p tl =
 					| None ->
 					| None ->
 						begin match cf_old.cf_kind with
 						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) ->
 							| 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 "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;
 								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 ->
 					| Some e ->
 						cf_new.cf_expr <- Some (generic_substitute_expr gctx e)
 						cf_new.cf_expr <- Some (generic_substitute_expr gctx e)
 				) with Unify_error l ->
 				) 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;
 				end;
 				t
 				t
 			in
 			in
@@ -315,10 +316,10 @@ let rec build_generic_class ctx c p tl =
 			cf_new.cf_type <- TLazy r;
 			cf_new.cf_type <- TLazy r;
 			cf_new
 			cf_new
 		in
 		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
 		List.iter (fun cf -> match cf.cf_kind with
 			| Method MethMacro when not ctx.com.is_macro_context -> ()
 			| 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;
 		) c.cl_ordered_statics;
 		cg.cl_super <- (match c.cl_super with
 		cg.cl_super <- (match c.cl_super with
 			| None -> None
 			| None -> None
@@ -340,7 +341,7 @@ let rec build_generic_class ctx c p tl =
 			| _, Some cf, _ -> Some (build_field cf)
 			| _, Some cf, _ -> Some (build_field cf)
 			| Some ctor, _, _ -> Some ctor
 			| Some ctor, _, _ -> Some ctor
 			| None, None, None -> None
 			| 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) ->
 		cg.cl_implements <- List.map (fun (i,tl) ->
 			(match follow (generic_substitute_type gctx (TInst (i, List.map (generic_substitute_type gctx) tl))) with
 			(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__
 		| _ -> die "" __LOC__
 	in
 	in
 	let cf = fcc.fc_field 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
 	begin match with_type with
 		| WithType.WithType(t,_) -> unify ctx fcc.fc_ret t p
 		| 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 name = cf.cf_name ^ "_" ^ gctx.name in
 		let unify_existing_field tcf pcf = try
 		let unify_existing_field tcf pcf = try
 			unify_raise tcf fcc.fc_type p
 			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
 		in
 		let fa = try
 		let fa = try
 			let cf2 = if stat then
 			let cf2 = if stat then
@@ -413,6 +417,7 @@ let type_generic_function ctx fa fcc with_type p =
 				ignore(follow cf.cf_type);
 				ignore(follow cf.cf_type);
 				let rec check e = match e.eexpr with
 				let rec check e = match e.eexpr with
 					| TNew({cl_kind = KTypeParameter _} as c,_,_) when not (TypeloadCheck.is_generic_parameter ctx c) ->
 					| 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 "Only generic type parameters can be constructed" e.epos;
 						display_error ctx.com "While specializing this call" p;
 						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
 		let dispatch = new CallUnification.call_dispatcher ctx (MCall []) with_type p in
 		dispatch#field_call fa el []
 		dispatch#field_call fa el []
 	with Generic_Exception (msg,p) ->
 	with Generic_Exception (msg,p) ->
-		typing_error msg p)
+		raise_typing_error msg p)
 
 
 ;;
 ;;
 Typecore.type_generic_function_ref := type_generic_function
 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
 		match fst e with
 		| EField (e,f,_) -> f :: loop e
 		| EField (e,f,_) -> f :: loop e
 		| EConst (Ident i) -> [i]
 		| EConst (Ident i) -> [i]
-		| _ -> typing_error "Invalid macro call" p
+		| _ -> raise_typing_error "Invalid macro call" p
 	in
 	in
 	let path = match e with
 	let path = match e with
 		| (EConst(Ident i)),_ ->
 		| (EConst(Ident i)),_ ->
@@ -19,7 +19,7 @@ let get_macro_path ctx e args p =
 			with Not_found -> try
 			with Not_found -> try
 				(t_infos (let path,_,_ = PMap.find i ctx.m.module_globals in path)).mt_path
 				(t_infos (let path,_,_ = PMap.find i ctx.m.module_globals in path)).mt_path
 			with Not_found ->
 			with Not_found ->
-				typing_error "Invalid macro call" p
+				raise_typing_error "Invalid macro call" p
 			in
 			in
 			i :: (snd path) :: (fst path)
 			i :: (snd path) :: (fst path)
 		| _ ->
 		| _ ->
@@ -27,7 +27,7 @@ let get_macro_path ctx e args p =
 	in
 	in
 	(match path with
 	(match path with
 	| meth :: cl :: path -> (List.rev path,cl), meth, args
 	| 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 build_macro_type ctx pl p =
 	let path, field, args = (match pl with
 	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),_],_) },_)] ->
 		| [TInst ({ cl_kind = KExpr (EArrayDecl [ECall (e,args),_],_) },_)] ->
 			get_macro_path ctx e args p
 			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
 	) in
 	let old = ctx.ret in
 	let old = ctx.ret in
 	let t = (match ctx.g.do_macro ctx MMacroType path field args p with
 	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 path, field, args =
 		let build_expr =
 		let build_expr =
 			try Meta.get Meta.GenericBuild c.cl_meta
 			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
 		in
 		match build_expr with
 		match build_expr with
 		| _,[ECall(e,args),_],_ -> get_macro_path ctx e args p
 		| _,[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
 	in
 	let old = ctx.ret,ctx.get_build_infos in
 	let old = ctx.ret,ctx.get_build_infos in
 	ctx.get_build_infos <- (fun() -> Some (TClassDecl c, pl, cfl));
 	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
 		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);
 		List.iter (fun (s,i) -> Printf.fprintf ch "\nline %i: %s" i s) (List.rev errors);
 		close_out ch;
 		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 get_type_patch ctx t sub =
 	let new_patch() =
 	let new_patch() =
@@ -83,20 +83,13 @@ let macro_timer com l =
 
 
 let typing_timer ctx need_type f =
 let typing_timer ctx need_type f =
 	let t = Timer.timer ["typing"] in
 	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
 	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)
 		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
 	if need_type && ctx.pass < PTypeField then begin
 		ctx.pass <- PTypeField;
 		ctx.pass <- PTypeField;
@@ -104,7 +97,7 @@ let typing_timer ctx need_type f =
 	end;
 	end;
 	let exit() =
 	let exit() =
 		t();
 		t();
-		ctx.com.located_error <- old;
+		ctx.com.error_ext <- old;
 		ctx.pass <- oldp;
 		ctx.pass <- oldp;
 		ctx.locals <- oldlocals;
 		ctx.locals <- oldlocals;
 		restore_report_mode ();
 		restore_report_mode ();
@@ -113,15 +106,15 @@ let typing_timer ctx need_type f =
 		let r = f() in
 		let r = f() in
 		exit();
 		exit();
 		r
 		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 =
 let make_macro_com_api com p =
 	{
 	{
@@ -188,7 +181,7 @@ let make_macro_com_api com p =
 			Interp.exc_string "unsupported"
 			Interp.exc_string "unsupported"
 		);
 		);
 		parse = (fun entry s ->
 		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
 			| ParseSuccess(r,_,_) -> r
 			| ParseError(_,(msg,p),_) -> Parser.error msg p
 			| 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 make_macro_api ctx p =
 	let parse_expr_string s p inl =
 	let parse_expr_string s p inl =
 		typing_timer ctx false (fun() ->
 		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,true,_) when inl -> data (* ignore errors when inline-parsing in display file *)
 				| ParseSuccess(data,_,_) -> data
 				| ParseSuccess(data,_,_) -> data
 				| ParseError _ -> raise MacroApi.Invalid_expr)
 				| ParseError _ -> raise MacroApi.Invalid_expr)
 	in
 	in
 	let parse_metadata s p =
 	let parse_metadata s p =
 		try
 		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
 			| ParseSuccess(meta,_,_) -> meta
-			| ParseError(_,_,_) -> typing_error "Malformed metadata string" p
+			| ParseError(_,_,_) -> raise_typing_error "Malformed metadata string" p
 		with _ ->
 		with _ ->
-			typing_error "Malformed metadata string" p
+			raise_typing_error "Malformed metadata string" p
 	in
 	in
 	let com_api = make_macro_com_api ctx.com p in
 	let com_api = make_macro_com_api ctx.com p in
 	{
 	{
@@ -321,7 +314,7 @@ let make_macro_api ctx p =
 				try
 				try
 					let m = Some (Typeload.load_instance ctx (tp,p) true) in
 					let m = Some (Typeload.load_instance ctx (tp,p) true) in
 					m
 					m
-				with Error (Module_not_found _,p2,_) when p == p2 ->
+				with Error { err_message = Module_not_found _; err_pos = p2 } when p == p2 ->
 					None
 					None
 			)
 			)
 		);
 		);
@@ -345,7 +338,7 @@ let make_macro_api ctx p =
 		MacroApi.type_patch = (fun t f s v ->
 		MacroApi.type_patch = (fun t f s v ->
 			typing_timer ctx false (fun() ->
 			typing_timer ctx false (fun() ->
 				let v = (match v with None -> None | Some s ->
 				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
 					| ParseSuccess((ct,_),_,_) -> Some ct
 					| ParseError(_,(msg,p),_) -> Parser.error msg p (* p is null_pos, but we don't have anything else here... *)
 					| ParseError(_,(msg,p),_) -> Parser.error msg p (* p is null_pos, but we don't have anything else here... *)
 				) in
 				) in
@@ -473,7 +466,7 @@ let make_macro_api ctx p =
 				try
 				try
 					ignore(AbstractCast.cast_or_unify_raise ctx t e p);
 					ignore(AbstractCast.cast_or_unify_raise ctx t e p);
 					true
 					true
-				with Error (Unify _,_,_) ->
+				with Error { err_message = Unify _ } ->
 					false
 					false
 			)
 			)
 		);
 		);
@@ -608,7 +601,7 @@ and flush_macro_context mint mctx =
 		List.iter (fun f -> f t) type_filters
 		List.iter (fun f -> f t) type_filters
 	in
 	in
 	(try Interp.add_types mint types ready
 	(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()
 	t()
 
 
 let create_macro_interp api mctx =
 let create_macro_interp api mctx =
@@ -622,11 +615,19 @@ let create_macro_interp api mctx =
 			Interp.do_reuse mint api;
 			Interp.do_reuse mint api;
 			mint, (fun() -> ())
 			mint, (fun() -> ())
 	) in
 	) 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;
 		Interp.set_error (Interp.get_ctx()) true;
 		macro_interp_cache := None;
 		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 *)
 	(* mctx.g.core_api <- ctx.g.core_api; // causes some issues because of optional args and Null type in Flash9 *)
 	init();
 	init();
@@ -702,14 +703,14 @@ let load_macro'' com mctx display cpath f p =
 			with Not_found ->
 			with Not_found ->
 				let name = Option.default (snd mpath) sub in
 				let name = Option.default (snd mpath) sub in
 				let path = fst mpath, name 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
 				match mt with
 				| TClassDecl c ->
 				| TClassDecl c ->
 					Finalization.finalize mctx;
 					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
 		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();
 		restore();
 		if not com.is_macro_context then flush_macro_context mint mctx;
 		if not com.is_macro_context then flush_macro_context mint mctx;
 		mctx.com.cached_macros#add (cpath,f) meth;
 		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;
 			unify_raise mret ttype mpos;
 			(* TODO: enable this again in the future *)
 			(* TODO: enable this again in the future *)
 			(* warning ctx WDeprecated "Returning Type from @:genericBuild macros is deprecated, consider returning ComplexType instead" p; *)
 			(* 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 cttype = mk_type_path ~sub:"ComplexType" (["haxe";"macro"],"Expr") in
 			let ttype = Typeload.load_instance mctx (cttype,p) false in
 			let ttype = Typeload.load_instance mctx (cttype,p) false in
 			unify_raise mret ttype mpos;
 			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) ->
 		let eargs = List.map (fun (n,o,t) ->
 			try unify_raise t expr p; (n, o, t_dynamic), MAExpr
 			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 _ ->
 				| TFun _ ->
 					(n,o,t), MAFunction
 					(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
 	let mctx, (margs,_,mclass,mfield), call = load_macro ctx false path meth p in
 	mctx.curclass <- null_class;
 	mctx.curclass <- null_class;
 	let el, _ = CallUnification.unify_call_args mctx args margs t_dynamic p false false false in
 	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 call_init_macro ctx e =
 	let p = { pfile = "--macro " ^ e; pmin = -1; pmax = -1 } in
 	let p = { pfile = "--macro " ^ e; pmin = -1; pmax = -1 } in
 	let e = try
 	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
 		| ParseSuccess(data,_,_) -> data
 		| ParseError(_,(msg,p),_) -> (Parser.error msg p)
 		| ParseError(_,(msg,p),_) -> (Parser.error msg p)
 		end
 		end
@@ -954,16 +955,16 @@ let call_init_macro ctx e =
 			match fst e with
 			match fst e with
 			| EField (e,f,_) -> f :: loop e
 			| EField (e,f,_) -> f :: loop e
 			| EConst (Ident i) -> [i]
 			| EConst (Ident i) -> [i]
-			| _ -> typing_error "Invalid macro call" p
+			| _ -> raise_typing_error "Invalid macro call" p
 		in
 		in
 		let path, meth = (match loop e with
 		let path, meth = (match loop e with
 		| [meth] -> (["haxe";"macro"],"Compiler"), meth
 		| [meth] -> (["haxe";"macro"],"Compiler"), meth
 		| [meth;"server"] -> (["haxe";"macro"],"CompilationServer"), meth
 		| [meth;"server"] -> (["haxe";"macro"],"CompilationServer"), meth
 		| meth :: cl :: path -> (List.rev path,cl), 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);
 		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 interpret ctx =
 	let mctx = Interp.create ctx.com (make_macro_api ctx null_pos) false in
 	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 *)
 (* REMOTING PROXYS *)
 
 
 let extend_remoting ctx c t p async prot =
 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 *)
 	(* remove forbidden packages *)
 	let rules = ctx.com.package_rules in
 	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;
 	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
 	let t = (try
 		load_type_def ctx p (mk_type_path (fst path,new_name))
 		load_type_def ctx p (mk_type_path (fst path,new_name))
 	with
 	with
-		Error (Module_not_found _,p2,_) when p == p2 ->
+		Error { err_message = Module_not_found _; err_pos = p2 } when p == p2 ->
 	(* build it *)
 	(* build it *)
 	Common.log ctx.com ("Building proxy for " ^ s_type_path path);
 	Common.log ctx.com ("Building proxy for " ^ s_type_path path);
 	let file, decls = (try
 	let file, decls = (try
 		TypeloadParse.parse_module ctx path p
 		TypeloadParse.parse_module ctx path p
 	with
 	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
 		| e -> ctx.com.package_rules <- rules; raise e) in
 	ctx.com.package_rules <- rules;
 	ctx.com.package_rules <- rules;
 	let base_fields = [
 	let base_fields = [
@@ -41,7 +41,7 @@ let extend_remoting ctx c t p async prot =
 			acc
 			acc
 		else match f.cff_kind with
 		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) ->
 		| 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 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 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
 			let fargs, eargs = if async then match ftype with
@@ -81,11 +81,11 @@ let extend_remoting ctx c t p async prot =
 	try
 	try
 		List.find (fun tdecl -> snd (t_path tdecl) = new_name) m.m_types
 		List.find (fun tdecl -> snd (t_path tdecl) = new_name) m.m_types
 	with Not_found ->
 	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
 	) in
 	match t with
 	match t with
 	| TClassDecl c2 when c2.cl_params = [] -> ignore(c2.cl_build()); c.cl_super <- Some (c2,[]);
 	| 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) =
 let on_inherit ctx c p (is_extends,tp) =
 	if not is_extends then
 	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)
 				| TInst(c,_) -> loop (TClassDecl c)
 				| TEnum(en,_) -> loop (TEnumDecl en)
 				| TEnum(en,_) -> loop (TEnumDecl en)
 				| TAbstract(a,_) -> loop (TAbstractDecl a)
 				| 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
 			end
-		| _ -> typing_error "Cannot use this type as a value" p
+		| _ -> raise_typing_error "Cannot use this type as a value" p
 	in
 	in
 	Typeload.load_instance ctx ({tname=loop mt;tpackage=[];tsub=None;tparams=[]},p) true
 	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
 		| ConArray i -> make_int ctx.com.basic i p
 		| ConTypeExpr mt -> TyperBase.type_module_type ctx mt None p
 		| ConTypeExpr mt -> TyperBase.type_module_type ctx mt None p
 		| ConStatic(c,cf) -> make_static_field c cf 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)
 	let hash con = Hashtbl.hash (fst con)
 end
 end
@@ -183,18 +183,18 @@ module Pattern = struct
 		let ctx = pctx.ctx in
 		let ctx = pctx.ctx in
 		let p = pos e in
 		let p = pos e in
 		let fail () =
 		let fail () =
-			typing_error ("Unrecognized pattern: " ^ (Ast.Printer.s_expr e)) p
+			raise_typing_error ("Unrecognized pattern: " ^ (Ast.Printer.s_expr e)) p
 		in
 		in
 		let unify_expected t' =
 		let unify_expected t' =
 			unify ctx t' t p
 			unify ctx t' t p
 		in
 		in
 		let verror name p =
 		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
 		in
 		let add_local final name p =
 		let add_local final name p =
 			let is_wildcard_local = name = "_" in
 			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
 			match pctx.or_locals with
 			| Some map when not is_wildcard_local ->
 			| Some map when not is_wildcard_local ->
 				let v,p = try PMap.find name map with Not_found -> verror name p in
 				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
 			if pctx.is_postfix_match then DKMarked else DKPattern toplevel
 		in
 		in
 		let catch_errors () =
 		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
 			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 () ->
 			(fun () ->
 				restore_report_mode();
 				restore_report_mode();
-				ctx.com.located_error <- old
+				ctx.com.error_ext <- old
 			)
 			)
 		in
 		in
 		let try_typing e =
 		let try_typing e =
@@ -342,7 +340,7 @@ module Pattern = struct
 					| String (value,kind) when kind = Ast.SSingleQuotes ->
 					| String (value,kind) when kind = Ast.SSingleQuotes ->
 						let e = ctx.g.do_format_string ctx value p in
 						let e = ctx.g.do_format_string ctx value p in
 						begin match e with
 						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;
 						end;
 					| _ -> ()
 					| _ -> ()
@@ -356,7 +354,7 @@ module Pattern = struct
 				begin match follow t with
 				begin match follow t with
 					| TFun(ta,tr) when tr == fake_tuple_type ->
 					| TFun(ta,tr) when tr == fake_tuple_type ->
 						if i = "_" then PatTuple(List.map (fun (_,_,t) -> (PatAny,pos e)) ta)
 						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
 						if i = "_" then PatAny
 						else handle_ident i (pos e)
 						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
 						in
 						let patterns = loop el args in
 						let patterns = loop el args in
 						ignore(unapply_type_parameters ef.ef_params monos);
 						ignore(unapply_type_parameters ef.ef_params monos);
@@ -404,7 +402,7 @@ module Pattern = struct
 					try_typing e
 					try_typing e
 				with
 				with
 					| Exit -> fail()
 					| Exit -> fail()
-					| Bad_pattern s -> typing_error s p
+					| Bad_pattern s -> raise_typing_error s p
 				end
 				end
 			| EArrayDecl el ->
 			| EArrayDecl el ->
 				let rec pattern seen t = match follow t with
 				let rec pattern seen t = match follow t with
@@ -414,8 +412,8 @@ module Pattern = struct
 								let pat = make pctx false t e in
 								let pat = make pctx false t e in
 								pat :: loop el tl
 								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
 						in
 						let patterns = loop el tl in
 						let patterns = loop el tl in
 						PatTuple patterns
 						PatTuple patterns
@@ -470,7 +468,7 @@ module Pattern = struct
 								collect_field cf (apply_params a.a_params tl cf.cf_type) filter
 								collect_field cf (apply_params a.a_params tl cf.cf_type) filter
 						) c.cl_ordered_statics;
 						) 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
 				in
 				collect_fields t None;
 				collect_fields t None;
 				let is_matchable cf =
 				let is_matchable cf =
@@ -487,7 +485,7 @@ module Pattern = struct
 						else
 						else
 							patterns,fields
 							patterns,fields
 				) ([],[]) !known_fields in
 				) ([],[]) !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)
 				PatConstructor(con_fields fields (pos e),patterns)
 			| EBinop(OpOr,e1,e2) ->
 			| EBinop(OpOr,e1,e2) ->
 				let pctx1 = {pctx with current_locals = PMap.empty} in
 				let pctx1 = {pctx with current_locals = PMap.empty} in
@@ -575,7 +573,7 @@ module Case = struct
 				let e2 = collapse_case el in
 				let e2 = collapse_case el in
 				EBinop(OpOr,e,e2),punion (pos e) (pos e2)
 				EBinop(OpOr,e,e2),punion (pos e) (pos e2)
 			| [] ->
 			| [] ->
-				typing_error "case without pattern" p
+				raise_typing_error "case without pattern" p
 		in
 		in
 		let e = collapse_case el in
 		let e = collapse_case el in
 		let monos = List.map (fun _ -> mk_mono()) ctx.type_params in
 		let monos = List.map (fun _ -> mk_mono()) ctx.type_params in
@@ -1161,9 +1159,9 @@ module Compile = struct
 			| [],[] ->
 			| [],[] ->
 				bindings
 				bindings
 			| [],e :: _ ->
 			| [],e :: _ ->
-				typing_error "Invalid match: Not enough patterns" e.epos
+				raise_typing_error "Invalid match: Not enough patterns" e.epos
 			| (_,p) :: _,[] ->
 			| (_,p) :: _,[] ->
-				typing_error "Invalid match: Too many patterns" p
+				raise_typing_error "Invalid match: Too many patterns" p
 		in
 		in
 		let bindings = loop patterns subjects bindings in
 		let bindings = loop patterns subjects bindings in
 		if bindings = [] then dt else bind mctx (List.rev bindings) dt
 		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
 					| PatBind(v,pat1) -> loop ((make_bind v (pos pat) subject) :: bindings) pat1
 					| PatVariable _ | PatAny -> ()
 					| PatVariable _ | PatAny -> ()
 					| PatExtractor _ -> raise Extractor
 					| 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
 				in
 				loop bindings (List.hd patterns)
 				loop bindings (List.hd patterns)
 			) cases;
 			) cases;
@@ -1454,7 +1452,7 @@ module TexprConverter = struct
 			| _ -> kind = SKValue
 			| _ -> kind = SKValue
 		in
 		in
 		List.iter (fun sc ->
 		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
 			if sc.sc_unguarded then ConTable.remove h sc.sc_con
 		) cases;
 		) cases;
 		let unmatched = ConTable.fold (fun con _ acc -> con :: acc) h [] in
 		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)
 			| _ -> String.concat " | " (List.sort Pervasives.compare sl)
 		in
 		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 =
 	type dt_recursion =
 		| Toplevel
 		| Toplevel
@@ -1682,7 +1680,7 @@ module TexprConverter = struct
 		let e = loop Toplevel params dt in
 		let e = loop Toplevel params dt in
 		match e with
 		match e with
 		| None ->
 		| None ->
-			typing_error "Unmatched patterns: _" p;
+			raise_typing_error "Unmatched patterns: _" p;
 		| Some e ->
 		| Some e ->
 			Texpr.duplicate_tvars e
 			Texpr.duplicate_tvars e
 end
 end

+ 31 - 31
src/typing/operators.ml

@@ -9,11 +9,11 @@ open Calls
 open Fields
 open Fields
 open FieldAccess
 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
 module BinopResult = struct
 
 
@@ -91,7 +91,7 @@ end
 let check_assign ctx e =
 let check_assign ctx e =
 	match e.eexpr with
 	match e.eexpr with
 	| TLocal v when has_var_flag v VFinal && not (Common.ignore_error ctx.com) ->
 	| 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 _ ->
 	| TLocal {v_extra = None} | TArray _ | TField _ | TIdent _ ->
 		()
 		()
 	| TConst TThis | TTypeExpr _ when ctx.untyped ->
 	| 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) ->
 			| KAbstract (a,tl) ->
 				try
 				try
 					AbstractCast.cast_or_unify_raise ctx tstring e p
 					AbstractCast.cast_or_unify_raise ctx tstring e p
-				with Error (Unify _,_,_) ->
+				with Error { err_message = Unify _ } ->
 					loop (Abstract.get_underlying_type a tl)
 					loop (Abstract.get_underlying_type a tl)
 		in
 		in
 		loop e.etype
 		loop e.etype
@@ -290,7 +290,7 @@ let make_binop ctx op e1 e2 is_assign_op with_type p =
 		| KOther, _
 		| KOther, _
 		| _ , KOther ->
 		| _ , KOther ->
 			let pr = print_context() in
 			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
 	| OpAnd
 	| OpOr
 	| OpOr
@@ -334,9 +334,9 @@ let make_binop ctx op e1 e2 is_assign_op with_type p =
 	| OpNotEq ->
 	| OpNotEq ->
 		let e1,e2 = try
 		let e1,e2 = try
 			(* we only have to check one type here, because unification fails if one is Void and the other is not *)
 			(* 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
 			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
 			e1,AbstractCast.cast_or_unify ctx e1.etype e2 p
 		in
 		in
 		if not ctx.com.config.pf_supports_function_equality then begin match e1.eexpr, e2.eexpr with
 		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 , _
 		| _ , KOther ->
 		| _ , KOther ->
 			let pr = print_context() in
 			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
 		mk_op e1 e2 ctx.t.tbool
 	| OpBoolAnd
 	| 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
 		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)
 		BinopSpecial (mk (TNew ((match t with TInst (c,[]) -> c | _ -> die "" __LOC__),[],[e1;e2])) t p,false)
 	| OpArrow ->
 	| OpArrow ->
-		typing_error "Unexpected =>" p
+		raise_typing_error "Unexpected =>" p
 	| OpIn ->
 	| OpIn ->
-		typing_error "Unexpected in" p
+		raise_typing_error "Unexpected in" p
 	| OpNullCoal
 	| OpNullCoal
 	| OpAssign
 	| OpAssign
 	| OpAssignOp _ ->
 	| 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
 				let t_expected = BinopResult.get_type result in
 				begin try
 				begin try
 					unify_raise tret t_expected p
 					unify_raise tret t_expected p
-				with Error (Unify _,_,depth) ->
+				with Error { err_message = Unify _; err_depth = depth } ->
 					match follow tret with
 					match follow tret with
 						| TAbstract(a,tl) when type_iseq (Abstract.get_underlying_type a tl) t_expected ->
 						| TAbstract(a,tl) when type_iseq (Abstract.get_underlying_type a tl) t_expected ->
 							()
 							()
 						| _ ->
 						| _ ->
 							let st = s_type (print_context()) in
 							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;
 			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
 					in
 					begin try
 					begin try
 						check e1 e2 false
 						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;
 						if not (Meta.has Meta.Commutative cf.cf_meta) then raise Not_found;
 						check e2 e1 true
 						check e2 e1 true
-					with Not_found | Error (Unify _,_,_) | Unify_error _ ->
+					with Not_found | Error { err_message = Unify _ } | Unify_error _ ->
 						loop find_op ol
 						loop find_op ol
 					end
 					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 e1 = !type_access_ref ctx (fst e1) (snd e1) (MSet (Some e2)) with_type in
 	let type_rhs with_type = try
 	let type_rhs with_type = try
 		type_expr ctx e2 with_type
 		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)
 		Texpr.Builder.make_null t_dynamic (pos e2)
 	in
 	in
 	let assign_to e1 =
 	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
 		let e2 = AbstractCast.cast_or_unify ctx e1.etype e2 p in
 		check_assign ctx e1;
 		check_assign ctx e1;
 		(match e1.eexpr , e2.eexpr with
 		(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 ->
 		| 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
 		mk (TBinop (OpAssign,e1,e2)) e1.etype p
 	in
 	in
 	match e1 with
 	match e1 with
 	| AKNo(_,p) ->
 	| 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 _ ->
 	| AKUsingField _ | AKSafeNav _ ->
-		typing_error "Invalid operation" p
+		raise_typing_error "Invalid operation" p
 	| AKExpr { eexpr = TLocal { v_kind = VUser TVOLocalFunction; v_name = name } } ->
 	| 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 ->
 	| AKField fa ->
 		let ef = FieldAccess.get_field_expr fa FWrite in
 		let ef = FieldAccess.get_field_expr fa FWrite in
 		assign_to ef
 		assign_to ef
@@ -595,7 +595,7 @@ let type_assign ctx e1 e2 with_type p =
 	| AKUsingAccessor sea ->
 	| AKUsingAccessor sea ->
 		let fa_set = match FieldAccess.resolve_accessor sea.se_access (MSet (Some e2)) with
 		let fa_set = match FieldAccess.resolve_accessor sea.se_access (MSet (Some e2)) with
 			| AccessorFound fa -> fa
 			| AccessorFound fa -> fa
-			| _ -> typing_error "Could not resolve accessor" p
+			| _ -> raise_typing_error "Could not resolve accessor" p
 		in
 		in
 		let dispatcher = new call_dispatcher ctx (MCall [e2]) with_type p in
 		let dispatcher = new call_dispatcher ctx (MCall [e2]) with_type p in
 		dispatcher#field_call fa_set [sea.se_this] [e2]
 		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
 		begin try
 			type_non_assign_op ctx op e1 e2 true true with_type p
 			type_non_assign_op ctx op e1 e2 true true with_type p
 		with Not_found ->
 		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
 		end
 	| AKUsingField _ | AKSafeNav _ ->
 	| AKUsingField _ | AKSafeNav _ ->
-		typing_error "Invalid operation" p
+		raise_typing_error "Invalid operation" p
 	| AKExpr e ->
 	| AKExpr e ->
 		let e,vr = process_lhs_expr ctx "lhs" e in
 		let e,vr = process_lhs_expr ctx "lhs" e in
 		let e_rhs = type_binop2 ctx op e e2 true WithType.value p 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
 					| el -> mk (TBlock el) r_set p
 				end
 				end
 			| _ ->
 			| _ ->
-				typing_error "Invalid array access getter/setter combination" p
+				raise_typing_error "Invalid array access getter/setter combination" p
 		in
 		in
 		save();
 		save();
 		vr#to_texpr	e
 		vr#to_texpr	e
@@ -748,7 +748,7 @@ let type_binop ctx op e1 e2 is_assign_op with_type p =
 	| OpAssign ->
 	| OpAssign ->
 		type_assign ctx e1 e2 with_type p
 		type_assign ctx e1 e2 with_type p
 	| OpAssignOp (OpBoolAnd | OpBoolOr) ->
 	| OpAssignOp (OpBoolAnd | OpBoolOr) ->
-		typing_error "The operators ||= and &&= are not supported" p
+		raise_typing_error "The operators ||= and &&= are not supported" p
 	| OpAssignOp op ->
 	| OpAssignOp op ->
 		type_assign_op ctx op e1 e2 with_type p
 		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
 			raise Not_found
 	in
 	in
 	let unexpected_spread p =
 	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
 	in
 	let make e =
 	let make e =
 		let check_int () =
 		let check_int () =
@@ -861,7 +861,7 @@ let type_unop ctx op flag e with_type p =
 			begin try
 			begin try
 				try_abstract_unop_overloads (acc_get ctx acc)
 				try_abstract_unop_overloads (acc_get ctx acc)
 			with Not_found ->
 			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
 			end
 		| AKExpr e ->
 		| AKExpr e ->
 			find_overload_or_make 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
 				find_overload_or_make e
 			end
 			end
 		| AKUsingField _ | AKResolve _ | AKSafeNav _ ->
 		| 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
 				in
 				ef, fields, CTPath tpath
 				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
 			end
 		| [EConst(Ident i),p as expr] ->
 		| [EConst(Ident i),p as expr] ->
 			let tpath = { tpackage=[]; tname=i; tparams=[]; tsub=None } in
 			let tpath = { tpackage=[]; tname=i; tparams=[]; tsub=None } in
@@ -151,4 +151,4 @@ let check_strict_meta ctx metas =
 				| _ -> ()
 				| _ -> ()
 			) metas;
 			) metas;
 			!ret
 			!ret
-		| _ -> []
+		| _ -> []

+ 62 - 57
src/typing/typeload.ml

@@ -58,6 +58,7 @@ let check_field_access ctx cff =
 			try
 			try
 				let _,p2 = List.find (fun (access',_) -> access = access') acc in
 				let _,p2 = List.find (fun (access',_) -> access = access') acc in
 				if p1 <> null_pos && p2 <> null_pos then begin
 				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 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;
 					display_error ~depth:1 ctx.com (compl_msg "Previously defined here") p2;
 				end;
 				end;
@@ -66,6 +67,7 @@ let check_field_access ctx cff =
 				| APublic | APrivate ->
 				| APublic | APrivate ->
 					begin try
 					begin try
 						let _,p2 = List.find (fun (access',_) -> match access' with APublic | APrivate -> true | _ -> false) acc in
 						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 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;
 						display_error ~depth:1 ctx.com (compl_msg "Conflicts with this") p2;
 						loop p1 acc l
 						loop p1 acc l
@@ -92,14 +94,14 @@ let find_type_in_module_raise ctx m tname p =
 			let infos = t_infos mt in
 			let infos = t_infos mt in
 			if snd infos.mt_path = tname then
 			if snd infos.mt_path = tname then
 				if ctx.m.curmod != infos.mt_module && infos.mt_private 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
 				else
 					true
 					true
 			else
 			else
 				false
 				false
 		) m.m_types
 		) m.m_types
 	with Not_found ->
 	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 *)
 (* raises Module_not_found or Type_not_found *)
 let load_type_raise ctx mpath tname p =
 let load_type_raise ctx mpath tname p =
@@ -109,7 +111,7 @@ let load_type_raise ctx mpath tname p =
 (* raises Not_found *)
 (* raises Not_found *)
 let load_type ctx mpath tname p = try
 let load_type ctx mpath tname p = try
 	load_type_raise ctx mpath tname p
 	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
 	raise Not_found
 
 
 (** since load_type_def and load_instance are used in PASS2, they should not access the structure of a type **)
 (** 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 =
 				let m =
 					try
 					try
 						ctx.g.do_load_module ctx path p
 						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
 						raise Not_found
 				in
 				in
 				let r = f m ~resume:true 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 =
 			let m =
 				try
 				try
 					ctx.g.do_load_module ctx path p
 					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
 					raise Not_found
 			in
 			in
 			f m ~resume:resume
 			f m ~resume:resume
@@ -172,7 +174,7 @@ let find_in_modules_starting_from_current_package ~resume ctx mname p f =
 				let m =
 				let m =
 					try
 					try
 						ctx.g.do_load_module ctx path p
 						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
 						raise Not_found
 					in
 					in
 				f m ~resume:true;
 				f m ~resume:true;
@@ -200,7 +202,7 @@ let load_unqualified_type_def ctx mname tname p =
 let load_module ctx path p =
 let load_module ctx path p =
 	try
 	try
 		ctx.g.do_load_module ctx path p
 		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
 		match path with
 		| ("std" :: pack, name) ->
 		| ("std" :: pack, name) ->
 			ctx.g.do_load_module ctx (pack,name) p
 			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 cf2 = PMap.find cf1.cf_name fields in
 		let st = s_type (print_context()) in
 		let st = s_type (print_context()) in
 		if not (type_iseq cf1.cf_type cf2.cf_type) then begin
 		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 ("Cannot redefine field " ^ cf1.cf_name ^ " with different type") p;
 			display_error ctx.com ("First type was " ^ (st cf1.cf_type)) cf1.cf_pos;
 			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
 		end else
 			true
 			true
 	with Not_found ->
 	with Not_found ->
@@ -270,7 +273,7 @@ let make_extension_type ctx tl =
 				else fields
 				else fields
 			) a.a_fields fields
 			) a.a_fields fields
 		| _ ->
 		| _ ->
-			typing_error "Can only extend structures" p
+			raise_typing_error "Can only extend structures" p
 	in
 	in
 	let fields = List.fold_left mk_extension PMap.empty tl in
 	let fields = List.fold_left mk_extension PMap.empty tl in
 	let tl = List.map (fun (t,_) -> t) 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
 			let ti = map ti in
 			try
 			try
 				unify_raise t ti p
 				unify_raise t ti p
-			with Error(Unify l,p,depth) ->
+			with Error ({ err_message = Unify l } as err) ->
 				let fail() =
 				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
 				in
 				match follow t with
 				match follow t with
 				| TInst({cl_kind = KExpr e},_) ->
 				| TInst({cl_kind = KExpr e},_) ->
 					let e = type_expr {ctx with locals = PMap.empty} e (WithType.with_type ti) in
 					let e = type_expr {ctx with locals = PMap.empty} e (WithType.with_type ti) in
 					begin try unify_raise e.etype ti p
 					begin try unify_raise e.etype ti p
-					with Error (Unify _,_,_) -> fail() end
+					with Error { err_message = Unify _ } -> fail() end
 				| _ ->
 				| _ ->
 					fail()
 					fail()
 
 
@@ -305,7 +308,7 @@ let rec load_instance' ctx (t,p) allow_no_params =
 	let t = try
 	let t = try
 		if t.tpackage <> [] || t.tsub <> None then raise Not_found;
 		if t.tpackage <> [] || t.tsub <> None then raise Not_found;
 		let pt = lookup_param t.tname ctx.type_params in
 		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
 		pt
 	with Not_found ->
 	with Not_found ->
 		let mt = load_type_def ctx p t in
 		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
 			match t.tparams with
 			| [] -> t_dynamic
 			| [] -> t_dynamic
 			| [TPType t] -> TDynamic (Some (load_complex_type ctx true t))
 			| [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
 		else begin
 			let is_java_rest = ctx.com.platform = Java && is_extern in
 			let is_java_rest = ctx.com.platform = Java && is_extern in
 			let is_rest = is_rest || is_java_rest 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
 						let accepts_expression = name = "Rest" in
 						if is_expression then begin
 						if is_expression then begin
 							if not expects_expression && not accepts_expression then
 							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
 						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
 					in
 					let is_rest = is_rest || name = "Rest" && is_generic_build in
 					let is_rest = is_rest || name = "Rest" && is_generic_build in
 					let t = match follow t2 with
 					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
 							if ignore_error ctx.com then
 								t :: loop [] tl is_rest
 								t :: loop [] tl is_rest
 							else
 							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 ->
 						| Some t ->
 							t :: loop [] tl is_rest
 							t :: loop [] tl is_rest
 					end
 					end
@@ -405,7 +408,7 @@ let rec load_instance' ctx (t,p) allow_no_params =
 					else if ignore_error ctx.com then
 					else if ignore_error ctx.com then
 						[]
 						[]
 					else
 					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
 			in
 			let params = loop t.tparams types false in
 			let params = loop t.tparams types false in
 			if not is_rest then begin
 			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
 		let t = load_instance' ctx tp allow_no_params in
 		if allow_display then DisplayEmitter.check_display_type ctx t tp;
 		if allow_display then DisplayEmitter.check_display_type ctx t tp;
 		t
 		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
 		let s = s_type_path path in
 		DisplayToplevel.collect_and_raise ctx TKType NoValue CRTypeHint (s,pn) (patch_string_pos pn s)
 		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
 	| CTParent t -> load_complex_type ctx allow_display t
 	| CTPath { tpackage = ["$"]; tname = "_hx_mono" } -> spawn_monomorph ctx p
 	| CTPath { tpackage = ["$"]; tname = "_hx_mono" } -> spawn_monomorph ctx p
 	| CTPath t -> load_instance ~allow_display ctx (t,p) false
 	| 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 ->
 	| CTIntersection tl ->
 		let tl = List.map (fun (t,pn) ->
 		let tl = List.map (fun (t,pn) ->
 			try
 			try
@@ -476,13 +479,13 @@ and load_complex_type' ctx allow_display (t,p) =
 			let mk_extension (t,p) =
 			let mk_extension (t,p) =
 				match follow t with
 				match follow t with
 				| TInst ({cl_kind = KTypeParameter _},_) ->
 				| TInst ({cl_kind = KTypeParameter _},_) ->
-					typing_error "Cannot structurally extend type parameters" p
+					raise_typing_error "Cannot structurally extend type parameters" p
 				| TMono _ ->
 				| 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 ->
 				| TAnon a2 ->
 					PMap.iter (fun _ cf -> ignore(is_redefined ctx cf a2.a_fields p)) a.a_fields;
 					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]))
 					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
 			in
 			let loop (t,p) = match follow t with
 			let loop (t,p) = match follow t with
 				| TAnon a2 ->
 				| 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
 							a.a_fields <- PMap.add f cf a.a_fields
 					) a2.a_fields
 					) a2.a_fields
 				| _ ->
 				| _ ->
-					typing_error "Can only extend structures" p
+					raise_typing_error "Can only extend structures" p
 			in
 			in
 			let il = List.map (fun (t,pn) ->
 			let il = List.map (fun (t,pn) ->
 				try
 				try
@@ -525,15 +528,15 @@ and load_complex_type' ctx allow_display (t,p) =
 			let n = fst f.cff_name in
 			let n = fst f.cff_name in
 			let pf = snd f.cff_name in
 			let pf = snd f.cff_name in
 			let p = f.cff_pos 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
 			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
 				| Some t -> load_complex_type ctx allow_display t
 			in
 			in
 			if n = "new" then warning ctx WDeprecated "Structures with new are deprecated, use haxe.Constraints.Constructible instead" p;
 			if n = "new" then warning ctx WDeprecated "Structures with new are deprecated, use haxe.Constraints.Constructible instead" p;
 			let no_expr = function
 			let no_expr = function
 				| None -> ()
 				| None -> ()
-				| Some (_,p) -> typing_error "Expression not allowed here" p
+				| Some (_,p) -> raise_typing_error "Expression not allowed here" p
 			in
 			in
 			let pub = ref true in
 			let pub = ref true in
 			let dyn = ref false in
 			let dyn = ref false in
@@ -550,15 +553,15 @@ and load_complex_type' ctx allow_display (t,p) =
 					pub := false;
 					pub := false;
 				| ADynamic when (match f.cff_kind with FFun _ -> true | _ -> false) -> dyn := true
 				| ADynamic when (match f.cff_kind with FFun _ -> true | _ -> false) -> dyn := true
 				| AFinal -> final := 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;
 			) f.cff_access;
 			let t , access = (match f.cff_kind with
 			let t , access = (match f.cff_kind with
 				| FVar(t,e) when !final ->
 				| FVar(t,e) when !final ->
 					no_expr e;
 					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 }
 					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"}),_),_) ->
 				| 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) ->
 				| FVar (t, e) ->
 					no_expr e;
 					no_expr e;
 					topt t, Var { v_read = AccNormal; v_write = AccNormal }
 					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 get && x = "get_" ^ n -> AccCall
 						| x when not get && x = "set_" ^ 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
 					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 }
 					load_complex_type ctx allow_display t, Var { v_read = access i1 true; v_write = access i2 false }
 			) in
 			) in
 			let t = if Meta.has Meta.Optional f.cff_meta then ctx.t.tnull t else t 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) =
 and load_complex_type ctx allow_display (t,pn) =
 	try
 	try
 		load_complex_type' ctx allow_display (t,pn)
 		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
 			t_dynamic
 		end else if ignore_error ctx.com && not (DisplayPosition.display_position#enclosed_in pn) then
 		end else if ignore_error ctx.com && not (DisplayPosition.display_position#enclosed_in pn) then
 			t_dynamic
 			t_dynamic
 		else
 		else
-			raise exc
+			raise (Error err)
 
 
 and init_meta_overloads ctx co cf =
 and init_meta_overloads ctx co cf =
 	let overloads = ref [] in
 	let overloads = ref [] in
@@ -646,10 +649,10 @@ and init_meta_overloads ctx co cf =
 	cf.cf_meta <- List.filter (fun m ->
 	cf.cf_meta <- List.filter (fun m ->
 		match m with
 		match m with
 		| (Meta.Overload,[(EFunction (kind,f),p)],_)  ->
 		| (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
 			(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
 			let old = ctx.type_params in
 			begin match cf.cf_params with
 			begin match cf.cf_params with
@@ -662,7 +665,7 @@ and init_meta_overloads ctx co cf =
 			end;
 			end;
 			let params : type_params = (!type_function_params_rec) ctx f cf.cf_name p in
 			let params : type_params = (!type_function_params_rec) ctx f cf.cf_name p in
 			ctx.type_params <- params @ ctx.type_params;
 			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 =
 			let args =
 				List.map
 				List.map
 					(fun ((a,_),opt,_,t,cto) ->
 					(fun ((a,_),opt,_,t,cto) ->
@@ -679,15 +682,15 @@ and init_meta_overloads ctx co cf =
 			false
 			false
 		| (Meta.Overload,[],_) when ctx.com.config.pf_overload ->
 		| (Meta.Overload,[],_) when ctx.com.config.pf_overload ->
 			add_class_field_flag cf CfOverload;
 			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
 			(match follow cf.cf_type with
 			| TFun (args,_) -> List.iter topt args
 			| TFun (args,_) -> List.iter topt args
 			| _ -> () (* could be a variable *));
 			| _ -> () (* could be a variable *));
 			true
 			true
 		| (Meta.Overload,[],p) ->
 		| (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) ->
 		| (Meta.Overload,_,p) ->
-			typing_error "Invalid @:overload metadata format" p
+			raise_typing_error "Invalid @:overload metadata format" p
 		| _ ->
 		| _ ->
 			true
 			true
 	) cf.cf_meta;
 	) cf.cf_meta;
@@ -785,7 +788,7 @@ let rec type_type_param ctx host path get_params p tp =
 			(* check against direct recursion *)
 			(* check against direct recursion *)
 			let rec loop t =
 			let rec loop t =
 				match follow t with
 				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 },_) ->
 				| TInst ({ cl_kind = KTypeParameter cl },_) ->
 					List.iter loop 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
 					List.iter2 (fun t1 t2 -> type_eq EqCoreType t2 t1) l1 l2
 				with
 				with
 					| Invalid_argument _ ->
 					| 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 ->
 					| 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;
 						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
 				end
 			| t1,t2 ->
 			| t1,t2 ->
 				Printf.printf "%s %s" (s_type (print_context()) t1) (s_type (print_context()) t2);
 				Printf.printf "%s %s" (s_type (print_context()) t1) (s_type (print_context()) t2);
 				die "" __LOC__
 				die "" __LOC__
 		) ccore.cl_params c.cl_params;
 		) ccore.cl_params c.cl_params;
 	with Invalid_argument _ ->
 	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;
 	end;
 	(match c.cl_doc with
 	(match c.cl_doc with
 	| None -> c.cl_doc <- ccore.cl_doc
 	| None -> c.cl_doc <- ccore.cl_doc
@@ -864,9 +868,10 @@ let init_core_api ctx c =
 		(try
 		(try
 			type_eq EqCoreType (apply_params ccore.cl_params (extract_param_types c.cl_params) f.cf_type) f2.cf_type
 			type_eq EqCoreType (apply_params ccore.cl_params (extract_param_types c.cl_params) f.cf_type) f2.cf_type
 		with Unify_error l ->
 		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;
 			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
 		(match f2.cf_doc with
 		| None -> f2.cf_doc <- f.cf_doc
 		| None -> f2.cf_doc <- f.cf_doc
 		| Some _ -> ());
 		| Some _ -> ());
@@ -875,25 +880,25 @@ let init_core_api ctx c =
 			| Method MethInline, Method MethNormal -> () (* allow to add 'inline' *)
 			| Method MethInline, Method MethNormal -> () (* allow to add 'inline' *)
 			| Method MethNormal, Method MethInline -> () (* allow to disable '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;
 		end;
 		(match follow f.cf_type, follow f2.cf_type with
 		(match follow f.cf_type, follow f2.cf_type with
 		| TFun (pl1,_), TFun (pl2,_) ->
 		| 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,_,_) ->
 			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;
 			) pl1 pl2;
 		| _ -> ());
 		| _ -> ());
 	in
 	in
 	let check_fields fcore fl =
 	let check_fields fcore fl =
 		PMap.iter (fun i f ->
 		PMap.iter (fun i f ->
 			if not (has_class_field_flag f CfPublic) then () else
 			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;
 			compare_fields f f2;
 		) fcore;
 		) fcore;
 		PMap.iter (fun i f ->
 		PMap.iter (fun i f ->
 			let p = (match f.cf_expr with None -> c.cl_pos | Some e -> e.epos) in
 			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;
 		) fl;
 	in
 	in
 	check_fields ccore.cl_fields c.cl_fields;
 	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 cf, _ when not (has_class_field_flag cf CfPublic) -> ()
 	| Some f, Some f2 -> compare_fields f f2
 	| Some f, Some f2 -> compare_fields f f2
 	| None, Some cf when not (has_class_field_flag cf CfPublic) -> ()
 	| 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) =
 let string_list_of_expr_path (e,p) =
 	try string_list_of_expr_path_raise (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
 		raise Not_found
 	| _ ->
 	| _ ->
-		typing_error "String expected" mp
+		raise_typing_error "String expected" mp
 
 
 let check_native_name_override ctx child base =
 let check_native_name_override ctx child base =
 	let error base_pos child_pos =
 	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 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
 		display_error ~depth:1 ctx.com (compl_msg "Base field is defined here") base_pos
 	in
 	in
@@ -211,9 +212,10 @@ let check_overriding ctx c f =
 				valid_redefinition ctx map map f f.cf_type f2 t;
 				valid_redefinition ctx map map f f.cf_type f2 t;
 			with
 			with
 				Unify_error l ->
 				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 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;
 					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
 		with
 			Not_found ->
 			Not_found ->
 				if has_class_field_flag f CfOverride then
 				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
 	let t = t_infos t in
 	try
 	try
 		let path2 = ctx.com.type_to_module#find t.mt_path in
 		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 m2 = ctx.com.module_lut#find path2 in
 		let hex1 = Digest.to_hex m.m_extra.m_sign in
 		let hex1 = Digest.to_hex m.m_extra.m_sign in
 		let hex2 = Digest.to_hex m2.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
 		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
 	with
 		Not_found ->
 		Not_found ->
 			ctx.com.type_to_module#add t.mt_path m.m_path
 			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
 	let check_extends ctx c t p = match follow t with
 		| TInst (csup,params) ->
 		| 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
 			begin match csup.cl_kind with
 				| KTypeParameter _ ->
 				| 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
 				| _ -> csup,params
 			end
 			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 =
 	let rec check_interface ctx missing c intf params =
 		List.iter (fun (i2,p2) ->
 		List.iter (fun (i2,p2) ->
@@ -396,9 +398,10 @@ module Inheritance = struct
 					with
 					with
 						Unify_error l ->
 						Unify_error l ->
 							if not (Meta.has Meta.CsNative c.cl_meta && (has_class_flag c CExtern)) then begin
 							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 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;
 								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
 							end
 				)
 				)
 			with Not_found ->
 			with Not_found ->
@@ -489,6 +492,7 @@ module Inheritance = struct
 		| l ->
 		| l ->
 			let singular = match l with [_] -> true | _ -> false in
 			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;
 			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;
 			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
 			let pctx = print_context() in
 			List.iter (fun (cf,_) ->
 			List.iter (fun (cf,_) ->
@@ -512,7 +516,7 @@ module Inheritance = struct
 				| _ -> ()
 				| _ -> ()
 			) csup.cl_meta;
 			) 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
 			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
 		in
 		let check_cancel_build csup =
 		let check_cancel_build csup =
 			match csup.cl_build() with
 			match csup.cl_build() with
@@ -565,17 +569,17 @@ module Inheritance = struct
 					check_interfaces ctx c
 					check_interfaces ctx c
 			in
 			in
 			if is_extends then begin
 			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
 				let csup,params = check_extends ctx c t p in
 				if (has_class_flag c CInterface) then begin
 				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;
 					c.cl_implements <- (csup,params) :: c.cl_implements;
 					if not !has_interf then begin
 					if not !has_interf then begin
 						if not is_lib then delay ctx PConnectField check_interfaces_or_delay;
 						if not is_lib then delay ctx PConnectField check_interfaces_or_delay;
 						has_interf := true;
 						has_interf := true;
 					end
 					end
 				end else begin
 				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)
 					c.cl_super <- Some (csup,params)
 				end;
 				end;
 				(fun () ->
 				(fun () ->
@@ -584,13 +588,13 @@ module Inheritance = struct
 				)
 				)
 			end else begin match follow t with
 			end else begin match follow t with
 				| TInst ({ cl_path = [],"ArrayAccess" } as ca,[t]) when (has_class_flag ca CExtern) ->
 				| 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;
 					c.cl_array_access <- Some t;
 					(fun () -> ())
 					(fun () -> ())
 				| TInst (intf,params) ->
 				| 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;
 					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
 					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;
 						delay ctx PConnectField check_interfaces_or_delay;
@@ -601,12 +605,12 @@ module Inheritance = struct
 						process_meta intf;
 						process_meta intf;
 					)
 					)
 				| TDynamic t ->
 				| 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;
 					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);
 					c.cl_dynamic <- Some (match t with None -> t_dynamic | Some t -> t);
 					(fun () -> ())
 					(fun () -> ())
 				| _ ->
 				| _ ->
-					typing_error "Should implement by using an interface" p
+					raise_typing_error "Should implement by using an interface" p
 			end
 			end
 		in
 		in
 		let fl = ExtList.List.filter_map (fun (is_extends,(ct,p)) ->
 		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
 					raise_fields l (if is_extends then CRExtends else CRImplements) r.fsubject
 				in
 				in
 				Some (check_herit t is_extends p)
 				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;
 				if Diagnostics.error_in_diagnostics_run ctx.com p then DisplayToplevel.handle_unresolved_identifier ctx name p true;
 				None
 				None
 		) herits in
 		) 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 ->
 	| FProp ((("get" | "never"),_),(("set" | "never"),_),_,_) when not stat ->
 		f
 		f
 	| FProp _ when not stat && not (Meta.has Meta.Enum f.cff_meta) ->
 	| 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 ->
 	| 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 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 cast e = (ECast(e,None)),pos e in
 		let ret p = (EReturn (Some (cast (EConst (Ident "this"),p))),p) in
 		let ret p = (EReturn (Some (cast (EConst (Ident "this"),p))),p) in
 		let meta = (Meta.NoCompletion,[],null_pos) :: f.cff_meta in
 		let meta = (Meta.NoCompletion,[],null_pos) :: f.cff_meta in
 		if Meta.has Meta.MultiType a.a_meta then begin
 		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;
 			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;
 			f.cff_access <- (AExtern,null_pos) :: f.cff_access;
 		end;
 		end;
 		(try
 		(try
 			let _, p = List.find (fun (acc, _) -> acc = AMacro) f.cff_access in
 			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 -> ());
 		with Not_found -> ());
 		(* We don't want the generated expression positions to shadow the real code. *)
 		(* We don't want the generated expression positions to shadow the real code. *)
 		let p = { p with pmax = p.pmin } in
 		let p = { p with pmax = p.pmin } in
@@ -299,7 +299,7 @@ let transform_abstract_field com this_t a_t a f =
 		} in
 		} in
 		{ f with cff_name = "_new",pos f.cff_name; cff_kind = FFun fu; cff_meta = meta }
 		{ f with cff_name = "_new",pos f.cff_name; cff_kind = FFun fu; cff_meta = meta }
 	| FFun fu when not stat ->
 	| 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 with cff_kind = FFun fu }
 	| _ ->
 	| _ ->
 		f
 		f
@@ -474,7 +474,7 @@ let build_enum_abstract ctx c a fields p =
 let apply_macro ctx mode path el p =
 let apply_macro ctx mode path el p =
 	let cpath, meth = (match List.rev (ExtString.String.nsplit path ".") with
 	let cpath, meth = (match List.rev (ExtString.String.nsplit path ".") with
 		| meth :: name :: pack -> (List.rev pack,name), meth
 		| meth :: name :: pack -> (List.rev pack,name), meth
-		| _ -> typing_error "Invalid macro path" p
+		| _ -> raise_typing_error "Invalid macro path" p
 	) in
 	) in
 	ctx.g.do_macro ctx mode cpath meth el p
 	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 () ->
 		| Meta.Build,args,p when not is_typedef -> (fun () ->
 				let epath, el = (match args with
 				let epath, el = (match args with
 					| [ECall (epath,el),p] -> epath, el
 					| [ECall (epath,el),p] -> epath, el
-					| _ -> typing_error "Invalid build parameters" p
+					| _ -> raise_typing_error "Invalid build parameters" p
 				) in
 				) 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
 				let old = ctx.get_build_infos in
 				ctx.get_build_infos <- (fun() -> Some (mt, extract_param_types (t_infos mt).mt_params, fvars()));
 				ctx.get_build_infos <- (fun() -> Some (mt, extract_param_types (t_infos mt).mt_params, fvars()));
 				context_init#run;
 				context_init#run;
 				let r = try apply_macro ctx MBuild s el p with e -> ctx.get_build_infos <- old; raise e in
 				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;
 				ctx.get_build_infos <- old;
 				(match r with
 				(match r with
-				| None -> typing_error "Build failure" p
+				| None -> raise_typing_error "Build failure" p
 				| Some e -> fbuild e)
 				| Some e -> fbuild e)
 			) :: f_build
 			) :: f_build
 		| Meta.Using,el,p -> (fun () ->
 		| 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
 						ti.mt_using <- (filter_classes types) @ ti.mt_using
 					)
 					)
 				with Exit ->
 				with Exit ->
-					typing_error "dot path expected" (pos e)
+					raise_typing_error "dot path expected" (pos e)
 			) el;
 			) el;
 		) :: f_build
 		) :: 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 ->
 		| 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 *)
 			(* 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
 			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
 	f
 
 
@@ -745,7 +745,7 @@ let build_fields (ctx,cctx) c fields =
 		| EVars [{ ev_type = Some (CTAnonymous f,p); ev_expr = None }] ->
 		| 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
 			let f = List.map (fun f -> transform_field (ctx,cctx) c f fields p) f in
 			fields := f
 			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]);
 	c.cl_build <- (fun() -> Building [c]);
 	List.iter (fun f -> f()) !pending;
 	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 create_variable (ctx,cctx,fctx) c f t eo p =
 	let is_abstract_enum_field = Meta.has Meta.Enum f.cff_meta in
 	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 && 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;
 	if fctx.is_inline && eo = None then missing_expression ctx.com fctx "Inline variable must be initialized" p;
 	let missing_initialization =
 	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 ->
 					let r = exc_protect ctx (fun r ->
 						r := lazy_processing (fun () -> t);
 						r := lazy_processing (fun () -> t);
 						(* the return type of a from-function must be the abstract, not the underlying type *)
 						(* 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
 						match t with
 							| TFun([_,_,t],_) -> t
 							| TFun([_,_,t],_) -> t
 							| TFun([(_,_,t1);(_,true,t2)],_) when is_pos_infos t2 -> t1
 							| 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
 					) "@:from" in
 					a.a_from_field <- (TLazy r,cf) :: a.a_from_field;
 					a.a_from_field <- (TLazy r,cf) :: a.a_from_field;
 				| (Meta.To,_,_) :: _ ->
 				| (Meta.To,_,_) :: _ ->
@@ -1088,19 +1088,19 @@ let check_abstract (ctx,cctx,fctx) c cf fd t ret p =
 					in
 					in
 					(match cf.cf_kind, cf.cf_type with
 					(match cf.cf_kind, cf.cf_type with
 					| Var _, _ ->
 					| 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) ->
 					| 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 *)
 						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) ->
 					| 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 *)
 						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... *)
 					(* TODO: this doesn't seem quite right... *)
 					if not (has_class_field_flag cf CfImpl) then add_class_field_flag cf CfImpl;
 					if not (has_class_field_flag cf CfImpl) then add_class_field_flag cf CfImpl;
 					let resolve_m args =
 					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
 						match follow m with
 							| TMono _ when (match t with TFun(_,r) -> r == t_dynamic | _ -> false) -> t_dynamic
 							| TMono _ when (match t with TFun(_,r) -> r == t_dynamic | _ -> false) -> t_dynamic
 							| m -> m
 							| m -> m
@@ -1114,7 +1114,7 @@ let check_abstract (ctx,cctx,fctx) c cf fd t ret p =
 							let ctor = try
 							let ctor = try
 								PMap.find "_new" c.cl_statics
 								PMap.find "_new" c.cl_statics
 							with Not_found ->
 							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
 							in
 							(* delay ctx PFinal (fun () -> unify ctx m tthis f.cff_pos); *)
 							(* delay ctx PFinal (fun () -> unify ctx m tthis f.cff_pos); *)
 							let args = match follow (monomorphs a.a_params ctor.cf_type) with
 							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;
 					a.a_array <- cf :: a.a_array;
 					allow_no_expr();
 					allow_no_expr();
 				| (Meta.Op,[EBinop(OpAssign,_,_),_],_) :: _ ->
 				| (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(OpAssignOp OpNullCoal,_,_),_],_) :: _
 				| (Meta.Op,[EBinop(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(_,_,_),_],_) :: _ ->
 				| (Meta.Op,[ETernary(_,_,_),_],_) :: _ ->
-					typing_error "Ternary overloading is not supported" p;
+					raise_typing_error "Ternary overloading is not supported" p;
 				| (Meta.Op,[EBinop(op,_,_),_],_) :: _ ->
 				| (Meta.Op,[EBinop(op,_,_),_],_) :: _ ->
 					if fctx.is_macro then invalid_modifier ctx.com fctx "macro" "operator function" p;
 					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
 					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
 							type_iseq targ t1,type_iseq targ t2
 						| _ ->
 						| _ ->
 							if fctx.is_abstract_member then
 							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
 							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
 					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;
 					a.a_ops <- (op,cf) :: a.a_ops;
 					allow_no_expr();
 					allow_no_expr();
 				| (Meta.Op,[EUnop(op,flag,_),_],_) :: _ ->
 				| (Meta.Op,[EUnop(op,flag,_),_],_) :: _ ->
 					if fctx.is_macro then invalid_modifier ctx.com fctx "macro" "operator function" p;
 					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
 					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;
 					a.a_unops <- (op,flag,cf) :: a.a_unops;
 					allow_no_expr();
 					allow_no_expr();
 				| (Meta.Op,[ECall _,_],_) :: _ ->
 				| (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 targ = if fctx.is_abstract_member then tthis else ta in
 					let check_fun t1 t2 =
 					let check_fun t1 t2 =
 						if not fctx.is_macro then begin
 						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
 						end
 					in
 					in
 					begin match follow t with
 					begin match follow t with
 						| TFun((_,_,t1) :: (_,_,t2) :: args,_) when is_empty_or_pos_infos args ->
 						| 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;
 							check_fun t1 t2;
 							a.a_read <- Some cf;
 							a.a_read <- Some cf;
 						| TFun((_,_,t1) :: (_,_,t2) :: (_,_,t3) :: args,_) when is_empty_or_pos_infos args ->
 						| 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;
 							check_fun t1 t2;
 							a.a_write <- Some cf;
 							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;
 					end;
 				| _ -> ());
 				| _ -> ());
 				match ml with
 				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 cf.cf_name = "_new" && Meta.has Meta.MultiType a.a_meta then fctx.do_bind <- false;
 			if fd.f_expr = None then begin
 			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 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
 				if !allows_no_expr then begin
 					cf.cf_meta <- (Meta.NoExpr,[],null_pos) :: cf.cf_meta;
 					cf.cf_meta <- (Meta.NoExpr,[],null_pos) :: cf.cf_meta;
 					fctx.do_bind <- false;
 					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 name = fst f.cff_name in
 	let params = TypeloadFunction.type_function_params ctx fd name p in
 	let params = TypeloadFunction.type_function_params ctx fd name p in
 	if fctx.is_generic then begin
 	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;
 	end;
 	let fd = if fctx.is_macro && not ctx.com.is_macro_context && not fctx.is_static then
 	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 *)
 		(* 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
 			let to_dyn p t = match t with
 				| { tpackage = ["haxe";"macro"]; tname = "Expr"; tsub = Some ("ExprOf"); tparams = [TPType t] } -> Some t
 				| { tpackage = ["haxe";"macro"]; tname = "Expr"; tsub = Some ("ExprOf"); tparams = [TPType t] } -> Some t
 				| { tpackage = []; tname = ("ExprOf"); tsub = None; 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
 				| _ -> tdyn
 			in
 			in
 			{
 			{
@@ -1340,7 +1340,7 @@ let create_method (ctx,cctx,fctx) c f fd p =
 	end in
 	end in
 	begin match (has_class_flag c CInterface),fctx.field_kind with
 	begin match (has_class_flag c CInterface),fctx.field_kind with
 		| true,FKConstructor ->
 		| true,FKConstructor ->
-			typing_error "An interface cannot have a constructor" p;
+			raise_typing_error "An interface cannot have a constructor" p;
 		| true,_ ->
 		| 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 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;
 			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) ->
 				| Some (CTPath ({ tpackage = []; tname = "Void" } as tp),p) ->
 					if ctx.is_display_file && DisplayPosition.display_position#enclosed_in p then
 					if ctx.is_display_file && DisplayPosition.display_position#enclosed_in p then
 						ignore(load_instance ~allow_display:true ctx (tp,p) false);
 						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
 			end
 		| false,_ ->
 		| 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
 	let name = fst f.cff_name in
 	(* TODO is_lib: lazify load_complex_type *)
 	(* TODO is_lib: lazify load_complex_type *)
 	let ret = (match t, eo with
 	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()
 		| None, _ -> mk_mono()
 		| Some t, _ -> lazy_display_type ctx (fun () -> load_type_hint ctx p (Some t))
 		| Some t, _ -> lazy_display_type ctx (fun () -> load_type_hint ctx p (Some t))
 	) in
 	) in
 	let t_get,t_set = match cctx.abstract with
 	let t_get,t_set = match cctx.abstract with
 		| Some a when fctx.is_abstract_member ->
 		| 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
 			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 [ta] ret, tfun [ta;ret] ret
 		| _ -> tfun [] ret, TFun(["value",false,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;
 					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
 					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;
 						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
 		with
 			| Not_found ->
 			| 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;
 			display_error ctx.com (name ^ ": Custom property accessor is no longer supported, please use `set`") pset;
 			AccCall
 			AccCall
 	) in
 	) 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 };
 	cf.cf_kind <- Var { v_read = get; v_write = set };
 	if fctx.is_extern then add_class_field_flag cf CfExtern;
 	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;
 	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
 	in
 	let rec check_if_feature = function
 	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
 		| _ :: l -> check_if_feature l
 	in
 	in
 	let cl_if_feature = check_if_feature c.cl_meta 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;
 			end;
 			if fctx.is_field_debug then print_endline ("Created field: " ^ Printer.s_tclass_field "" cf);
 			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
 			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 =
 			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
 				ctx.m.curmod.m_extra.m_if_feature <- (s,(c,cf,fctx.is_static)) :: ctx.m.curmod.m_extra.m_if_feature
 			in
 			in
@@ -1832,7 +1832,7 @@ let init_class ctx c p context_init herits fields =
 				()
 				()
 			| FKNormal ->
 			| 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
 				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
 				if fctx.override <> None then
 					add_class_field_flag cf CfOverride;
 					add_class_field_flag cf CfOverride;
 				let is_var cf = match cf.cf_kind with
 				let is_var cf = match cf.cf_kind with
@@ -1856,8 +1856,8 @@ let init_class ctx c p context_init herits fields =
 				else
 				else
 				if fctx.do_add then TClass.add_field c cf
 				if fctx.do_add then TClass.add_field c cf
 			end
 			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;
 	) fields;
 		begin match cctx.abstract with
 		begin match cctx.abstract with
 		| Some a ->
 		| 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
 				EBlock [],p
 			else
 			else
 				if fmode = FunMember && has_class_flag ctx.curclass CAbstract then
 				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
 				else
-					typing_error "Function body required" p
+					raise_typing_error "Function body required" p
 		| Some e -> e
 		| Some e -> e
 	in
 	in
 	let is_position_debug = Meta.has (Meta.Custom ":debug.position") ctx.curfield.cf_meta 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 *)
 		(* 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;
 			DeprecationCheck.check_is com meta [] name meta p;
 			let error prev_pos =
 			let error prev_pos =
 				display_error ctx.com ("Name " ^ name ^ " is already defined in this module") p;
 				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
 			in
 			List.iter (fun (t2,(_,p2)) ->
 			List.iter (fun (t2,(_,p2)) ->
 				if snd (t_path t2) = name then error (t_infos t2).mt_name_pos
 				if snd (t_path t2) = name then error (t_infos t2).mt_name_pos
@@ -93,7 +93,7 @@ module ModuleLevel = struct
 			in
 			in
 			let acc = (match fst decl with
 			let acc = (match fst decl with
 			| EImport _ | EUsing _ ->
 			| 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
 				acc
 			| EStatic d ->
 			| EStatic d ->
 				check_name (fst d.d_name) d.d_meta false (snd d.d_name);
 				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 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
 				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 *)
 				(* 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_module <- m;
 				c.cl_private <- priv;
 				c.cl_private <- priv;
 				c.cl_doc <- d.d_doc;
 				c.cl_doc <- d.d_doc;
@@ -131,7 +131,7 @@ module ModuleLevel = struct
 				has_declaration := true;
 				has_declaration := true;
 				let priv = List.mem EPrivate d.d_flags in
 				let priv = List.mem EPrivate d.d_flags in
 				let path = make_path name priv d.d_meta p 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 = {
 				let e = {
 					e_path = path;
 					e_path = path;
 					e_module = m;
 					e_module = m;
@@ -304,7 +304,7 @@ module ModuleLevel = struct
 						| ParseSuccess(data,_,_) -> data
 						| ParseSuccess(data,_,_) -> data
 						| ParseError(_,(msg,p),_) -> Parser.error msg p
 						| ParseError(_,(msg,p),_) -> Parser.error msg p
 					in
 					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);
 					add_dependency m (make_import_module path r);
 					r
 					r
 				end else begin
 				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;
 				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.Generic c.cl_meta && c.cl_params <> [] then c.cl_kind <- KGeneric;
 				if Meta.has Meta.GenericBuild c.cl_meta then begin
 				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;
 					c.cl_kind <- KGenericBuild d.d_data;
 				end;
 				end;
 				if c.cl_path = (["haxe";"macro"],"MacroType") then c.cl_kind <- KMacroType;
 				if c.cl_path = (["haxe";"macro"],"MacroType") then c.cl_kind <- KMacroType;
@@ -356,7 +356,7 @@ module TypeLevel = struct
 				| TEnum (te,_) when te == e ->
 				| 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
 				t
 		) in
 		) in
 		let t = (match c.ec_args with
 		let t = (match c.ec_args with
@@ -365,8 +365,8 @@ module TypeLevel = struct
 				is_flat := false;
 				is_flat := false;
 				let pnames = ref PMap.empty in
 				let pnames = ref PMap.empty in
 				TFun (List.map (fun (s,opt,(t,tp)) ->
 				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);
 					pnames := PMap.add s () (!pnames);
 					s, opt, load_type_hint ~opt ctx p (Some (t,tp))
 					s, opt, load_type_hint ~opt ctx p (Some (t,tp))
 				) l, rt)
 				) l, rt)
@@ -426,7 +426,7 @@ module TypeLevel = struct
 					(match state with
 					(match state with
 					| Built -> die "" __LOC__
 					| Built -> die "" __LOC__
 					| Building cl ->
 					| 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;
 						prev_build_count := !build_count;
 						rebuild();
 						rebuild();
 						Building (c :: cl)
 						Building (c :: cl)
@@ -472,7 +472,7 @@ module TypeLevel = struct
 		(match h with
 		(match h with
 		| None -> ()
 		| None -> ()
 		| Some (h,hcl) ->
 		| 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);
 			e.e_meta <- e.e_meta @ hcl.tp_meta);
 		let constructs = ref d.d_data in
 		let constructs = ref d.d_data in
 		let get_constructs() =
 		let get_constructs() =
@@ -496,10 +496,10 @@ module TypeLevel = struct
 					let args, params, t = (match f.cff_kind with
 					let args, params, t = (match f.cff_kind with
 					| FVar (t,None) -> [], [], t
 					| FVar (t,None) -> [], [], t
 					| FFun { f_params = pl; f_type = t; f_expr = (None|Some (EBlock [],_)); f_args = al } ->
 					| 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
 						al, pl, t
 					| _ ->
 					| _ ->
-						typing_error "Invalid enum constructor in @:build result" p
+						raise_typing_error "Invalid enum constructor in @:build result" p
 					) in
 					) in
 					{
 					{
 						ec_name = f.cff_name;
 						ec_name = f.cff_name;
@@ -511,7 +511,7 @@ module TypeLevel = struct
 						ec_type = t;
 						ec_type = t;
 					}
 					}
 				) fields
 				) 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 et = TEnum (e,extract_param_types e.e_params) in
 		let names = ref [] in
 		let names = ref [] in
@@ -519,7 +519,7 @@ module TypeLevel = struct
 		let is_flat = ref true in
 		let is_flat = ref true in
 		let fields = ref PMap.empty in
 		let fields = ref PMap.empty in
 		List.iter (fun c ->
 		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
 			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;
 			e.e_constrs <- PMap.add f.ef_name f e.e_constrs;
 			fields := PMap.add cf.cf_name cf !fields;
 			fields := PMap.add cf.cf_name cf !fields;
@@ -555,14 +555,14 @@ module TypeLevel = struct
 		| CTExtend _ -> tt
 		| CTExtend _ -> tt
 		| CTPath { tpackage = ["haxe";"macro"]; tname = "MacroType" } ->
 		| CTPath { tpackage = ["haxe";"macro"]; tname = "MacroType" } ->
 			(* we need to follow MacroType immediately since it might define other module types that we will load afterwards *)
 			(* 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
 			tt
 		| _ ->
 		| _ ->
 			if (Meta.has Meta.Eager d.d_meta) then
 			if (Meta.has Meta.Eager d.d_meta) then
 				follow tt
 				follow tt
 			else begin
 			else begin
 				let rec check_rec tt =
 				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
 					match tt with
 					| TMono r ->
 					| TMono r ->
 						(match r.tm_type with
 						(match r.tm_type with
@@ -571,7 +571,7 @@ module TypeLevel = struct
 					| TLazy f ->
 					| TLazy f ->
 						check_rec (lazy_type f);
 						check_rec (lazy_type f);
 					| TType (td,tl) ->
 					| 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)
 						check_rec (apply_typedef td tl)
 					| _ ->
 					| _ ->
 						()
 						()
@@ -610,15 +610,15 @@ module TypeLevel = struct
 				if !is_type then begin
 				if !is_type then begin
 					let r = exc_protect ctx (fun r ->
 					let r = exc_protect ctx (fun r ->
 						r := lazy_processing (fun() -> t);
 						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
 						t
 					) "constraint" in
 					) "constraint" in
 					TLazy r
 					TLazy r
 				end else
 				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
 			end else begin
 				if Meta.has Meta.Callable a.a_meta then
 				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
 				t
 			end in
 			end in
 			t
 			t
@@ -627,15 +627,15 @@ module TypeLevel = struct
 			| AbFrom t -> a.a_from <- (load_type t true) :: a.a_from
 			| AbFrom t -> a.a_from <- (load_type t true) :: a.a_from
 			| AbTo t -> a.a_to <- (load_type t false) :: a.a_to
 			| AbTo t -> a.a_to <- (load_type t false) :: a.a_to
 			| AbOver t ->
 			| 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
 				let at = load_complex_type ctx true t in
 				delay ctx PForce (fun () ->
 				delay ctx PForce (fun () ->
 					let rec loop stack t =
 					let rec loop stack t =
 						match follow t with
 						match follow t with
 						| TAbstract(a,_) when not (Meta.has Meta.CoreType a.a_meta) ->
 						| TAbstract(a,_) when not (Meta.has Meta.CoreType a.a_meta) ->
 							if List.memq a stack then
 							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
 							else
 								loop (a :: stack) a.a_this
 								loop (a :: stack) a.a_this
 						| _ -> ()
 						| _ -> ()
@@ -654,7 +654,7 @@ module TypeLevel = struct
 			if Meta.has Meta.CoreType a.a_meta then
 			if Meta.has Meta.CoreType a.a_meta then
 				a.a_this <- TAbstract(a,extract_param_types a.a_params)
 				a.a_this <- TAbstract(a,extract_param_types a.a_params)
 			else
 			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;
 		end;
 		if Meta.has Meta.InheritDoc a.a_meta then
 		if Meta.has Meta.InheritDoc a.a_meta then
 			delay ctx PConnectField (fun() -> InheritDoc.build_abstract_doc ctx a)
 			delay ctx PConnectField (fun() -> InheritDoc.build_abstract_doc ctx a)
@@ -677,8 +677,8 @@ module TypeLevel = struct
 				check_path_display path p;
 				check_path_display path p;
 				ImportHandling.init_import ctx context_init path mode p;
 				ImportHandling.init_import ctx context_init path mode p;
 				ImportHandling.commit_import ctx 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
 			end
 		| EUsing path ->
 		| EUsing path ->
 			check_path_display path p;
 			check_path_display path p;
@@ -796,9 +796,7 @@ let load_module' ctx g m p =
 		| Some m ->
 		| Some m ->
 			m
 			m
 		| None ->
 		| 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.com.module_nonexistent_lut#mem m then raise_not_found();
 			if ctx.g.load_only_cached_modules then raise_not_found();
 			if ctx.g.load_only_cached_modules then raise_not_found();
 			let is_extern = ref false in
 			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
 	with
 		| Sedlexing.MalFormed ->
 		| Sedlexing.MalFormed ->
 			t();
 			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 ->
 		| e ->
 			t();
 			t();
 			raise e
 			raise e
@@ -76,7 +76,7 @@ let parse_file com file p =
 		in
 		in
 		parse_file_from_string com file p s
 		parse_file_from_string com file p s
 	else
 	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)
 		Std.finally (fun() -> close_in ch) (parse_file_from_lexbuf com file p) (Sedlexing.Utf8.from_channel ch)
 
 
 let parse_hook = ref parse_file
 let parse_hook = ref parse_file
@@ -270,8 +270,8 @@ let handle_parser_result com p result =
 		let msg = Parser.error_msg msg in
 		let msg = Parser.error_msg msg in
 		match com.display.dms_error_policy with
 		match com.display.dms_error_policy with
 			| EPShow ->
 			| 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 ->
 			| EPIgnore ->
 				com.has_error <- true
 				com.has_error <- true
 	in
 	in
@@ -347,4 +347,4 @@ let parse_module ctx m p =
 
 
 (* let parse_module ctx m p =
 (* let parse_module ctx m p =
 	let timer = Timer.timer ["typing";"parse_module"] in
 	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
 			let e = try
 				f()
 				f()
 			with
 			with
-			| Error (Unknown_ident n,_,_) ->
+			| Error { err_message = Unknown_ident n; err_sub = sub } ->
 				restore();
 				restore();
 				raise_or_display_message ctx (StringError.string_error n fields ("Identifier '" ^ n ^ "' is not part of " ^ s_type_path path)) p;
 				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)
 				AKExpr (mk (TConst TNull) (mk_mono()) p)
@@ -243,13 +243,13 @@ let rec unify_min_raise ctx (el:texpr list) : t =
 			| UnifyMinOk t ->
 			| UnifyMinOk t ->
 				t
 				t
 			| UnifyMinError(l,index) ->
 			| 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
 			end
 
 
 let unify_min ctx el =
 let unify_min ctx el =
 	try unify_min_raise 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
 		(List.hd el).etype
 
 
 let unify_min_for_type_source ctx el src =
 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
 			begin match ctx.curclass.cl_kind with
 			| KAbstractImpl _ ->
 			| KAbstractImpl _ ->
 				if not (assign_to_this_is_allowed ctx) then
 				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
 				acc
 			| _ ->
 			| _ ->
 				AKNo(acc,p)
 				AKNo(acc,p)
@@ -299,7 +299,7 @@ let rec type_ident_raise ctx i p mode with_type =
 		end;
 		end;
 	| "abstract" ->
 	| "abstract" ->
 		begin match mode, ctx.curclass.cl_kind with
 		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)
 			| (MGet, KAbstractImpl ab)
 			| (MCall _, KAbstractImpl ab) ->
 			| (MCall _, KAbstractImpl ab) ->
 				let tl = extract_param_types ab.a_params in
 				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
 				let e = {e with etype = TAbstract (ab,tl)} in
 				AKExpr e
 				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
 		end
 	| "super" ->
 	| "super" ->
 		let t = (match ctx.curclass.cl_super with
 		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)
 			| Some (c,params) -> TInst(c,params)
 		) in
 		) in
 		(match ctx.curfun with
 		(match ctx.curfun with
 		| FunMember | FunConstructor -> ()
 		| 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)
 		AKExpr (mk (TConst TSuper) t p)
 	| "null" ->
 	| "null" ->
 		let acc =
 		let acc =
@@ -356,8 +356,8 @@ let rec type_ident_raise ctx i p mode with_type =
 			(match e with
 			(match e with
 			| Some ({ eexpr = TFunction f } as e) when ctx.com.display.dms_inline ->
 			| Some ({ eexpr = TFunction f } as e) when ctx.com.display.dms_inline ->
 				begin match mode with
 				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 _ ->
 					| MCall _ ->
 						(* create a fake class with a fake field to emulate inlining *)
 						(* 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
 						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_impl = has_class_field_flag f CfImpl in
 		let is_enum = has_class_field_flag f CfEnum 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
 		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
 		let e,fa = match ctx.curclass.cl_kind with
 			| KAbstractImpl a when is_impl && not is_enum ->
 			| KAbstractImpl a when is_impl && not is_enum ->
 				let tl = extract_param_types a.a_params in
 				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
 	with Not_found -> try
 		(* lookup type *)
 		(* lookup type *)
 		if is_lower_ident i p then raise Not_found;
 		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
 		AKExpr e
 	with Not_found ->
 	with Not_found ->
 		let resolved_to_type_parameter = ref false in
 		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
 					let t = mk_mono() in
 					AKExpr ((mk (TIdent i)) t p)
 					AKExpr ((mk (TIdent i)) t p)
 			end else begin
 			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
 				if !resolved_to_type_parameter then begin
 					display_error ctx.com ("Only @:const type parameters on @:generic classes can be used as value") p;
 					display_error ctx.com ("Only @:const type parameters on @:generic classes can be used as value") p;
 					AKExpr (mk (TConst TNull) t_dynamic p)
 					AKExpr (mk (TConst TNull) t_dynamic p)
 				end else begin
 				end else begin
 					let err = Unknown_ident i in
 					let err = Unknown_ident i in
 					if ctx.in_display then begin
 					if ctx.in_display then begin
-						raise (Error (err,p,0))
+						raise_error_msg err p
 					end;
 					end;
 					if Diagnostics.error_in_diagnostics_run ctx.com p then begin
 					if Diagnostics.error_in_diagnostics_run ctx.com p then begin
 						DisplayToplevel.handle_unresolved_identifier ctx i p false;
 						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)
 						AKExpr (mk (TIdent i) t p)
 					end else match ctx.com.display.dms_kind with
 					end else match ctx.com.display.dms_kind with
 						| DMNone ->
 						| 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
 							let t = mk_mono() in
 							(* Add a fake local for #8751. *)
 							(* Add a fake local for #8751. *)
 							if !ServerConfig.legacy_completion then
 							if !ServerConfig.legacy_completion then
@@ -533,7 +533,7 @@ and handle_efield ctx e p0 mode with_type =
 				try
 				try
 					(* TODO: we don't really want to do full type_ident again, just the second part of it *)
 					(* 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)
 					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
 						(* try raising a more sensible error if there was an uppercase-first (module name) part *)
 						(* try raising a more sensible error if there was an uppercase-first (module name) part *)
 						begin
 						begin
@@ -557,9 +557,9 @@ and handle_efield ctx e p0 mode with_type =
 							let mpath = (pack,name) in
 							let mpath = (pack,name) in
 							if ctx.com.module_lut#mem mpath then
 							if ctx.com.module_lut#mem mpath then
 								let tname = Option.default name sub in
 								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
 							else
-								raise (Error (Module_not_found mpath,p,0))
+								raise_error_msg (Module_not_found mpath) p
 						end
 						end
 					with Not_found ->
 					with Not_found ->
 						(* if there was no module name part, last guess is that we're trying to get package completion *)
 						(* 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
 							else
 								DisplayToplevel.collect_and_raise ctx TKType WithType.no_value (CRToplevel None) (String.concat "." sl,p0) p0
 								DisplayToplevel.collect_and_raise ctx TKType WithType.no_value (CRToplevel None) (String.concat "." sl,p0) p0
 						end;
 						end;
-						raise e
+						raise_error e
 	in
 	in
 
 
 	(* loop through the given EField expression to figure out whether it's a dot-path that we have to resolve,
 	(* 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
 		begin match e1.eexpr with
 			| TTypeExpr (TClassDecl c) ->
 			| TTypeExpr (TClassDecl c) ->
 				begin match mode with
 				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 -> ()
 				| MGet -> ()
 				end;
 				end;
 				let monos = Monomorph.spawn_constrained_monos (fun t -> t) (match c.cl_kind with KAbstractImpl a -> a.a_params | _ -> c.cl_params) in
 				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_type = t;
 					tf_expr = mk (TReturn (Some ec)) t p;
 					tf_expr = mk (TReturn (Some ec)) t p;
 				}) (TFun ((List.map (fun v -> v.v_name,false,v.v_type) vl),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;
 		end;
 	| EField _ ->
 	| EField _ ->
 		handle_efield ctx e p mode with_type
 		handle_efield ctx e p mode with_type
@@ -711,14 +711,14 @@ and type_vars ctx vl p =
 				DisplayEmitter.display_variable ctx v pv;
 				DisplayEmitter.display_variable ctx v pv;
 			v,e
 			v,e
 		with
 		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... *)
 				add_local ctx VGenerated n t_dynamic pv, None (* TODO: What to do with this... *)
 	) vl in
 	) vl in
 	List.iter (fun (v,_) ->
 	List.iter (fun (v,_) ->
 		delay_if_mono ctx PTypeField v.v_type (fun() ->
 		delay_if_mono ctx PTypeField v.v_type (fun() ->
 			if ExtType.is_void (follow v.v_type) then
 			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;
 	) vl;
 	match vl with
 	match vl with
@@ -792,7 +792,7 @@ and format_string ctx s p =
 			if i = len then
 			if i = len then
 				match groups with
 				match groups with
 				| [] -> die "" __LOC__
 				| [] -> 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
 			else
 				let c = String.unsafe_get s i in
 				let c = String.unsafe_get s i in
 				if c = gopen then
 				if c = gopen then
@@ -811,8 +811,8 @@ and format_string ctx s p =
 			let e =
 			let e =
 				let ep = { p with pmin = !pmin + pos + 2; pmax = !pmin + send + 1 } in
 				let ep = { p with pmin = !pmin + pos + 2; pmax = !pmin + send + 1 } in
 				let error msg pos =
 				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
 				in
 				match ParserEntry.parse_expr_string ctx.com.defines scode ep error true with
 				match ParserEntry.parse_expr_string ctx.com.defines scode ep error true with
 					| ParseSuccess(data,_,_) -> data
 					| ParseSuccess(data,_,_) -> data
@@ -838,7 +838,7 @@ and type_block ctx el with_type p =
 	let rec loop acc = function
 	let rec loop acc = function
 		| [] -> List.rev acc
 		| [] -> List.rev acc
 		| e :: l ->
 		| 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
 			loop acc l
 	in
 	in
 	let l = loop [] el 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 extra_fields = ref [] in
 		let fl = List.map (fun ((n,pn,qs),e) ->
 		let fl = List.map (fun ((n,pn,qs),e) ->
 			let is_valid = Lexer.is_valid_identifier n in
 			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 is_final = ref false in
 			let e = try
 			let e = try
 				let t = match !dynamic_parameter with
 				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
 				type_expr ctx e WithType.value
 			in
 			in
 			if is_valid then begin
 			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
 				let cf = mk_field n e.etype (punion pn e.epos) pn in
 				if !is_final then add_class_field_flag cf CfFinal;
 				if !is_final then add_class_field_flag cf CfFinal;
 				fields := PMap.add n cf !fields;
 				fields := PMap.add n cf !fields;
@@ -929,13 +929,13 @@ and type_object_decl ctx fl with_type p =
 	let type_plain_fields () =
 	let type_plain_fields () =
 		let rec loop (l,acc) ((f,pf,qs),e) =
 		let rec loop (l,acc) ((f,pf,qs),e) =
 			let is_valid = Lexer.is_valid_identifier f in
 			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
 			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
 			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;
 			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
 			(((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
 				PMap.add f cf acc
 			end else acc)
 			end else acc)
 		in
 		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
 			let fcc = unify_field_call ctx fa [] el p fa.fa_inline in
 			check_constructor_access ctx c fcc.fc_field p;
 			check_constructor_access ctx c fcc.fc_field p;
 			fcc
 			fcc
-		with Error (e,p,depth) ->
-			located_typing_error ~depth (error_msg p e);
+		with Error err ->
+			raise_typing_error_ext err
 	in
 	in
 	let display_position_in_el () =
 	let display_position_in_el () =
 		List.exists (fun e -> DisplayPosition.display_position#enclosed_in (pos e)) 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
 			end
 			end
 		| mt ->
 		| 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
 		end
 	| Error _ as exc when display_position_in_el() ->
 	| Error _ as exc when display_position_in_el() ->
 		List.iter (fun e -> ignore(type_expr ctx e WithType.value)) 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
 		let cf = fa.fa_field in
 		no_abstract_constructor c p;
 		no_abstract_constructor c p;
 		begin match cf.cf_kind with
 		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;
 		end;
 		unify_constructor_call c fa
 		unify_constructor_call c fa
 	in
 	in
 	try begin match Abstract.follow_with_forward_ctor t with
 	try begin match Abstract.follow_with_forward_ctor t with
 	| TInst ({cl_kind = KTypeParameter tl} as c,params) ->
 	| 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
  		begin match get_constructible_constraint ctx tl p with
 		| None ->
 		| None ->
-			raise_typing_error (No_constructor (TClassDecl c)) p
+			raise_typing_error_ext (make_error (No_constructor (TClassDecl c)) p)
 		| Some(tl,tr) ->
 		| Some(tl,tr) ->
 			let el,_ = unify_call_args ctx el tl tr p false false false in
 			let el,_ = unify_call_args ctx el tl tr p false false false in
 			mk (TNew (c,params,el)) t p
 			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
 		let el = fcc.fc_args in
 		mk (TNew (c,params,el)) t p
 		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)
 		Diagnostics.secure_generated_code ctx (mk (TConst TNull) t p)
 
 
 and type_try ctx e1 catches with_type p =
 and type_try ctx e1 catches with_type p =
@@ -1156,7 +1156,7 @@ and type_try ctx e1 catches with_type p =
 	in
 	in
 	let check_catch_type_params params p =
 	let check_catch_type_params params p =
 		List.iter (fun pt ->
 		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
 		) params
 	in
 	in
 	let catches,el = List.fold_left (fun (acc1,acc2) ((v,pv),t,e_ast,pc) ->
 	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 t = Typeload.load_complex_type ctx true th in
 		let rec loop t = match follow t with
 		let rec loop t = match follow t with
 			| TInst ({ cl_kind = KTypeParameter _} as c,_) when not (TypeloadCheck.is_generic_parameter ctx c) ->
 			| 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) ->
 			| TInst (_,params) | TEnum (_,params) ->
 				check_catch_type_params params (snd th);
 				check_catch_type_params params (snd th);
 				t
 				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) ->
 			| TAbstract(a,tl) when not (Meta.has Meta.CoreType a.a_meta) ->
 				loop (Abstract.get_underlying_type a tl)
 				loop (Abstract.get_underlying_type a tl)
 			| TDynamic _ -> t
 			| 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
 		in
 		let t2 = loop t in
 		let t2 = loop t in
 		check_unreachable acc1 t2 (pos e_ast);
 		check_unreachable acc1 t2 (pos e_ast);
@@ -1222,7 +1222,7 @@ and type_map_declaration ctx e1 el with_type p =
 		try
 		try
 			let p = Hashtbl.find keys e_key.eexpr in
 			let p = Hashtbl.find keys e_key.eexpr in
 			display_error ctx.com "Duplicate key" e_key.epos;
 			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 ->
 		with Not_found ->
 			begin match e_key.eexpr with
 			begin match e_key.eexpr with
 			| TConst _ -> Hashtbl.add keys e_key.eexpr e_key.epos;
 			| 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
 		| EBinop(OpArrow,e1,e2) -> e1,e2
 		| EDisplay _ ->
 		| EDisplay _ ->
 			ignore(type_expr ctx e (WithType.with_type tkey));
 			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
 	) el in
 	let el_k,el_v,tkey,tval = if has_type then begin
 	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) ->
 		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
 	let params = TypeloadFunction.type_function_params ctx f (match name with None -> "localfun" | Some (n,_) -> n) p in
 	if params <> [] then begin
 	if params <> [] then begin
 		if name = None then display_error ctx.com "Type parameters not supported in unnamed local functions" p;
 		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;
 	end;
 	let v,pname = (match name with
 	let v,pname = (match name with
 		| None -> None,p
 		| 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 el = List.map (fun e -> type_expr ctx e WithType.value) el in
 		let t = try
 		let t = try
 			unify_min_raise ctx el
 			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
 			if !allow_array_dynamic || ctx.untyped || ignore_error ctx.com then
 				t_dynamic
 				t_dynamic
 			else begin
 			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
 			end
 		in
 		in
 		mk (TArrayDecl el) (ctx.t.tarray t) p
 		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
 				match follow e.etype with
 				| TAbstract({a_path=[],"Void"},_) ->
 				| TAbstract({a_path=[],"Void"},_) ->
 					begin match (Texpr.skip e).eexpr with
 					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;
 					end;
 					(* if we get a Void expression (e.g. from inlining) we don't want to return it (issue #4323) *)
 					(* 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;
 					]) t e.epos;
 				| _ ->
 				| _ ->
 					mk (TReturn (Some e)) (mono_or_dynamic ctx with_type p) p
 					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
 			(* 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). *)
 				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
 			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
 	let check_param pt = match follow pt with
 		| TMono _ -> () (* This probably means that Dynamic wasn't bound (issue #4675). *)
 		| TMono _ -> () (* This probably means that Dynamic wasn't bound (issue #4675). *)
 		| t when t == t_dynamic -> ()
 		| 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
 	in
 	let rec loop t = match follow t with
 	let rec loop t = match follow t with
 		| TInst (_,params) | TEnum (_,params) ->
 		| TInst (_,params) | TEnum (_,params) ->
 			List.iter check_param params;
 			List.iter check_param params;
 			(match follow t with
 			(match follow t with
 			| TInst (c,_) ->
 			| 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
 				TClassDecl c
 			| TEnum (e,_) -> TEnumDecl e
 			| TEnum (e,_) -> TEnumDecl e
 			| _ -> die "" __LOC__);
 			| _ -> die "" __LOC__);
@@ -1614,7 +1615,7 @@ and type_cast ctx e t p =
 		| TAbstract (a,params) ->
 		| TAbstract (a,params) ->
 			loop (Abstract.get_underlying_type 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
 	in
 	let texpr = loop t in
 	let texpr = loop t in
 	mk (TCast (type_expr ctx e WithType.value,Some texpr)) t p
 	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 =
 and type_if ctx e e1 e2 with_type is_ternary p =
 	let e = type_expr ctx e WithType.value in
 	let e = type_expr ctx e WithType.value in
 	if is_ternary then begin match e.eexpr with
 	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;
 	end;
 	let e = AbstractCast.cast_or_unify ctx ctx.t.tbool e p in
 	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
 				| TAbstract({a_impl = Some c},_) when PMap.mem "toString" c.cl_statics -> call_to_string ctx e
 				| _ -> e)
 				| _ -> e)
 		| (Meta.Markup,_,_) ->
 		| (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,_,_) ->
 		| (Meta.Analyzer,_,_) ->
 			let e = e() in
 			let e = e() in
 			{e with eexpr = TMeta(m,e)}
 			{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),_),_ ->
 	| (EDisplay((EConst (Ident "super"),_ as e1),dk),_),_ ->
 		TyperDisplay.handle_display ctx (ECall(e1,el),p) dk mode with_type
 		TyperDisplay.handle_display ctx (ECall(e1,el),p) dk mode with_type
 	| (EConst (Ident "super"),sp) , el ->
 	| (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
 		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) ->
 		| Some (c,params) ->
 			let fa = FieldAccess.get_constructor_access c params p in
 			let fa = FieldAccess.get_constructor_access c params p in
 			let cf = fa.fa_field in
 			let cf = fa.fa_field in
 			let t = TInst (c,params) in
 			let t = TInst (c,params) in
 			let e = mk (TConst TSuper) t sp 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 fa = FieldAccess.create e cf (FHInstance(c,params)) false p in
 			let fcc = unify_field_call ctx fa [] el p false in
 			let fcc = unify_field_call ctx fa [] el p false in
 			let el = fcc.fc_args 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) =
 and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
 	match e with
 	match e with
 	| EField ((EConst (String(s,_)),ps),"code",EFNormal) ->
 	| 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
 		mk (TConst (TInt (Int32.of_int (UCharExt.code (UTF8.get s 0))))) ctx.t.tint p
 	| EField(_,n,_) when starts_with n '$' ->
 	| 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) ->
 	| 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
 		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
 		acc_get ctx e
 	| EField _
 	| EField _
@@ -1862,9 +1863,9 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
 		(match suffix with
 		(match suffix with
 		| "i32" ->
 		| "i32" ->
 			(try mk (TConst (TInt (Int32.of_string s))) ctx.com.basic.tint p
 			(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" ->
 		| "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 i64  = Int64.of_string s in
 			let high = Int64.to_int32 (Int64.shift_right i64 32) 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" ->
 		| "u32" ->
 			let check = ECheckType ((EConst (Int (s, None)), p), (CTPath (mk_type_path ([],"UInt")), p)), p in
 			let check = ECheckType ((EConst (Int (s, None)), p), (CTPath (mk_type_path ([],"UInt")), p)), p in
 			type_expr ctx check with_type
 			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) ->
 	| EConst (Float (s, Some suffix) as c) ->
 		(match suffix with
 		(match suffix with
 		| "f64" -> Texpr.type_constant ctx.com.basic c p
 		| "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 ->
 	| EConst c ->
 		Texpr.type_constant ctx.com.basic c p
 		Texpr.type_constant ctx.com.basic c p
 	| EBinop (OpNullCoal,e1,e2) ->
 	| EBinop (OpNullCoal,e1,e2) ->
@@ -2011,8 +2012,8 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
 	| EThrow e ->
 	| EThrow e ->
 		let e = try
 		let e = try
 			type_expr ctx e WithType.value
 			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
 			Texpr.Builder.make_null t_dynamic p
 		in
 		in
 		mk (TThrow e) (mono_or_dynamic ctx with_type p) p
 		mk (TThrow e) (mono_or_dynamic ctx with_type p) p
@@ -2145,12 +2146,12 @@ let rec create com =
 	ctx.g.std <- (try
 	ctx.g.std <- (try
 		TypeloadModule.load_module ctx ([],"StdTypes") null_pos
 		TypeloadModule.load_module ctx ([],"StdTypes") null_pos
 	with
 	with
-		Error (Module_not_found ([],"StdTypes"),_,_) ->
+		Error { err_message = Module_not_found ([],"StdTypes") } ->
 			try
 			try
 				let std_path = Sys.getenv "HAXE_STD_PATH" in
 				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 ->
 			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). *)
 	(* 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;
 	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_call_target_ref := type_call_target;
 type_access_ref := type_access;
 type_access_ref := type_access;
 type_block_ref := type_block;
 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 =
 let is_lower_ident s p =
 	try Ast.is_lower_ident s
 	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 =
 let get_this ctx p =
 	match ctx.curfun with
 	match ctx.curfun with
 	| FunStatic ->
 	| FunStatic ->
-		typing_error "Cannot access this from a static function" p
+		raise_typing_error "Cannot access this from a static function" p
 	| FunMemberClassLocal | FunMemberAbstractLocal ->
 	| FunMemberClassLocal | FunMemberAbstractLocal ->
 		let v = match ctx.vthis with
 		let v = match ctx.vthis with
 			| None ->
 			| None ->
@@ -168,7 +168,7 @@ let get_this ctx p =
 		in
 		in
 		mk (TLocal v) ctx.tthis p
 		mk (TLocal v) ctx.tthis p
 	| FunMemberAbstract ->
 	| 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
 		mk (TLocal v) v.v_type p
 	| FunConstructor | FunMember ->
 	| FunConstructor | FunMember ->
 		mk (TConst TThis) ctx.tthis p
 		mk (TConst TThis) ctx.tthis p
@@ -192,7 +192,7 @@ let rec type_module_type ctx t tparams p =
 			module_type_of_type t
 			module_type_of_type t
 		with Exit ->
 		with Exit ->
 			if follow t == t_dynamic then Typeload.load_type_def ctx p (mk_type_path ([],"Dynamic"))
 			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
 		in
 		type_module_type ctx mt None p
 		type_module_type ctx mt None p
 	| TClassDecl c ->
 	| TClassDecl c ->
@@ -212,11 +212,11 @@ let rec type_module_type ctx t tparams p =
 		| TAbstract (a,params) ->
 		| TAbstract (a,params) ->
 			type_module_type ctx (TAbstractDecl a) (Some params) p
 			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 } ->
 	| TAbstractDecl { a_impl = Some c } ->
 		type_module_type ctx (TClassDecl c) tparams p
 		type_module_type ctx (TClassDecl c) tparams p
 	| TAbstractDecl a ->
 	| 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
 		let t_tmp = abstract_module_type a [] in
 		mk (TTypeExpr (TAbstractDecl a)) (TType (t_tmp,[])) p
 		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 get_constructible_constraint ctx tl p =
 	let extract_function t = match follow t with
 	let extract_function t = match follow t with
 		| TFun(tl,tr) -> tl,tr
 		| 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
 	in
 	let rec loop tl = match tl with
 	let rec loop tl = match tl with
 		| [] -> None
 		| [] -> None
@@ -339,4 +339,4 @@ let get_abstract_froms ctx a pl =
 				acc)
 				acc)
 		| _ ->
 		| _ ->
 			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 ->
 	| DMDefinition | DMTypeDefinition ->
 		raise_positions []
 		raise_positions []
 	| _ ->
 	| _ ->
-		typing_error "Unsupported method" p
+		raise_typing_error "Unsupported method" p
 	end
 	end
 
 
 let rec handle_signature_display ctx e_ast with_type =
 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
 		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)
 			| 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)
 			| 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
 		in
 		let tl = List.map follow_with_callable tl in
 		let tl = List.map follow_with_callable tl in
 		let rec loop i acc el = match el with
 		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
 						let _ = unify_call_args ctx el args r p false false false in
 						true
 						true
 					with
 					with
-					| Error(Call_error (Not_enough_arguments _),_,_) -> true
+					| Error { err_message = Call_error (Not_enough_arguments _) } -> true
 					| _ -> false
 					| _ -> false
 					end
 					end
 				in
 				in
@@ -253,7 +253,7 @@ let rec handle_signature_display ctx e_ast with_type =
 	let find_constructor_types t = match follow t with
 	let find_constructor_types t = match follow t with
 		| TInst ({cl_kind = KTypeParameter tl} as c,_) ->
 		| TInst ({cl_kind = KTypeParameter tl} as c,_) ->
 			let rec loop tl = match tl with
 			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
 				| t :: tl -> match follow t with
 					| TAbstract({a_path = ["haxe"],"Constructible"},[t]) -> t
 					| TAbstract({a_path = ["haxe"],"Constructible"},[t]) -> t
 					| _ -> loop tl
 					| _ -> loop tl
@@ -274,10 +274,10 @@ let rec handle_signature_display ctx e_ast with_type =
 				try
 				try
 					acc_get ctx (!type_call_target_ref ctx e1 el with_type None)
 					acc_get ctx (!type_call_target_ref ctx e1 el with_type None)
 				with
 				with
-				| Error (Unknown_ident "trace",_,_) ->
+				| Error { err_message = Unknown_ident "trace" } ->
 					let e = expr_of_type_path (["haxe";"Log"],"trace") p in
 					let e = expr_of_type_path (["haxe";"Log"],"trace") p in
 					type_expr ctx e WithType.value
 					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))
 					display_dollar_type ctx p (fun t -> t,(CompletionType.from_type (get_import_status ctx) t))
 			in
 			in
 			let e1 = match e1 with
 			let e1 = match e1 with
@@ -337,11 +337,11 @@ let rec handle_signature_display ctx e_ast with_type =
 			| _ ->
 			| _ ->
 				raise_signatures [] 0 0 SKArrayAccess
 				raise_signatures [] 0 0 SKArrayAccess
 			end
 			end
-		| _ -> typing_error "Call expected" p
+		| _ -> raise_typing_error "Call expected" p
 
 
 and display_expr ctx e_ast e dk mode with_type p =
 and display_expr ctx e_ast e dk mode with_type p =
 	let get_super_constructor () = match ctx.curclass.cl_super with
 	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) ->
 		| Some (c,params) ->
 			let fa = get_constructor_access c params p in
 			let fa = get_constructor_access c params p in
 			fa.fa_field,c
 			fa.fa_field,c
@@ -541,20 +541,20 @@ let handle_display ctx e_ast dk mode with_type =
 		| DMDefinition | DMTypeDefinition ->
 		| DMDefinition | DMTypeDefinition ->
 			raise_positions []
 			raise_positions []
 		| _ ->
 		| _ ->
-			typing_error "Unsupported method" p
+			raise_typing_error "Unsupported method" p
 		end
 		end
 	| (EConst (Ident "_"),p),WithType.WithType(t,_) ->
 	| (EConst (Ident "_"),p),WithType.WithType(t,_) ->
 		mk (TConst TNull) t p (* This is "probably" a bind skip, let's just use the expected type *)
 		mk (TConst TNull) t p (* This is "probably" a bind skip, let's just use the expected type *)
 	| (_,p),_ -> try
 	| (_,p),_ -> try
 		type_expr ~mode ctx e_ast with_type
 		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))
         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)
 		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
 		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))
 			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 ->
 		with Not_found ->
-			raise err
+			raise_error err
 		end else
 		end else
 			raise_toplevel ctx dk with_type (s_type_path path,p)
 			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) ->
 	| 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,_) ->
 		| WithType.WithType(t,_) ->
 			(* We don't want to actually use the transformed expression which may have inserted implicit cast calls.
 			(* We don't want to actually use the transformed expression which may have inserted implicit cast calls.
 			   It only matters that unification takes place. *)
 			   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;
 	end;
@@ -700,7 +700,7 @@ let handle_structure_display ctx e fields origin =
 		let pinsert = DisplayPosition.display_position#with_pos (pos e) in
 		let pinsert = DisplayPosition.display_position#with_pos (pos e) in
 		raise_fields fields CRStructureField (make_subject None pinsert)
 		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_edisplay ctx e dk mode with_type =
 	let handle_display ctx e dk 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
 	try
 		let m = Typeload.load_module ctx (pack,name) p in
 		let m = Typeload.load_module ctx (pack,name) p in
 		resolve_in_module ctx m next_path p mode with_type
 		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
 		(* 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 ¯\_(ツ)_/¯ *)
 		   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 *)
 		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 : 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());
  12 |   Context.warning(("1" :DeprecatedType), Context.currentPos());
     |                         ^^^^^^^^^^^^^^
     |                         ^^^^^^^^^^^^^^