X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FType.lhs;h=fd8e8c5ac61915e57ef6293ebc19d4457de9217f;hb=15cb792d18b1094e98c035dca6ecec5dad516056;hp=ccabfb778a004a8ca739e0fde0fa448477f937b1;hpb=c76c69c5b62f1ca4fa52d75b0dfbd37b7eddbb09;p=ghc-hetmet.git diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs index ccabfb7..fd8e8c5 100644 --- a/compiler/types/Type.lhs +++ b/compiler/types/Type.lhs @@ -47,7 +47,7 @@ module Type ( splitTyConApp_maybe, splitTyConApp, splitNewTyConApp_maybe, splitNewTyConApp, - repType, typePrimRep, coreView, tcView, stgView, kindView, + repType, typePrimRep, coreView, tcView, kindView, mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys, applyTy, applyTys, isForAllTy, dropForAlls, @@ -106,31 +106,26 @@ import TypeRep -- friends: import Var ( Var, TyVar, tyVarKind, tyVarName, - setTyVarName, setTyVarKind, mkTyVar, isTyVar ) -import Name ( Name(..) ) -import Unique ( Unique ) + setTyVarName, setTyVarKind ) import VarEnv import VarSet import OccName ( tidyOccName ) -import Name ( NamedThing(..), mkInternalName, tidyNameOcc ) +import Name ( NamedThing(..), tidyNameOcc ) import Class ( Class, classTyCon ) import PrelNames( openTypeKindTyConKey, unliftedTypeKindTyConKey, - ubxTupleKindTyConKey, argTypeKindTyConKey, - eqCoercionKindTyConKey ) + ubxTupleKindTyConKey, argTypeKindTyConKey ) import TyCon ( TyCon, isRecursiveTyCon, isPrimTyCon, isUnboxedTupleTyCon, isUnLiftedTyCon, isFunTyCon, isNewTyCon, newTyConRep, newTyConRhs, isAlgTyCon, tyConArity, isSuperKindTyCon, tcExpandTyCon_maybe, coreExpandTyCon_maybe, - stgExpandTyCon_maybe, tyConKind, PrimRep(..), tyConPrimRep, tyConUnique, isCoercionTyCon_maybe, isCoercionTyCon ) -- others import StaticFlags ( opt_DictsStrict ) -import SrcLoc ( noSrcLoc ) import Util ( mapAccumL, seqList, lengthIs, snocView, thenCmp, isEqual, all2 ) import Outputable import UniqSet ( sizeUniqSet ) -- Should come via VarSet @@ -177,19 +172,6 @@ coreView (TyConApp tc tys) | Just (tenv, rhs, tys') <- coreExpandTyCon_maybe tc -- partially-applied type constructor; indeed, usually will! coreView ty = Nothing -{-# INLINE stgView #-} -stgView :: Type -> Maybe Type --- When generating STG from Core it is important that we look through newtypes --- but for the rest of Core we are just using coercions. This does just what --- coreView USED to do. -stgView (NoteTy _ ty) = Just ty -stgView (PredTy p) = Just (predTypeRep p) -stgView (TyConApp tc tys) | Just (tenv, rhs, tys') <- stgExpandTyCon_maybe tc tys - = Just (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys') - -- Its important to use mkAppTys, rather than (foldl AppTy), - -- because the function part might well return a - -- partially-applied type constructor; indeed, usually will! -stgView ty = Nothing ----------------------------------------------- @@ -695,8 +677,9 @@ tyVarsOfTypes :: [Type] -> TyVarSet tyVarsOfTypes tys = foldr (unionVarSet.tyVarsOfType) emptyVarSet tys tyVarsOfPred :: PredType -> TyVarSet -tyVarsOfPred (IParam _ ty) = tyVarsOfType ty -tyVarsOfPred (ClassP _ tys) = tyVarsOfTypes tys +tyVarsOfPred (IParam _ ty) = tyVarsOfType ty +tyVarsOfPred (ClassP _ tys) = tyVarsOfTypes tys +tyVarsOfPred (EqPred ty1 ty2) = tyVarsOfType ty1 `unionVarSet` tyVarsOfType ty2 tyVarsOfTheta :: ThetaType -> TyVarSet tyVarsOfTheta = foldr (unionVarSet . tyVarsOfPred) emptyVarSet @@ -770,6 +753,7 @@ tidyTypes env tys = map (tidyType env) tys tidyPred :: TidyEnv -> PredType -> PredType tidyPred env (IParam n ty) = IParam n (tidyType env ty) tidyPred env (ClassP clas tys) = ClassP clas (tidyTypes env tys) +tidyPred env (EqPred ty1 ty2) = EqPred (tidyType env ty1) (tidyType env ty2) \end{code} @@ -888,8 +872,9 @@ seqNote :: TyNote -> () seqNote (FTVNote set) = sizeUniqSet set `seq` () seqPred :: PredType -> () -seqPred (ClassP c tys) = c `seq` seqTypes tys -seqPred (IParam n ty) = n `seq` seqType ty +seqPred (ClassP c tys) = c `seq` seqTypes tys +seqPred (IParam n ty) = n `seq` seqType ty +seqPred (EqPred ty1 ty2) = seqType ty1 `seq` seqType ty2 \end{code}