Sfoglia il codice sorgente

ensure that ctx.tnull will not force lazy types to be evaluated immediately (fixed issue #815)

Nicolas Cannasse 13 anni fa
parent
commit
6fc35b9da3
2 ha cambiato i file con 16 aggiunte e 3 eliminazioni
  1. 2 2
      type.ml
  2. 14 1
      typer.ml

+ 2 - 2
type.ml

@@ -523,13 +523,13 @@ let rec follow t =
 		follow (apply_params t.t_types tl t.t_type)
 	| _ -> t
 
-let rec is_nullable = function
+let rec is_nullable ?(no_lazy=false) = function
 	| TMono r ->
 		(match !r with None -> false | Some t -> is_nullable t)
 	| TType ({ t_path = ([],"Null") },[_]) ->
 		true
 	| TLazy f ->
-		is_nullable (!f())
+		if no_lazy then raise Exit else is_nullable (!f())
 	| TType (t,tl) ->
 		is_nullable (apply_params t.t_types tl t.t_type)
 	| TFun _ ->

+ 14 - 1
typer.ml

@@ -2715,7 +2715,20 @@ let rec create com =
 		| TTypeDecl td ->
 			(match snd td.t_path with
 			| "Null" ->
-				ctx.t.tnull <- if not (is_static_platform com) then (fun t -> t) else (fun t -> if not (is_nullable t) then TType (td,[t]) else t);
+				let mk_null t =
+					try
+						if not (is_nullable ~no_lazy:true t) then TType (td,[t]) else t
+					with Exit ->
+						(* don't force lazy evaluation *)
+						let r = exc_protect (fun r ->
+							let tnull = TType (td,[t]) in
+							(* assume null as-default wrt recursion *)
+							r := (fun() -> tnull);
+							if not (is_nullable t) then tnull else begin r := (fun() -> t); t; end
+						) in
+						TLazy r
+				in
+				ctx.t.tnull <- if not (is_static_platform com) then (fun t -> t) else mk_null;
 			| _ -> ());
 	) ctx.g.std.m_types;
 	let m = Typeload.load_module ctx ([],"String") null_pos in