diff options
author | Ian Lynagh <igloo@earth.li> | 2009-04-24 15:05:19 +0000 |
---|---|---|
committer | Ian Lynagh <igloo@earth.li> | 2009-04-24 15:05:19 +0000 |
commit | 269210b04b1428ae5270f15024ab9af23c7497fc (patch) | |
tree | 5b993ca574fe0534d25fb21394d8f04a40278b41 /compiler | |
parent | 5f044d4807abe23d22ec62920aabfe91f61ef78e (diff) | |
download | haskell-269210b04b1428ae5270f15024ab9af23c7497fc.tar.gz |
Do the second part of #2806: Disallow unlifted types in ~ patterns
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/typecheck/TcPat.lhs | 10 |
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)) |