checkTauTvUpdate: take synonym families into account

[ghc-hetmet.git] / compiler / types / FamInstEnv.lhs

diff --git a/compiler/types/FamInstEnv.lhs b/compiler/types/FamInstEnv.lhs
index eb31751..b9276b7 100644 (file)
--- a/compiler/types/FamInstEnv.lhs
+++ b/compiler/types/FamInstEnv.lhs
@@ -10,7 +10,8 @@ module FamInstEnv (
        pprFamInst, pprFamInstHdr, pprFamInsts, 
        famInstHead, mkLocalFamInst, mkImportedFamInst,
 
-       FamInstEnv, emptyFamInstEnv, extendFamInstEnv, extendFamInstEnvList, 
+       FamInstEnvs, FamInstEnv, emptyFamInstEnv, 
+       extendFamInstEnv, extendFamInstEnvList, 
        famInstEnvElts, familyInstances,
 
        lookupFamInstEnv, lookupFamInstEnvUnify
@@ -142,6 +143,9 @@ InstEnv maps a family name to the list of known instances for that family.
 \begin{code}
 type FamInstEnv = UniqFM FamilyInstEnv -- Maps a family to its instances
 
+type FamInstEnvs = (FamInstEnv, FamInstEnv)
+       -- External package inst-env, Home-package inst-env
+
 data FamilyInstEnv
   = FamIE [FamInst]    -- The instances for a particular family, in any order
          Bool          -- True <=> there is an instance of form T a b c
@@ -184,60 +188,13 @@ extendFamInstEnv inst_env ins_item@(FamInst {fi_fam = cls_nm, fi_tcs = mb_tcs})
 %*                                                                     *
 %************************************************************************
 
-@lookupFamInstEnvExact@ looks up in a @FamInstEnv@ using an exact match.
-This is used when we want the @TyCon@ of a particular family instance (e.g.,
-during deriving classes).
-
-\begin{code}
-{-             NOT NEEDED ANY MORE
-lookupFamInstEnvExact :: (FamInstEnv           -- External package inst-env
-                        ,FamInstEnv)           -- Home-package inst-env
-                     -> TyCon -> [Type]        -- What we are looking for
-                     -> Maybe FamInst
-lookupFamInstEnvExact (pkg_ie, home_ie) fam tys
-  = home_matches `mplus` pkg_matches
-  where
-    rough_tcs    = roughMatchTcs tys
-    all_tvs      = all isNothing rough_tcs
-    home_matches = lookup home_ie 
-    pkg_matches  = lookup pkg_ie  
-
-    --------------
-    lookup env = case lookupUFM env fam of
-                  Nothing -> Nothing           -- No instances for this class
-                  Just (FamIE insts has_tv_insts)
-                      -- Short cut for common case:
-                      --   The thing we are looking up is of form (C a
-                      --   b c), and the FamIE has no instances of
-                      --   that form, so don't bother to search 
-                    | all_tvs && not has_tv_insts -> Nothing
-                    | otherwise                   -> find insts
-
-    --------------
-    find [] = Nothing
-    find (item@(FamInst { fi_tcs = mb_tcs, fi_tys = tpl_tys }) : rest)
-       -- Fast check for no match, uses the "rough match" fields
-      | instanceCantMatch rough_tcs mb_tcs
-      = find rest
-
-        -- Proper check
-      | tcEqTypes tpl_tys tys
-      = Just item
-
-        -- No match => try next
-      | otherwise
-      = find rest
--}
-\end{code}
-
 @lookupFamInstEnv@ looks up in a @FamInstEnv@, using a one-way match.
 Multiple matches are only possible in case of type families (not data
 families), and then, it doesn't matter which match we choose (as the
 instances are guaranteed confluent).
 
 \begin{code}
-lookupFamInstEnv :: (FamInstEnv        -- External package inst-env
-                   ,FamInstEnv)        -- Home-package inst-env
+lookupFamInstEnv :: FamInstEnvs
                 -> TyCon -> [Type]             -- What we are looking for
                 -> [(TvSubst, FamInst)]        -- Successful matches
 lookupFamInstEnv (pkg_ie, home_ie) fam tys