Browse Source

[typer] add more uctx

Simon Krajewski 5 years ago
parent
commit
cec6bc7c21
3 changed files with 19 additions and 14 deletions
  1. 11 10
      src/context/abstractCast.ml
  2. 4 2
      src/context/typecore.ml
  3. 4 2
      src/core/tUnification.ml

+ 11 - 10
src/context/abstractCast.ml

@@ -25,8 +25,7 @@ let rec make_static_call ctx c cf a pl args t p =
 	end else
 		Typecore.make_static_call ctx c cf (apply_params a.a_params pl) args t p
 
-and do_check_cast ctx tleft eright p =
-	let uctx = default_unification_context in
+and do_check_cast ctx uctx tleft eright p =
 	let recurse cf f =
 		(*
 			Without this special check for macro @:from methods we will always get "Recursive implicit cast" error
@@ -52,7 +51,7 @@ and do_check_cast ctx tleft eright p =
 			)
 			| None -> die "" __LOC__
 	in
-	if type_iseq tleft eright.etype then
+	if type_iseq_custom uctx tleft eright.etype then
 		eright
 	else begin
 		let rec loop stack tleft tright =
@@ -68,7 +67,7 @@ and do_check_cast ctx tleft eright p =
 					with Not_found ->
 						let rec loop2 tcl = match tcl with
 							| tc :: tcl ->
-								if not (type_iseq tc tleft) then loop stack (apply_params a.a_params tl tc) tright
+								if not (type_iseq_custom uctx tc tleft) then loop stack (apply_params a.a_params tl tc) tright
 								else loop2 tcl
 							| [] -> raise Not_found
 						in
@@ -79,7 +78,7 @@ and do_check_cast ctx tleft eright p =
 					with Not_found ->
 						let rec loop2 tcl = match tcl with
 							| tc :: tcl ->
-								if not (type_iseq tc tright) then loop stack tleft (apply_params a.a_params tl tc)
+								if not (type_iseq_custom uctx tc tright) then loop stack tleft (apply_params a.a_params tl tc)
 								else loop2 tcl
 							| [] -> raise Not_found
 						in
@@ -92,13 +91,15 @@ and do_check_cast ctx tleft eright p =
 		loop [] tleft eright.etype
 	end
 
-and cast_or_unify_raise ctx tleft eright p =
+and cast_or_unify_raise ctx ?(uctx=None) tleft eright p =
+	let uctx = match uctx with
+		| None -> default_unification_context
+		| Some uctx -> uctx
+	in
 	try
-		(* can't do that anymore because this might miss macro calls (#4315) *)
-		(* if ctx.com.display <> DMNone then raise Not_found; *)
-		do_check_cast ctx tleft eright p
+		do_check_cast ctx uctx tleft eright p
 	with Not_found ->
-		unify_raise ctx eright.etype tleft p;
+		unify_raise_custom uctx ctx eright.etype tleft p;
 		eright
 
 and cast_or_unify ctx tleft eright p =

+ 4 - 2
src/context/typecore.ml

@@ -214,14 +214,16 @@ let unify ctx t1 t2 p =
 		Unify_error l ->
 			raise_or_display ctx l p
 
-let unify_raise ctx t1 t2 p =
+let unify_raise_custom uctx (ctx : typer) t1 t2 p =
 	try
-		Type.unify t1 t2
+		Type.unify_custom uctx t1 t2
 	with
 		Unify_error l ->
 			(* no untyped check *)
 			raise (Error (Unify l,p))
 
+let unify_raise = unify_raise_custom default_unification_context
+
 let save_locals ctx =
 	let locals = ctx.locals in
 	(fun() -> ctx.locals <- locals)

+ 4 - 2
src/core/tUnification.ml

@@ -547,13 +547,15 @@ and type_eq_params uctx a b tl1 tl2 =
 			error (err :: (Invariant_parameter !i) :: l)
 		) tl1 tl2
 
-let type_iseq a b =
+let type_iseq_custom uctx a b =
 	try
-		type_eq default_unification_context a b;
+		type_eq uctx a b;
 		true
 	with
 		Unify_error _ -> false
 
+let type_iseq = type_iseq_custom default_unification_context
+
 let type_iseq_strict a b =
 	try
 		type_eq {default_unification_context with equality_kind = EqDoNotFollowNull} a b;