Commit 40739684 authored by mnislaih's avatar mnislaih
Browse files

Fix Trac 1865: GHCi debugger crashes with :print

parent f0cecc6c
......@@ -81,7 +81,7 @@ 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
Just subst = computeRTTIsubst (idType id) (reconstructed_type)
subst = computeRTTIsubst (idType id) (reconstructed_type)
return (term',subst)
tidyTermTyVars :: Session -> Term -> IO Term
......
......@@ -736,16 +736,20 @@ cvReconstructType hsc_env max_depth mb_ty hval = runTR_maybe hsc_env $ do
-- improved rtti_t computed by RTTI
-- The main difference between RTTI types and their normal counterparts
-- is that the former are _not_ polymorphic, thus polymorphism must
-- be stripped. Syntactically, forall's must be stripped
computeRTTIsubst :: Type -> Type -> Maybe TvSubst
-- be stripped. Syntactically, forall's must be stripped.
-- We also remove predicates.
computeRTTIsubst :: Type -> Type -> TvSubst
computeRTTIsubst ty rtti_ty =
case mb_subst of
Just subst -> subst
Nothing -> pprPanic "Failed to compute a RTTI substitution"
(ppr (ty, rtti_ty))
-- In addition, we strip newtypes too, since the reconstructed type might
-- not have recovered them all
tcUnifyTys (const BindMe)
[repType' $ dropForAlls$ ty]
[repType' $ rtti_ty]
-- TODO stripping newtypes shouldn't be necessary, test
-- TODO stripping newtypes shouldn't be necessary, test
where mb_subst = tcUnifyTys (const BindMe)
[rttiView ty]
[rttiView rtti_ty]
-- Dealing with newtypes
{-
......
......@@ -609,7 +609,7 @@ rttiEnvironment hsc_env@HscEnv{hsc_IC=ic} = do
let substs = [computeRTTIsubst ty ty'
| (ty, Just ty') <- zip (map idType incompletelyTypedIds) tys]
ic' = foldr (flip substInteractiveContext) ic
(map skolemiseSubst $ catMaybes substs)
(map skolemiseSubst substs)
return hsc_env{hsc_IC=ic'}
skolemiseSubst subst = subst `setTvSubstEnv`
......
......@@ -55,7 +55,7 @@ module Type (
splitTyConApp_maybe, splitTyConApp,
splitNewTyConApp_maybe, splitNewTyConApp,
repType, repType', typePrimRep, coreView, tcView, kindView,
repType, typePrimRep, coreView, tcView, kindView, rttiView,
mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys,
applyTy, applyTys, isForAllTy, dropForAlls,
......@@ -189,6 +189,18 @@ tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- tcExpandTyCon_maybe tc tys
= Just (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
tcView ty = Nothing
-----------------------------------------------
rttiView :: Type -> Type
-- Same, but for the RTTI system, which cannot deal with predicates nor polymorphism
rttiView (ForAllTy _ ty) = rttiView ty
rttiView (NoteTy _ ty) = rttiView ty
rttiView (FunTy PredTy{} ty) = rttiView ty
rttiView (FunTy NoteTy{} ty) = rttiView ty
rttiView ty@TyConApp{} | Just ty' <- coreView ty
= rttiView ty'
rttiView (TyConApp tc tys) = mkTyConApp tc (map rttiView tys)
rttiView ty = ty
-----------------------------------------------
{-# INLINE kindView #-}
kindView :: Kind -> Maybe Kind
......@@ -483,16 +495,6 @@ repType (TyConApp tc tys)
repType ty = ty
-- repType' aims to be a more thorough version of repType
-- For now it simply looks through the TyConApp args too
repType' ty -- | pprTrace "repType'" (ppr ty $$ ppr (go1 ty)) False = undefined
| otherwise = go1 ty
where
go1 = go . repType
go (TyConApp tc tys) = mkTyConApp tc (map repType' tys)
go ty = ty
-- ToDo: this could be moved to the code generator, using splitTyConApp instead
-- of inspecting the type directly.
typePrimRep :: Type -> PrimRep
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment