diff options
| -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)) |