X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcUnify.lhs;h=709b7c4aab0bae2d21562c3d5fe8f1e650ee67a9;hb=a162b85d26966ba0eecc4d2ae02d4fd71f5cb9f8;hp=4aa9b3d3c4e721d22374dcf8d77ee0bc452cc6e3;hpb=4cf7988f740ee799bbdb0b6e653c096099378085;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs
index 4aa9b3d..709b7c4 100644
--- a/compiler/typecheck/TcUnify.lhs
+++ b/compiler/typecheck/TcUnify.lhs
@@ -60,6 +60,7 @@ import BasicTypes
 import Util
 import Outputable
 import Unique
+import FastString
 
 import Control.Monad
 \end{code}
@@ -615,6 +616,12 @@ boxy_match tmpl_tvs orig_tmpl_ty boxy_tvs orig_boxy_ty subst
 			Nothing -> orig_boxy_ty
 			Just ty -> ty `boxyLub` orig_boxy_ty
 
+    go _ (TyVarTy tv) | isMetaTyVar tv
+	= subst		-- Don't fail if the template has more info than the target!
+			-- Otherwise, with tmpl_tvs = [a], matching (a -> Int) ~ (Bool -> beta)
+			-- would fail to instantiate 'a', because the meta-type-variable
+			-- beta is as yet un-filled-in
+	
     go _ _ = emptyTvSubst	-- It's important to *fail* by returning the empty substitution
 	-- Example:  Tree a ~ Maybe Int
 	-- We do not want to bind (a |-> Int) in pre-matching, because that can give very
@@ -643,6 +650,10 @@ boxyLub orig_ty1 orig_ty2
       | isTcTyVar tv1, isBoxyTyVar tv1 	-- choose ty2 if ty2 is a box
       = orig_ty2	
 
+    go ty1 (TyVarTy tv2) 		-- Symmetrical case
+      | isTcTyVar tv2, isBoxyTyVar tv2
+      = orig_ty1	
+
 	-- Look inside type synonyms, but only if the naive version fails
     go ty1 ty2 | Just ty1' <- tcView ty1 = go ty1' ty2
 	       | Just ty2' <- tcView ty1 = go ty1 ty2'