Преглед изворни кода

separate forced/unforced lazy functions

Simon Krajewski пре 9 месеци
родитељ
комит
30cea1a479
3 измењених фајлова са 21 додато и 17 уклоњено
  1. 14 0
      src/context/common.ml
  2. 5 15
      src/context/typecore.ml
  3. 2 2
      src/typing/typeloadFields.ml

+ 14 - 0
src/context/common.ml

@@ -1143,3 +1143,17 @@ let get_entry_point com =
 		let e = Option.get com.main.main_expr in (* must be present at this point *)
 		(snd path, c, e)
 	) com.main.main_class
+
+let make_unforced_lazy t_proc f where =
+	let r = ref (lazy_available t_dynamic) in
+	r := lazy_wait (fun() ->
+		try
+			r := lazy_processing t_proc;
+			let t = f () in
+			r := lazy_available t;
+			t
+		with
+			| Error.Error e ->
+				raise (Error.Fatal_error e)
+	);
+	r

+ 5 - 15
src/context/typecore.ml

@@ -503,19 +503,9 @@ let make_pass ctx f = f
 let enter_field_typing_pass g info =
 	flush_pass g PConnectField info
 
-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 t_proc;
-			let t = f () in
-			r := lazy_available t;
-			t
-		with
-			| Error e ->
-				raise (Fatal_error e)
-	);
-	if force then delay ctx PForce (fun () -> ignore(lazy_type r));
+let make_lazy ctx t_proc f where =
+	let r = make_unforced_lazy t_proc f where in
+	delay ctx PForce (fun () -> ignore(lazy_type r));
 	r
 
 let is_removable_field com f =
@@ -893,7 +883,7 @@ let make_where ctx where =
 	let inf = ctx_pos ctx in
 	where ^ " (" ^ String.concat "." inf ^ ")",inf
 
-let make_lazy ?(force=true) ctx t f (where:string) =
+let make_lazy 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
@@ -905,7 +895,7 @@ let make_lazy ?(force=true) ctx t f (where:string) =
 			| Error e ->
 				raise (Fatal_error e)
 	));
-	if force then delay ctx PForce (fun () -> ignore(lazy_type r));
+	delay ctx PForce (fun () -> ignore(lazy_type r));
 	r
 
 *)

+ 2 - 2
src/typing/typeloadFields.ml

@@ -748,7 +748,7 @@ module TypeBinding = struct
 					mk_cast e cf.cf_type e.epos
 			end
 		in
-		let r = make_lazy ~force:false ctx.g t (fun () ->
+		let r = make_unforced_lazy t (fun () ->
 			(* type constant init fields (issue #1956) *)
 			if not ctx.g.return_partial_type || (match fst e with EConst _ -> true | _ -> false) then begin
 				enter_field_typing_pass ctx.g ("bind_var_expression",fst ctx.c.curclass.cl_path @ [snd ctx.c.curclass.cl_path;ctx.f.curfield.cf_name]);
@@ -877,7 +877,7 @@ module TypeBinding = struct
 			if not ctx.g.return_partial_type then bind ();
 			t
 		in
-		let r = make_lazy ~force:false ctx.g t maybe_bind "type_fun" in
+		let r = make_unforced_lazy t maybe_bind "type_fun" in
 		bind_type ctx cctx fctx cf r p
 end