X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcSMonad.lhs;h=3d8163d997dfdd6cdb173a49b85c968bdb4f0946;hb=e646bb2961a7250915e519e7852fecdb3f86cc15;hp=d558e699ff96f247559cbb0cb95d426f52492fe4;hpb=f8b7b3c6100d55125543b5f833b1a0078ad68908;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs
index d558e69..3d8163d 100644
--- a/compiler/typecheck/TcSMonad.lhs
+++ b/compiler/typecheck/TcSMonad.lhs
@@ -4,7 +4,9 @@ module TcSMonad (
 
        -- Canonical constraints
     CanonicalCts, emptyCCan, andCCan, andCCans, 
-    singleCCan, extendCCans, isEmptyCCan, isTyEqCCan, 
+    singleCCan, extendCCans, isEmptyCCan, isCTyEqCan, 
+    isCDictCan_Maybe, isCIPCan_Maybe, isCFunEqCan_Maybe, 
+
     CanonicalCt(..), Xi, tyVarsOfCanonical, tyVarsOfCanonicals, tyVarsOfCDicts, 
     mkWantedConstraints, deCanonicaliseWanted, 
     makeGivens, makeSolvedByInst,
@@ -152,11 +154,11 @@ data CanonicalCt
        --   * tv not in tvs(xi)   (occurs check)
        --   * If constraint is given then typeKind xi `compatKind` typeKind tv 
        --                See Note [Spontaneous solving and kind compatibility] 
-       --   * if @xi@ is a flatten skolem then @tv@ can only be: 
+       --   * If 'xi' is a flatten skolem then 'tv' can only be: 
        --              - a flatten skolem or a unification variable
        --     i.e. equalities prefer flatten skolems in their LHS 
-       --                See Note [Loopy Spontaneous Solving, Example 4]
-       --                Also related to [Flatten Skolem Equivalence Classes]
+       --     See Note [Loopy Spontaneous Solving, Example 4]
+       --     Also related to [Flatten Skolem Equivalence Classes]
       cc_id     :: EvVar, 
       cc_flavor :: CtFlavor, 
       cc_tyvar  :: TcTyVar, 
@@ -281,10 +283,22 @@ emptyCCan = emptyBag
 isEmptyCCan :: CanonicalCts -> Bool
 isEmptyCCan = isEmptyBag
 
-isTyEqCCan :: CanonicalCt -> Bool 
-isTyEqCCan (CTyEqCan {})  = True 
-isTyEqCCan (CFunEqCan {}) = False
-isTyEqCCan _              = False 
+isCTyEqCan :: CanonicalCt -> Bool 
+isCTyEqCan (CTyEqCan {})  = True 
+isCTyEqCan (CFunEqCan {}) = False
+isCTyEqCan _              = False 
+
+isCDictCan_Maybe :: CanonicalCt -> Maybe Class
+isCDictCan_Maybe (CDictCan {cc_class = cls })  = Just cls
+isCDictCan_Maybe _              = Nothing
+
+isCIPCan_Maybe :: CanonicalCt -> Maybe (IPName Name)
+isCIPCan_Maybe  (CIPCan {cc_ip_nm = nm }) = Just nm
+isCIPCan_Maybe _                = Nothing
+
+isCFunEqCan_Maybe :: CanonicalCt -> Maybe TyCon
+isCFunEqCan_Maybe (CFunEqCan { cc_fun = tc }) = Just tc
+isCFunEqCan_Maybe _ = Nothing
 
 \end{code}