Some tyvars were being introduced in the environment via the thunk bindings '_ti...

diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index 28a45ae..52c6030 100644 (file)
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -27,6 +27,7 @@ import NameEnv
 import RdrName
 import UniqSupply
 import Type
 import RdrName
 import UniqSupply
 import Type

+import TcType

 import TyCon
 import TcGadt
 import GHC
 import TyCon
 import TcGadt
 import GHC

@@ -60,7 +61,7 @@ pprintClosureCommand bindThings force str = do
                       (words str)
   substs <- catMaybes `liftM` mapM (io . go cms) 
                                    [id | AnId id <- tythings]
                       (words str)
   substs <- catMaybes `liftM` mapM (io . go cms) 
                                    [id | AnId id <- tythings]

-  mapM (io . applySubstToEnv cms) substs
+  mapM (io . applySubstToEnv cms . skolemSubst) substs

   return ()
  where 
 
   return ()
  where 
 

@@ -92,7 +93,7 @@ pprintClosureCommand bindThings force str = do
       let ictxt    = hsc_IC hsc_env
           type_env = ic_type_env ictxt
           ids      = typeEnvIds type_env
       let ictxt    = hsc_IC hsc_env
           type_env = ic_type_env ictxt
           ids      = typeEnvIds type_env

-          ids'     = map (\id -> setIdType id (substTy subst (idType id))) ids
+          ids'     = map (\id -> id `setIdType` substTy subst (idType id)) ids

           type_env'= extendTypeEnvWithIds type_env ids'
           ictxt'   = ictxt { ic_type_env = type_env' }
       writeIORef ref (hsc_env {hsc_IC = ictxt'})
           type_env'= extendTypeEnvWithIds type_env ids'
           ictxt'   = ictxt { ic_type_env = type_env' }
       writeIORef ref (hsc_env {hsc_IC = ictxt'})

@@ -112,7 +113,7 @@ bindSuspensions cms@(Session ref) t = do
       availNames_var  <- newIORef availNames
       (t', stuff)     <- foldTerm (nameSuspensionsAndGetInfos availNames_var) t
       let (names, tys, hvals) = unzip3 stuff
       availNames_var  <- newIORef availNames
       (t', stuff)     <- foldTerm (nameSuspensionsAndGetInfos availNames_var) t
       let (names, tys, hvals) = unzip3 stuff

-      let ids = [ mkGlobalId VanillaGlobal name ty vanillaIdInfo
+      let ids = [ mkGlobalId VanillaGlobal name (mk_skol_ty ty) vanillaIdInfo

                   | (name,ty) <- zip names tys]
           new_type_env = extendTypeEnvWithIds type_env ids 
           new_rn_env   = extendLocalRdrEnv rn_env names
                   | (name,ty) <- zip names tys]
           new_type_env = extendTypeEnvWithIds type_env ids 
           new_rn_env   = extendLocalRdrEnv rn_env names

@@ -190,3 +191,11 @@ newGrimName cms userName  = do
         occname = mkOccName varName userName
         name    = mkInternalName unique occname noSrcLoc
     return name
         occname = mkOccName varName userName
         name    = mkInternalName unique occname noSrcLoc
     return name

+
+skolemSubst subst = subst `setTvSubstEnv` 
+                      mapVarEnv mk_skol_ty (getTvSubstEnv subst)
+mk_skol_ty ty | tyvars  <- varSetElems (tyVarsOfType ty)
+              , tyvars' <- map (mkTyVarTy . mk_skol_tv) tyvars
+              = substTyWith tyvars tyvars' ty
+mk_skol_tv tv = mkTcTyVar (tyVarName tv) (tyVarKind tv) 
+                      (SkolemTv UnkSkol)

diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index 1b7bb64..55b16d9 100644 (file)
--- a/compiler/typecheck/TcMType.lhs
+++ b/compiler/typecheck/TcMType.lhs
@@ -422,7 +422,7 @@ zonkTcTyVarsAndFV tyvars = mappM zonkTcTyVar tyvars `thenM` \ tys ->
                           returnM (tyVarsOfTypes tys)
 
 zonkTcTyVar :: TcTyVar -> TcM TcType
                           returnM (tyVarsOfTypes tys)
 
 zonkTcTyVar :: TcTyVar -> TcM TcType

-zonkTcTyVar tyvar = ASSERT( isTcTyVar tyvar )
+zonkTcTyVar tyvar = ASSERT2( isTcTyVar tyvar, ppr tyvar)

                    zonk_tc_tyvar (\ tv -> returnM (TyVarTy tv)) tyvar
 \end{code}
 
                    zonk_tc_tyvar (\ tv -> returnM (TyVarTy tv)) tyvar
 \end{code}