X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FType.lhs;h=de0215e835a15238bd4d8dec191d0be2d8dc5742;hb=d29f86b1fe7daf919e9b47a9003daed74b812790;hp=f8164934761f700ab7feae032f34fda6c77bf6f5;hpb=db375d630cb6e3377e48daaa0388ba5a4f798f7b;p=ghc-hetmet.git diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs index f816493..de0215e 100644 --- a/compiler/types/Type.lhs +++ b/compiler/types/Type.lhs @@ -1,8 +1,9 @@ % +% (c) The University of Glasgow 2006 % (c) The GRASP/AQUA Project, Glasgow University, 1998 % -\section[Type]{Type - public interface} +Type - public interface \begin{code} module Type ( @@ -93,7 +94,7 @@ module Type ( substPred, substTyVar, substTyVarBndr, deShadowTy, lookupTyVar, -- Pretty-printing - pprType, pprParendType, pprTyThingCategory, + pprType, pprParendType, pprTyThingCategory, pprForAll, pprPred, pprTheta, pprThetaArrow, pprClassPred, pprKind, pprParendKind ) where @@ -105,36 +106,22 @@ module Type ( import TypeRep -- friends: -import Var ( Var, TyVar, tyVarKind, tyVarName, - setTyVarName, setTyVarKind, mkWildCoVar ) +import Var import VarEnv import VarSet -import OccName ( tidyOccName ) -import Name ( NamedThing(..), tidyNameOcc ) -import Class ( Class, classTyCon ) -import PrelNames( openTypeKindTyConKey, unliftedTypeKindTyConKey, - ubxTupleKindTyConKey, argTypeKindTyConKey ) -import TyCon ( TyCon, isPrimTyCon, - isUnboxedTupleTyCon, isUnLiftedTyCon, - isFunTyCon, isNewTyCon, isClosedNewTyCon, - newTyConRep, newTyConRhs, - isAlgTyCon, isSuperKindTyCon, - tcExpandTyCon_maybe, coreExpandTyCon_maybe, - tyConKind, PrimRep(..), tyConPrimRep, tyConUnique - ) +import Name +import Class +import PrelNames +import TyCon -- others -import StaticFlags ( opt_DictsStrict ) -import Util ( mapAccumL, seqList, snocView, thenCmp, isEqual, all2 ) +import StaticFlags +import Util import Outputable -import UniqSet ( sizeUniqSet ) -- Should come via VarSet -import Maybe ( isJust ) +import UniqSet -#ifdef DEBUG -import TyCon ( isRecursiveTyCon, tyConArity, isCoercionTyCon ) -import Util ( lengthIs ) -#endif +import Data.Maybe ( isJust ) \end{code} @@ -1028,10 +1015,12 @@ cmpTypesX env ty [] = GT ------------- cmpPredX :: RnEnv2 -> PredType -> PredType -> Ordering cmpPredX env (IParam n1 ty1) (IParam n2 ty2) = (n1 `compare` n2) `thenCmp` cmpTypeX env ty1 ty2 - -- Compare types as well as names for implicit parameters - -- This comparison is used exclusively (I think) for the - -- finite map built in TcSimplify -cmpPredX env (ClassP c1 tys1) (ClassP c2 tys2) = (c1 `compare` c2) `thenCmp` cmpTypesX env tys1 tys2 + -- Compare names only for implicit parameters + -- This comparison is used exclusively (I believe) + -- for the Avails finite map built in TcSimplify + -- If the types differ we keep them distinct so that we see + -- a distinct pair to run improvement on +cmpPredX env (ClassP c1 tys1) (ClassP c2 tys2) = (c1 `compare` c2) `thenCmp` (cmpTypesX env tys1 tys2) cmpPredX env (EqPred ty1 ty2) (EqPred ty1' ty2') = (cmpTypeX env ty1 ty1') `thenCmp` (cmpTypeX env ty2 ty2') -- Constructor order: IParam < ClassP < EqPred @@ -1060,11 +1049,13 @@ instance Ord PredType where { compare = tcCmpPred } data TvSubst = TvSubst InScopeSet -- The in-scope type variables TvSubstEnv -- The substitution itself - -- See Note [Apply Once] + -- See Note [Apply Once] + -- and Note [Extending the TvSubstEnv] {- ---------------------------------------------------------- - Note [Apply Once] +Note [Apply Once] +~~~~~~~~~~~~~~~~~ We use TvSubsts to instantiate things, and we might instantiate forall a b. ty \with the types @@ -1081,6 +1072,38 @@ variations happen to; for example [a -> (a, b)]. A TvSubst is not idempotent, but, unlike the non-idempotent substitution we use during unifications, it must not be repeatedly applied. + +Note [Extending the TvSubst] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The following invariant should hold of a TvSubst + + The in-scope set is needed *only* to + guide the generation of fresh uniques + + In particular, the *kind* of the type variables in + the in-scope set is not relevant + +This invariant allows a short-cut when the TvSubstEnv is empty: +if the TvSubstEnv is empty --- i.e. (isEmptyTvSubt subst) holds --- +then (substTy subst ty) does nothing. + +For example, consider: + (/\a. /\b:(a~Int). ...b..) Int +We substitute Int for 'a'. The Unique of 'b' does not change, but +nevertheless we add 'b' to the TvSubstEnv, because b's type does change + +This invariant has several crucial consequences: + +* In substTyVarBndr, we need extend the TvSubstEnv + - if the unique has changed + - or if the kind has changed + +* In substTyVar, we do not need to consult the in-scope set; + the TvSubstEnv is enough + +* In substTy, substTheta, we can short-circuit when the TvSubstEnv is empty + + -------------------------------------------------------------- -} @@ -1109,6 +1132,7 @@ composeTvSubst in_scope env1 env2 emptyTvSubst = TvSubst emptyInScopeSet emptyVarEnv isEmptyTvSubst :: TvSubst -> Bool + -- See Note [Extending the TvSubstEnv] isEmptyTvSubst (TvSubst _ env) = isEmptyVarEnv env mkTvSubst :: InScopeSet -> TvSubstEnv -> TvSubst @@ -1267,17 +1291,19 @@ subst_ty subst ty substTyVar :: TvSubst -> TyVar -> Type substTyVar subst@(TvSubst in_scope env) tv = case lookupTyVar subst tv of { - Nothing -> TyVarTy tv; + Nothing -> TyVarTy tv; Just ty -> ty -- See Note [Apply Once] } lookupTyVar :: TvSubst -> TyVar -> Maybe Type + -- See Note [Extending the TvSubst] lookupTyVar (TvSubst in_scope env) tv = lookupVarEnv env tv substTyVarBndr :: TvSubst -> TyVar -> (TvSubst, TyVar) substTyVarBndr subst@(TvSubst in_scope env) old_var = (TvSubst (in_scope `extendInScopeSet` new_var) new_env, new_var) where + is_co_var = isCoVar old_var new_env | no_change = delVarEnv env old_var | otherwise = extendVarEnv env old_var (TyVarTy new_var) @@ -1285,6 +1311,7 @@ substTyVarBndr subst@(TvSubst in_scope env) old_var no_change = new_var == old_var && not is_co_var -- no_change means that the new_var is identical in -- all respects to the old_var (same unique, same kind) + -- See Note [Extending the TvSubst] -- -- In that case we don't need to extend the substitution -- to map old to new. But instead we must zap any @@ -1296,12 +1323,10 @@ substTyVarBndr subst@(TvSubst in_scope env) old_var -- The uniqAway part makes sure the new variable is not already in scope subst_old_var -- subst_old_var is old_var with the substitution applied to its kind - -- It's only worth doing the substitution for coercions, - -- becuase only they can have free type variables - | is_co_var = setTyVarKind old_var (substTy subst kind) + -- It's only worth doing the substitution for coercions, + -- becuase only they can have free type variables + | is_co_var = setTyVarKind old_var (substTy subst (tyVarKind old_var)) | otherwise = old_var - kind = tyVarKind old_var - is_co_var = isCoercionKind kind \end{code} ---------------------------------------------------- @@ -1477,14 +1502,6 @@ defaultKind k | isSubArgTypeKind k = liftedTypeKind | otherwise = k -isCoercionKind :: Kind -> Bool --- All coercions are of form (ty1 :=: ty2) --- This function is here rather than in Coercion, --- because it's used by substTy -isCoercionKind k | Just k' <- kindView k = isCoercionKind k' -isCoercionKind (PredTy (EqPred {})) = True -isCoercionKind other = False - isEqPred :: PredType -> Bool isEqPred (EqPred _ _) = True isEqPred other = False