瀏覽代碼

[matcher] don't use GADT-applied types in extractors

closes #5952
Simon Krajewski 6 年之前
父節點
當前提交
8867b9fecf

+ 29 - 16
src/typing/matcher.ml

@@ -42,9 +42,18 @@ let type_field_access ctx ?(resume=false) e name =
 	Calls.acc_get ctx (Fields.type_field (Fields.TypeFieldConfig.create resume) ctx e name e.epos MGet) e.epos
 
 let unapply_type_parameters params monos =
+	let unapplied = ref [] in
 	List.iter2 (fun (_,t1) t2 ->
-		match t2,follow t2 with TMono m1,TMono m2 -> m1 := Some t1 | _ -> ()
-	) params monos
+		match t2,follow t2 with
+		| TMono m1,TMono m2 ->
+			unapplied := (m1,!m1) :: !unapplied;
+			m1 := Some t1;
+		| _ -> ()
+	) params monos;
+	!unapplied
+
+let reapply_type_parameters unapplied =
+	List.iter (fun (m,o) -> m := o) unapplied
 
 let get_general_module_type ctx mt p =
 	let rec loop = function
@@ -147,6 +156,7 @@ module Pattern = struct
 		mutable current_locals : (string, tvar * pos) PMap.t;
 		mutable in_reification : bool;
 		is_postfix_match : bool;
+		unapply_type_parameters : unit -> (Type.t option ref * Type.t option) list;
 	}
 
 	exception Bad_pattern of string
@@ -345,7 +355,7 @@ module Pattern = struct
 								error "Too many arguments" p
 						in
 						let patterns = loop el args in
-						unapply_type_parameters ef.ef_params monos;
+						ignore(unapply_type_parameters ef.ef_params monos);
 						PatConstructor(con_enum en ef e1.epos,patterns)
 					| _ ->
 						fail()
@@ -467,7 +477,11 @@ module Pattern = struct
 				let restore = save_locals ctx in
 				ctx.locals <- pctx.ctx_locals;
 				let v = add_local false "_" null_pos in
+				(* Tricky stuff: Extractor expressions are like normal expressions, so we don't want to deal with GADT-applied types here.
+				   Let's unapply, then reapply after we're done with the extractor (#5952). *)
+				let unapplied = pctx.unapply_type_parameters () in
 				let e1 = type_expr ctx e1 WithType.value in
+				reapply_type_parameters unapplied;
 				v.v_name <- "tmp";
 				restore();
 				let pat = make pctx toplevel e1.etype e2 in
@@ -500,21 +514,11 @@ module Pattern = struct
 		in
 		let pat = loop e in
 		pat,p
-
-	let make ctx t e postfix_match =
-		let pctx = {
-			ctx = ctx;
-			current_locals = PMap.empty;
-			ctx_locals = ctx.locals;
-			or_locals = None;
-			in_reification = false;
-			is_postfix_match = postfix_match;
-		} in
-		make pctx true t e
 end
 
 module Case = struct
 	open Typecore
+	open Pattern
 
 	type t = {
 		case_guard : texpr option;
@@ -543,8 +547,17 @@ module Case = struct
 		) ctx.locals [] in
 		let old_ret = ctx.ret in
 		ctx.ret <- map ctx.ret;
-		let pat = Pattern.make ctx (map t) e postfix_match in
-		unapply_type_parameters ctx.type_params monos;
+		let pctx = {
+			ctx = ctx;
+			current_locals = PMap.empty;
+			ctx_locals = ctx.locals;
+			or_locals = None;
+			in_reification = false;
+			is_postfix_match = postfix_match;
+			unapply_type_parameters = (fun () -> unapply_type_parameters ctx.type_params monos);
+		} in
+		let pat = Pattern.make pctx true (map t) e in
+		ignore(unapply_type_parameters ctx.type_params monos);
 		let eg = match eg with
 			| None -> None
 			| Some e -> Some (type_expr ctx e WithType.value)

+ 14 - 0
tests/misc/projects/Issue5952/Main.hx

@@ -0,0 +1,14 @@
+class Main {
+    public static function foo<T>(v:T):T return v;
+
+    public static function main():Void {
+        var a = foo;
+        doSwitch(a);
+    }
+
+    public static function doSwitch<A, T:A->A>(a:T):Void {
+        switch (a){
+            case _.bind("asdf", "foo") => b: trace(b());
+        }
+    }
+}

+ 2 - 0
tests/misc/projects/Issue5952/compile1-fail.hxml

@@ -0,0 +1,2 @@
+--main Main
+--interp

+ 1 - 0
tests/misc/projects/Issue5952/compile1-fail.hxml.stderr

@@ -0,0 +1 @@
+Main.hx:11: characters 20-24 : doSwitch.T has no field bind