diff options
| author | Vladislav Zavialov <vlad.z.4096@gmail.com> | 2022-11-18 12:53:00 +0300 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-11-25 04:39:04 -0500 |
| commit | 13d627bbd0bc3dd30d672de341aa7f471be0aa2c (patch) | |
| tree | 3464a8c6dca4b9bb47db356352d964279eca94fe /compiler/GHC/Core/Opt/Monad.hs | |
| parent | 1f1b99b86ab2b005604aea08b0614279a8ad1244 (diff) | |
| download | haskell-13d627bbd0bc3dd30d672de341aa7f471be0aa2c.tar.gz | |
Print unticked promoted data constructors (#20531)
Before this patch, GHC unconditionally printed ticks before promoted
data constructors:
ghci> type T = True -- unticked (user-written)
ghci> :kind! T
T :: Bool
= 'True -- ticked (compiler output)
After this patch, GHC prints ticks only when necessary:
ghci> type F = False -- unticked (user-written)
ghci> :kind! F
F :: Bool
= False -- unticked (compiler output)
ghci> data False -- introduce ambiguity
ghci> :kind! F
F :: Bool
= 'False -- ticked by necessity (compiler output)
The old behavior can be enabled by -fprint-redundant-promotion-ticks.
Summary of changes:
* Rename PrintUnqualified to NamePprCtx
* Add QueryPromotionTick to it
* Consult the GlobalRdrEnv to decide whether to print a tick (see mkPromTick)
* Introduce -fprint-redundant-promotion-ticks
Co-authored-by: Artyom Kuznetsov <hi@wzrd.ht>
Diffstat (limited to 'compiler/GHC/Core/Opt/Monad.hs')
| -rw-r--r-- | compiler/GHC/Core/Opt/Monad.hs | 22 |
1 files changed, 11 insertions, 11 deletions
diff --git a/compiler/GHC/Core/Opt/Monad.hs b/compiler/GHC/Core/Opt/Monad.hs index 6f520cfcfd..d38f3e6c59 100644 --- a/compiler/GHC/Core/Opt/Monad.hs +++ b/compiler/GHC/Core/Opt/Monad.hs @@ -21,7 +21,7 @@ module GHC.Core.Opt.Monad ( getDynFlags, getPackageFamInstEnv, getInteractiveContext, getUniqMask, - getPrintUnqualified, getSrcSpanM, + getNamePprCtx, getSrcSpanM, -- ** Writing to the monad addSimplCount, @@ -114,7 +114,7 @@ data CoreReader = CoreReader { cr_hsc_env :: HscEnv, cr_rule_base :: RuleBase, -- Home package table rules cr_module :: Module, - cr_print_unqual :: PrintUnqualified, + cr_name_ppr_ctx :: NamePprCtx, cr_loc :: SrcSpan, -- Use this for log/error messages so they -- are at least tagged with the right source file cr_uniq_mask :: !Char -- Mask for creating unique values @@ -178,18 +178,18 @@ runCoreM :: HscEnv -> RuleBase -> Char -- ^ Mask -> Module - -> PrintUnqualified + -> NamePprCtx -> SrcSpan -> CoreM a -> IO (a, SimplCount) -runCoreM hsc_env rule_base mask mod print_unqual loc m +runCoreM hsc_env rule_base mask mod name_ppr_ctx loc m = liftM extract $ runIOEnv reader $ unCoreM m where reader = CoreReader { cr_hsc_env = hsc_env, cr_rule_base = rule_base, cr_module = mod, - cr_print_unqual = print_unqual, + cr_name_ppr_ctx = name_ppr_ctx, cr_loc = loc, cr_uniq_mask = mask } @@ -252,8 +252,8 @@ initRuleEnv guts getExternalRuleBase :: CoreM RuleBase getExternalRuleBase = eps_rule_base <$> get_eps -getPrintUnqualified :: CoreM PrintUnqualified -getPrintUnqualified = read cr_print_unqual +getNamePprCtx :: CoreM NamePprCtx +getNamePprCtx = read cr_name_ppr_ctx getSrcSpanM :: CoreM SrcSpan getSrcSpanM = read cr_loc @@ -360,14 +360,14 @@ msg :: MessageClass -> SDoc -> CoreM () msg msg_class doc = do logger <- getLogger loc <- getSrcSpanM - unqual <- getPrintUnqualified + name_ppr_ctx <- getNamePprCtx let sty = case msg_class of MCDiagnostic _ _ _ -> err_sty MCDump -> dump_sty _ -> user_sty - err_sty = mkErrStyle unqual - user_sty = mkUserStyle unqual AllTheWay - dump_sty = mkDumpStyle unqual + err_sty = mkErrStyle name_ppr_ctx + user_sty = mkUserStyle name_ppr_ctx AllTheWay + dump_sty = mkDumpStyle name_ppr_ctx liftIO $ logMsg logger msg_class loc (withPprStyle sty doc) -- | Output a String message to the screen |