[project @ 2003-10-27 14:08:04 by simonpj]

Improve duplicate-instance reporting; swap inst-env param order

diff --git a/ghc/compiler/typecheck/Inst.lhs b/ghc/compiler/typecheck/Inst.lhs
index 11d41a4..ad51a49 100644 (file)
--- a/ghc/compiler/typecheck/Inst.lhs
+++ b/ghc/compiler/typecheck/Inst.lhs
@@ -540,40 +540,40 @@ tcExtendLocalInstEnv :: [DFunId] -> TcM a -> TcM a
   -- Add new locally-defined instances
 tcExtendLocalInstEnv dfuns thing_inside
  = do { traceDFuns dfuns
-      ; eps <- getEps
       ; env <- getGblEnv
       ; dflags  <- getDOpts
-      ; inst_env' <- foldlM (extend dflags (eps_inst_env eps)) 
-                           (tcg_inst_env env) 
-                           dfuns
+      ; inst_env' <- foldlM (addInst dflags) (tcg_inst_env env) dfuns
       ; let env' = env { tcg_insts = dfuns ++ tcg_insts env,
                         tcg_inst_env = inst_env' }
       ; setGblEnv env' thing_inside }
- where
-  extend dflags pkg_ie home_ie dfun
-   = do        { checkNewInst dflags (home_ie, pkg_ie) dfun
-       ; return (extendInstEnv home_ie dfun) }
 
-checkNewInst :: DynFlags -> (InstEnv, InstEnv) -> DFunId -> TcM ()
--- Check that the proposed new instance is OK
-checkNewInst dflags ies dfun
-  = do {       -- Check functional dependencies
-         case checkFunDeps ies dfun of
+addInst :: DynFlags -> InstEnv -> DFunId -> TcM InstEnv
+-- Check that the proposed new instance is OK, 
+-- and then add it to the home inst env
+addInst dflags home_ie dfun
+  = do {       -- Load imported instances, so that we report
+               -- duplicates correctly
+         pkg_ie  <- loadImportedInsts cls tys
+
+               -- Check functional dependencies
+       ; case checkFunDeps (pkg_ie, home_ie) dfun of
                Just dfuns -> funDepErr dfun dfuns
                Nothing    -> return ()
 
                -- Check for duplicate instance decls
+       ; let { (matches, _) = lookupInstEnv dflags (pkg_ie, home_ie) cls tys
+             ; dup_dfuns = [dup_dfun | (_, (_, dup_tys, dup_dfun)) <- matches,
+                                       isJust (matchTys (mkVarSet tvs) tys dup_tys)] }
+               -- Find memebers of the match list which 
+               -- dfun itself matches. If the match is 2-way, it's a duplicate
        ; case dup_dfuns of
            dup_dfun : _ -> dupInstErr dfun dup_dfun
            []           -> return ()
-       }
+
+               -- OK, now extend the envt
+       ; return (extendInstEnv home_ie dfun) }
   where
     (tvs, _, cls, tys) = tcSplitDFunTy (idType dfun)
-    (matches, _) = lookupInstEnv dflags ies cls tys
-    dup_dfuns = [dup_dfun | (_, (_, dup_tys, dup_dfun)) <- matches,
-                           isJust (matchTys (mkVarSet tvs) tys dup_tys)]
-       -- Find memebers of the match list which 
-       -- dfun itself matches. If the match is 2-way, it's a duplicate
 
 traceDFuns dfuns
   = traceTc (text "Adding instances:" <+> vcat (map pp dfuns))

diff --git a/ghc/compiler/types/InstEnv.lhs b/ghc/compiler/types/InstEnv.lhs
index f8daac9..a5f28a9 100644 (file)
--- a/ghc/compiler/types/InstEnv.lhs
+++ b/ghc/compiler/types/InstEnv.lhs
@@ -250,8 +250,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,7 +265,7 @@ 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, [])
@@ -362,7 +362,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