From 0ee11df0098509d06cf6fc03d1a18429985b6081 Mon Sep 17 00:00:00 2001 From: simonpj Date: Fri, 24 Dec 2004 11:03:06 +0000 Subject: [PATCH] [project @ 2004-12-24 11:02:39 by simonpj] Further wibbles to the scoped-tyvar story. This commit tidies up the ATyVar in TcTyThing, making it ATyVar Name Type instead of the previous misleading ATyVar TyVar Type But the main thing is that we must take care with definitions like this: type T a = forall b. b -> (a,b) f :: forall c. T c f = ... Here, we want only 'c' to scope over the RHS of f. The renamer ensures that... but we must also take care that we freshly instantiate the expanded type signature (forall c b. b -> (c,b)) before checking f's RHS, so that we don't get false sharing between uses of T. --- ghc/compiler/typecheck/TcBinds.lhs | 27 ++++++++---- ghc/compiler/typecheck/TcClassDcl.lhs | 48 ++++++++++++--------- ghc/compiler/typecheck/TcEnv.lhs | 28 ++++++------ ghc/compiler/typecheck/TcExpr.lhs | 10 ++--- ghc/compiler/typecheck/TcHsType.lhs | 75 +++++++++++++++++++-------------- ghc/compiler/typecheck/TcInstDcls.lhs | 2 +- ghc/compiler/typecheck/TcPat.lhs | 3 +- ghc/compiler/typecheck/TcRnTypes.lhs | 2 +- 8 files changed, 112 insertions(+), 83 deletions(-) diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs index bd0e95c..7234664 100644 --- a/ghc/compiler/typecheck/TcBinds.lhs +++ b/ghc/compiler/typecheck/TcBinds.lhs @@ -13,7 +13,8 @@ import {-# SOURCE #-} TcExpr ( tcCheckSigma, tcCheckRho ) import CmdLineOpts ( DynFlag(Opt_MonomorphismRestriction) ) import HsSyn ( HsExpr(..), HsBind(..), LHsBinds, Sig(..), - LSig, Match(..), HsBindGroup(..), IPBind(..), + LSig, Match(..), HsBindGroup(..), IPBind(..), + HsType(..), hsLTyVarNames, LPat, GRHSs, MatchGroup(..), emptyLHsBinds, isEmptyLHsBinds, collectHsBindBinders, collectPatBinders, pprPatBind ) @@ -21,7 +22,7 @@ import TcHsSyn ( TcId, TcDictBinds, zonkId, mkHsLet ) import TcRnMonad import Inst ( InstOrigin(..), newDictsAtLoc, newIPDict, instToId ) -import TcEnv ( tcExtendIdEnv, tcExtendIdEnv2, tcExtendTyVarEnv, newLocalName, tcLookupLocalIds ) +import TcEnv ( tcExtendIdEnv, tcExtendIdEnv2, tcExtendTyVarEnv2, newLocalName, tcLookupLocalIds ) import TcUnify ( Expected(..), tcInfer, checkSigTyVars, sigCtxt ) import TcSimplify ( tcSimplifyInfer, tcSimplifyInferCheck, tcSimplifyRestricted, tcSimplifyToDicts, tcSimplifyIPs ) @@ -30,7 +31,7 @@ import TcHsType ( tcHsSigType, UserTypeCtxt(..), tcAddLetBoundTyVars, ) import TcPat ( tcPat, PatCtxt(..) ) import TcSimplify ( bindInstsOfLocalFuns ) -import TcMType ( newTyFlexiVarTy, tcSkolSigType, zonkQuantifiedTyVar, zonkTcTypes ) +import TcMType ( newTyFlexiVarTy, tcSkolType, zonkQuantifiedTyVar, zonkTcTypes ) import TcType ( TcTyVar, SkolemInfo(SigSkol), TcTauType, TcSigmaType, TvSubstEnv, mkTvSubst, substTheta, substTy, @@ -442,10 +443,12 @@ tcMonoBinds binds lookup_sig is_rec -- though each type sig should scope only over its own RHS, -- because the renamer has sorted all that out. ; let mono_info = getMonoBindInfo tc_binds - rhs_tvs = [ tv | (_, Just sig, _) <- mono_info, tv <- sig_tvs sig ] + rhs_tvs = [ (name, mkTyVarTy tv) + | (_, Just sig, _) <- mono_info, + (name, tv) <- sig_scoped sig `zip` sig_tvs sig ] rhs_id_env = map mk mono_info -- A binding for each term variable - ; binds' <- tcExtendTyVarEnv rhs_tvs $ + ; binds' <- tcExtendTyVarEnv2 rhs_tvs $ tcExtendIdEnv2 rhs_id_env $ mapBagM (wrapLocM tcRhs) tc_binds ; return (binds', mono_info) } @@ -562,10 +565,18 @@ tcTySig (L span (Sig (L _ name) ty)) do { sigma_ty <- tcHsSigType (FunSigCtxt name) ty ; let rigid_info = SigSkol name poly_id = mkLocalId name sigma_ty - ; (tvs, theta, tau) <- tcSkolSigType rigid_info sigma_ty + + -- The scoped names are the ones explicitly mentioned + -- in the HsForAll. (There may be more in sigma_ty, because + -- of nested type synonyms. See Note [Scoped] with TcSigInfo.) + scoped_names = case ty of + L _ (HsForAllTy _ tvs _ _) -> hsLTyVarNames tvs + other -> [] + + ; (tvs, theta, tau) <- tcSkolType rigid_info sigma_ty ; loc <- getInstLoc (SigOrigin rigid_info) - ; return (TcSigInfo { sig_id = poly_id, sig_tvs = tvs, - sig_theta = theta, sig_tau = tau, + ; return (TcSigInfo { sig_id = poly_id, sig_scoped = scoped_names, + sig_tvs = tvs, sig_theta = theta, sig_tau = tau, sig_loc = loc }) } checkSigCtxt :: TcSigInfo -> TcSigInfo -> TcM TcSigInfo diff --git a/ghc/compiler/typecheck/TcClassDcl.lhs b/ghc/compiler/typecheck/TcClassDcl.lhs index 8b12865..d5536a1 100644 --- a/ghc/compiler/typecheck/TcClassDcl.lhs +++ b/ghc/compiler/typecheck/TcClassDcl.lhs @@ -26,11 +26,11 @@ import TcEnv ( tcLookupLocatedClass, tcExtendIdEnv2, InstBindings(..), newDFunName ) import TcBinds ( tcMonoBinds, tcSpecSigs ) -import TcHsType ( TcSigInfo(..), mkTcSig, tcHsKindedType, tcHsSigType ) +import TcHsType ( TcSigInfo(..), tcHsKindedType, tcHsSigType ) import TcSimplify ( tcSimplifyCheck, bindInstsOfLocalFuns ) import TcUnify ( checkSigTyVars, sigCtxt ) -import TcMType ( tcSkolSigTyVars, UserTypeCtxt( GenPatCtxt ) ) -import TcType ( Type, SkolemInfo(ClsSkol, InstSkol), +import TcMType ( tcSkolSigTyVars, UserTypeCtxt( GenPatCtxt ), tcSkolType ) +import TcType ( Type, SkolemInfo(ClsSkol, InstSkol, SigSkol), TcType, TcThetaType, TcTyVar, mkTyVarTys, mkClassPred, tcSplitSigmaTy, tcSplitFunTys, tcIsTyVarTy, tcSplitTyConApp_maybe, tcSplitForAllTys, tcSplitPhiTy, @@ -342,15 +342,23 @@ tcMethodBind inst_tyvars inst_theta avail_insts prags -- Check the bindings; first adding inst_tyvars to the envt -- so that we don't quantify over them in nested places - mkTcSig meth_id `thenM` \ meth_sig -> - let lookup_sig name = ASSERT( name == idName meth_id ) - Just meth_sig - in - tcExtendTyVarEnv inst_tyvars ( + + + let -- Fake up a TcSigInfo to pass to tcMonoBinds + rigid_info = SigSkol (idName meth_id) + in + tcSkolType rigid_info (idType meth_id) `thenM` \ (tyvars', theta', tau') -> + getInstLoc (SigOrigin rigid_info) `thenM` \ loc -> + let meth_sig = TcSigInfo { sig_id = meth_id, sig_tvs = tyvars', sig_scoped = [], + sig_theta = theta', sig_tau = tau', sig_loc = loc } + lookup_sig name = ASSERT( name == idName meth_id ) + Just meth_sig + in + tcExtendTyVarEnv inst_tyvars ( addErrCtxt (methodCtxt sel_id) $ getLIE $ tcMonoBinds (unitBag meth_bind) lookup_sig NonRecursive - ) `thenM` \ ((meth_bind, mono_bind_infos), meth_lie) -> + ) `thenM` \ ((meth_bind, mono_bind_infos), meth_lie) -> -- Now do context reduction. We simplify wrt both the local tyvars -- and the ones of the class/instance decl, so that there is @@ -360,20 +368,20 @@ tcMethodBind inst_tyvars inst_theta avail_insts prags -- -- We do this for each method independently to localise error messages - addErrCtxtM (sigCtxt sel_id inst_tyvars inst_theta (idType meth_id)) $ - newDictsAtLoc (sig_loc meth_sig) (sig_theta meth_sig) `thenM` \ meth_dicts -> - let + addErrCtxtM (sigCtxt sel_id inst_tyvars inst_theta (idType meth_id)) $ + newDictsAtLoc (sig_loc meth_sig) (sig_theta meth_sig) `thenM` \ meth_dicts -> + let meth_tvs = sig_tvs meth_sig all_tyvars = meth_tvs ++ inst_tyvars all_insts = avail_insts ++ meth_dicts - in - tcSimplifyCheck + in + tcSimplifyCheck (ptext SLIT("class or instance method") <+> quotes (ppr sel_id)) all_tyvars all_insts meth_lie `thenM` \ lie_binds -> - checkSigTyVars all_tyvars `thenM_` + checkSigTyVars all_tyvars `thenM_` - let + let sel_name = idName sel_id inline_prags = [ (is_inl, phase) | L _ (InlineSig is_inl (L _ name) phase) <- prags, @@ -397,19 +405,19 @@ tcMethodBind inst_tyvars inst_theta avail_insts prags inlines (lie_binds `unionBags` meth_bind) - in + in -- Deal with specialisation pragmas -- The sel_name is what appears in the pragma - tcExtendIdEnv2 [(sel_name, final_meth_id)] ( + tcExtendIdEnv2 [(sel_name, final_meth_id)] ( getLIE (tcSpecSigs spec_prags) `thenM` \ (spec_binds1, prag_lie) -> -- The prag_lie for a SPECIALISE pragma will mention the function itself, -- so we have to simplify them away right now lest they float outwards! bindInstsOfLocalFuns prag_lie [final_meth_id] `thenM` \ spec_binds2 -> returnM (spec_binds1 `unionBags` spec_binds2) - ) `thenM` \ spec_binds -> + ) `thenM` \ spec_binds -> - returnM (poly_meth_bind `consBag` spec_binds) + returnM (poly_meth_bind `consBag` spec_binds) mkMethodBind :: InstOrigin diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs index e5ea1aa..2f64d4c 100644 --- a/ghc/compiler/typecheck/TcEnv.lhs +++ b/ghc/compiler/typecheck/TcEnv.lhs @@ -56,7 +56,7 @@ import TcType ( Type, TcKind, TcTyVar, TcTyVarSet, TcType, ) import qualified Type ( getTyVar_maybe ) import Id ( idName, isLocalId ) -import Var ( TyVar, Id, idType ) +import Var ( TyVar, Id, idType, tyVarName ) import VarSet import VarEnv import RdrName ( extendLocalRdrEnv ) @@ -248,21 +248,17 @@ tcExtendKindEnv things thing_inside tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r tcExtendTyVarEnv tvs thing_inside - = tc_extend_tv_env [ATyVar tv (mkTyVarTy tv) | tv <- tvs] thing_inside + = tcExtendTyVarEnv2 [(tyVarName tv, mkTyVarTy tv) | tv <- tvs] thing_inside -tcExtendTyVarEnv2 :: [(TyVar,TcType)] -> TcM r -> TcM r -tcExtendTyVarEnv2 ty_pairs thing_inside - = tc_extend_tv_env [ATyVar tv1 ty2 | (tv1,ty2) <- ty_pairs] thing_inside - -tc_extend_tv_env binds thing_inside +tcExtendTyVarEnv2 :: [(Name,TcType)] -> TcM r -> TcM r +tcExtendTyVarEnv2 binds thing_inside = getLclEnv `thenM` \ env@(TcLclEnv {tcl_env = le, tcl_tyvars = gtvs, tcl_rdr = rdr_env}) -> let - names = [getName tv | ATyVar tv _ <- binds] - rdr_env' = extendLocalRdrEnv rdr_env names - le' = extendNameEnvList le (names `zip` binds) - new_tv_set = tyVarsOfTypes [ty | ATyVar _ ty <- binds] + rdr_env' = extendLocalRdrEnv rdr_env (map fst binds) + new_tv_set = tyVarsOfTypes (map snd binds) + le' = extendNameEnvList le [(name, ATyVar name ty) | (name, ty) <- binds] in -- It's important to add the in-scope tyvars to the global tyvar set -- as well. Consider @@ -347,17 +343,17 @@ find_thing ignore_it tidy_env (ATyVar tv ty) if ignore_it tv_ty then returnM (tidy_env, Nothing) else let - (tidy_env1, tv1) = tidyOpenTyVar tidy_env tv - (tidy_env2, tidy_ty) = tidyOpenType tidy_env1 tv_ty - msg = sep [ppr tv1 <+> eq_stuff, nest 2 bound_at] + -- The name tv is scoped, so we don't need to tidy it + (tidy_env1, tidy_ty) = tidyOpenType tidy_env tv_ty + msg = sep [ppr tv <+> eq_stuff, nest 2 bound_at] eq_stuff | Just tv' <- Type.getTyVar_maybe tv_ty, - tv == tv' = empty + tv == tyVarName tv' = empty | otherwise = equals <+> ppr tidy_ty -- It's ok to use Type.getTyVar_maybe because ty is zonked by now bound_at = ptext SLIT("bound at:") <+> ppr (getSrcLoc tv) in - returnM (tidy_env2, Just msg) + returnM (tidy_env1, Just msg) \end{code} diff --git a/ghc/compiler/typecheck/TcExpr.lhs b/ghc/compiler/typecheck/TcExpr.lhs index de6ecff..3d42d8d 100644 --- a/ghc/compiler/typecheck/TcExpr.lhs +++ b/ghc/compiler/typecheck/TcExpr.lhs @@ -11,6 +11,7 @@ module TcExpr ( tcCheckSigma, tcCheckRho, tcInferRho, tcMonoExpr ) where #ifdef GHCI /* Only if bootstrapped */ import {-# SOURCE #-} TcSplice( tcSpliceExpr, tcBracket ) import Id ( Id ) +import Name ( isExternalName ) import TcType ( isTauTy ) import TcEnv ( checkWellStaged ) import HsSyn ( nlHsApp ) @@ -36,19 +37,19 @@ import TcMatches ( tcMatchesCase, tcMatchLambda, tcDoStmts, tcThingWithSig, TcMa import TcHsType ( tcHsSigType, UserTypeCtxt(..) ) import TcPat ( badFieldCon, refineTyVars ) import TcMType ( tcInstTyVars, tcInstType, newTyFlexiVarTy, zonkTcType ) -import TcType ( Type, TcTyVar, TcType, TcSigmaType, TcRhoType, MetaDetails(..), +import TcType ( Type, TcTyVar, TcType, TcSigmaType, TcRhoType, tcSplitFunTys, tcSplitTyConApp, mkTyVarTys, isSigmaTy, mkFunTy, mkTyConApp, tyVarsOfTypes, isLinearPred, tcSplitSigmaTy, tidyOpenType ) import Kind ( openTypeKind, liftedTypeKind, argTypeKind ) -import Id ( idType, recordSelectorFieldLabel, isRecordSelector, idName ) +import Id ( idType, recordSelectorFieldLabel, isRecordSelector ) import DataCon ( DataCon, dataConFieldLabels, dataConStrictMarks, dataConWrapId ) -import Name ( Name, isExternalName ) +import Name ( Name ) import TyCon ( TyCon, FieldLabel, tyConTyVars, tyConStupidTheta, tyConDataCons, tyConFields ) -import Type ( zipTopTvSubst, mkTopTvSubst, substTheta, substTy ) +import Type ( zipTopTvSubst, substTheta, substTy ) import VarSet ( emptyVarSet, elemVarSet ) import TysWiredIn ( boolTy, parrTyCon, tupleTyCon ) import PrelNames ( enumFromName, enumFromThenName, @@ -60,7 +61,6 @@ import CmdLineOpts import HscTypes ( TyThing(..) ) import SrcLoc ( Located(..), unLoc, getLoc ) import Util -import Maybes ( catMaybes ) import Outputable import FastString diff --git a/ghc/compiler/typecheck/TcHsType.lhs b/ghc/compiler/typecheck/TcHsType.lhs index 04aa686..4ba7b99 100644 --- a/ghc/compiler/typecheck/TcHsType.lhs +++ b/ghc/compiler/typecheck/TcHsType.lhs @@ -18,8 +18,7 @@ module TcHsType ( tcHsPatSigType, tcAddLetBoundTyVars, - TcSigInfo(..), mkTcSig, - TcSigFun, lookupSig + TcSigInfo(..), TcSigFun, lookupSig ) where #include "HsVersions.h" @@ -33,21 +32,20 @@ import TcEnv ( tcExtendTyVarEnv, tcExtendKindEnv, tcLookup, tcLookupClass, tcLookupTyCon, TyThing(..), getInLocalScope, wrongThingErr ) -import TcMType ( newKindVar, tcSkolType, newMetaTyVar, - zonkTcKindToKind, +import TcMType ( newKindVar, newMetaTyVar, zonkTcKindToKind, checkValidType, UserTypeCtxt(..), pprHsSigCtxt ) import TcUnify ( unifyFunKind, checkExpectedKind ) import TcType ( Type, PredType(..), ThetaType, - SkolemInfo(SigSkol), MetaDetails(Flexi), + MetaDetails(Flexi), TcType, TcTyVar, TcKind, TcThetaType, TcTauType, mkForAllTys, mkFunTys, tcEqType, isPredTy, mkFunTy, mkSigmaTy, mkPredTy, mkGenTyConApp, mkTyConApp, mkAppTys, - tcSplitFunTy_maybe, tcSplitForAllTys ) + tcSplitFunTy_maybe, tcSplitForAllTys, typeKind ) import Kind ( Kind, isLiftedTypeKind, liftedTypeKind, ubxTupleKind, openTypeKind, argTypeKind, splitKindFunTys ) -import Id ( idName, idType ) -import Var ( TyVar, mkTyVar, tyVarKind ) +import Id ( idName ) +import Var ( TyVar, mkTyVar ) import TyCon ( TyCon, tyConKind ) import Class ( Class, classTyCon ) import Name ( Name, mkInternalName ) @@ -150,6 +148,9 @@ the TyCon being defined. \begin{code} tcHsSigType :: UserTypeCtxt -> LHsType Name -> TcM Type -- Do kind checking, and hoist for-alls to the top + -- NB: it's important that the foralls that come from the top-level + -- HsForAllTy in hs_ty occur *first* in the returned type. + -- See Note [Scoped] with TcSigInfo tcHsSigType ctxt hs_ty = addErrCtxt (pprHsSigCtxt ctxt hs_ty) $ do { kinded_ty <- kcTypeType hs_ty @@ -391,7 +392,7 @@ kcTyVar name -- Could be a tyvar or a tycon tcLookup name `thenM` \ thing -> traceTc (text "lk2" <+> ppr name <+> ppr thing) `thenM_` case thing of - ATyVar tv _ -> returnM (tyVarKind tv) + ATyVar _ ty -> returnM (typeKind ty) AThing kind -> returnM kind AGlobal (ATyCon tc) -> returnM (tyConKind tc) other -> wrongThingErr "type" thing name @@ -501,8 +502,6 @@ ds_var_app name arg_tys case thing of ATyVar _ ty -> returnM (mkAppTys ty arg_tys) AGlobal (ATyCon tc) -> returnM (mkGenTyConApp tc arg_tys) --- AThing _ -> tcLookupTyCon name `thenM` \ tc -> --- returnM (mkGenTyConApp tc arg_tys) other -> pprPanic "ds_app_type" (ppr name <+> ppr arg_tys) \end{code} @@ -775,13 +774,42 @@ been instantiated. \begin{code} data TcSigInfo = TcSigInfo { - sig_id :: TcId, -- *Polymorphic* binder for this value... - sig_tvs :: [TcTyVar], -- tyvars - sig_theta :: TcThetaType, -- theta - sig_tau :: TcTauType, -- tau - sig_loc :: InstLoc -- The location of the signature + sig_id :: TcId, -- *Polymorphic* binder for this value... + + sig_scoped :: [Name], -- Names for any scoped type variables + -- Invariant: correspond 1-1 with an initial + -- segment of sig_tvs (see Note [Scoped]) + + sig_tvs :: [TcTyVar], -- Instantiated type variables + -- See Note [Instantiate sig] + + sig_theta :: TcThetaType, -- Instantiated theta + sig_tau :: TcTauType, -- Instantiated tau + sig_loc :: InstLoc -- The location of the signature } +-- Note [Scoped] +-- There may be more instantiated type variables than scoped +-- ones. For example: +-- type T a = forall b. b -> (a,b) +-- f :: forall c. T c +-- Here, the signature for f will have one scoped type variable, c, +-- but two instantiated type variables, c' and b'. +-- +-- We assume that the scoped ones are at the *front* of sig_tvs, +-- and remember the names from the original HsForAllTy in sig_scoped + +-- Note [Instantiate sig] +-- It's vital to instantiate a type signature with fresh variable. +-- For example: +-- type S = forall a. a->a +-- f,g :: S +-- f = ... +-- g = ... +-- Here, we must use distinct type variables when checking f,g's right hand sides. +-- (Instantiation is only necessary because of type synonyms. Otherwise, +-- it's all cool; each signature has distinct type variables from the renamer.) + type TcSigFun = Name -> Maybe TcSigInfo instance Outputable TcSigInfo where @@ -793,21 +821,6 @@ lookupSig [] name = Nothing lookupSig (sig : sigs) name | name == idName (sig_id sig) = Just sig | otherwise = lookupSig sigs name - -mkTcSig :: TcId -> TcM TcSigInfo -mkTcSig poly_id - = -- Instantiate this type - -- It's important to do this even though in the error-free case - -- we could just split the sigma_tc_ty (since the tyvars don't - -- unified with anything). But in the case of an error, when - -- the tyvars *do* get unified with something, we want to carry on - -- typechecking the rest of the program with the function bound - -- to a pristine type, namely sigma_tc_ty - do { let rigid_info = SigSkol (idName poly_id) - ; (tyvars', theta', tau') <- tcSkolType rigid_info (idType poly_id) - ; loc <- getInstLoc (SigOrigin rigid_info) - ; return (TcSigInfo { sig_id = poly_id, sig_tvs = tyvars', - sig_theta = theta', sig_tau = tau', sig_loc = loc }) } \end{code} diff --git a/ghc/compiler/typecheck/TcInstDcls.lhs b/ghc/compiler/typecheck/TcInstDcls.lhs index afada00..929797a 100644 --- a/ghc/compiler/typecheck/TcInstDcls.lhs +++ b/ghc/compiler/typecheck/TcInstDcls.lhs @@ -16,7 +16,7 @@ import TcRnMonad import TcMType ( tcSkolSigType, checkValidTheta, checkValidInstHead, instTypeErr, checkAmbiguity, SourceTyCtxt(..) ) import TcType ( mkClassPred, tyVarsOfType, - tcSplitSigmaTy, getClassPredTys, tcSplitDFunHead, mkTyVarTys, + tcSplitSigmaTy, tcSplitDFunHead, mkTyVarTys, SkolemInfo(InstSkol), tcSplitDFunTy, pprClassPred ) import Inst ( tcInstClassOp, newDicts, instToId, showLIE, tcExtendLocalInstEnv ) import TcDeriv ( tcDeriving ) diff --git a/ghc/compiler/typecheck/TcPat.lhs b/ghc/compiler/typecheck/TcPat.lhs index 0ae7013..0ddb0d9 100644 --- a/ghc/compiler/typecheck/TcPat.lhs +++ b/ghc/compiler/typecheck/TcPat.lhs @@ -18,6 +18,7 @@ import Inst ( InstOrigin(..), instToId, tcInstStupidTheta, tcSyntaxName ) import Id ( Id, idType, mkLocalId ) +import Var ( tyVarName ) import Name ( Name ) import TcSimplify ( tcSimplifyCheck, bindInstsOfLocalFuns ) import TcEnv ( newLocalName, tcExtendIdEnv1, tcExtendTyVarEnv2, @@ -245,7 +246,7 @@ tc_pat ctxt (SigPatIn pat sig) pat_ty thing_inside (sig_tvs, sig_ty) <- tcHsPatSigType PatSigCtxt sig ; tcSubPat sig_ty pat_ty ; subst <- refineTyVars sig_tvs -- See note [Type matching] - ; let tv_binds = [(tv, substTyVar subst tv) | tv <- sig_tvs] + ; let tv_binds = [(tyVarName tv, substTyVar subst tv) | tv <- sig_tvs] sig_ty' = substTy subst sig_ty ; (pat', tvs, res) <- tcExtendTyVarEnv2 tv_binds $ diff --git a/ghc/compiler/typecheck/TcRnTypes.lhs b/ghc/compiler/typecheck/TcRnTypes.lhs index ed1fb86..f01df31 100644 --- a/ghc/compiler/typecheck/TcRnTypes.lhs +++ b/ghc/compiler/typecheck/TcRnTypes.lhs @@ -389,7 +389,7 @@ data TcTyThing | ATcId TcId ThLevel ProcLevel -- Ids defined in this module; may not be fully zonked - | ATyVar TyVar TcType -- Type variables; tv -> type. It can't just be a TyVar + | ATyVar Name TcType -- Type variables; tv -> type. It can't just be a TyVar -- that is mutated to point to the type it is bound to, -- because that would make it a wobbly type, and we -- want pattern-bound lexically-scoped type variables to -- 1.7.10.4