add safeCom.ml

src/context/common.ml

@@ -333,6 +333,19 @@ let to_gctx com = {
 	std = com.std;
 }
 
+let to_safe_com com = {
+	SafeCom.basic = com.basic;
+	platform = com.platform;
+	defines = com.defines;
+	platform_config = com.config;
+	debug = com.debug;
+	is_macro_context = com.is_macro_context;
+	exceptions = ref [];
+	exceptions_mutex = Mutex.create ();
+	curclass = null_class;
+	curfield = null_field;
+}
+
 let enter_stage com stage =
 	(* print_endline (Printf.sprintf "Entering stage %s" (s_compiler_stage stage)); *)
 	com.stage <- stage

src/context/safeCom.ml

@@ -0,0 +1,58 @@
+open Globals
+open Type
+open PlatformConfig
+
+type t = {
+	basic : basic_types;
+	platform : platform;
+	defines : Define.define;
+	platform_config : platform_config;
+	debug : bool;
+	is_macro_context : bool;
+	exceptions : exn list ref;
+	exceptions_mutex : Mutex.t;
+	curclass : tclass;
+	curfield : tclass_field;
+}
+
+let add_exn com exn =
+	Mutex.protect com.exceptions_mutex (fun () -> com.exceptions := exn :: !(com.exceptions))
+
+let run_expression_filters_safe (com : t) detail_times filters t =
+	let run com identifier e =
+		List.fold_left (fun e (filter_name,f) ->
+			try
+				FilterContext.with_timer detail_times filter_name identifier (fun () -> f com e)
+			with exc ->
+				add_exn com exc;
+				e
+		) e filters
+	in
+	match t with
+	| TClassDecl c when FilterContext.is_removable_class c -> ()
+	| TClassDecl c ->
+		let com = {com with curclass = c} in
+		let rec process_field cf =
+			if not (has_class_field_flag cf CfPostProcessed) then begin
+				let com = {com with curfield = cf} in
+				(match cf.cf_expr with
+				| Some e when not (FilterContext.is_removable_field com.is_macro_context cf) ->
+					let identifier = Printf.sprintf "%s.%s" (s_type_path c.cl_path) cf.cf_name in
+					cf.cf_expr <- Some (run com (Some identifier) e);
+				| _ -> ());
+			end;
+			List.iter process_field cf.cf_overloads
+		in
+		List.iter process_field c.cl_ordered_fields;
+		List.iter process_field c.cl_ordered_statics;
+		(match c.cl_constructor with
+		| None -> ()
+		| Some f -> process_field f);
+		(match TClass.get_cl_init c with
+		| None -> ()
+		| Some e ->
+			let identifier = Printf.sprintf "%s.__init__" (s_type_path c.cl_path) in
+			TClass.set_cl_init c (run com (Some identifier) e))
+	| TEnumDecl _ -> ()
+	| TTypeDecl _ -> ()
+	| TAbstractDecl _ -> ()

src/context/typecore.ml

@@ -500,15 +500,6 @@ let make_lazy ctx t_proc f where =
 	delay ctx PForce (fun () -> ignore(lazy_type r));
 	r
 
-let is_removable_field com f =
-	not (has_class_field_flag f CfOverride) && (
-		has_class_field_flag f CfExtern || has_class_field_flag f CfGeneric
-		|| (match f.cf_kind with
-			| Var {v_read = AccRequire (s,_)} -> true
-			| Method MethMacro -> not com.is_macro_context
-			| _ -> false)
-	)
-
 let is_forced_inline c cf =
 	match c with
 	| Some { cl_kind = KAbstractImpl _ } -> true

src/filters/addFieldInits.ml

