Merge branch 'master' into type-nats
[ghc.git] / compiler / typecheck / TcSMonad.lhs
index 0992fb9..c7c667e 100644 (file)
@@ -45,6 +45,7 @@ module TcSMonad (
 
     getInstEnvs, getFamInstEnvs,                -- Getting the environments
     getTopEnv, getGblEnv, getTcEvBinds, getUntouchables,
+    tcsLookupClass, tcsLookupTyCon,
     getTcEvBindsBag, getTcSContext, getTcSTyBinds, getTcSTyBindsMap,
 
     newFlattenSkolemTy,                         -- Flatten skolems 
@@ -85,7 +86,8 @@ import FamInstEnv
 import qualified TcRnMonad as TcM
 import qualified TcMType as TcM
 import qualified TcEnv as TcM 
-       ( checkWellStaged, topIdLvl, tcLookupFamInst, tcGetDefaultTys )
+       ( checkWellStaged, topIdLvl, tcLookupFamInst, tcGetDefaultTys
+       , tcLookupClass, tcLookupTyCon )
 import Kind
 import TcType
 import DynFlags
@@ -758,6 +760,12 @@ getTopEnv = wrapTcS $ TcM.getTopEnv
 getGblEnv :: TcS TcGblEnv 
 getGblEnv = wrapTcS $ TcM.getGblEnv 
 
+tcsLookupClass :: Name -> TcS Class
+tcsLookupClass name = wrapTcS (TcM.tcLookupClass name)
+
+tcsLookupTyCon :: Name -> TcS TyCon
+tcsLookupTyCon name = wrapTcS (TcM.tcLookupTyCon name)
+
 -- Various smaller utilities [TODO, maybe will be absorbed in the instance matcher]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
@@ -916,13 +924,13 @@ matchClass clas tys
   = do { let pred = mkClassPred clas tys 
         ; instEnvs <- getInstEnvs
         ; case lookupInstEnv instEnvs clas tys of {
-            ([], unifs)               -- Nothing matches  
+            ([], unifs, _)               -- Nothing matches  
                 -> do { traceTcS "matchClass not matching"
                                  (vcat [ text "dict" <+> ppr pred, 
                                          text "unifs" <+> ppr unifs ]) 
                       ; return MatchInstNo  
                       } ;  
-           ([(ispec, inst_tys)], []) -- A single match 
+           ([(ispec, inst_tys)], [], _) -- A single match 
                -> do   { let dfun_id = is_dfun ispec
                        ; traceTcS "matchClass success"
                                   (vcat [text "dict" <+> ppr pred, 
@@ -931,7 +939,7 @@ matchClass clas tys
                                  -- Record that this dfun is needed
                         ; return $ MatchInstSingle (dfun_id, inst_tys)
                         } ;
-           (matches, unifs)          -- More than one matches 
+           (matches, unifs, _)          -- More than one matches 
                -> do   { traceTcS "matchClass multiple matches, deferring choice"
                                   (vcat [text "dict" <+> ppr pred,
                                          text "matches" <+> ppr matches,