X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FInstEnv.lhs;h=9cb68c80e5dcb19535db16072095dc8b4dfe61aa;hb=13cd965d80be5c25dc54534a833df39ab7aa7a12;hp=7d131d41b4672249a5b9088c688370f7e0e48693;hpb=899fd7fb59cedf25b3939f951016f0c8b5d1541a;p=ghc-hetmet.git

diff --git a/compiler/types/InstEnv.lhs b/compiler/types/InstEnv.lhs
index 7d131d4..9cb68c8 100644
--- 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,11 +50,11 @@ 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 
@@ -66,13 +63,12 @@ data Instance
 	     , 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
@@ -89,7 +85,7 @@ 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 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.)
 
 
-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
@@ -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,
-		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)