diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2012-10-02 15:20:05 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2012-10-02 15:20:05 +0100 |
| commit | 4708d3838d1d76c4a6d153b3e3a42b97c7d2f9c3 (patch) | |
| tree | 836dd5a22ba251ab2fc9c580c8d8135aae08fc3f /compiler/types/Type.lhs | |
| parent | 74d65116e7c047215f79deb410029ba727c6df5e (diff) | |
| parent | 815dcff13084fa5ffb43d743d08bb4f021ae2753 (diff) | |
| download | haskell-4708d3838d1d76c4a6d153b3e3a42b97c7d2f9c3.tar.gz | |
Merge branch 'tc-untouchables'
Diffstat (limited to 'compiler/types/Type.lhs')
| -rw-r--r-- | compiler/types/Type.lhs | 20 |
1 files changed, 14 insertions, 6 deletions
diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs index 4e8e631015..a8fb161b7f 100644 --- a/compiler/types/Type.lhs +++ b/compiler/types/Type.lhs @@ -54,7 +54,8 @@ module Type ( isDictLikeTy, mkEqPred, mkPrimEqPred, mkClassPred, - noParenPred, isClassPred, isEqPred, isIPPred, isIPPred_maybe, + noParenPred, isClassPred, isEqPred, + isIPPred, isIPPred_maybe, isIPTyCon, isIPClass, -- Deconstructing predicate types PredTree(..), predTreePredType, classifyPredType, @@ -152,7 +153,7 @@ import Class import TyCon import TysPrim import {-# SOURCE #-} TysWiredIn ( eqTyCon, mkBoxedTupleTy ) -import PrelNames ( eqTyConKey, ipClassName ) +import PrelNames ( eqTyConKey, ipClassNameKey ) -- others import Unique ( Unique, hasKey ) @@ -857,13 +858,20 @@ isEqPred ty = case tyConAppTyCon_maybe ty of _ -> False isIPPred ty = case tyConAppTyCon_maybe ty of - Just tyCon -> tyConName tyCon == ipClassName - _ -> False + Just tc -> isIPTyCon tc + _ -> False + +isIPTyCon :: TyCon -> Bool +isIPTyCon tc = tc `hasKey` ipClassNameKey + +isIPClass :: Class -> Bool +isIPClass cls = cls `hasKey` ipClassNameKey + -- Class and it corresponding TyCon have the same Unique isIPPred_maybe :: Type -> Maybe (FastString, Type) isIPPred_maybe ty = do (tc,[t1,t2]) <- splitTyConApp_maybe ty - guard (tyConName tc == ipClassName) + guard (isIPTyCon tc) x <- isStrLitTy t1 return (x,t2) \end{code} @@ -875,7 +883,7 @@ Make PredTypes -- | Creates a type equality predicate mkEqPred :: Type -> Type -> PredType mkEqPred ty1 ty2 - = WARN( not (k `eqKind` typeKind ty2), ppr ty1 $$ ppr ty2 ) + = WARN( not (k `eqKind` typeKind ty2), ppr ty1 $$ ppr ty2 $$ ppr k $$ ppr (typeKind ty2) ) TyConApp eqTyCon [k, ty1, ty2] where k = typeKind ty1 |