[project @ 1999-12-06 22:52:26 by lewie]

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

diff --git a/ghc/compiler/typecheck/TcType.lhs b/ghc/compiler/typecheck/TcType.lhs
index 72d4eb7..4f33951 100644 (file)
--- a/ghc/compiler/typecheck/TcType.lhs
+++ b/ghc/compiler/typecheck/TcType.lhs
@@ -52,11 +52,13 @@ 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, 
-                         typeCon, openTypeKind, boxedTypeKind, boxedKind, superKind, superBoxity
                        )
 import Subst           ( Subst, mkTopTyVarSubst, substTy )
 import TyCon           ( tyConKind, mkPrimTyCon )
@@ -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')