Minor refactoring of Edward's recent orphans patch (Trac #2182)

This patch is all small stuff
  - Move VisibleOrphanModules from Module to InstEnv (with the other orphan stuff)
  - Move Notes about orphans from IfaceSyn to InstEnv (ditto)
  - Make use of the record field names in InstEnvs

8 files changed, 289 insertions, 252 deletions

diff --git a/compiler/basicTypes/Module.lhs b/compiler/basicTypes/Module.lhs
index 120a11438b..44279e5e7d 100644
--- a/compiler/basicTypes/Module.lhs
+++ b/compiler/basicTypes/Module.lhs
@@ -72,7 +72,7 @@ module Module
         ModuleNameEnv,
 
         -- * Sets of Modules
-        ModuleSet, VisibleOrphanModules,
+        ModuleSet, 
         emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
     ) where
 
@@ -511,10 +511,5 @@ UniqFM.
 \begin{code}
 -- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
 type ModuleNameEnv elt = UniqFM elt
-
--- | Set of visible orphan modules, according to what modules have been directly
--- imported.  This is based off of the dep_orphs field, which records
--- transitively reachable orphan modules (modules that define orphan instances).
-type VisibleOrphanModules = ModuleSet
 \end{code}
 
diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 98bfae9f81..790556fad3 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -214,7 +214,7 @@ data IfaceClsInst
                    ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of ClsInst
                    ifDFun     :: IfExtName,                -- The dfun
                    ifOFlag    :: OverlapFlag,              -- Overlap flag
-                   ifInstOrph :: IsOrphan }                -- See Note [Orphans]
+                   ifInstOrph :: IsOrphan }                -- See Note [Orphans] in InstEnv
         -- There's always a separate IfaceDecl for the DFun, which gives
         -- its IdInfo with its full type and version number.
         -- The instance declarations taken together have a version number,
@@ -228,7 +228,7 @@ data IfaceFamInst
   = IfaceFamInst { ifFamInstFam      :: IfExtName            -- Family name
                  , ifFamInstTys      :: [Maybe IfaceTyCon]   -- See above
                  , ifFamInstAxiom    :: IfExtName            -- The axiom
-                 , ifFamInstOrph     :: IsOrphan       -- Just like IfaceClsInst
+                 , ifFamInstOrph     :: IsOrphan             -- Just like IfaceClsInst
                  }
 
 data IfaceRule
@@ -303,77 +303,6 @@ data IfaceIdDetails
 \end{code}
 
 
