X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcPat.lhs;h=ee33d4ac8f8aa225b6cd40c2d1e03b993ef22a2c;hb=c295ee8ac9d7afb4d660dc3b63c10cca0a0b26e7;hp=3c1c3bacdca2949f222cf14f785c6dd8d617adf2;hpb=1dc5c28c2370cc8254f024c5734f76d7e5827cd6;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index 3c1c3ba..ee33d4a 100644
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -278,7 +278,7 @@ tc_pat pstate (BangPat pat) pat_ty thing_inside
   = do	{ (pat', tvs, res) <- tc_lpat pstate pat pat_ty thing_inside
 	; return (BangPat pat', tvs, res) }
 
--- There's a wrinkle with irrefuatable patterns, namely that we
+-- There's a wrinkle with irrefutable patterns, namely that we
 -- must not propagate type refinement from them.  For example
 --	data T a where { T1 :: Int -> T Int; ... }
 --	f :: T a -> Int -> a
@@ -293,8 +293,14 @@ tc_pat pstate lpat@(LazyPat pat) pat_ty thing_inside
 				  thing_inside pstate
 					-- Ignore refined pstate',
 					-- revert to pstate
+	-- Check no existentials
 	; if (null pat_tvs) then return ()
 	  else lazyPatErr lpat pat_tvs
+
+	-- Check that the pattern has a lifted type
+	; pat_tv <- newBoxyTyVar liftedTypeKind
+	; boxyUnify pat_ty (mkTyVarTy pat_tv)
+
 	; return (LazyPat pat', [], res) }
 
 tc_pat pstate (WildPat _) pat_ty thing_inside