Fix some corner cases in :print after the recent changes

diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index 03eeb65..bcc9b4e 100644 (file)
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -76,8 +76,12 @@ pprintClosureCommand session bindThings force str = do
      --  Then, we extract a substitution, 
      --  mapping the old tyvars to the reconstructed types.
        let Just reconstructed_type = termType term
-           mb_subst = tcUnifyTys (const BindMe) [idType id] [reconstructed_type]
-       ASSERT (isJust mb_subst) return mb_subst
+     -- tcUnifyTys doesn't look through forall's, so we drop them from 
+     -- the original type, instead of sigma-typing the reconstructed type
+           mb_subst = tcUnifyTys (const BindMe) [dropForAlls$ idType id] 
+                       [reconstructed_type]  
+       ASSERT2 (isJust mb_subst, ppr reconstructed_type $$ (ppr$ idType id)) 
+        return mb_subst
 
    applySubstToEnv :: Session -> TvSubst -> IO ()
    applySubstToEnv cms subst | isEmptyTvSubst subst = return ()

diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index 45c5b0f..d4475a7 100644 (file)
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -565,7 +565,8 @@ cvObtainTerm1 hsc_env force mb_ty hval = runTR hsc_env $ do
                            , ptext SLIT("reOrderTerms") $$ (ppr pointed $$ ppr unpointed))
                     head unpointed : reOrderTerms pointed (tail unpointed) tys
 
-isMonomorphic = isEmptyVarSet . tyVarsOfType
+isMonomorphic ty | isForAllTy ty = False
+isMonomorphic ty = (isEmptyVarSet . tyVarsOfType) ty
 
 zonkTerm :: Term -> TcM Term
 zonkTerm = foldTerm idTermFoldM {