-Note [Orphans]: the ifInstOrph and ifRuleOrph fields
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Class instances, rules, and family instances are divided into orphans
-and non-orphans.  Roughly speaking, an instance/rule is an orphan if
-its left hand side mentions nothing defined in this module.  Orphan-hood
-has two major consequences
-
- * A non-orphan is not finger-printed separately.  Instead, for
-   fingerprinting purposes it is treated as part of the entity it
-   mentions on the LHS.  For example
-      data T = T1 | T2
-      instance Eq T where ....
-   The instance (Eq T) is incorprated as part of T's fingerprint.
-
-   In constrast, orphans are all fingerprinted together in the
-   mi_orph_hash field of the ModIface.
-
-   See MkIface.addFingerprints.
-
- * A module that contains orphans is called an "orphan module".  If
-   the module being compiled depends (transitively) on an oprhan
-   module M, then M.hi is read in regardless of whether M is oherwise
-   needed. This is to ensure that we don't miss any instance decls in
-   M.  But it's painful, because it means we need to keep track of all
-   the orphan modules below us.
-
-Orphan-hood is computed when we generate an IfaceInst, IfaceRule, or
-IfaceFamInst respectively:
-
- - If an instance is an orphan its ifInstOprh field is Nothing
-   Otherwise ifInstOrph is (Just n) where n is the Name of a
-   local class or tycon that witnesses its non-orphan-hood.
-   This computation is done by MkIface.instanceToIfaceInst
-
- - Similarly for ifRuleOrph
-   The computation is done by MkIface.coreRuleToIfaceRule
-
-Note [When exactly is an instance decl an orphan?]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  (see MkIface.instanceToIfaceInst, which implements this)
-Roughly speaking, an instance is an orphan if its head (after the =>)
-mentions nothing defined in this module.
-
-Functional dependencies complicate the situation though. Consider
-
-  module M where { class C a b | a -> b }
-
-and suppose we are compiling module X:
-
-  module X where
-        import M
-        data T = ...
-        instance C Int T where ...
-
-This instance is an orphan, because when compiling a third module Y we
-might get a constraint (C Int v), and we'd want to improve v to T.  So
-we must make sure X's instances are loaded, even if we do not directly
-use anything from X.
-
-More precisely, an instance is an orphan iff
-
-  If there are no fundeps, then at least of the names in
-  the instance head is locally defined.
-
-  If there are fundeps, then for every fundep, at least one of the
-  names free in a *non-determined* part of the instance head is
-  defined in this module.
-
-(Note that these conditions hold trivially if the class is locally
-defined.)
-
 Note [Versioning of instances]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 See [http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance#Instances]
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 8b5dac58e7..8614d1ffda 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -744,7 +744,7 @@ data IfaceDeclExtras
   | IfaceDataExtras
        Fixity                   -- Fixity of the tycon itself
        [IfaceInstABI]           -- Local class and family instances of this tycon
-                                -- See Note [Orphans] in IfaceSyn
+                                -- See Note [Orphans] in InstEnv
        [AnnPayload]             -- Annotations of the type itself
        [IfaceIdExtras]          -- For each constructor: fixity, RULES and annotations
 
@@ -752,7 +752,7 @@ data IfaceDeclExtras
        Fixity                   -- Fixity of the class itself
        [IfaceInstABI]           -- Local instances of this class *or*
                                 --   of its associated data types
-                                -- See Note [Orphans] in IfaceSyn
+                                -- See Note [Orphans] in InstEnv
        [AnnPayload]             -- Annotations of the type itself
        [IfaceIdExtras]          -- For each class method: fixity, RULES and annotations
 
@@ -1948,7 +1948,7 @@ coreRuleToIfaceRule mod rule@(Rule { ru_name = name, ru_fn = fn,
     do_arg (Coercion co) = IfaceCo   (toIfaceCoercion co)
     do_arg arg           = toIfaceExpr arg
 
-        -- Compute orphanhood.  See Note [Orphans] in IfaceSyn
+        -- Compute orphanhood.  See Note [Orphans] in InstEnv
         -- A rule is an orphan only if none of the variables
         -- mentioned on its left-hand side are locally defined
     lhs_names = nameSetElems (ruleLhsOrphNames rule)
diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index f3d3dff2c2..c737d627ca 100644
--- a/compiler/typecheck/Inst.lhs
+++ b/compiler/typecheck/Inst.lhs
@@ -398,15 +398,6 @@ getOverlapFlag overlap_mode
               final_oflag = setOverlapModeMaybe default_oflag overlap_mode
         ; return final_oflag }
 
-tcGetInstEnvs :: TcM InstEnvs
--- Gets both the external-package inst-env
--- and the home-pkg inst env (includes module being compiled)
-tcGetInstEnvs = do { eps <- getEps
-                   ; env <- getGblEnv
-                   ; return (InstEnvs (eps_inst_env eps)
-                                      (tcg_inst_env env)
-                                      (tcg_visible_orphan_mods env))}
-
 tcGetInsts :: TcM [ClsInst]
 -- Gets the local class instances.
 tcGetInsts = fmap tcg_insts getGblEnv
@@ -485,9 +476,9 @@ addLocalInst (home_ie, my_insts) ispec
                global_ie
                     | isJust (tcg_sig_of tcg_env) = emptyInstEnv
                     | otherwise = eps_inst_env eps
-               inst_envs       = InstEnvs global_ie
-                                          home_ie'
-                                          (tcg_visible_orphan_mods tcg_env)
+               inst_envs       = InstEnvs { ie_global  = global_ie
+                                          , ie_local   = home_ie'
+                                          , ie_visible = tcg_visible_orphan_mods tcg_env }
                (matches, _, _) = lookupInstEnv inst_envs cls tys
                dups            = filter (identicalInstHead ispec) (map fst matches)
 
diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs
index 765ac4d071..c4a3f2f0d3 100644
--- a/compiler/typecheck/TcEnv.lhs
+++ b/compiler/typecheck/TcEnv.lhs
@@ -21,7 +21,7 @@ module TcEnv(
         tcLookupField, tcLookupTyCon, tcLookupClass,
         tcLookupDataCon, tcLookupPatSyn, tcLookupConLike,
         tcLookupLocatedGlobalId, tcLookupLocatedTyCon,
-        tcLookupLocatedClass, tcLookupInstance, tcLookupAxiom,
+        tcLookupLocatedClass, tcLookupAxiom,
         
         -- Local environment
         tcExtendKindEnv, tcExtendKindEnv2,
@@ -38,8 +38,11 @@ module TcEnv(
 
         tcExtendRecEnv,         -- For knot-tying
 
+        -- Instances
+        tcLookupInstance, tcGetInstEnvs,
+
         -- Rules
-         tcExtendRules,
+        tcExtendRules,
 
         -- Defaults
         tcGetDefaultTys,
@@ -225,12 +228,14 @@ tcLookupInstance cls tys
         extractTyVar (TyVarTy tv) = tv
         extractTyVar _            = panic "TcEnv.tcLookupInstance: extractTyVar"
 
-    -- NB: duplicated to prevent circular dependence on Inst
-    tcGetInstEnvs = do { eps <- getEps
-                       ; env <- getGblEnv
-                       ; return (InstEnvs (eps_inst_env eps)
-                                          (tcg_inst_env env)
-                                          (tcg_visible_orphan_mods env)) }
+tcGetInstEnvs :: TcM InstEnvs
+-- Gets both the external-package inst-env
+-- and the home-pkg inst env (includes module being compiled)
+tcGetInstEnvs = do { eps <- getEps
+                   ; env <- getGblEnv
+                   ; return (InstEnvs { ie_global  = eps_inst_env eps
+                                      , ie_local   = tcg_inst_env env
+                                      , ie_visible = tcg_visible_orphan_mods env }) }
 \end{code}
 
 \begin{code}
diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 901f8f1410..29086c6ebe 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -79,7 +79,6 @@ import DataCon
 import Type
 import Class
 import CoAxiom
-import Inst     ( tcGetInstEnvs )
 import Annotations
 import Data.List ( sortBy )
 import Data.Ord
@@ -1974,7 +1973,7 @@ tcRnGetInfo hsc_env name
 
 lookupInsts :: TyThing -> TcM ([ClsInst],[FamInst])
 lookupInsts (ATyCon tc)
-  = do  { InstEnvs pkg_ie home_ie vis_mods <- tcGetInstEnvs
+  = do  { InstEnvs { ie_global = pkg_ie, ie_local = home_ie, ie_visible = vis_mods } <- tcGetInstEnvs
         ; (pkg_fie, home_fie) <- tcGetFamInstEnvs
                 -- Load all instances for all classes that are
                 -- in the type environment (which are all the ones
diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index bbbdd483ac..96006fbeb2 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -273,6 +273,7 @@ data TcGblEnv
           -- ^ The set of orphan modules which transitively reachable from
           -- direct imports.  We use this to figure out if an orphan instance
           -- in the global InstEnv should be considered visible.
+          -- See Note [Instance lookup and orphan instances] in InstEnv
 
                 -- Now a bunch of things about this module that are simply
                 -- accumulated, but never consulted until the end.
diff --git a/compiler/types/InstEnv.hs b/compiler/types/InstEnv.hs
index 19fec2b179..e9eb1dd001 100644
--- a/compiler/types/InstEnv.hs
+++ b/compiler/types/InstEnv.hs
@@ -19,7 +19,7 @@ module InstEnv (
 
         IsOrphan(..), isOrphan, notOrphan,
 
-        InstEnvs(..), InstEnv,
+        InstEnvs(..), VisibleOrphanModules, InstEnv,
         emptyInstEnv, extendInstEnv, deleteFromInstEnv, identicalInstHead,
         extendInstEnvList, lookupUniqueInstEnv, lookupInstEnv', lookupInstEnv, instEnvElts,
         memberInstEnv, instIsVisible,
@@ -55,39 +55,11 @@ import Data.Monoid
 {-
 ************************************************************************
 *                                                                      *
-\subsection{The key types}
+           ClsInst: the data type for type-class instances
 *                                                                      *
 ************************************************************************
 -}
 
--- | Is this instance an orphan?  If it is not an orphan, contains an 'OccName'
--- witnessing the instance's non-orphanhood.
-data IsOrphan = IsOrphan | NotOrphan OccName
-    deriving (Data, Typeable)
-
--- | Returns true if 'IsOrphan' is orphan.
-isOrphan :: IsOrphan -> Bool
-isOrphan IsOrphan = True
-isOrphan _ = False
-
--- | Returns true if 'IsOrphan' is not an orphan.
-notOrphan :: IsOrphan -> Bool
-notOrphan NotOrphan{} = True
-notOrphan _ = False
-
-instance Binary IsOrphan where
-    put_ bh IsOrphan = putByte bh 0
-    put_ bh (NotOrphan n) = do
-        putByte bh 1
-        put_ bh n
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> return IsOrphan
-            _ -> do
-                n <- get bh
-                return $ NotOrphan n
-
 data ClsInst
   = ClsInst {   -- Used for "rough matching"; see Note [Rough-match field]
                 -- INVARIANT: is_tcs = roughMatchTcs is_tys
@@ -242,10 +214,9 @@ mkLocalInstance :: DFunId -> OverlapFlag
                 -> [TyVar] -> Class -> [Type]
                 -> ClsInst
 -- Used for local instances, where we can safely pull on the DFunId
--- TODO: what is the difference between source_tvs and tvs?
-mkLocalInstance dfun oflag source_tvs cls tys
+mkLocalInstance dfun oflag tvs cls tys
   = ClsInst { is_flag = oflag, is_dfun = dfun
-            , is_tvs = source_tvs
+            , is_tvs = tvs
             , is_cls = cls, is_cls_nm = cls_name
             , is_tys = tys, is_tcs = roughMatchTcs tys
             , is_orphan = orph
@@ -256,11 +227,11 @@ mkLocalInstance dfun oflag source_tvs cls tys
     this_mod = ASSERT( isExternalName dfun_name ) nameModule dfun_name
     is_local name = nameIsLocalOrFrom this_mod name
 
-        -- Compute orphanhood.  See Note [Orphans] in IfaceSyn
-    (tvs, fds) = classTvsFds cls
+        -- Compute orphanhood.  See Note [Orphans] in InstEnv
+    (cls_tvs, fds) = classTvsFds cls
     arg_names = [filterNameSet is_local (orphNamesOfType ty) | ty <- tys]
 
-    -- See Note [When exactly is an instance decl an orphan?] in IfaceSyn
+    -- See Note [When exactly is an instance decl an orphan?]
     orph | is_local cls_name = NotOrphan (nameOccName cls_name)
          | all notOrphan mb_ns  = ASSERT( not (null mb_ns) ) head mb_ns
          | otherwise         = IsOrphan
@@ -272,7 +243,7 @@ mkLocalInstance dfun oflag source_tvs cls tys
                            -- that is not in the "determined" arguments
     mb_ns | null fds   = [choose_one arg_names]
           | otherwise  = map do_one fds
-    do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
+    do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- cls_tvs `zip` arg_names
                                           , not (tv `elem` rtvs)]
 
     choose_one :: [NameSet] -> IsOrphan
@@ -313,127 +284,115 @@ instanceCantMatch (Just t : ts) (Just a : as) = t/=a || instanceCantMatch ts as
 instanceCantMatch _             _             =  False  -- Safe
 
 {-
-Note [Overlapping instances]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Overlap is permitted, but only in such a way that one can make
-a unique choice when looking up.  That is, overlap is only permitted if
-one template matches the other, or vice versa.  So this is ok:
-
-  [a]  [Int]
-
-but this is not
-
-  (Int,a)  (b,Int)
-
-If overlap is permitted, the list is kept most specific first, so that
-the first lookup is the right choice.
-
-
-For now we just use association lists.
-
-\subsection{Avoiding a problem with overlapping}
+************************************************************************
+*                                                                      *
+                Orphans
+*                                                                      *
+************************************************************************
+-}
 
-Consider this little program:
+-- | Is this instance an orphan?  If it is not an orphan, contains an 'OccName'
+-- witnessing the instance's non-orphanhood.
+-- See Note [Orphans]
+data IsOrphan
+  = IsOrphan
+  | NotOrphan OccName  -- The OccName 'n' witnesses the instance's non-orphanhood
+                       -- In that case, the instance is fingerprinted as part
+                       -- of the definition of 'n's definition
+    deriving (Data, Typeable)
 
-\begin{pseudocode}
-     class C a        where c :: a
-     class C a => D a where d :: a
+-- | Returns true if 'IsOrphan' is orphan.
+isOrphan :: IsOrphan -> Bool
+isOrphan IsOrphan = True
+isOrphan _ = False
 
-     instance C Int where c = 17
-     instance D Int where d = 13
+-- | Returns true if 'IsOrphan' is not an orphan.
+notOrphan :: IsOrphan -> Bool
+notOrphan NotOrphan{} = True
+notOrphan _ = False
 
-     instance C a => C [a] where c = [c]
-     instance ({- C [a], -} D a) => D [a] where d = c
+instance Binary IsOrphan where
+    put_ bh IsOrphan = putByte bh 0
+    put_ bh (NotOrphan n) = do
+        putByte bh 1
+        put_ bh n
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> return IsOrphan
+            _ -> do
+                n <- get bh
+                return $ NotOrphan n
 
-     instance C [Int] where c = [37]
+{-
+Note [Orphans]
+~~~~~~~~~~~~~~
+Class instances, rules, and family instances are divided into orphans
+and non-orphans.  Roughly speaking, an instance/rule is an orphan if
+its left hand side mentions nothing defined in this module.  Orphan-hood
+has two major consequences
 
-     main = print (d :: [Int])
-\end{pseudocode}
+ * A module that contains orphans is called an "orphan module".  If
+   the module being compiled depends (transitively) on an oprhan
+   module M, then M.hi is read in regardless of whether M is oherwise
+   needed. This is to ensure that we don't miss any instance decls in
+   M.  But it's painful, because it means we need to keep track of all
+   the orphan modules below us.
 
-What do you think `main' prints  (assuming we have overlapping instances, and
-all that turned on)?  Well, the instance for `D' at type `[a]' is defined to
-be `c' at the same type, and we've got an instance of `C' at `[Int]', so the
-answer is `[37]', right? (the generic `C [a]' instance shouldn't apply because
-the `C [Int]' instance is more specific).
+ * A non-orphan is not finger-printed separately.  Instead, for
+   fingerprinting purposes it is treated as part of the entity it
+   mentions on the LHS.  For example
+      data T = T1 | T2
+      instance Eq T where ....
+   The instance (Eq T) is incorprated as part of T's fingerprint.
 
-Ghc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong.  That
-was easy ;-)  Let's just consult hugs for good measure.  Wait - if I use old
-hugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it
-doesn't even compile!  What's going on!?
+   In constrast, orphans are all fingerprinted together in the
+   mi_orph_hash field of the ModIface.
 
-What hugs complains about is the `D [a]' instance decl.
+   See MkIface.addFingerprints.
 
-\begin{pseudocode}
-     ERROR "mj.hs" (line 10): Cannot build superclass instance
-     *** Instance            : D [a]
-     *** Context supplied    : D a
-     *** Required superclass : C [a]
-\end{pseudocode}
+Orphan-hood is computed
+  * For class instances:
+      when we make a ClsInst
+    (because it is needed during instance lookup)
 
-You might wonder what hugs is complaining about.  It's saying that you
-need to add `C [a]' to the context of the `D [a]' instance (as appears
-in comments).  But there's that `C [a]' instance decl one line above
-that says that I can reduce the need for a `C [a]' instance to the
-need for a `C a' instance, and in this case, I already have the
-necessary `C a' instance (since we have `D a' explicitly in the
-context, and `C' is a superclass of `D').
+  * For rules and family instances:
+       when we generate an IfaceRule (MkIface.coreRuleToIfaceRule)
+                     or IfaceFamInst (MkIface.instanceToIfaceInst)
 
-Unfortunately, the above reasoning indicates a premature commitment to the
-generic `C [a]' instance.  I.e., it prematurely rules out the more specific
-instance `C [Int]'.  This is the mistake that ghc-4.06 makes.  The fix is to
-add the context that hugs suggests (uncomment the `C [a]'), effectively
-deferring the decision about which instance to use.
+Note [When exactly is an instance decl an orphan?]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  (see MkIface.instanceToIfaceInst, which implements this)
+Roughly speaking, an instance is an orphan if its head (after the =>)
+mentions nothing defined in this module.
 
-Now, interestingly enough, 4.04 has this same bug, but it's covered up
-in this case by a little known `optimization' that was disabled in
-4.06.  Ghc-4.04 silently inserts any missing superclass context into
-an instance declaration.  In this case, it silently inserts the `C
-[a]', and everything happens to work out.
+Functional dependencies complicate the situation though. Consider
 
-(See `basicTypes/MkId:mkDictFunId' for the code in question.  Search for
-`Mark Jones', although Mark claims no credit for the `optimization' in
-question, and would rather it stopped being called the `Mark Jones
-optimization' ;-)
+  module M where { class C a b | a -> b }
 
-So, what's the fix?  I think hugs has it right.  Here's why.  Let's try
-something else out with ghc-4.04.  Let's add the following line:
+and suppose we are compiling module X:
 
-    d' :: D a => [a]
-    d' = c
+  module X where
+        import M
+        data T = ...
+        instance C Int T where ...
 
-Everyone raise their hand who thinks that `d :: [Int]' should give a
-different answer from `d' :: [Int]'.  Well, in ghc-4.04, it does.  The
-`optimization' only applies to instance decls, not to regular
-bindings, giving inconsistent behavior.
+This instance is an orphan, because when compiling a third module Y we
+might get a constraint (C Int v), and we'd want to improve v to T.  So
+we must make sure X's instances are loaded, even if we do not directly
+use anything from X.
 
-Old hugs had this same bug.  Here's how we fixed it: like GHC, the
-list of instances for a given class is ordered, so that more specific
-instances come before more generic ones.  For example, the instance
-list for C might contain:
-    ..., C Int, ..., C a, ...
-When we go to look for a `C Int' instance we'll get that one first.
-But what if we go looking for a `C b' (`b' is unconstrained)?  We'll
-pass the `C Int' instance, and keep going.  But if `b' is
-unconstrained, then we don't know yet if the more specific instance
-will eventually apply.  GHC keeps going, and matches on the generic `C
-a'.  The fix is to, at each step, check to see if there's a reverse
-match, and if so, abort the search.  This prevents hugs from
-prematurely chosing a generic instance when a more specific one
-exists.
+More precisely, an instance is an orphan iff
 
---Jeff
+  If there are no fundeps, then at least of the names in
+  the instance head is locally defined.
 
-BUT NOTE [Nov 2001]: we must actually *unify* not reverse-match in
-this test.  Suppose the instance envt had
-    ..., forall a b. C a a b, ..., forall a b c. C a b c, ...
-(still most specific first)
-Now suppose we are looking for (C x y Int), where x and y are unconstrained.
-        C x y Int  doesn't match the template {a,b} C a a b
-but neither does
-        C a a b  match the template {x,y} C x y Int
-But still x and y might subsequently be unified so they *do* match.
+  If there are fundeps, then for every fundep, at least one of the
+  names free in a *non-determined* part of the instance head is
+  defined in this module.
 
-Simple story: unify, don't match.
+(Note that these conditions hold trivially if the class is locally
+defined.)
 
 
 ************************************************************************
@@ -462,11 +421,18 @@ type InstEnv = UniqFM ClsInstEnv        -- Maps Class to instances for that clas
 -- transitively reachable orphan modules (according to what modules have been
 -- directly imported) used to test orphan instance visibility.
 data InstEnvs = InstEnvs {
-        ie_global  :: InstEnv,
-        ie_local   :: InstEnv,
-        ie_visible :: VisibleOrphanModules
+        ie_global  :: InstEnv,               -- External-package instances
+        ie_local   :: InstEnv,               -- Home-package instances
+        ie_visible :: VisibleOrphanModules   -- Set of all orphan modules transitively
+                                             -- reachable from the module being compiled
+                                             -- See Note [Instance lookup and orphan instances]
     }
 
+-- | Set of visible orphan modules, according to what modules have been directly
+-- imported.  This is based off of the dep_orphs field, which records
+-- transitively reachable orphan modules (modules that define orphan instances).
+type VisibleOrphanModules = ModuleSet
+
 newtype ClsInstEnv
   = ClsIE [ClsInst]    -- The instances for a particular class, in any order
 
@@ -490,22 +456,24 @@ instEnvElts ie = [elt | ClsIE elts <- eltsUFM ie, elt <- elts]
 
 -- | Test if an instance is visible, by checking that its origin module
 -- is in 'VisibleOrphanModules'.
+-- See Note [Instance lookup and orphan instances]
 instIsVisible :: VisibleOrphanModules -> ClsInst -> Bool
 instIsVisible vis_mods ispec
   -- NB: Instances from the interactive package always are visible. We can't
   -- add interactive modules to the set since we keep creating new ones
   -- as a GHCi session progresses.
-  | isInteractiveModule mod = True
+  | isInteractiveModule mod     = True
   | IsOrphan <- is_orphan ispec = mod `elemModuleSet` vis_mods
-  | otherwise = True
-  where mod = nameModule (idName (is_dfun ispec))
+  | otherwise                   = True
+  where
+    mod = nameModule (idName (is_dfun ispec))
 
 classInstances :: InstEnvs -> Class -> [ClsInst]
-classInstances (InstEnvs pkg_ie home_ie vis_mods) cls
-  = filter (instIsVisible vis_mods) (get home_ie ++ get pkg_ie)
+classInstances (InstEnvs { ie_global = pkg_ie, ie_local = home_ie, ie_visible = vis_mods }) cls
+  = get home_ie ++ get pkg_ie
   where
     get env = case lookupUFM env cls of
-                Just (ClsIE insts) -> insts
+                Just (ClsIE insts) -> filter (instIsVisible vis_mods) insts
                 Nothing            -> []
 
 -- | Collects the names of concrete types and type constructors that make
@@ -562,6 +530,32 @@ identicalInstHead (ClsInst { is_cls_nm = cls_nm1, is_tcs = rough1, is_tvs = tvs1
 the env is kept ordered, the first match must be the only one.  The
 thing we are looking up can have an arbitrary "flexi" part.
 
+Note [Instance lookup and orphan instances]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Suppose we are compiling a module M, and we have a zillion packages
+loaded, and we are looking up an instance for C (T W).  If we find a
+match in module 'X' from package 'p', should be "in scope"; that is,
+
+  is p:X in the transitive closure of modules imported from M?
+
+The difficulty is that the "zillion packages" might include ones loaded
+through earlier invocations of the GHC API, or earlier module loads in GHCi.
+They might not be in the dependencies of M itself; and if not, the instances
+in them should not be visible.  Trac #2182, #8427.
+
+There are two cases:
+  * If the instance is *not an orphan*, then module X defines C, T, or W.
+    And in order for those types to be involved in typechecking M, it
+    must be that X is in the transitive closure of M's imports.  So we
+    can use the instance.
+
+  * If the instance *is an orphan*, the above reasoning does not apply.
+    So we keep track of the set of orphan modules transitively below M;
+    this is the ie_visible field of InstEnvs, of type VisibleOrphanModules.
+
+    If module p:X is in this set, then we can use the instance, otherwise
+    we can't.
+
 Note [Rules for instance lookup]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 These functions implement the carefully-written rules in the user
@@ -608,6 +602,128 @@ of the target constraint (C ty1 .. tyn). The search works like this.
 
  * If only one candidate remains, pick it. Otherwise if all remaining
    candidates are incoherent, pick an arbitrary candidate. Otherwise fail.
+
+Note [Overlapping instances]   (NB: these notes are quite old)
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Overlap is permitted, but only in such a way that one can make
+a unique choice when looking up.  That is, overlap is only permitted if
+one template matches the other, or vice versa.  So this is ok:
+
+  [a]  [Int]
+
+but this is not
+
+  (Int,a)  (b,Int)
+
+If overlap is permitted, the list is kept most specific first, so that
+the first lookup is the right choice.
+
+
+For now we just use association lists.
+
+\subsection{Avoiding a problem with overlapping}
+
+Consider this little program:
+
+\begin{pseudocode}
+     class C a        where c :: a
+     class C a => D a where d :: a
+
+     instance C Int where c = 17
+     instance D Int where d = 13
+
+     instance C a => C [a] where c = [c]
+     instance ({- C [a], -} D a) => D [a] where d = c
+
+     instance C [Int] where c = [37]
+
+     main = print (d :: [Int])
+\end{pseudocode}
+
+What do you think `main' prints  (assuming we have overlapping instances, and
+all that turned on)?  Well, the instance for `D' at type `[a]' is defined to
+be `c' at the same type, and we've got an instance of `C' at `[Int]', so the
+answer is `[37]', right? (the generic `C [a]' instance shouldn't apply because
+the `C [Int]' instance is more specific).
+
+Ghc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong.  That
+was easy ;-)  Let's just consult hugs for good measure.  Wait - if I use old
+hugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it
+doesn't even compile!  What's going on!?
+
+What hugs complains about is the `D [a]' instance decl.
+
+\begin{pseudocode}
+     ERROR "mj.hs" (line 10): Cannot build superclass instance
+     *** Instance            : D [a]
+     *** Context supplied    : D a
+     *** Required superclass : C [a]
+\end{pseudocode}
+
+You might wonder what hugs is complaining about.  It's saying that you
+need to add `C [a]' to the context of the `D [a]' instance (as appears
+in comments).  But there's that `C [a]' instance decl one line above
+that says that I can reduce the need for a `C [a]' instance to the
+need for a `C a' instance, and in this case, I already have the
+necessary `C a' instance (since we have `D a' explicitly in the
+context, and `C' is a superclass of `D').
+
+Unfortunately, the above reasoning indicates a premature commitment to the
+generic `C [a]' instance.  I.e., it prematurely rules out the more specific
+instance `C [Int]'.  This is the mistake that ghc-4.06 makes.  The fix is to
+add the context that hugs suggests (uncomment the `C [a]'), effectively
+deferring the decision about which instance to use.
+
+Now, interestingly enough, 4.04 has this same bug, but it's covered up
+in this case by a little known `optimization' that was disabled in
+4.06.  Ghc-4.04 silently inserts any missing superclass context into
+an instance declaration.  In this case, it silently inserts the `C
+[a]', and everything happens to work out.
+
+(See `basicTypes/MkId:mkDictFunId' for the code in question.  Search for
+`Mark Jones', although Mark claims no credit for the `optimization' in
+question, and would rather it stopped being called the `Mark Jones
+optimization' ;-)
+
+So, what's the fix?  I think hugs has it right.  Here's why.  Let's try
+something else out with ghc-4.04.  Let's add the following line:
+
+    d' :: D a => [a]
+    d' = c
+
+Everyone raise their hand who thinks that `d :: [Int]' should give a
+different answer from `d' :: [Int]'.  Well, in ghc-4.04, it does.  The
+`optimization' only applies to instance decls, not to regular
+bindings, giving inconsistent behavior.
+
+Old hugs had this same bug.  Here's how we fixed it: like GHC, the
+list of instances for a given class is ordered, so that more specific
+instances come before more generic ones.  For example, the instance
+list for C might contain:
+    ..., C Int, ..., C a, ...
+When we go to look for a `C Int' instance we'll get that one first.
+But what if we go looking for a `C b' (`b' is unconstrained)?  We'll
+pass the `C Int' instance, and keep going.  But if `b' is
+unconstrained, then we don't know yet if the more specific instance
+will eventually apply.  GHC keeps going, and matches on the generic `C
+a'.  The fix is to, at each step, check to see if there's a reverse
+match, and if so, abort the search.  This prevents hugs from
+prematurely chosing a generic instance when a more specific one
+exists.
+
+--Jeff
+v
+BUT NOTE [Nov 2001]: we must actually *unify* not reverse-match in
+this test.  Suppose the instance envt had
+    ..., forall a b. C a a b, ..., forall a b c. C a b c, ...
+(still most specific first)
+Now suppose we are looking for (C x y Int), where x and y are unconstrained.
+        C x y Int  doesn't match the template {a,b} C a a b
+but neither does
+        C a a b  match the template {x,y} C x y Int
+But still x and y might subsequently be unified so they *do* match.
+
+Simple story: unify, don't match.
 -}
 
 type DFunInstType = Maybe Type
@@ -686,7 +802,8 @@ lookupInstEnv' ie vis_mods cls tys
     find ms us (item@(ClsInst { is_tcs = mb_tcs, is_tvs = tpl_tvs
                               , is_tys = tpl_tys, is_flag = oflag }) : rest)
       | not (instIsVisible vis_mods item)
-      = find ms us rest
+      = find ms us rest  -- See Note [Instance lookup and orphan instances]
+
         -- Fast check for no match, uses the "rough match" fields
       | instanceCantMatch rough_tcs mb_tcs
       = find ms us rest
@@ -726,7 +843,7 @@ lookupInstEnv :: InstEnvs     -- External and home package inst-env
               -> Class -> [Type]   -- What we are looking for
               -> ClsInstLookupResult
 -- ^ See Note [Rules for instance lookup]
-lookupInstEnv (InstEnvs pkg_ie home_ie vis_mods) cls tys
+lookupInstEnv (InstEnvs { ie_global = pkg_ie, ie_local = home_ie, ie_visible = vis_mods }) cls tys
   = (final_matches, final_unifs, safe_fail)
   where
     (home_matches, home_unifs) = lookupInstEnv' home_ie vis_mods cls tys