summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorIan Lynagh <igloo@earth.li>2009-04-24 15:05:19 +0000
committerIan Lynagh <igloo@earth.li>2009-04-24 15:05:19 +0000
commit269210b04b1428ae5270f15024ab9af23c7497fc (patch)
tree5b993ca574fe0534d25fb21394d8f04a40278b41 /compiler
parent5f044d4807abe23d22ec62920aabfe91f61ef78e (diff)
downloadhaskell-269210b04b1428ae5270f15024ab9af23c7497fc.tar.gz
Do the second part of #2806: Disallow unlifted types in ~ patterns
Diffstat (limited to 'compiler')
-rw-r--r--compiler/typecheck/TcPat.lhs10
1 files changed, 10 insertions, 0 deletions
diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index 23e6bbf819..bef5ec742b 100644
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -367,6 +367,10 @@ tc_pat pstate lpat@(LazyPat pat) pat_ty thing_inside
-- Check no existentials
; unless (null pat_tvs) $ lazyPatErr lpat pat_tvs
+ -- Check there are no unlifted types under the lazy pattern
+ ; when (any (isUnLiftedType . idType) $ collectPatBinders pat') $
+ lazyUnliftedPatErr lpat
+
-- Check that the pattern has a lifted type
; pat_tv <- newBoxyTyVar liftedTypeKind
; boxyUnify pat_ty (mkTyVarTy pat_tv)
@@ -1039,6 +1043,12 @@ lazyPatErr _ tvs
hang (ptext (sLit "A lazy (~) pattern cannot match existential or GADT data constructors"))
2 (vcat (map pprSkolTvBinding tvs))
+lazyUnliftedPatErr :: OutputableBndr name => Pat name -> TcM ()
+lazyUnliftedPatErr pat
+ = failWithTc $
+ hang (ptext (sLit "A lazy (~) pattern cannot contain unlifted types"))
+ 2 (ppr pat)
+
nonRigidMatch :: PatCtxt -> DataCon -> SDoc
nonRigidMatch ctxt con
= hang (ptext (sLit "GADT pattern match in non-rigid context for") <+> quotes (ppr con))