X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcType.lhs;h=47bb554e867d4760659079f8bd8bfbe3c6f89813;hb=14a496fd0b3aa821b69eb02736d5f41086576761;hp=b49dbffe280714a9226d63873c814168950e40fd;hpb=2072edcfe180f617d8f9f8990f682589c4e35082;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index b49dbff..47bb554 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -30,7 +30,7 @@ module TcType ( isImmutableTyVar, isSkolemTyVar, isMetaTyVar, isMetaTyVarTy, isSigTyVar, isExistentialTyVar, isTyConableTyVar, metaTvRef, - isFlexi, isIndirect, isRuntimeUnk, isUnk, + isFlexi, isIndirect, isUnkSkol, isRuntimeUnkSkol, -------------------------------- -- Builders @@ -123,7 +123,8 @@ module TcType ( -- Type substitutions TvSubst(..), -- Representation visible to a few friends TvSubstEnv, emptyTvSubst, substEqSpec, - mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst, + mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, + mkTopTvSubst, notElemTvSubst, unionTvSubst, getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope, lookupTyVar, extendTvSubst, extendTvSubstList, isInScope, mkTvSubst, zipTyEnv, substTy, substTys, substTyWith, substTheta, substTyVar, substTyVars, substTyVarBndr, @@ -302,6 +303,11 @@ data MetaInfo -- The Name is the name of the function from whose -- type signature we got this skolem + | TcsTv -- A MetaTv allocated by the constraint solver + -- Its particular property is that it is always "touchable" + -- Nevertheless, the constraint solver has to try to guess + -- what type to instantiate it to + ---------------------------------- -- SkolemInfo describes a site where -- a) type variables are skolemised @@ -329,6 +335,7 @@ data SkolemInfo | RuleSkol RuleName -- The LHS of a RULE | GenSkol TcType -- Bound when doing a subsumption check for ty + | RuntimeUnkSkol -- a type variable used to represent an unknown -- runtime type (used in the GHCi debugger) @@ -408,6 +415,7 @@ pprTcTyVarDetails :: TcTyVarDetails -> SDoc pprTcTyVarDetails (SkolemTv _) = ptext (sLit "sk") pprTcTyVarDetails (FlatSkol {}) = ptext (sLit "fsk") pprTcTyVarDetails (MetaTv TauTv _) = ptext (sLit "tau") +pprTcTyVarDetails (MetaTv TcsTv _) = ptext (sLit "tcs") pprTcTyVarDetails (MetaTv (SigTv _) _) = ptext (sLit "sig") pprUserTypeCtxt :: UserTypeCtxt -> SDoc @@ -433,8 +441,9 @@ pprSkolTvBinding tv where ppr_details (SkolemTv info) = ppr_skol info ppr_details (FlatSkol {}) = ptext (sLit "is a flattening type variable") - ppr_details (MetaTv TauTv _) = ptext (sLit "is a meta type variable") - ppr_details (MetaTv (SigTv n) _) = ptext (sLit "is bound by the type signature for") <+> quotes (ppr n) + ppr_details (MetaTv (SigTv n) _) = ptext (sLit "is bound by the type signature for") + <+> quotes (ppr n) + ppr_details (MetaTv _ _) = ptext (sLit "is a meta type variable") ppr_skol UnkSkol = ptext (sLit "is an unknown type variable") -- Unhelpful ppr_skol RuntimeUnkSkol = ptext (sLit "is an unknown runtime type") @@ -615,8 +624,8 @@ isTyConableTyVar tv -- not a SigTv = ASSERT( isTcTyVar tv) case tcTyVarDetails tv of - MetaTv TauTv _ -> True - _ -> False + MetaTv (SigTv _) _ -> False + _ -> True isSkolemTyVar tv = ASSERT2( isTcTyVar tv, ppr tv ) @@ -662,15 +671,17 @@ isFlexi _ = False isIndirect (Indirect _) = True isIndirect _ = False -isRuntimeUnk :: TyVar -> Bool -isRuntimeUnk x | isTcTyVar x - , SkolemTv RuntimeUnkSkol <- tcTyVarDetails x = True - | otherwise = False - -isUnk :: TyVar -> Bool -isUnk x | isTcTyVar x - , SkolemTv UnkSkol <- tcTyVarDetails x = True - | otherwise = False +isRuntimeUnkSkol :: TyVar -> Bool +-- Called only in TcErrors; see Note [Runtime skolems] there +isRuntimeUnkSkol x | isTcTyVar x + , SkolemTv RuntimeUnkSkol <- tcTyVarDetails x + = True + | otherwise = False + +isUnkSkol :: TyVar -> Bool +isUnkSkol x | isTcTyVar x + , SkolemTv UnkSkol <- tcTyVarDetails x = True + | otherwise = False \end{code}