diff options
| -rw-r--r-- | compiler/GHC/Types/TyThing/Ppr.hs | 17 | ||||
| -rw-r--r-- | ghc/GHCi/UI.hs | 15 |
2 files changed, 10 insertions, 22 deletions
diff --git a/compiler/GHC/Types/TyThing/Ppr.hs b/compiler/GHC/Types/TyThing/Ppr.hs index aad90365a7..b4084f9bf8 100644 --- a/compiler/GHC/Types/TyThing/Ppr.hs +++ b/compiler/GHC/Types/TyThing/Ppr.hs @@ -13,7 +13,6 @@ module GHC.Types.TyThing.Ppr ( pprTyThingLoc, pprTyThingInContextLoc, pprTyThingHdr, - pprTypeForUser, pprFamInst ) where @@ -25,12 +24,11 @@ import GHC.Driver.Ppr (warnPprTrace) import GHC.Types.TyThing ( TyThing(..), tyThingParent_maybe ) import GHC.Types.Name -import GHC.Types.Var.Env( emptyTidyEnv ) -import GHC.Core.Type ( Type, ArgFlag(..), mkTyVarBinders, tidyOpenType ) +import GHC.Core.Type ( ArgFlag(..), mkTyVarBinders ) import GHC.Core.Coercion.Axiom ( coAxiomTyCon ) import GHC.Core.FamInstEnv( FamInst(..), FamFlavor(..) ) -import GHC.Core.TyCo.Ppr ( pprUserForAll, pprTypeApp, pprSigmaType ) +import GHC.Core.TyCo.Ppr ( pprUserForAll, pprTypeApp ) import GHC.Iface.Syntax ( ShowSub(..), ShowHowMuch(..), AltPpr(..) , showToHeader, pprIfaceDecl ) @@ -192,17 +190,6 @@ pprTyThing ss ty_thing Nothing -> WARN( True, ppr name ) Nothing -- Nothing is unexpected here; TyThings have External names -pprTypeForUser :: Type -> SDoc --- The type is tidied -pprTypeForUser ty - = pprSigmaType tidy_ty - where - (_, tidy_ty) = tidyOpenType emptyTidyEnv ty - -- Often the types/kinds we print in ghci are fully generalised - -- and have no free variables, but it turns out that we sometimes - -- print un-generalised kinds (eg when doing :k T), so it's - -- better to use tidyOpenType here - showWithLoc :: SDoc -> SDoc -> SDoc showWithLoc loc doc = hang doc 2 (char '\t' <> comment <+> loc) diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index a97200c5c3..80700e9caf 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -66,6 +66,7 @@ import GHC.Driver.Env import GHC.Runtime.Context import GHC.Types.TyThing import GHC.Types.TyThing.Ppr +import GHC.Core.TyCo.Ppr import GHC.Types.SafeHaskell ( getSafeMode ) import GHC.Types.Name import GHC.Types.SourceText @@ -1855,10 +1856,10 @@ sigAndLocDoc :: String -> TyThing -> SDoc sigAndLocDoc str tyThing = let tyThingTyDoc :: TyThing -> SDoc tyThingTyDoc = \case - AnId i -> pprTypeForUser $ varType i - AConLike (RealDataCon dc) -> pprTypeForUser $ dataConDisplayType False dc + AnId i -> pprSigmaType $ varType i + AConLike (RealDataCon dc) -> pprSigmaType $ dataConDisplayType False dc AConLike (PatSynCon patSyn) -> pprPatSynType patSyn - ATyCon tyCon -> pprTypeForUser $ GHC.tyConKind tyCon + ATyCon tyCon -> pprSigmaType $ GHC.tyConKind tyCon ACoAxiom _ -> empty tyDoc = tyThingTyDoc tyThing @@ -2229,7 +2230,7 @@ typeOfExpr str = handleSourceError GHC.printException $ do_it mode expr_str = do { ty <- GHC.exprType mode expr_str ; printForUser $ sep [ text expr_str - , nest 2 (dcolon <+> pprTypeForUser ty)] } + , nest 2 (dcolon <+> pprSigmaType ty)] } ----------------------------------------------------------------------------- -- | @:type-at@ command @@ -2277,7 +2278,7 @@ allTypesCmd _ = runExceptGhcMonad $ do let tyInfo = unwords . words $ showSDocForUser (hsc_dflags hsc_env) (hsc_units hsc_env) - alwaysQualify (pprTypeForUser ty) + alwaysQualify (pprSigmaType ty) liftIO . putStrLn $ showRealSrcSpan (spaninfoSrcSpan span') ++ ": " ++ tyInfo | otherwise = return () @@ -2362,8 +2363,8 @@ showRealSrcSpan spn = concat [ fp, ":(", show sl, ",", show sc kindOfType :: GHC.GhcMonad m => Bool -> String -> m () kindOfType norm str = handleSourceError GHC.printException $ do (ty, kind) <- GHC.typeKind norm str - printForUser $ vcat [ text str <+> dcolon <+> pprTypeForUser kind - , ppWhen norm $ equals <+> pprTypeForUser ty ] + printForUser $ vcat [ text str <+> dcolon <+> pprSigmaType kind + , ppWhen norm $ equals <+> pprSigmaType ty ] ----------------------------------------------------------------------------- -- :quit |