[typer] rename exc_protect to make_lazy

also make it less error prone by managing the lazy_processing itself instead of relying on everyone else to do that

src/context/typecore.ml

@@ -462,10 +462,11 @@ let make_pass ctx f = f
 let init_class_done ctx =
 	ctx.pass <- PTypeField
 
-let exc_protect ?(force=true) ctx f where =
+let make_lazy ?(force=true) ctx t_proc f where =
 	let r = ref (lazy_available t_dynamic) in
 	r := lazy_wait (fun() ->
 		try
+			r := lazy_processing (fun() -> t_proc);
 			let t = f r in
 			r := lazy_available t;
 			t
@@ -930,10 +931,11 @@ let make_where ctx where =
 	let inf = ctx_pos ctx in
 	where ^ " (" ^ String.concat "." inf ^ ")",inf
 
-let exc_protect ?(force=true) ctx f (where:string) =
+let make_lazy ?(force=true) ctx t f (where:string) =
 	let r = ref (lazy_available t_dynamic) in
 	r := lazy_wait (make_pass ~inf:(make_where ctx where) ctx (fun() ->
 		try
+			r := lazy_processing (fun () -> t);
 			let t = f r in
 			r := lazy_available t;
 			t

src/typing/generic.ml

@@ -350,9 +350,8 @@ let rec build_generic_class ctx c p tl =
 				if gctx.generic_debug then print_endline (Printf.sprintf "[GENERIC] %s" (Printer.s_tclass_field "  " cf_new));
 				t
 			in
-			let r = exc_protect ctx (fun r ->
-				let t = spawn_monomorph ctx p in
-				r := lazy_processing (fun() -> t);
+			let t = spawn_monomorph ctx p in
+			let r = make_lazy ctx t (fun r ->
 				let t0 = f() in
 				unify_raise t0 t p;
 				link_dynamic t0 t;

src/typing/instanceBuilder.ml

@@ -73,9 +73,8 @@ let get_build_info ctx mtype p =
 	| TClassDecl c ->
 		if ctx.pass > PBuildClass then ignore(c.cl_build());
 		let build f s tl =
-			let r = exc_protect ctx (fun r ->
-				let t = spawn_monomorph ctx p in
-				r := lazy_processing (fun() -> t);
+			let t = spawn_monomorph ctx p in
+			let r = make_lazy ctx t (fun r ->
 				let tf = f tl in
 				unify_raise tf t p;
 				link_dynamic t tf;

src/typing/typeload.ml

@@ -492,8 +492,7 @@ and load_complex_type' ctx allow_display (t,p) =
 		) tl in
 		let tr = Monomorph.create() in
 		let t = TMono tr in
-		let r = exc_protect ctx (fun r ->
-			r := lazy_processing (fun() -> t);
+		let r = make_lazy ctx t (fun r ->
 			let ta = make_extension_type ctx tl in
 			Monomorph.bind tr ta;
 			ta
@@ -534,8 +533,7 @@ and load_complex_type' ctx allow_display (t,p) =
 			) tl in
 			let tr = Monomorph.create() in
 			let t = TMono tr in
-			let r = exc_protect ctx (fun r ->
-				r := lazy_processing (fun() -> t);
+			let r = make_lazy ctx t (fun r ->
 				Monomorph.bind tr (match il with
 					| [i] ->
 						mk_extension i
@@ -787,8 +785,7 @@ let rec type_type_param ctx host path get_params p tp =
 		| None ->
 			None
 		| Some ct ->
-			let r = exc_protect ctx (fun r ->
-				r := lazy_processing (fun() -> t);
+			let r = make_lazy ctx t (fun r ->
 				let t = load_complex_type ctx true ct in
 				begin match host with
 				| TPHType ->
@@ -806,8 +803,7 @@ let rec type_type_param ctx host path get_params p tp =
 	| None ->
 		mk_type_param n t default
 	| Some th ->
-		let r = exc_protect ctx (fun r ->
-			r := lazy_processing (fun() -> t);
+		let r = make_lazy ctx t (fun r ->
 			let ctx = { ctx with type_params = ctx.type_params @ get_params() } in
 			let rec loop th = match fst th with
 				| CTIntersection tl -> List.map (load_complex_type ctx true) tl

src/typing/typeloadFields.ml

@@ -362,15 +362,7 @@ let patch_class ctx c fields =
 		List.rev fields
 
 let lazy_display_type ctx f =
-	(* if ctx.is_display_file then begin
-		let r = exc_protect ctx (fun r ->
-			let t = f () in
-			r := lazy_processing (fun () -> t);
-			t
-		) "" in
-		TLazy r
-	end else *)
-		f ()
+	f ()
 
 type enum_abstract_mode =
 	| EAString
@@ -865,10 +857,9 @@ module TypeBinding = struct
 					mk_cast e cf.cf_type e.epos
 			end
 		in
-		let r = exc_protect ~force:false ctx (fun r ->
+		let r = make_lazy ~force:false ctx t (fun r ->
 			(* type constant init fields (issue #1956) *)
 			if not !return_partial_type || (match fst e with EConst _ -> true | _ -> false) then begin
-				r := lazy_processing (fun() -> t);
 				if (Meta.has (Meta.Custom ":debug.typing") (c.cl_meta @ cf.cf_meta)) then ctx.com.print (Printf.sprintf "Typing field %s.%s\n" (s_type_path c.cl_path) cf.cf_name);
 				let e = type_var_field ctx t e fctx.is_static fctx.is_display_field p in
 				let maybe_run_analyzer e = match e.eexpr with
@@ -944,7 +935,6 @@ module TypeBinding = struct
 	let bind_method ctx cctx fctx cf t args ret e p =
 		let c = cctx.tclass in
 		let bind r =
-			r := lazy_processing (fun() -> t);
 			incr stats.s_methods_typed;
 			if (Meta.has (Meta.Custom ":debug.typing") (c.cl_meta @ cf.cf_meta)) then ctx.com.print (Printf.sprintf "Typing method %s.%s\n" (s_type_path c.cl_path) cf.cf_name);
 			let fmode = (match cctx.abstract with
@@ -988,7 +978,7 @@ module TypeBinding = struct
 			if not !return_partial_type then bind r;
 			t
 		in
-		let r = exc_protect ~force:false ctx maybe_bind "type_fun" in
+		let r = make_lazy ~force:false ctx t maybe_bind "type_fun" in
 		bind_type ctx cctx fctx cf r p
 end
 
@@ -1052,8 +1042,7 @@ let check_abstract (ctx,cctx,fctx) a c cf fd t ret p =
 		fctx.expr_presence_matters <- true;
 	end in
 	let handle_from () =
-		let r = exc_protect ctx (fun r ->
-			r := lazy_processing (fun () -> t);
+		let r = make_lazy ctx t (fun r ->
 			(* 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 -> raise_typing_error_ext (make_error (Unify l) p));
 			match t with
@@ -1093,8 +1082,7 @@ let check_abstract (ctx,cctx,fctx) a c cf fd t ret p =
 		let is_multitype_cast = Meta.has Meta.MultiType a.a_meta && not fctx.is_abstract_member in
 		if is_multitype_cast && not (Meta.has Meta.MultiType cf.cf_meta) then
 			cf.cf_meta <- (Meta.MultiType,[],null_pos) :: cf.cf_meta;
-		let r = exc_protect ctx (fun r ->
-			r := lazy_processing (fun () -> t);
+		let r = make_lazy ctx t (fun r ->
 			let args = if is_multitype_cast then begin
 				let ctor = try
 					PMap.find "_new" c.cl_statics

src/typing/typeloadFunction.ml

@@ -187,9 +187,8 @@ let add_constructor ctx c force_constructor p =
 		cf.cf_kind <- cfsup.cf_kind;
 		cf.cf_params <- cfsup.cf_params;
 		cf.cf_meta <- List.filter (fun (m,_,_) -> m = Meta.CompilerGenerated) cfsup.cf_meta;
-		let r = exc_protect ctx (fun r ->
-			let t = mk_mono() in
-			r := lazy_processing (fun() -> t);
+		let t = spawn_monomorph ctx p in
+		let r = make_lazy ctx t (fun r ->
 			let ctx = { ctx with
 				curfield = cf;
 				pass = PTypeField;

src/typing/typeloadModule.ml

@@ -583,8 +583,7 @@ module TypeLevel = struct
 					| _ ->
 						()
 				in
-				let r = exc_protect ctx (fun r ->
-					r := lazy_processing (fun() -> tt);
+				let r = make_lazy ctx tt (fun r ->
 					check_rec tt;
 					tt
 				) "typedef_rec_check" in
@@ -615,8 +614,7 @@ module TypeLevel = struct
 			let t = load_complex_type ctx true t in
 			let t = if not (Meta.has Meta.CoreType a.a_meta) then begin
 				if !is_type then begin
-					let r = exc_protect ctx (fun r ->
-						r := lazy_processing (fun() -> t);
+					let r = make_lazy ctx t (fun r ->
 						(try (if from then Type.unify t a.a_this else Type.unify a.a_this t) with Unify_error _ -> raise_typing_error "You can only declare from/to with compatible types" pos);
 						t
 					) "constraint" in