[project @ 2000-10-16 16:34:33 by sewardj]
[ghc-hetmet.git] / ghc / compiler / typecheck / TcImprove.lhs
index 9093ccb..8a66a7d 100644 (file)
@@ -4,25 +4,22 @@ module TcImprove ( tcImprove ) where
 #include "HsVersions.h"
 
 import Name            ( Name )
-import Class           ( Class, FunDep, className, classExtraBigSig )
-import Unify           ( unifyTyListsX, matchTys )
+import Class           ( Class, FunDep, className )
+import Unify           ( unifyTyListsX )
 import Subst           ( mkSubst, emptyInScopeSet, substTy )
-import TcEnv           ( tcGetInstEnv, classInstEnv )
+import TcEnv           ( tcGetInstEnv )
+import TcInstUtil      ( classInstEnv )
 import TcMonad
-import TcType          ( TcType, TcTyVar, TcTyVarSet, zonkTcType, zonkTcTypes )
+import TcType          ( TcType, TcTyVarSet, zonkTcType )
 import TcUnify         ( unifyTauTyLists )
-import Inst            ( LIE, Inst, LookupInstResult(..),
-                         lookupInst, getFunDepsOfLIE, getIPsOfLIE,
-                         zonkLIE, zonkFunDeps {- for debugging -} )
+import Inst            ( LIE, getFunDepsOfLIE, getIPsOfLIE )
 import VarSet          ( VarSet, emptyVarSet, unionVarSet )
-import VarEnv          ( emptyVarEnv )
 import FunDeps         ( instantiateFdClassTys )
-import Outputable
-import List            ( elemIndex, nub )
+import List            ( nub )
 \end{code}
 
 \begin{code}
-tcImprove :: LIE -> TcM s ()
+tcImprove :: LIE -> TcM ()
 -- Do unifications based on functional dependencies in the LIE
 tcImprove lie 
   = tcGetInstEnv       `thenNF_Tc` \ inst_env ->
@@ -61,7 +58,7 @@ tcImprove lie
     iterImprove nfdss
 
 
-iterImprove :: [(VarSet, Name, [FunDep TcType])] -> TcM s ()
+iterImprove :: [(VarSet, Name, [FunDep TcType])] -> TcM ()
 iterImprove [] = returnTc ()
 iterImprove cfdss
   = selfImprove pairImprove cfdss      `thenTc` \ change2 ->
@@ -125,15 +122,6 @@ zonkEqTys ts1 ts2
     mapTc zonkTcType ts2 `thenTc` \ ts2' ->
     returnTc (ts1' == ts2')
 
-zonkMatchTys ts1 free ts2
-  = mapTc zonkTcType ts1 `thenTc` \ ts1' ->
-    mapTc zonkTcType ts2 `thenTc` \ ts2' ->
-    -- pprTrace "zMT" (ppr (ts1', free, ts2')) $
-    case matchTys free ts2' ts1' of
-      Just (subst, []) -> -- pprTrace "zMT match!" empty $
-                         returnTc (Just subst)
-      Nothing -> returnTc Nothing
-
 zonkUnifyTys free ts1 ts2
   = mapTc zonkTcType ts1 `thenTc` \ ts1' ->
     mapTc zonkTcType ts2 `thenTc` \ ts2' ->