X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Fghci%2FRtClosureInspect.hs;h=7c144c09bdefa54d5069db6fd985992c63b03226;hb=cdfe9b087902b321b56dd58df7d996a966947585;hp=d4475a7463d2b082694ca98384d27e413ab17875;hpb=de73aab4cab85f9b28afdf00c0174591e7070160;p=ghc-hetmet.git diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index d4475a7..7c144c0 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -66,7 +66,7 @@ import GHC.Word ( Word32(..), Word64(..) ) import Control.Monad import Data.Maybe import Data.Array.Base -import Data.List ( partition ) +import Data.List ( partition, nub ) import Foreign.Storable import IO @@ -472,24 +472,7 @@ instScheme ty | (tvs, rho) <- tcSplitForAllTys ty = liftTcM$ do return (ty', zipTopTvSubst tvs' (mkTyVarTys tvs)) cvObtainTerm :: HscEnv -> Bool -> Maybe Type -> HValue -> IO Term -cvObtainTerm hsc_env force mb_ty a = do - -- Obtain the term and tidy the type before returning it - term <- cvObtainTerm1 hsc_env force mb_ty a - return $ tidyTypes term - where - tidyTypes = foldTerm idTermFold { - fTerm = \ty dc hval tt -> Term (tidy ty) dc hval tt, - fSuspension = \ct mb_ty hval n -> - Suspension ct (fmap tidy mb_ty) hval n - } - tidy ty = tidyType (emptyTidyOccEnv, tidyVarEnv ty) ty - tidyVarEnv ty = mkVarEnv$ - [ (v, setTyVarName v (tyVarName tv)) - | (tv,v) <- zip alphaTyVars vars] - where vars = varSetElems$ tyVarsOfType ty - -cvObtainTerm1 :: HscEnv -> Bool -> Maybe Type -> HValue -> IO Term -cvObtainTerm1 hsc_env force mb_ty hval = runTR hsc_env $ do +cvObtainTerm hsc_env force mb_ty hval = runTR hsc_env $ do tv <- liftM mkTyVarTy (newVar argTypeKind) case mb_ty of Nothing -> go tv tv hval