[project @ 2004-01-05 12:11:42 by simonpj]

[ghc-hetmet.git] / ghc / compiler / iface / TcIface.lhs

diff --git a/ghc/compiler/iface/TcIface.lhs b/ghc/compiler/iface/TcIface.lhs
index 071948b..1d2d941 100644 (file)
--- a/ghc/compiler/iface/TcIface.lhs
+++ b/ghc/compiler/iface/TcIface.lhs
@@ -6,7 +6,7 @@
 \begin{code}
 module TcIface ( 
        tcImportDecl, typecheckIface,
-       tcIfaceKind, loadImportedInsts, loadImportedRules,
+       loadImportedInsts, loadImportedRules,
        tcExtCoreBindings
  ) where
 #include "HsVersions.h"
@@ -20,8 +20,7 @@ import IfaceEnv               ( lookupIfaceTop, newGlobalBinder, lookupOrig,
                          newIfaceName, newIfaceNames )
 import BuildTyCl       ( buildSynTyCon, buildAlgTyCon, buildDataCon, buildClass )
 import TcRnMonad
-import Type            ( Kind, openTypeKind, liftedTypeKind, 
-                         unliftedTypeKind, mkArrowKind, splitTyConApp, 
+import Type            ( liftedTypeKind, splitTyConApp, 
                          mkTyVarTys, mkGenTyConApp, mkTyVarTys, ThetaType, pprClassPred )
 import TypeRep         ( Type(..), PredType(..) )
 import TyCon           ( TyCon, tyConName )
@@ -29,7 +28,7 @@ import HscTypes               ( ExternalPackageState(..), PackageInstEnv, PackageRuleBase,
                          HscEnv, TyThing(..), implicitTyThings, typeEnvIds,
                          ModIface(..), ModDetails(..), InstPool, ModGuts,
                          TypeEnv, mkTypeEnv, extendTypeEnvList, lookupTypeEnv,
-                         DeclPool, RulePool, Pool(..), Gated, addRuleToPool )
+                         RulePool, Pool(..) )
 import InstEnv         ( extendInstEnv )
 import CoreSyn
 import PprCore         ( pprIdRules )
@@ -529,8 +528,9 @@ selectInsts pool@(Pool insts n_in n_out) cls tycons
 
        -- Reverses the gated decls, but that doesn't matter
     choose2 (gis, decls) (gates, decl)
-       | any (`elem` tycons) gates = (gis,                decl:decls)
-       | otherwise                 = ((gates,decl) : gis, decls)
+       |  null gates   -- Happens when we have 'instance T a where ...'
+        || any (`elem` tycons) gates = (gis,              decl:decls)
+       | otherwise                  = ((gates,decl) : gis, decls)
 \end{code}
 
 %************************************************************************
@@ -586,7 +586,7 @@ selectRules (Pool rules n_in n_out) type_env
        | null gates' = (pool, rule:if_rules)
        | otherwise   = ((gates',rule) : pool, if_rules)
        where
-         gates' = filter (`elemNameEnv` type_env) gates
+         gates' = filter (not . (`elemNameEnv` type_env)) gates
 
 
 tcIfaceRule :: IfaceRule -> IfL IdCoreRule
@@ -611,13 +611,6 @@ tcIfaceRule (IfaceBuiltinRule fn_rdr core_rule)
 %************************************************************************
 
 \begin{code}
-tcIfaceKind :: IfaceKind -> Kind
-tcIfaceKind IfaceOpenTypeKind     = openTypeKind
-tcIfaceKind IfaceLiftedTypeKind   = liftedTypeKind
-tcIfaceKind IfaceUnliftedTypeKind = unliftedTypeKind
-tcIfaceKind (IfaceFunKind k1 k2)  = mkArrowKind (tcIfaceKind k1) (tcIfaceKind k2)
-
------------------------------------------
 tcIfaceType :: IfaceType -> IfL Type
 tcIfaceType (IfaceTyVar n)        = do { tv <- tcIfaceTyVar n; return (TyVarTy tv) }
 tcIfaceType (IfaceAppTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (AppTy t1' t2') }
@@ -968,5 +961,5 @@ bindIfaceTyVars bndrs thing_inside
   where
     (occs,kinds) = unzip bndrs
 
-mk_iface_tyvar name kind = mkTyVar name (tcIfaceKind kind)
+mk_iface_tyvar name kind = mkTyVar name kind
 \end{code}