removed usage of error protection : instead uses display_error + Fatal_error (prevent eating errors when catching Error _)

codegen.ml

@@ -412,7 +412,7 @@ let build_instance ctx mtype p =
 		let ft = (fun pl ->
 			match c.cl_kind with
 			| KGeneric ->
-				let r = exc_protect (fun r ->
+				let r = exc_protect ctx (fun r ->
 					let t = mk_mono() in
 					r := (fun() -> t);
 					unify_raise ctx (build_generic ctx c p pl) t p;
@@ -421,7 +421,7 @@ let build_instance ctx mtype p =
 				delay ctx (fun() -> ignore ((!r)()));
 				TLazy r
 			| KMacroType ->
-				let r = exc_protect (fun r ->
+				let r = exc_protect ctx (fun r ->
 					let t = mk_mono() in
 					r := (fun() -> t);
 					unify_raise ctx (build_macro_type ctx pl p) t p;

main.ml

@@ -1088,7 +1088,7 @@ try
 	Sys.catch_break false;
 	if not !no_output then List.iter (run_command ctx) (List.rev !cmds)
 with
-	| Abort ->
+	| Abort | Typecore.Fatal_error ->
 		()
 	| Common.Abort (m,p) ->
 		error ctx m p

typecore.ml

@@ -89,11 +89,12 @@ type error_msg =
 	| Type_not_found of path * string
 	| Unify of unify_error list
 	| Custom of string
-	| Protect of error_msg
 	| Unknown_ident of string
 	| Stack of error_msg * error_msg
 	| Forbid_package of string * path
 
+exception Fatal_error
+
 exception Error of error_msg * pos
 
 let type_expr_ref : (typer -> Ast.expr -> bool -> texpr) ref = ref (fun _ _ _ -> assert false)
@@ -142,7 +143,6 @@ let rec error_msg = function
 	| Unknown_ident s -> "Unknown identifier : " ^ s
 	| Custom s -> s
 	| Stack (m1,m2) -> error_msg m1 ^ "\n" ^ error_msg m2
-	| Protect m -> error_msg m
 	| Forbid_package (p,m) ->
 		"You can't access the " ^ p ^ " package with current compilation flags (for " ^ Ast.s_type_path m ^ ")"
 
@@ -171,13 +171,14 @@ let unify_raise ctx t1 t2 p =
 			(* no untyped check *)
 			raise (Error (Unify l,p))
 
-let exc_protect f =
+let exc_protect ctx f =
 	let rec r = ref (fun() ->
 		try
 			f r
 		with
-			| Error (Protect _,_) as e -> raise e
-			| Error (m,p) -> raise (Error (Protect m,p))
+			| Error (m,p) -> 
+				display_error ctx (error_msg m) p;
+				raise Fatal_error
 	) in
 	r
 

typeload.ml

@@ -171,7 +171,7 @@ let rec load_instance ctx t p allow_no_params =
 				| TInst ({ cl_implements = [] }, []) ->
 					t
 				| TInst (c,[]) ->
-					let r = exc_protect (fun r ->
+					let r = exc_protect ctx (fun r ->
 						r := (fun() -> t);
 						check_param_constraints ctx types t tparams c p;
 						t
@@ -581,7 +581,7 @@ let type_type_params ctx path get_params p (n,flags) =
 	match flags with
 	| [] -> n, t
 	| _ ->
-		let r = exc_protect (fun r ->
+		let r = exc_protect ctx (fun r ->
 			r := (fun _ -> t);
 			let ctx = { ctx with type_params = ctx.type_params @ get_params() } in
 			set_heritance ctx c (List.map (fun t -> match t with CTPath t -> HImplements t | _ -> error "Unsupported type constraint" p) flags) p;
@@ -930,7 +930,7 @@ let init_class ctx c p herits fields =
 		let t = cf.cf_type in
 		match e with
 		| None when ctx.com.dead_code_elimination && not ctx.com.display ->
-			let r = exc_protect (fun r ->
+			let r = exc_protect ctx (fun r ->
 				r := (fun() -> t);
 				mark_used cf;
 				t
@@ -940,7 +940,7 @@ let init_class ctx c p herits fields =
 		| None ->
 			(fun() -> ())
 		| Some e ->
-			let r = exc_protect (fun r ->
+			let r = exc_protect ctx (fun r ->
 				if not !return_partial_type then begin
 					r := (fun() -> t);
 					if ctx.com.verbose then Common.log ctx.com ("Typing " ^ (if ctx.in_macro then "macro " else "") ^ s_type_path c.cl_path ^ "." ^ cf.cf_name);
@@ -1078,7 +1078,7 @@ let init_class ctx c p herits fields =
 				cf_overloads = [];
 			} in
 			init_meta_overloads ctx cf;
-			let r = exc_protect (fun r ->
+			let r = exc_protect ctx (fun r ->
 				if not !return_partial_type then begin
 					r := (fun() -> t);
 					incr stats.s_methods_typed;