Deal more correctly with orphan instances

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

diff --git a/compiler/types/InstEnv.lhs b/compiler/types/InstEnv.lhs
index b8e10d5..9cb68c8 100644 (file)
--- a/compiler/types/InstEnv.lhs
+++ b/compiler/types/InstEnv.lhs
@@ -25,9 +25,6 @@ import Class
 import Var
 import VarSet
 import Name
-import OccName
-import NameSet
-import Type
 import TcType
 import TyCon
 import TcGadt
@@ -53,23 +50,25 @@ type DFunId = Id
 data Instance 
   = Instance { is_cls  :: Name         -- Class name
        
-               -- Used for "rough matching"; see note below
+               -- Used for "rough matching"; see Note [Rough-match field]
+               -- INVARIANT: is_tcs = roughMatchTcs is_tys
             , is_tcs  :: [Maybe Name]  -- Top of type args
 
-               -- Used for "proper matching"; see note
+               -- Used for "proper matching"; see Note [Proper-match fields]
             , is_tvs  :: TyVarSet      -- Template tyvars for full match
             , is_tys  :: [Type]        -- Full arg types
+               -- INVARIANT: is_dfun Id has type 
+               --      forall is_tvs. (...) => is_cls is_tys
 
             , is_dfun :: DFunId
             , is_flag :: OverlapFlag   -- See detailed comments with
                                        -- the decl of BasicTypes.OverlapFlag
-
-            , is_orph :: Maybe OccName }
+    }
 \end{code}
 
-The "rough-match" fields
-~~~~~~~~~~~~~~~~~~~~~~~~~
-The is_cls, is_args fields allow a "rough match" to be done
+Note [Rough-match field]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The is_cls, is_tcs fields allow a "rough match" to be done
 without poking inside the DFunId.  Poking the DFunId forces
 us to suck in all the type constructors etc it involves,
 which is a total waste of time if it has no chance of matching
@@ -86,9 +85,9 @@ In is_tcs,
                different real tycons can't.)
                NB: newtypes are not transparent, though!
 
-The "proper-match" fields
+Note [Proper-match fields]
 ~~~~~~~~~~~~~~~~~~~~~~~~~
-The is_tvs, is_tys fields are simply cahced values, pulled
+The is_tvs, is_tys fields are simply cached values, pulled
 out (lazily) from the dfun id. They are cached here simply so 
 that we don't need to decompose the DFunId each time we want 
 to match it.  The hope is that the fast-match fields mean
@@ -102,31 +101,6 @@ However, note that:
     instantiate the dfun's context.)
 
 
-Note [Orphans]: the "is_orph" field
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-An instance is an orphan if its head (after the =>) mentions
-nothing defined in this module.  
-
-   Just n      The head mentions n, which is defined in this module
-               This is used for versioning; the instance decl is
-               considered part of the defn of n when computing versions
-
-   Nothing     The head mentions nothing defined in this module
-
-If a module contains any orphans, then its interface file is read 
-regardless, so that its instances are not missed. 
-
-Functional dependencies worsen the situation a bit. Consider
-       class C a b | a -> b
-In some other module we might have
-   module M where
-       data T = ...
-       instance C Int T where ...
-This isn't considered an orphan, so we will only read M's interface
-if something from M is used (e.g. T).  So there's a risk we'll
-miss the improvement from the instance.  Workaround: import M.
-
-Rules are orphans and versioned in much the same way.
 
 \begin{code}
 instanceDFunId :: Instance -> DFunId
@@ -183,26 +157,18 @@ mkLocalInstance :: DFunId -> OverlapFlag -> Instance
 mkLocalInstance dfun oflag
   = Instance { is_flag = oflag, is_dfun = dfun,
                is_tvs = mkVarSet tvs, is_tys = tys,
-               is_cls = cls_name, is_tcs = roughMatchTcs tys,
-               is_orph = orph }
+               is_cls = className cls, is_tcs = roughMatchTcs tys }
   where
     (tvs, _, cls, tys) = tcSplitDFunTy (idType dfun)
-    mod = nameModule (idName dfun)
-    cls_name = getName cls
-    tycl_names = foldr (unionNameSets . tyClsNamesOfType) 
-                      (unitNameSet cls_name) tys
-    orph = case filter (nameIsLocalOrFrom mod) (nameSetToList tycl_names) of
-               []     -> Nothing
-               (n:ns) -> Just (getOccName n)
-
-mkImportedInstance :: Name -> [Maybe Name] -> Maybe OccName
+
+mkImportedInstance :: Name -> [Maybe Name]
                   -> DFunId -> OverlapFlag -> Instance
 -- Used for imported instances, where we get the rough-match stuff
 -- from the interface file
-mkImportedInstance cls mb_tcs orph dfun oflag
+mkImportedInstance cls mb_tcs dfun oflag
   = Instance { is_flag = oflag, is_dfun = dfun,
                is_tvs = mkVarSet tvs, is_tys = tys,
-               is_cls = cls, is_tcs = mb_tcs, is_orph = orph }
+               is_cls = cls, is_tcs = mb_tcs }
   where
     (tvs, _, _, tys) = tcSplitDFunTy (idType dfun)