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 7d131d4..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 Var
 import VarSet
 import Name

-import OccName
-import NameSet
-import Type

 import TcType
 import TyCon
 import TcGadt
 import TcType
 import TyCon
 import TcGadt

@@ -53,11 +50,11 @@ type DFunId = Id
 data Instance 
   = Instance { is_cls  :: Name         -- Class name
        
 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
 
                -- 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 
             , is_tvs  :: TyVarSet      -- Template tyvars for full match
             , is_tys  :: [Type]        -- Full arg types
                -- INVARIANT: is_dfun Id has type 

@@ -66,13 +63,12 @@ data Instance
             , is_dfun :: DFunId
             , is_flag :: OverlapFlag   -- See detailed comments with
                                        -- the decl of BasicTypes.OverlapFlag
             , is_dfun :: DFunId
             , is_flag :: OverlapFlag   -- See detailed comments with
                                        -- the decl of BasicTypes.OverlapFlag

-
-            , is_orph :: Maybe OccName }
+    }

 \end{code}
 
 \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
 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

@@ -89,7 +85,7 @@ In is_tcs,
                different real tycons can't.)
                NB: newtypes are not transparent, though!
 
                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 cached values, pulled
 out (lazily) from the dfun id. They are cached here simply so 
 ~~~~~~~~~~~~~~~~~~~~~~~~~
 The is_tvs, is_tys fields are simply cached values, pulled
 out (lazily) from the dfun id. They are cached here simply so 

@@ -105,31 +101,6 @@ However, note that:
     instantiate the dfun's context.)
 
 
     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
 
 \begin{code}
 instanceDFunId :: Instance -> DFunId

@@ -186,26 +157,18 @@ mkLocalInstance :: DFunId -> OverlapFlag -> Instance
 mkLocalInstance dfun oflag
   = Instance { is_flag = oflag, is_dfun = dfun,
                is_tvs = mkVarSet tvs, is_tys = tys,
 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)
   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
                   -> 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,
   = 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)
 
   where
     (tvs, _, _, tys) = tcSplitDFunTy (idType dfun)