projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Template Haskell: allow type splices
[ghc-hetmet.git]
/
compiler
/
typecheck
/
TcPat.lhs
diff --git
a/compiler/typecheck/TcPat.lhs
b/compiler/typecheck/TcPat.lhs
index
23e6bbf
..
bef5ec7
100644
(file)
--- 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 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)
-- 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))
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))
nonRigidMatch :: PatCtxt -> DataCon -> SDoc
nonRigidMatch ctxt con
= hang (ptext (sLit "GADT pattern match in non-rigid context for") <+> quotes (ppr con))