[project @ 2005-04-29 23:37:10 by simonpj]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcEnv.lhs

diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs
index e825223..8657a85 100644 (file)
--- a/ghc/compiler/typecheck/TcEnv.lhs
+++ b/ghc/compiler/typecheck/TcEnv.lhs
@@ -16,7 +16,7 @@ module TcEnv(
        tcLookupLocatedClass, 
        
        -- Local environment
-       tcExtendKindEnv,
+       tcExtendKindEnv, tcExtendKindEnvTvs,
        tcExtendTyVarEnv, tcExtendTyVarEnv2, 
        tcExtendIdEnv, tcExtendIdEnv1, tcExtendIdEnv2, 
        tcLookup, tcLookupLocated, tcLookupLocalIds,
@@ -42,7 +42,8 @@ module TcEnv(
 
 #include "HsVersions.h"
 
-import HsSyn           ( LRuleDecl, LHsBinds, LSig, pprLHsBinds )
+import HsSyn           ( LRuleDecl, LHsBinds, LSig, 
+                         LHsTyVarBndr, HsTyVarBndr(..), pprLHsBinds )
 import TcIface         ( tcImportDecl )
 import IfaceEnv                ( newGlobalBinder )
 import TcRnTypes       ( pprTcTyThingCategory )
@@ -243,6 +244,14 @@ tcExtendKindEnv things thing_inside
     upd lcl_env = lcl_env { tcl_env = extend (tcl_env lcl_env) }
     extend env  = extendNameEnvList env [(n, AThing k) | (n,k) <- things]
 
+tcExtendKindEnvTvs :: [LHsTyVarBndr Name] -> TcM r -> TcM r
+tcExtendKindEnvTvs bndrs thing_inside
+  = updLclEnv upd thing_inside
+  where
+    upd lcl_env = lcl_env { tcl_env = extend (tcl_env lcl_env) }
+    extend env  = extendNameEnvList env pairs
+    pairs       = [(n, AThing k) | L _ (KindedTyVar n k) <- bndrs]
+
 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
 tcExtendTyVarEnv tvs thing_inside
   = tcExtendTyVarEnv2 [(tyVarName tv, mkTyVarTy tv) | tv <- tvs] thing_inside