From de73aab4cab85f9b28afdf00c0174591e7070160 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 25 Apr 2007 16:21:20 +0000 Subject: [PATCH] Fix some corner cases in :print after the recent changes --- compiler/ghci/Debugger.hs | 8 ++++++-- compiler/ghci/RtClosureInspect.hs | 3 ++- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs index 03eeb65..bcc9b4e 100644 --- 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 --- 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 { -- 1.7.10.4