From: Pepe Iborra Date: Sat, 20 Jan 2007 20:11:05 +0000 (+0000) Subject: Fix a bug in the closure viewer X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=5cceab60a792e0d05a544135d1d65b1255645970 Fix a bug in the closure viewer --- diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs index 071e370..9f0684c 100644 --- a/compiler/ghci/Debugger.hs +++ b/compiler/ghci/Debugger.hs @@ -260,7 +260,6 @@ stripUnknowns :: [Name] -> Id -> Id stripUnknowns names id = setIdType id . sigmaType . fst . go names . idType $ id where - sigmaType ty = mkForAllTys (varSetElems$ tyVarsOfType (dropForAlls ty)) ty go tyvarsNames@(v:vv) ty | Just (ty1,ty2) <- splitFunTy_maybe ty = let (ty1',vv') = go tyvarsNames ty1 diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index 170dec0..e0a1250 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -39,6 +39,8 @@ module RtClosureInspect( isPointed, isFullyEvaluatedTerm, -- unsafeDeepSeq, + + sigmaType ) where #include "HsVersions.h" @@ -472,7 +474,7 @@ cvObtainTerm1 hsc_env force mb_ty hval | Nothing <- mb_ty = runTR hsc_env . go argTypeKind $ hval | Just ty <- mb_ty = runTR hsc_env $ do term <- go argTypeKind hval - ty' <- instScheme ty + ty' <- instScheme (sigmaType ty) addConstraint ty' (fromMaybe (error "by definition") (termType term)) return term @@ -539,6 +541,11 @@ zonkTerm = foldTerm idTermFoldM { ,fSuspension = \ct ty v b -> fmapMMaybe zonkTcType ty >>= \ty -> return (Suspension ct ty v b)} + +-- Is this defined elsewhere? +-- Find all free tyvars and insert the appropiate ForAll. +sigmaType ty = mkForAllTys (varSetElems$ tyVarsOfType (dropForAlls ty)) ty + {- Example of Type Reconstruction --------------------------------