[project @ 2003-11-17 14:23:30 by simonmar]

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

diff --git a/ghc/compiler/types/InstEnv.lhs b/ghc/compiler/types/InstEnv.lhs
index 64591bc..44f2db3 100644 (file)
--- a/ghc/compiler/types/InstEnv.lhs
+++ b/ghc/compiler/types/InstEnv.lhs
@@ -9,7 +9,7 @@ The bits common to TcInstDcls and TcDeriv.
 module InstEnv (
        DFunId, InstEnv,
 
-       emptyInstEnv, extendInstEnv, pprInstEnv,
+       emptyInstEnv, extendInstEnv,
        lookupInstEnv, 
        classInstEnv, simpleDFunClassTyCon, checkFunDeps
     ) where
@@ -63,6 +63,7 @@ extendInstEnv inst_env dfun_id
     ins_tv_set = mkVarSet ins_tvs
     ins_item   = (ins_tv_set, ins_tys, dfun_id)
 
+#ifdef UNUSED
 pprInstEnv :: InstEnv -> SDoc
 pprInstEnv env
   = vcat [ brackets (pprWithCommas ppr (varSetElems tyvars)) <+> 
@@ -70,7 +71,7 @@ pprInstEnv env
         | cls_inst_env <-  eltsUFM env
         , (tyvars, tys, dfun) <- cls_inst_env
         ]
-
+#endif
 
 simpleDFunClassTyCon :: DFunId -> (Class, TyCon)
 simpleDFunClassTyCon dfun
@@ -250,8 +251,8 @@ thing we are looking up can have an arbitrary "flexi" part.
 
 \begin{code}
 lookupInstEnv :: DynFlags
-             -> (InstEnv,      -- Home-package inst-env
-                 InstEnv)      -- External package inst-env
+             -> (InstEnv       -- External package inst-env
+                ,InstEnv)      -- Home-package inst-env
              -> Class -> [Type]                        -- What we are looking for
              -> ([(TyVarSubstEnv, InstEnvElt)],        -- Successful matches
                  [Id])                                 -- These don't match but do unify
@@ -265,27 +266,27 @@ lookupInstEnv :: DynFlags
        -- but Foo [Int] is a unifier.  This gives the caller a better chance of
        -- giving a suitable error messagen
 
-lookupInstEnv dflags (home_ie, pkg_ie) cls tys
+lookupInstEnv dflags (pkg_ie, home_ie) cls tys
   | not (null all_unifs) = (all_matches, all_unifs)    -- This is always an error situation,
                                                        -- so don't attempt to pune the matches
   | otherwise           = (pruned_matches, [])
   where
     incoherent_ok = dopt Opt_AllowIncoherentInstances  dflags
     overlap_ok    = dopt Opt_AllowOverlappingInstances dflags
-    (home_matches, home_unifs) = lookup_inst_env incoherent_ok home_ie cls tys
-    (pkg_matches,  pkg_unifs)  = lookup_inst_env incoherent_ok pkg_ie  cls tys
+    (home_matches, home_unifs) = lookup_inst_env home_ie cls tys
+    (pkg_matches,  pkg_unifs)  = lookup_inst_env pkg_ie  cls tys
     all_matches = home_matches ++ pkg_matches
-    all_unifs   = home_unifs ++ pkg_unifs
+    all_unifs | incoherent_ok = []     -- Don't worry about these if incoherent is ok!
+             | otherwise     = home_unifs ++ pkg_unifs
 
     pruned_matches | overlap_ok = foldr insert_overlapping [] all_matches
                   | otherwise  = all_matches
 
-lookup_inst_env :: Bool
-             -> InstEnv                                -- The envt
-             -> Class -> [Type]                        -- What we are looking for
-             -> ([(TyVarSubstEnv, InstEnvElt)],        -- Successful matches
-                 [Id])                                 -- These don't match but do unify
-lookup_inst_env incoherent_ok env key_cls key_tys
+lookup_inst_env :: InstEnv                             -- The envt
+               -> Class -> [Type]                      -- What we are looking for
+               -> ([(TyVarSubstEnv, InstEnvElt)],      -- Successful matches
+                   [Id])                               -- These don't match but do unify
+lookup_inst_env env key_cls key_tys
   = find (classInstEnv env key_cls) [] []
   where
     key_vars = tyVarsOfTypes key_tys
@@ -296,10 +297,6 @@ lookup_inst_env incoherent_ok env key_cls key_tys
          Just (subst, leftovers) -> ASSERT( null leftovers )
                                     find rest ((subst,item):ms) us
          Nothing 
-          | incoherent_ok -> find rest ms us
-               -- If we allow incoherent instances we don't worry about the 
-               -- test and just blaze on anyhow.  Requested by John Hughes.
-          | otherwise
                -- Does not match, so next check whether the things unify
                -- [see notes about overlapping instances above]
           -> case unifyTyListsX (key_vars `unionVarSet` tpl_tyvars) key_tys tpl of
@@ -366,7 +363,7 @@ checkFunDeps :: (InstEnv, InstEnv) -> DFunId
             -> Maybe [DFunId]  -- Nothing  <=> ok
                                -- Just dfs <=> conflict with dfs
 -- Check wheher adding DFunId would break functional-dependency constraints
-checkFunDeps (home_ie, pkg_ie) dfun
+checkFunDeps (pkg_ie, home_ie) dfun
   | null bad_fundeps = Nothing
   | otherwise       = Just bad_fundeps
   where