X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcSMonad.lhs;h=0920a8be8b406fb987c6d27488a82f2db61cd56f;hb=ef6d82a4e1d4ba4884c322be85cff291e017f0e6;hp=85b5847b9ddbeb5508f088d436ba8ecfbd48bf3d;hpb=5723262f616ac02ddf637f6ff480a599c737ea0d;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs
index 85b5847..0920a8b 100644
--- a/compiler/typecheck/TcSMonad.lhs
+++ b/compiler/typecheck/TcSMonad.lhs
@@ -87,14 +87,11 @@ import InstEnv
 import FamInst 
 import FamInstEnv
 
-import NameSet ( addOneToNameSet ) 
-
 import qualified TcRnMonad as TcM
 import qualified TcMType as TcM
 import qualified TcEnv as TcM 
        ( checkWellStaged, topIdLvl, tcLookupFamInst, tcGetDefaultTys )
 import TcType
-import Module 
 import DynFlags
 
 import Coercion
@@ -184,8 +181,9 @@ data CanonicalCt
 compatKind :: Kind -> Kind -> Bool 
 compatKind k1 k2 = k1 `isSubKind` k2 || k2 `isSubKind` k1 
 
-makeGivens :: CanonicalCts -> CanonicalCts
-makeGivens = mapBag (\ct -> ct { cc_flavor = mkGivenFlavor (cc_flavor ct) UnkSkol })
+makeGivens :: Bag WantedEvVar -> Bag (CtFlavor,EvVar) 
+makeGivens = mapBag (\(WantedEvVar ev wloc) -> (mkGivenFlavor (Wanted wloc) UnkSkol, ev))
+-- ct { cc_flavor = mkGivenFlavor (cc_flavor ct) UnkSkol })
 	   -- The UnkSkol doesn't matter because these givens are
 	   -- not contradictory (else we'd have rejected them already)
 
@@ -952,8 +950,7 @@ matchClass clas tys
 				          text "witness" <+> ppr dfun_id
 					   <+> ppr (idType dfun_id) ])
 				  -- Record that this dfun is needed
-			; record_dfun_usage dfun_id
-			; return $ MatchInstSingle (dfun_id, inst_tys) 
+                        ; return $ MatchInstSingle (dfun_id, inst_tys)
                         } ;
      	    (matches, unifs)          -- More than one matches 
 		-> do	{ traceTcS "matchClass multiple matches, deferring choice"
@@ -964,26 +961,8 @@ matchClass clas tys
 		        }
 	}
         }
-  where record_dfun_usage :: Id -> TcS () 
-        record_dfun_usage dfun_id 
-          = do { hsc_env <- getTopEnv 
-               ; let  dfun_name = idName dfun_id
-        	      dfun_mod  = ASSERT( isExternalName dfun_name ) 
-        	         	  nameModule dfun_name
-               ; if isInternalName dfun_name ||    -- Internal name => defined in this module
-        	    modulePackageId dfun_mod /= thisPackage (hsc_dflags hsc_env)
-        	 then return () -- internal, or in another package
-        	 else do updInstUses dfun_id 
-               }
-
-        updInstUses :: Id -> TcS () 
-        updInstUses dfun_id 
-            = do { tcg_env <- getGblEnv 
-                 ; wrapTcS $ TcM.updMutVar (tcg_inst_uses tcg_env) 
-                                            (`addOneToNameSet` idName dfun_id) 
-                 }
-
-matchFam :: TyCon 
+
+matchFam :: TyCon
          -> [Type] 
          -> TcS (MatchInstResult (TyCon, [Type]))
 matchFam tycon args