diff options
| author | Matthew Pickering <matthewtpickering@gmail.com> | 2021-04-05 16:58:14 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-04-09 03:32:47 -0400 |
| commit | 28d2d6460e5af75f07e64c3d8ed1a3ad70d64aa6 (patch) | |
| tree | 6be719186994b73ea4462addc2e387f13c229c75 /ghc | |
| parent | d4a71b0cbfe1307b022ac3746c9a3a79bc5b90b8 (diff) | |
| download | haskell-28d2d6460e5af75f07e64c3d8ed1a3ad70d64aa6.tar.gz | |
Don't tidy type in pprTypeForUser
There used to be some cases were kinds were not generalised properly
before being printed in GHCi. This seems to have changed in the past so
now it's uncessary to tidy before printing out the test case.
```
> :set -XPolyKinds
> data A x y
> :k A
k1 -> k2 -> A
```
This tidying was causing issues with an attempt to increase sharing by
making `mkTyConApp` (see !4762)
Diffstat (limited to 'ghc')
| -rw-r--r-- | ghc/GHCi/UI.hs | 15 |
1 files changed, 8 insertions, 7 deletions
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 |