From 269210b04b1428ae5270f15024ab9af23c7497fc Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Fri, 24 Apr 2009 15:05:19 +0000 Subject: [PATCH] Do the second part of #2806: Disallow unlifted types in ~ patterns --- compiler/typecheck/TcPat.lhs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs index 23e6bbf..bef5ec7 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)) -- 1.7.10.4