Make exceptions filter thread-safe (#12122)

* make inliner thread-safe

* put Task.run around the entire callback instead of individual parallelism calls (#12121)

* deal with isOfType

* make exceptions filter thread-safe

* The Parallel Reunion

* yes we do

src/compiler/compiler.ml

@@ -387,7 +387,7 @@ let compile ctx actx callbacks =
 		(* Actual compilation starts here *)
 		let (tctx,display_file_dot_path) = Timer.time ctx.timer_ctx ["typing"] (do_type ctx mctx actx) display_file_dot_path in
 		DisplayProcessing.handle_display_after_typing ctx tctx display_file_dot_path;
-		let ectx = Exceptions.create_exception_context tctx in
+		let ectx = ExceptionInit.create_exception_context tctx in
 		finalize_typing ctx tctx;
 		let is_compilation = is_compilation com in
 		com.callbacks#add_after_save (fun () ->

src/context/typecore.ml

@@ -438,8 +438,6 @@ let add_local_with_origin ctx origin n t p =
 	Naming.check_local_variable_name ctx.com n origin p;
 	add_local ctx (VUser origin) n t p
 
-let gen_local_prefix = "`"
-
 let gen_local ctx t p =
 	add_local ctx VGenerated gen_local_prefix t p
 

src/core/globals.ml

@@ -171,6 +171,8 @@ let s_version_full v =
 
 let patch_string_pos p s = { p with pmin = p.pmax - String.length s }
 
+let gen_local_prefix = "`"
+
 (* msg * backtrace *)
 exception Ice of string * string
 

src/filters/exception/exceptionFunctions.ml

@@ -0,0 +1,27 @@
+open Type
+
+let haxe_exception_type_path = (["haxe"],"Exception")
+let value_exception_type_path = (["haxe"],"ValueException")
+
+(**
+	Check if `cls` is or extends (if `check_parent=true`) `haxe.Exception`
+*)
+let rec is_haxe_exception_class ?(check_parent=true) cls =
+	cls.cl_path = haxe_exception_type_path
+	|| (check_parent && match cls.cl_super with
+		| None -> false
+		| Some (cls, _) -> is_haxe_exception_class ~check_parent cls
+	)
+
+(**
+	Check if `t` is or extends `haxe.Exception`
+*)
+let is_haxe_exception ?(check_parent=true) (t:Type.t) =
+	match Abstract.follow_with_abstracts t with
+		| TInst (cls, _) -> is_haxe_exception_class ~check_parent cls
+		| _ -> false
+
+let is_dynamic t =
+	match Abstract.follow_with_abstracts t with
+	| TAbstract({ a_path = [],"Dynamic" }, _) -> true
+	| t -> t == t_dynamic

src/filters/exception/exceptionInit.ml

@@ -0,0 +1,78 @@
+open Globals
+open Ast
+open Common
+open Error
+open Exceptions
+open Type
+open Typecore
+open ExceptionFunctions
+
+let create_exception_context tctx =
+	match tctx.com.platform with (* TODO: implement for all targets *)
+	| Php | Js | Jvm | Python | Lua | Eval | Neko | Flash | Hl | Cpp ->
+		let config = tctx.com.config.pf_exceptions in
+		let tp (pack,name) =
+			let tp = match List.rev pack with
+			| module_name :: pack_rev when not (Ast.is_lower_ident module_name) ->
+				mk_type_path ~sub:name (List.rev pack_rev,module_name)
+			| _ ->
+				mk_type_path (pack,name)
+			in
+			make_ptp tp null_pos
+		in
+		let wildcard_catch_type =
+			let t = Typeload.load_instance tctx (tp config.ec_wildcard_catch) ParamSpawnMonos LoadNormal in
+			if is_dynamic t then t_dynamic
+			else t
+		and base_throw_type =
+			let t = Typeload.load_instance tctx (tp config.ec_base_throw) ParamSpawnMonos LoadNormal in
+			if is_dynamic t then t_dynamic
+			else t
+		and haxe_exception_type, haxe_exception_class =
+			match Typeload.load_instance tctx (tp haxe_exception_type_path) ParamSpawnMonos LoadNormal with
+			| TInst(cls,_) as t -> t,cls
+			| _ -> raise_typing_error "haxe.Exception is expected to be a class" null_pos
+		and value_exception_type, value_exception_class =
+			match Typeload.load_instance tctx (tp value_exception_type_path) ParamSpawnMonos LoadNormal with
+			| TInst(cls,_) as t -> t,cls
+			| _ -> raise_typing_error "haxe.ValueException is expected to be a class" null_pos
+		and haxe_native_stack_trace =
+			match Typeload.load_instance tctx (tp (["haxe"],"NativeStackTrace")) ParamSpawnMonos LoadNormal with
+			| TInst(cls,_) -> cls
+			| TAbstract({ a_impl = Some cls },_) -> cls
+			| _ -> raise_typing_error "haxe.NativeStackTrace is expected to be a class or an abstract" null_pos
+		in
+		let is_path_of_dynamic (pack,name) =
+			name = "Dynamic" && (pack = [] || pack = ["StdTypes"])
+		in
+		let is_of_type =
+			let std_cls = tctx.com.std in
+			let isOfType_field =
+				try PMap.find "isOfType" std_cls.cl_statics
+				with Not_found -> raise_typing_error ("Std has no field isOfType") null_pos
+			in
+			let return_type =
+				match follow isOfType_field.cf_type with
+				| TFun(_,t) -> t
+				| _ -> raise_typing_error ("Std.isOfType is not a function and cannot be called") null_pos
+			in
+			(std_cls,isOfType_field,return_type)
+		in
+		let ctx = {
+			scom = SafeCom.of_typer tctx;
+			basic = tctx.t;
+			config = config;
+			wildcard_catch_type = wildcard_catch_type;
+			base_throw_type = base_throw_type;
+			throws_anything = is_path_of_dynamic config.ec_base_throw && config.ec_avoid_wrapping;
+			catches_anything = is_path_of_dynamic config.ec_wildcard_catch && config.ec_avoid_wrapping;
+			haxe_exception_class = haxe_exception_class;
+			haxe_exception_type = haxe_exception_type;
+			haxe_native_stack_trace = haxe_native_stack_trace;
+			value_exception_type = value_exception_type;
+			value_exception_class = value_exception_class;
+			is_of_type = is_of_type;
+		} in
+		Some ctx
+	| Cross | CustomTarget _ ->
+		None

src/filters/exceptions.ml → src/filters/exception/exceptions.ml

@@ -1,14 +1,12 @@
 open Globals
 open Ast
 open Type
-open Common
 open PlatformConfig
-open Typecore
 open Error
 open ExceptionFunctions
 
 type context = {
-	typer : typer;
+	scom : SafeCom.t;
 	basic : basic_types;
 	config : exceptions_config;
 	wildcard_catch_type : Type.t;
@@ -20,12 +18,28 @@ type context = {
 	haxe_native_stack_trace : tclass;
 	value_exception_type : Type.t;
 	value_exception_class : tclass;
+	is_of_type : (tclass * tclass_field * Type.t);
 }
 
-let is_dynamic t =
-	match Abstract.follow_with_abstracts t with
-	| TAbstract({ a_path = [],"Dynamic" }, _) -> true
-	| t -> t == t_dynamic
+let make_call scom eon el tret p =
+	let default () =
+		mk (TCall(eon,el)) tret p
+	in
+	match eon.eexpr with
+	| TField(ef,(FStatic(cl,cf) | FInstance(cl,_,cf))) when SafeCom.needs_inline scom (Some cl) cf ->
+		begin match cf.cf_expr with
+		| Some {eexpr = TFunction tf} ->
+			let config = Inline.inline_config (Some cl) cf el tret in
+			Inline.type_inline (Inline.context_of_scom scom) cf tf ef el tret config p false
+		| _ ->
+			default ()
+		end
+	| _ ->
+		default ()
+
+let make_static_call scom c cf el tret p =
+	let ef = Texpr.Builder.make_static_field c cf p in
+	make_call scom ef el tret p
 
 (**
 	Generate `haxe.Exception.method_name(args)`
@@ -40,8 +54,8 @@ let haxe_exception_static_call ctx method_name args p =
 		| TFun(_,t) -> t
 		| _ -> raise_typing_error ("haxe.Exception." ^ method_name ^ " is not a function and cannot be called") p
 	in
-	add_dependency ctx.typer.c.curclass.cl_module ctx.haxe_exception_class.cl_module MDepFromTyping;
-	CallUnification.make_static_call_better ctx.typer ctx.haxe_exception_class method_field [] args return_type p
+	add_dependency ctx.scom.curclass.cl_module ctx.haxe_exception_class.cl_module MDepFromTyping;
+	make_static_call ctx.scom ctx.haxe_exception_class method_field args return_type p
 
 (**
 	Generate `haxe_exception.method_name(args)`
@@ -56,7 +70,7 @@ let haxe_exception_instance_call ctx haxe_exception method_name args p =
 			| _ ->
 				raise_typing_error ((s_type (print_context()) haxe_exception.etype) ^ "." ^ method_name ^ " is not a function and cannot be called") p
 		in
-		make_call ctx.typer efield args rt p
+		make_call ctx.scom efield args rt p
 	| _ -> raise_typing_error ((s_type (print_context()) haxe_exception.etype) ^ "." ^ method_name ^ " is expected to be an instance method") p
 
 (**
@@ -64,18 +78,9 @@ let haxe_exception_instance_call ctx haxe_exception method_name args p =
 *)
 let std_is ctx e t p =
 	let t = follow t in
-	let std_cls = ctx.typer.com.std in
-	let isOfType_field =
-		try PMap.find "isOfType" std_cls.cl_statics
-		with Not_found -> raise_typing_error ("Std has no field isOfType") p
-	in
-	let return_type =
-		match follow isOfType_field.cf_type with
-		| TFun(_,t) -> t
-		| _ -> raise_typing_error ("Std.isOfType is not a function and cannot be called") p
-	in
-	let type_expr = TyperBase.type_module_type ctx.typer (module_type_of_type t) p in
-	CallUnification.make_static_call_better ctx.typer std_cls isOfType_field [] [e; type_expr] return_type p
+	let type_expr = TyperBase.type_module_type_simple (module_type_of_type t) p in
+	let (std_cls,isOfType_field,return_type) = ctx.is_of_type in
+	make_static_call ctx.scom std_cls isOfType_field [e; type_expr] return_type p
 
 (**
 	Check if type path of `t` exists in `lst`
@@ -493,62 +498,6 @@ let catch_native ctx catches t p =
 	in
 	transform [] None catches
 
-let create_exception_context tctx =
-	match tctx.com.platform with (* TODO: implement for all targets *)
-	| Php | Js | Jvm | Python | Lua | Eval | Neko | Flash | Hl | Cpp ->
-		let config = tctx.com.config.pf_exceptions in
-		let tp (pack,name) =
-			let tp = match List.rev pack with
-			| module_name :: pack_rev when not (Ast.is_lower_ident module_name) ->
-				mk_type_path ~sub:name (List.rev pack_rev,module_name)
-			| _ ->
-				mk_type_path (pack,name)
-			in
-			make_ptp tp null_pos
-		in
-		let wildcard_catch_type =
-			let t = Typeload.load_instance tctx (tp config.ec_wildcard_catch) ParamSpawnMonos LoadNormal in
-			if is_dynamic t then t_dynamic
-			else t
-		and base_throw_type =
-			let t = Typeload.load_instance tctx (tp config.ec_base_throw) ParamSpawnMonos LoadNormal in
-			if is_dynamic t then t_dynamic
-			else t
-		and haxe_exception_type, haxe_exception_class =
-			match Typeload.load_instance tctx (tp haxe_exception_type_path) ParamSpawnMonos LoadNormal with
-			| TInst(cls,_) as t -> t,cls
-			| _ -> raise_typing_error "haxe.Exception is expected to be a class" null_pos
-		and value_exception_type, value_exception_class =
-			match Typeload.load_instance tctx (tp value_exception_type_path) ParamSpawnMonos LoadNormal with
-			| TInst(cls,_) as t -> t,cls
-			| _ -> raise_typing_error "haxe.ValueException is expected to be a class" null_pos
-		and haxe_native_stack_trace =
-			match Typeload.load_instance tctx (tp (["haxe"],"NativeStackTrace")) ParamSpawnMonos LoadNormal with
-			| TInst(cls,_) -> cls
-			| TAbstract({ a_impl = Some cls },_) -> cls
-			| _ -> raise_typing_error "haxe.NativeStackTrace is expected to be a class or an abstract" null_pos
-		in
-		let is_path_of_dynamic (pack,name) =
-			name = "Dynamic" && (pack = [] || pack = ["StdTypes"])
-		in
-		let ctx = {
-			typer = tctx;
-			basic = tctx.t;
-			config = config;
-			wildcard_catch_type = wildcard_catch_type;
-			base_throw_type = base_throw_type;
-			throws_anything = is_path_of_dynamic config.ec_base_throw && config.ec_avoid_wrapping;
-			catches_anything = is_path_of_dynamic config.ec_wildcard_catch && config.ec_avoid_wrapping;
-			haxe_exception_class = haxe_exception_class;
-			haxe_exception_type = haxe_exception_type;
-			haxe_native_stack_trace = haxe_native_stack_trace;
-			value_exception_type = value_exception_type;
-			value_exception_class = value_exception_class;
-		} in
-		Some ctx
-	| Cross | CustomTarget _ ->
-		None
-
 (**
 	Transform `throw` and `try..catch` expressions.
 	`rename_locals` is required to deal with the names of temp vars.
@@ -575,140 +524,4 @@ let filter ectx =
 			else stub e
 		)
 	| None ->
-		stub
-
-(**
-	Inserts `haxe.NativeStackTrace.saveStack(e)` in non-haxe.Exception catches.
-*)
-let insert_save_stacks ectx =
-	let tctx = ectx.typer in
-	if not (has_feature tctx.com "haxe.NativeStackTrace.exceptionStack") then
-		(fun e -> e)
-	else
-		let native_stack_trace_cls = ectx.haxe_native_stack_trace in
-		let rec contains_insertion_points e =
-			match e.eexpr with
-			| TTry (e, catches) ->
-				List.exists (fun (v, _) -> Meta.has Meta.NeedsExceptionStack v.v_meta) catches
-				|| contains_insertion_points e
-				|| List.exists (fun (_, e) -> contains_insertion_points e) catches
-			| _ ->
-				check_expr contains_insertion_points e
-		in
-		let save_exception_stack catch_var =
-			(* GOTCHA: `has_feature` always returns `true` if executed before DCE filters *)
-			if has_feature tctx.com "haxe.NativeStackTrace.exceptionStack" then
-				let method_field =
-					try PMap.find "saveStack" native_stack_trace_cls.cl_statics
-					with Not_found -> raise_typing_error ("haxe.NativeStackTrace has no field saveStack") null_pos
-				in
-				let return_type =
-					match follow method_field.cf_type with
-					| TFun(_,t) -> t
-					| _ -> raise_typing_error ("haxe.NativeStackTrace." ^ method_field.cf_name ^ " is not a function and cannot be called") null_pos
-				in
-				let catch_local = mk (TLocal catch_var) catch_var.v_type catch_var.v_pos in
-				begin
-					add_dependency tctx.c.curclass.cl_module native_stack_trace_cls.cl_module MDepFromTyping;
-					CallUnification.make_static_call_better tctx native_stack_trace_cls method_field [] [catch_local] return_type catch_var.v_pos
-				end
-			else
-				mk (TBlock[]) tctx.t.tvoid catch_var.v_pos
-		in
-		let rec run e =
-			match e.eexpr with
-			| TTry (e1, catches) ->
-				let e1 = map_expr run e1 in
-				let catches =
-					List.map (fun ((v, body) as catch) ->
-						if Meta.has Meta.NeedsExceptionStack v.v_meta then
-							let exprs =
-								match body.eexpr with
-								| TBlock exprs ->
-									save_exception_stack v :: exprs
-								| _ ->
-									[save_exception_stack v; body]
-							in
-							(v, { body with eexpr = TBlock exprs })
-						else
-							catch
-					) catches
-				in
-				{ e with eexpr = TTry (e1, catches) }
-			| _ ->
-				map_expr run e
-		in
-		(fun e ->
-			if contains_insertion_points e then run e
-			else e
-		)
-
-let insert_save_stacks tctx ectx =
-	match ectx with
-	| Some ctx ->
-		insert_save_stacks {ctx with typer = tctx}
-	| None ->
-		(fun e -> e)
-
-(**
-	Adds `this.__shiftStack()` calls to constructors of classes which extend `haxe.Exception`
-*)
-let patch_constructors ectx =
-	let tctx = ectx.typer in
-	match ectx.haxe_exception_type with
-	(* Add only if `__shiftStack` method exists *)
-	| TInst(cls,_) when PMap.mem "__shiftStack" cls.cl_fields ->
-		(fun mt ->
-			match mt with
-			| TClassDecl cls when not (has_class_flag cls CExtern) && cls.cl_path <> haxe_exception_type_path && is_haxe_exception_class cls ->
-				let shift_stack p =
-					let t = type_of_module_type mt in
-					let this = { eexpr = TConst(TThis); etype = t; epos = p } in
-					let faccess =
-						try quick_field t "__shiftStack"
-						with Not_found -> raise_typing_error "haxe.Exception has no field __shiftStack" p
-					in
-					match faccess with
-					| FInstance (_,_,cf) ->
-						let efield = { eexpr = TField(this,faccess); etype = cf.cf_type; epos = p } in
-						let rt =
-							match follow cf.cf_type with
-							| TFun(_,t) -> t
-							| _ ->
-								raise_typing_error "haxe.Exception.__shiftStack is not a function and cannot be called" cf.cf_name_pos
-						in
-						make_call tctx efield [] rt p
-					| _ -> raise_typing_error "haxe.Exception.__shiftStack is expected to be an instance method" p
-				in
-				TypeloadFunction.add_constructor tctx cls true cls.cl_name_pos;
-				Option.may (fun cf -> ignore(follow cf.cf_type)) cls.cl_constructor;
-				(match cls.cl_constructor with
-				| Some ({ cf_expr = Some e_ctor } as ctor) ->
-					let rec add e =
-						match e.eexpr with
-						| TFunction _ -> e
-						| TReturn _ -> mk (TBlock [shift_stack e.epos; e]) e.etype e.epos
-						| _ -> map_expr add e
-					in
-					(ctor.cf_expr <- match e_ctor.eexpr with
-						| TFunction fn ->
-							Some { e_ctor with
-								eexpr = TFunction { fn with
-									tf_expr = mk (TBlock [add fn.tf_expr; shift_stack fn.tf_expr.epos]) tctx.t.tvoid fn.tf_expr.epos
-								}
-							}
-						| _ -> die "" __LOC__
-					)
-				| None -> die "" __LOC__
-				| _ -> ()
-				)
-			| _ -> ()
-		)
-	| _ -> (fun _ -> ())
-
-let patch_constructors tctx ectx =
-	match ectx with
-	| Some ctx ->
-		patch_constructors {ctx with typer = tctx}
-	| None ->
-		(fun _ -> ())
+		stub

src/filters/exception/saveStacks.ml

@@ -0,0 +1,142 @@
+open Globals
+open Common
+open Type
+open Typecore
+open Error
+open ExceptionFunctions
+open Exceptions
+
+(**
+	Inserts `haxe.NativeStackTrace.saveStack(e)` in non-haxe.Exception catches.
+*)
+let insert_save_stacks com ectx =
+	let scom = ectx.scom in
+	if not (has_feature com "haxe.NativeStackTrace.exceptionStack") then
+		(fun e -> e)
+	else
+		let native_stack_trace_cls = ectx.haxe_native_stack_trace in
+		let rec contains_insertion_points e =
+			match e.eexpr with
+			| TTry (e, catches) ->
+				List.exists (fun (v, _) -> Meta.has Meta.NeedsExceptionStack v.v_meta) catches
+				|| contains_insertion_points e
+				|| List.exists (fun (_, e) -> contains_insertion_points e) catches
+			| _ ->
+				check_expr contains_insertion_points e
+		in
+		let save_exception_stack catch_var =
+			(* GOTCHA: `has_feature` always returns `true` if executed before DCE filters *)
+			if has_feature com "haxe.NativeStackTrace.exceptionStack" then
+				let method_field =
+					try PMap.find "saveStack" native_stack_trace_cls.cl_statics
+					with Not_found -> raise_typing_error ("haxe.NativeStackTrace has no field saveStack") null_pos
+				in
+				let return_type =
+					match follow method_field.cf_type with
+					| TFun(_,t) -> t
+					| _ -> raise_typing_error ("haxe.NativeStackTrace." ^ method_field.cf_name ^ " is not a function and cannot be called") null_pos
+				in
+				let catch_local = mk (TLocal catch_var) catch_var.v_type catch_var.v_pos in
+				begin
+					add_dependency scom.curclass.cl_module native_stack_trace_cls.cl_module MDepFromTyping;
+					make_static_call scom native_stack_trace_cls method_field [catch_local] return_type catch_var.v_pos
+				end
+			else
+				mk (TBlock[]) scom.basic.tvoid catch_var.v_pos
+		in
+		let rec run e =
+			match e.eexpr with
+			| TTry (e1, catches) ->
+				let e1 = map_expr run e1 in
+				let catches =
+					List.map (fun ((v, body) as catch) ->
+						if Meta.has Meta.NeedsExceptionStack v.v_meta then
+							let exprs =
+								match body.eexpr with
+								| TBlock exprs ->
+									save_exception_stack v :: exprs
+								| _ ->
+									[save_exception_stack v; body]
+							in
+							(v, { body with eexpr = TBlock exprs })
+						else
+							catch
+					) catches
+				in
+				{ e with eexpr = TTry (e1, catches) }
+			| _ ->
+				map_expr run e
+		in
+		(fun e ->
+			if contains_insertion_points e then run e
+			else e
+		)
+
+let insert_save_stacks tctx ectx =
+	match ectx with
+	| Some ctx ->
+		insert_save_stacks tctx.com {ctx with scom = SafeCom.of_typer tctx}
+	| None ->
+		(fun e -> e)
+
+(**
+	Adds `this.__shiftStack()` calls to constructors of classes which extend `haxe.Exception`
+*)
+let patch_constructors tctx ectx =
+	match ectx.haxe_exception_type with
+	(* Add only if `__shiftStack` method exists *)
+	| TInst(cls,_) when PMap.mem "__shiftStack" cls.cl_fields ->
+		(fun mt ->
+			match mt with
+			| TClassDecl cls when not (has_class_flag cls CExtern) && cls.cl_path <> haxe_exception_type_path && is_haxe_exception_class cls ->
+				let shift_stack p =
+					let t = type_of_module_type mt in
+					let this = { eexpr = TConst(TThis); etype = t; epos = p } in
+					let faccess =
+						try quick_field t "__shiftStack"
+						with Not_found -> raise_typing_error "haxe.Exception has no field __shiftStack" p
+					in
+					match faccess with
+					| FInstance (_,_,cf) ->
+						let efield = { eexpr = TField(this,faccess); etype = cf.cf_type; epos = p } in
+						let rt =
+							match follow cf.cf_type with
+							| TFun(_,t) -> t
+							| _ ->
+								raise_typing_error "haxe.Exception.__shiftStack is not a function and cannot be called" cf.cf_name_pos
+						in
+						make_call ectx.scom efield [] rt p
+					| _ -> raise_typing_error "haxe.Exception.__shiftStack is expected to be an instance method" p
+				in
+				TypeloadFunction.add_constructor tctx cls true cls.cl_name_pos;
+				Option.may (fun cf -> ignore(follow cf.cf_type)) cls.cl_constructor;
+				(match cls.cl_constructor with
+				| Some ({ cf_expr = Some e_ctor } as ctor) ->
+					let rec add e =
+						match e.eexpr with
+						| TFunction _ -> e
+						| TReturn _ -> mk (TBlock [shift_stack e.epos; e]) e.etype e.epos
+						| _ -> map_expr add e
+					in
+					(ctor.cf_expr <- match e_ctor.eexpr with
+						| TFunction fn ->
+							Some { e_ctor with
+								eexpr = TFunction { fn with
+									tf_expr = mk (TBlock [add fn.tf_expr; shift_stack fn.tf_expr.epos]) tctx.t.tvoid fn.tf_expr.epos
+								}
+							}
+						| _ -> die "" __LOC__
+					)
+				| None -> die "" __LOC__
+				| _ -> ()
+				)
+			| _ -> ()
+		)
+	| _ -> (fun _ -> ())
+
+let patch_constructors tctx ectx =
+	match ectx with
+	| Some ctx ->
+		patch_constructors tctx {ctx with scom = SafeCom.of_typer tctx}
+	| None ->
+		(fun _ -> ())

src/filters/exceptionFunctions.ml

@@ -1,22 +0,0 @@
-open Type
-
-let haxe_exception_type_path = (["haxe"],"Exception")
-let value_exception_type_path = (["haxe"],"ValueException")
-
-(**
-	Check if `cls` is or extends (if `check_parent=true`) `haxe.Exception`
-*)
-	let rec is_haxe_exception_class ?(check_parent=true) cls =
-		cls.cl_path = haxe_exception_type_path
-		|| (check_parent && match cls.cl_super with
-			| None -> false
-			| Some (cls, _) -> is_haxe_exception_class ~check_parent cls
-		)
-	
-	(**
-		Check if `t` is or extends `haxe.Exception`
-	*)
-	let is_haxe_exception ?(check_parent=true) (t:Type.t) =
-		match Abstract.follow_with_abstracts t with
-			| TInst (cls, _) -> is_haxe_exception_class ~check_parent cls
-			| _ -> false

src/filters/filters.ml

@@ -212,11 +212,11 @@ let destruction tctx scom ectx detail_times main locals =
 			tctx
 			detail_times
 			(* This has to run after DCE, or otherwise its condition always holds. *)
-			["insert_save_stacks",(fun tctx -> Exceptions.insert_save_stacks tctx ectx)]
+			["insert_save_stacks",(fun tctx -> SaveStacks.insert_save_stacks tctx ectx)]
 		)
 		com.types;
 	let type_filters = [
-		(fun tctx -> Exceptions.patch_constructors tctx ectx); (* TODO: I don't believe this should load_instance anything at this point... *)
+		(fun tctx -> SaveStacks.patch_constructors tctx ectx); (* TODO: I don't believe this should load_instance anything at this point... *)
 		(fun _ -> check_private_path com);
 		(fun _ -> Native.apply_native_paths);
 		(fun _ -> add_rtti com);
@@ -434,7 +434,8 @@ let run tctx ectx main before_destruction =
 	] in
 	List.iter (run_expression_filters tctx detail_times filters) new_types;
 
-	let filters = [
+	let cv_wrapper_impl = CapturedVars.get_wrapper_implementation com in
+	let filters_before_analyzer = [
 		"local_statics",LocalStatic.run;
 		"fix_return_dynamic_from_void_function",SafeFilters.fix_return_dynamic_from_void_function;
 		"check_local_vars_init",CheckVarInit.check_local_vars_init;
@@ -442,46 +443,35 @@ let run tctx ectx main before_destruction =
 		"Tre",if defined com Define.AnalyzerOptimize then Tre.run else (fun _ e -> e);
 		"reduce_expression",Optimizer.reduce_expression;
 		"inline_constructors",InlineConstructors.inline_constructors;
-	] in
-	Parallel.run_in_new_pool com.timer_ctx (fun pool ->
-		SafeCom.run_with_scom com scom pool (fun () ->
-			Parallel.ParallelArray.iter pool (SafeCom.run_expression_filters_safe scom detail_times filters) new_types_array
-		);
-	);
-
-	let filters = [
 		"Exceptions_filter",(fun _ -> Exceptions.filter ectx);
-	] in
-	List.iter (run_expression_filters tctx detail_times filters) new_types;
-
-	let cv_wrapper_impl = CapturedVars.get_wrapper_implementation com in
-	let filters = [
 		"captured_vars",(fun scom -> CapturedVars.captured_vars scom cv_wrapper_impl);
 	] in
+	let locals = RenameVars.init scom.platform_config com.types in
+	let filters_after_analyzer = [
+		"sanitize",(fun scom e -> Sanitize.sanitize scom.SafeCom.platform_config e);
+		"add_final_return",(fun _ -> if com.config.pf_add_final_return then AddFinalReturn.add_final_return else (fun e -> e));
+		"RenameVars",(match com.platform with
+			| Eval -> (fun _ e -> e)
+			| Jvm -> (fun _ e -> e)
+			| _ -> (fun scom e -> RenameVars.run scom.curclass.cl_path locals e)
+		);
+		"mark_switch_break_loops",SafeFilters.mark_switch_break_loops;
+	] in
 
-	let locals = Parallel.run_in_new_pool com.timer_ctx (fun pool ->
+	Parallel.run_in_new_pool com.timer_ctx (fun pool ->
 		SafeCom.run_with_scom com scom pool (fun () ->
-			Parallel.ParallelArray.iter pool (SafeCom.run_expression_filters_safe scom detail_times filters) new_types_array
+			Parallel.ParallelArray.iter pool (SafeCom.run_expression_filters_safe scom detail_times filters_before_analyzer) new_types_array
 		);
+
 		enter_stage com CAnalyzerStart;
 		if com.platform <> Cross then Analyzer.Run.run_on_types com pool new_types_array;
 		enter_stage com CAnalyzerDone;
-		let locals = RenameVars.init scom.platform_config com.types in
-		let filters = [
-			"sanitize",(fun scom e -> Sanitize.sanitize scom.SafeCom.platform_config e);
-			"add_final_return",(fun _ -> if com.config.pf_add_final_return then AddFinalReturn.add_final_return else (fun e -> e));
-			"RenameVars",(match com.platform with
-				| Eval -> (fun _ e -> e)
-				| Jvm -> (fun _ e -> e)
-				| _ -> (fun scom e -> RenameVars.run scom.curclass.cl_path locals e)
-			);
-			"mark_switch_break_loops",SafeFilters.mark_switch_break_loops;
-		] in
+
 		SafeCom.run_with_scom com scom pool (fun () ->
-			Parallel.ParallelArray.iter pool (SafeCom.run_expression_filters_safe scom detail_times filters) new_types_array
+			Parallel.ParallelArray.iter pool (SafeCom.run_expression_filters_safe scom detail_times filters_after_analyzer) new_types_array
 		);
-		locals
-	) in
+	);
+
 	with_timer tctx.com.timer_ctx detail_times "callbacks" None (fun () ->
 		com.callbacks#run com.error_ext com.callbacks#get_before_save;
 	);

src/filters/renameVars.ml

@@ -356,7 +356,7 @@ let maybe_rename_var rc reserved (v,overlaps) =
 		v.v_name <- name
 	in
 	(* chop escape char for all local variables generated *)
-	if String.unsafe_get v.v_name 0 = String.unsafe_get Typecore.gen_local_prefix 0 then begin
+	if String.unsafe_get v.v_name 0 = String.unsafe_get gen_local_prefix 0 then begin
 		let name = String.sub v.v_name 1 (String.length v.v_name - 1) in
 		commit ("_g" ^ (Str.replace_first trailing_numbers "" name))
 	end;

src/filters/tre.ml

@@ -51,7 +51,7 @@ let rec redeclare_vars ctx vars declarations replace_list =
 	match vars with
 	| [] -> declarations, replace_list
 	| v :: rest ->
-		let new_v = alloc_var VGenerated (Typecore.gen_local_prefix ^ v.v_name) v.v_type v.v_pos in
+		let new_v = alloc_var VGenerated (gen_local_prefix ^ v.v_name) v.v_type v.v_pos in
 		let decl =
 			{
 				eexpr = TVar (new_v, Some { eexpr = TLocal v; etype = v.v_type; epos = v.v_pos; });

src/typing/macroContext.ml

@@ -604,7 +604,7 @@ and flush_macro_context mint mctx =
 		let _, types, modules = Finalization.generate mctx main_module in
 		mctx.com.types <- types;
 		mctx.com.Common.modules <- modules;
-		let ectx = Exceptions.create_exception_context mctx in
+		let ectx = ExceptionInit.create_exception_context mctx in
 		(*
 			some filters here might cause side effects that would break compilation server.
 			let's save the minimal amount of information we need
@@ -661,7 +661,7 @@ and flush_macro_context mint mctx =
 		] in
 		let type_filters = [
 			FiltersCommon.remove_generic_base;
-			Exceptions.patch_constructors mctx ectx;
+			SaveStacks.patch_constructors mctx ectx;
 			(fun mt -> AddFieldInits.add_field_inits mctx.c.curclass.cl_path (RenameVars.init mctx.com.config mctx.com.types) scom mt);
 			Filters.update_cache_dependencies ~close_monomorphs:false mctx.com;
 			minimal_restore;

src/typing/typerBase.ml

@@ -193,6 +193,33 @@ let assign_to_this_is_allowed ctx =
 			)
 		| _ -> false
 
+let type_module_type_simple mt p =
+	(* No checks and building *)
+	let rec loop mt = match mt with
+		| TClassDecl c ->
+			mk (TTypeExpr (TClassDecl c)) c.cl_type p
+		| TEnumDecl e ->
+			mk (TTypeExpr (TEnumDecl e)) e.e_type p
+		| TTypeDecl s ->
+			let t = apply_typedef s (List.map (fun _ -> mk_mono()) s.t_params) in
+			begin match follow t with
+				| TEnum (e,params) ->
+					loop (TEnumDecl e)
+				| TInst (c,params) ->
+					loop (TClassDecl c)
+				| TAbstract (a,params) ->
+					loop (TAbstractDecl a)
+				| _ ->
+					die "" __LOC__
+			end
+		| TAbstractDecl { a_impl = Some c } ->
+			loop (TClassDecl c)
+		| TAbstractDecl a ->
+			let t_tmp = abstract_module_type a [] in
+			mk (TTypeExpr (TAbstractDecl a)) (TType (t_tmp,[])) p
+	in
+	loop mt
+
 let type_module_type ctx t p =
 	let rec loop t tparams =
 		match t with

tests/misc/projects/Issue4982/compile-fail.hxml.stderr

@@ -1 +1 @@
-Main.hx:3: characters 15-30 : Void should be Any
+Main.hx:3: characters 15-30 : Cannot use Void as value