@@ -55,7 +55,7 @@ let add_field_inits cl_path locals com t =
 			| Some e ->
 				(* This seems a bit expensive, but hopefully constructor expressions aren't that massive. *)
 				let e = RenameVars.run cl_path locals e in
-				let e = Optimizer.sanitize com e in
+				let e = Optimizer.sanitize com.config e in
 				let e = if com.config.pf_add_final_return then AddFinalReturn.add_final_return e else e in
 				cf.cf_expr <- Some e
 			| _ ->

src/filters/filterContext.ml

@@ -6,4 +6,31 @@ let with_timer detail_times label identifier f =
 		| _ -> ["filters"]
 	in
 	let timer = Timer.timer label in
-	Std.finally timer f ()
+	Std.finally timer f ()
+
+open Type
+
+let rec is_removable_class c =
+	match c.cl_kind with
+	| KGeneric ->
+		(Meta.has Meta.Remove c.cl_meta ||
+		(match c.cl_super with
+			| Some (c,_) -> is_removable_class c
+			| _ -> false) ||
+		List.exists (fun tp ->
+			has_ctor_constraint tp.ttp_class || Meta.has Meta.Const tp.ttp_class.cl_meta
+		) c.cl_params)
+	| KTypeParameter _ ->
+		(* this shouldn't happen, have to investigate (see #4092) *)
+		true
+	| _ ->
+		false
+
+let is_removable_field is_macro_context f =
+	not (has_class_field_flag f CfOverride) && (
+		has_class_field_flag f CfExtern || has_class_field_flag f CfGeneric
+		|| (match f.cf_kind with
+			| Var {v_read = AccRequire (s,_)} -> true
+			| Method MethMacro -> not is_macro_context
+			| _ -> false)
+	)

src/filters/filters.ml

@@ -267,12 +267,12 @@ let remove_extern_fields com t = match t with
 	| TClassDecl c ->
 		if not (Common.defined com Define.DocGen) then begin
 			c.cl_ordered_fields <- List.filter (fun f ->
-				let b = is_removable_field com f in
+				let b = FilterContext.is_removable_field com.is_macro_context f in
 				if b then c.cl_fields <- PMap.remove f.cf_name c.cl_fields;
 				not b
 			) c.cl_ordered_fields;
 			c.cl_ordered_statics <- List.filter (fun f ->
-				let b = is_removable_field com f in
+				let b = FilterContext.is_removable_field com.is_macro_context f in
 				if b then c.cl_statics <- PMap.remove f.cf_name c.cl_statics;
 				not b
 			) c.cl_ordered_statics;
@@ -638,6 +638,8 @@ let run tctx ectx main before_destruction =
 		end;
 		not cached
 	) com.types in
+	let new_types_array = Array.of_list new_types in
+	let safe_com = to_safe_com com in
 	(* IMPORTANT:
 	    There may be types in new_types which have already been post-processed, but then had their m_processed flag unset
 		because they received an additional dependency. This could happen in cases such as @:generic methods in #10635.
@@ -670,16 +672,16 @@ let run tctx ectx main before_destruction =
 	enter_stage com CAnalyzerDone;
 	let locals = RenameVars.init com in
 	let filters = [
-		"sanitize",(fun _ e -> Optimizer.sanitize com e);
+		"sanitize",(fun scom e -> Optimizer.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 tctx e -> RenameVars.run tctx.c.curclass.cl_path locals e));
+		| _ -> (fun scom e -> RenameVars.run scom.curclass.cl_path locals e));
 		"mark_switch_break_loops",(fun _ -> mark_switch_break_loops);
 	] in
 	Parallel.run_in_new_pool (fun pool ->
-		Parallel.ParallelArray.iter pool (run_expression_filters tctx detail_times filters) (Array.of_list new_types)
+		Parallel.ParallelArray.iter pool (SafeCom.run_expression_filters_safe safe_com detail_times filters) new_types_array
 	);
 	with_timer detail_times "callbacks" None (fun () ->
 		com.callbacks#run com.error_ext com.callbacks#get_before_save;

src/filters/filtersCommon.ml

@@ -21,24 +21,8 @@ open Type
 open Common
 open Typecore
 
-let rec is_removable_class c =
-	match c.cl_kind with
-	| KGeneric ->
-		(Meta.has Meta.Remove c.cl_meta ||
-		(match c.cl_super with
-			| Some (c,_) -> is_removable_class c
-			| _ -> false) ||
-		List.exists (fun tp ->
-			has_ctor_constraint tp.ttp_class || Meta.has Meta.Const tp.ttp_class.cl_meta
-		) c.cl_params)
-	| KTypeParameter _ ->
-		(* this shouldn't happen, have to investigate (see #4092) *)
-		true
-	| _ ->
-		false
-
 let remove_generic_base t = match t with
-	| TClassDecl c when is_removable_class c ->
+	| TClassDecl c when FilterContext.is_removable_class c ->
 		add_class_flag c CExtern;
 	| _ ->
 		()
@@ -65,7 +49,7 @@ let run_expression_filters ?(ignore_processed_status=false) ctx detail_times fil
 		) e filters
 	in
 	match t with
-	| TClassDecl c when is_removable_class c -> ()
+	| TClassDecl c when FilterContext.is_removable_class c -> ()
 	| TClassDecl c ->
 		let ctx = TyperManager.clone_for_module ctx (TypeloadModule.make_curmod ctx.com ctx.g c.cl_module) in
 		let ctx = TyperManager.clone_for_class ctx c in
@@ -73,7 +57,7 @@ let run_expression_filters ?(ignore_processed_status=false) ctx detail_times fil
 			if ignore_processed_status || not (has_class_field_flag cf CfPostProcessed) then begin
 				let ctx = TyperManager.clone_for_field ctx cf cf.cf_params in
 				(match cf.cf_expr with
-				| Some e when not (is_removable_field com cf) ->
+				| Some e when not (FilterContext.is_removable_field com.is_macro_context cf) ->
 					let identifier = Printf.sprintf "%s.%s" (s_type_path c.cl_path) cf.cf_name in
 					cf.cf_expr <- Some (run ctx (Some identifier) e);
 				| _ -> ());

src/optimization/analyzer.ml

@@ -1120,7 +1120,7 @@ module Run = struct
 		Optimizer.reduce_control_flow com e
 
 	let run_on_field' com exc_out config c cf = match cf.cf_expr with
-		| Some e when not (is_ignored cf.cf_meta) && not (Typecore.is_removable_field com cf) && not (has_class_field_flag cf CfPostProcessed) ->
+		| Some e when not (is_ignored cf.cf_meta) && not (FilterContext.is_removable_field com.Common.is_macro_context cf) && not (has_class_field_flag cf CfPostProcessed) ->
 			let config = update_config_from_meta com config cf.cf_meta in
 			let actx = create_analyzer_context com config (Printf.sprintf "%s.%s" (s_type_path c.cl_path) cf.cf_name) e in
 			let debug() =

src/optimization/optimizer.ml

@@ -67,7 +67,7 @@ let rec need_parent e =
 	| TCast _ | TThrow _ | TReturn _ | TTry _ | TSwitch _ | TIf _ | TWhile _ | TBinop _ | TContinue | TBreak
 	| TBlock _ | TVar _ | TFunction _ | TUnop _ -> true
 
-let sanitize_expr com e =
+let sanitize_expr config e =
 	let parent e =
 		match e.eexpr with
 		| TParenthesis _ -> e
@@ -95,13 +95,13 @@ let sanitize_expr com e =
 	in
 	match e.eexpr with
 	| TConst TNull ->
-		if com.config.pf_static && not (is_nullable e.etype) then begin
+		if config.PlatformConfig.pf_static && not (is_nullable e.etype) then begin
 			let rec loop t = match follow t with
 				| TMono _ -> () (* in these cases the null will cast to default value *)
 				| TFun _ -> () (* this is a bit a particular case, maybe flash-specific actually *)
 				(* TODO: this should use get_underlying_type, but we do not have access to Codegen here.  *)
 				| TAbstract(a,tl) when not (Meta.has Meta.CoreType a.a_meta) -> loop (apply_params a.a_params tl a.a_this)
-				| _ -> com.error ("On static platforms, null can't be used as basic type " ^ s_type (print_context()) e.etype) e.epos
+				| _ -> raise_typing_error ("On static platforms, null can't be used as basic type " ^ s_type (print_context()) e.etype) e.epos
 			in
 			loop e.etype
 		end;
@@ -226,8 +226,8 @@ let reduce_expr com e =
 	| _ ->
 		e
 
-let rec sanitize com e =
-	sanitize_expr com (reduce_expr com (Type.map_expr (sanitize com) e))
+let rec sanitize config e =
+	sanitize_expr config (reduce_expr config (Type.map_expr (sanitize config) e))
 
 (* ---------------------------------------------------------------------- *)
 (* REDUCE *)
@@ -335,7 +335,7 @@ let reduce_control_flow com e = match e.eexpr with
 
 let rec reduce_loop ctx stack e =
 	let e = Type.map_expr (reduce_loop ctx stack) e in
-	sanitize_expr ctx.com (match e.eexpr with
+	sanitize_expr ctx.com.config (match e.eexpr with
 	| TCall(e1,el) ->
 		begin match Texpr.skip e1 with
 			| { eexpr = TFunction func } as ef ->