[project @ 1998-05-13 09:32:34 by simonpj]
[ghc-hetmet.git] / ghc / compiler / typecheck / TcIfaceSig.lhs
index 4f0d6ee..000386f 100644 (file)
@@ -11,13 +11,14 @@ module TcIfaceSig ( tcInterfaceSigs ) where
 import HsSyn           ( HsDecl(..), IfaceSig(..) )
 import TcMonad
 import TcMonoType      ( tcHsType, tcHsTypeKind, tcTyVarScope )
-import TcEnv           ( tcExtendTyVarEnv, tcExtendGlobalValEnv,
+import TcEnv           ( tcExtendTyVarEnv, tcExtendGlobalValEnv, tcSetGlobalValEnv,
                          tcLookupTyConByKey, tcLookupGlobalValueMaybe,
-                         tcExplicitLookupGlobal
+                         tcExplicitLookupGlobal,
+                         GlobalValueEnv
                        )
 import TcKind          ( TcKind, kindToTcKind )
 
-import RnHsSyn         ( RenamedHsDecl(..) )
+import RnHsSyn         ( RenamedHsDecl )
 import HsCore
 import HsDecls         ( HsIdInfo(..), HsStrictnessInfo(..) )
 import Literal         ( Literal(..) )
@@ -52,7 +53,7 @@ As always, we do not have to worry about user-pragmas in interface
 signatures.
 
 \begin{code}
-tcInterfaceSigs :: TcEnv s             -- Envt to use when checking unfoldings
+tcInterfaceSigs :: GlobalValueEnv      -- Envt to use when checking unfoldings
                -> [RenamedHsDecl]      -- Ignore non-sig-decls in these decls
                -> TcM s [Id]
                
@@ -100,8 +101,12 @@ tcIdInfo unf_env name ty info info_ins
        = tcStrictness unf_env ty info strict
 
     tcPrag info (HsSpecialise tyvars tys rhs)
-       = tcTyVarScope tyvars           $ \ tyvars' ->
-         mapTc tcHsType tys            `thenTc` \ tys' -> 
+       = tcTyVarScope tyvars                   $ \ tyvars' ->
+         mapAndUnzipTc tcHsTypeKind tys        `thenTc` \ (kinds, tys') -> 
+               -- Assume that the kinds match the kinds of the 
+               -- type variables of the function; this is, after all, an
+               -- interface file generated by the compiler!
+
          tcPragExpr unf_env name rhs   `thenNF_Tc` \ maybe_rhs' ->
          let
                -- If spec_env isn't looked at, none of this 
@@ -159,7 +164,7 @@ an unfolding that isn't going to be looked at.
 tcPragExpr unf_env name core_expr
   = forkNF_Tc (
        recoverNF_Tc no_unfolding (
-               tcSetEnv unf_env $
+               tcSetGlobalValEnv unf_env $
                tcCoreExpr core_expr    `thenTc` \ core_expr' ->
                returnTc (Just core_expr')
     ))