[project @ 1999-07-27 07:31:16 by simonpj]

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

diff --git a/ghc/compiler/typecheck/TcType.lhs b/ghc/compiler/typecheck/TcType.lhs
index 48d58fe..4f33951 100644 (file)
--- a/ghc/compiler/typecheck/TcType.lhs
+++ b/ghc/compiler/typecheck/TcType.lhs
@@ -52,13 +52,15 @@ module TcType (
 
 -- friends:
 import PprType         ( pprType )
-import Type            ( Type(..), Kind, ThetaType, TyNote(..), 
+import TypeRep         ( Type(..), Kind, TyNote(..), 
+                         typeCon, openTypeKind, boxedTypeKind, boxedKind, superKind, superBoxity
+                       )  -- friend
+import Type            ( ThetaType,
                          mkAppTy, mkTyConApp,
                          splitDictTy_maybe, splitForAllTys, isNotUsgTy,
                          isTyVarTy, mkTyVarTy, mkTyVarTys, 
-                         fullSubstTy, substTopTy, 
-                         typeCon, openTypeKind, boxedTypeKind, boxedKind, superKind, superBoxity
                        )
+import Subst           ( Subst, mkTopTyVarSubst, substTy )
 import TyCon           ( tyConKind, mkPrimTyCon )
 import PrimRep         ( PrimRep(VoidRep) )
 import VarEnv
@@ -170,14 +172,17 @@ Instantiating a bunch of type variables
 
 \begin{code}
 tcInstTyVars :: [TyVar] 
-            -> NF_TcM s ([TcTyVar], [TcType], TyVarEnv TcType)
+            -> NF_TcM s ([TcTyVar], [TcType], Subst)
 
 tcInstTyVars tyvars
   = mapNF_Tc tcInstTyVar tyvars        `thenNF_Tc` \ tc_tyvars ->
     let
        tys = mkTyVarTys tc_tyvars
     in
-    returnNF_Tc (tc_tyvars, tys, zipVarEnv tyvars tys)
+    returnNF_Tc (tc_tyvars, tys, mkTopTyVarSubst tyvars tys)
+               -- Since the tyvars are freshly made,
+               -- they cannot possibly be captured by
+               -- any existing for-alls.  Hence mkTopTyVarSubst
 
 tcInstTyVar tyvar
   = tcGetUnique                `thenNF_Tc` \ uniq ->
@@ -229,10 +234,7 @@ tcInstTcType ty
   = case splitForAllTys ty of
        ([], _)       -> returnNF_Tc ([], ty)   -- Nothing to do
        (tyvars, rho) -> tcInstTyVars tyvars            `thenNF_Tc` \ (tyvars', _, tenv)  ->
-                        returnNF_Tc (tyvars', fullSubstTy tenv emptyVarSet rho)
-                                       -- Since the tyvars are freshly made,
-                                       -- they cannot possibly be captured by
-                                       -- any existing for-alls.  Hence emptyVarSet
+                        returnNF_Tc (tyvars', substTy tenv rho)
 \end{code}
 
 
@@ -310,8 +312,11 @@ zonkTcTyVars tyvars = mapNF_Tc zonkTcTyVar tyvars
 
 zonkTcTyVarBndr :: TcTyVar -> NF_TcM s TcTyVar
 zonkTcTyVarBndr tyvar
-  = zonkTcTyVar tyvar  `thenNF_Tc` \ (TyVarTy tyvar') ->
-    returnNF_Tc tyvar'
+  = zonkTcTyVar tyvar  `thenNF_Tc` \ ty ->
+    case ty of
+       TyVarTy tyvar' -> returnNF_Tc tyvar'
+       _              -> pprTrace "zonkTcTyVarBndr" (ppr tyvar <+> ppr ty) $
+                         returnNF_Tc tyvar
        
 zonkTcTyVar :: TcTyVar -> NF_TcM s TcType
 zonkTcTyVar tyvar = zonkTyVar (\ tv -> returnNF_Tc (TyVarTy tv)) tyvar
@@ -436,6 +441,9 @@ zonkType unbound_var_fn ty
     go (NoteTy (UsgNote usg) ty2) = go ty2             `thenNF_Tc` \ ty2' ->
                                    returnNF_Tc (NoteTy (UsgNote usg) ty2')
 
+    go (NoteTy (UsgForAll uv) ty2)= go ty2             `thenNF_Tc` \ ty2' ->
+                                   returnNF_Tc (NoteTy (UsgForAll uv) ty2')
+
     go (FunTy arg res)           = go arg              `thenNF_Tc` \ arg' ->
                                    go res              `thenNF_Tc` \ res' ->
                                    returnNF_Tc (FunTy arg' res')