diff options
| author | simonpj@microsoft.com <unknown> | 2009-08-25 07:30:59 +0000 |
|---|---|---|
| committer | simonpj@microsoft.com <unknown> | 2009-08-25 07:30:59 +0000 |
| commit | f670c47f9f93ffd6d06b331cd40554cd5e92484c (patch) | |
| tree | 909698f2ef5f2e04d7416297a10098ebb3d17475 | |
| parent | 738f70785e381ca2f43413a1d8efa4d5929b8231 (diff) | |
| download | haskell-f670c47f9f93ffd6d06b331cd40554cd5e92484c.tar.gz | |
Fix Trac #3406 (albeit not very satisfactorily): scoped type variables
The issue here is this:
type ItemColID a b = Int -- Discards a,b
get :: ItemColID a b -> a -> ItemColID a b
get (x :: ItemColID a b) = x :: ItemColID a b
The pattern signature for 'x' doesn't actually rigidly bind a,b.
This crashed GHC 6.10 with a 'readFilledBox' panic. Now we fail
with an erroe message
With the new outside-in algorithm we'll be able to accept this program.
| -rw-r--r-- | compiler/typecheck/TcHsType.lhs | 21 |
1 files changed, 21 insertions, 0 deletions
diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index d64461ffd5..91ef46fa0b 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -39,6 +39,7 @@ import TcIface import TcType import {- Kind parts of -} Type import Var +import VarSet import Coercion import TyCon import Class @@ -48,6 +49,7 @@ import PrelNames import TysWiredIn import BasicTypes import SrcLoc +import Util import UniqSupply import Outputable import FastString @@ -891,6 +893,16 @@ tcPatSig ctxt sig res_ty -- Check that pat_ty is rigid ; checkTc (isRigidTy res_ty) (wobblyPatSig sig_tvs) + -- Check that all newly-in-scope tyvars are in fact + -- constrained by the pattern. This catches tiresome + -- cases like + -- type T a = Int + -- f :: Int -> Int + -- f (x :: T a) = ... + -- Here 'a' doesn't get a binding. Sigh + ; let bad_tvs = filterOut (`elemVarSet` exactTyVarsOfType sig_ty) sig_tvs + ; checkTc (null bad_tvs) (badPatSigTvs sig_ty bad_tvs) + -- Now match the pattern signature against res_ty -- For convenience, and uniform-looking error messages -- we do the matching by allocating meta type variables, @@ -1041,6 +1053,15 @@ wobblyPatSig sig_tvs <+> pprQuotedList sig_tvs) 2 (ptext (sLit "unless the pattern has a rigid type context")) +badPatSigTvs :: TcType -> [TyVar] -> SDoc +badPatSigTvs sig_ty bad_tvs + = vcat [ fsep [ptext (sLit "The type variable") <> plural bad_tvs, + quotes (pprWithCommas ppr bad_tvs), + ptext (sLit "should be bound by the pattern signature") <+> quotes (ppr sig_ty), + ptext (sLit "but are actually discarded by a type synonym") ] + , ptext (sLit "To fix this, expand the type synonym") + , ptext (sLit "[Note: I hope to lift this restriction in due course]") ] + scopedNonVar :: Name -> Type -> SDoc scopedNonVar n ty = vcat [sep [ptext (sLit "The scoped type variable") <+> quotes (ppr n), |