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 | |
| 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>
157 files changed, 812 insertions, 553 deletions
diff --git a/compiler/GHC.hs b/compiler/GHC.hs index 1c5af5875c..308ea08780 100644 --- a/compiler/GHC.hs +++ b/compiler/GHC.hs @@ -97,12 +97,12 @@ module GHC ( modInfoSafe, lookupGlobalName, findGlobalAnns, - mkPrintUnqualifiedForModule, + mkNamePprCtxForModule, ModIface, ModIface_(..), SafeHaskellMode(..), -- * Printing - PrintUnqualified, alwaysQualify, + NamePprCtx, alwaysQualify, -- * Interactive evaluation @@ -119,7 +119,7 @@ module GHC ( setGHCiMonad, getGHCiMonad, -- ** Inspecting the current context - getBindings, getInsts, getPrintUnqual, + getBindings, getInsts, getNamePprCtx, findModule, lookupModule, findQualifiedModule, lookupQualifiedModule, renamePkgQualM, renameRawPkgQualM, @@ -1346,9 +1346,9 @@ getInsts = withSession $ \hsc_env -> let (inst_env, fam_env) = ic_instances (hsc_IC hsc_env) in return (instEnvElts inst_env, fam_env) -getPrintUnqual :: GhcMonad m => m PrintUnqualified -getPrintUnqual = withSession $ \hsc_env -> do - return $ icPrintUnqual (hsc_unit_env hsc_env) (hsc_IC hsc_env) +getNamePprCtx :: GhcMonad m => m NamePprCtx +getNamePprCtx = withSession $ \hsc_env -> do + return $ icNamePprCtx (hsc_unit_env hsc_env) (hsc_IC hsc_env) -- | Container for information about a 'Module'. data ModuleInfo = ModuleInfo { @@ -1442,12 +1442,14 @@ modInfoInstances = minf_instances modInfoIsExportedName :: ModuleInfo -> Name -> Bool modInfoIsExportedName minf name = elemNameSet name (availsToNameSet (minf_exports minf)) -mkPrintUnqualifiedForModule :: GhcMonad m => - ModuleInfo - -> m (Maybe PrintUnqualified) -- XXX: returns a Maybe X -mkPrintUnqualifiedForModule minf = withSession $ \hsc_env -> do - let mk_print_unqual = mkPrintUnqualified (hsc_unit_env hsc_env) - return (fmap mk_print_unqual (minf_rdr_env minf)) +mkNamePprCtxForModule :: + GhcMonad m => + ModuleInfo -> + m (Maybe NamePprCtx) -- XXX: returns a Maybe X +mkNamePprCtxForModule minf = withSession $ \hsc_env -> do + let mk_name_ppr_ctx = mkNamePprCtx ptc (hsc_unit_env hsc_env) + ptc = initPromotionTickContext (hsc_dflags hsc_env) + return (fmap mk_name_ppr_ctx (minf_rdr_env minf)) modInfoLookupName :: GhcMonad m => ModuleInfo -> Name diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs index bb192a3278..e299eb9171 100644 --- a/compiler/GHC/Core/Lint.hs +++ b/compiler/GHC/Core/Lint.hs @@ -321,7 +321,7 @@ data EndPassConfig = EndPassConfig , ep_lintPassResult :: !(Maybe LintPassResultConfig) -- ^ Whether we should lint the result of this pass. - , ep_printUnqual :: !PrintUnqualified + , ep_namePprCtx :: !NamePprCtx , ep_dumpFlag :: !(Maybe DumpFlag) @@ -336,7 +336,7 @@ endPassIO :: Logger -> IO () -- Used by the IO-is CorePrep too endPassIO logger cfg binds rules - = do { dumpPassResult logger (ep_dumpCoreSizes cfg) (ep_printUnqual cfg) mb_flag + = do { dumpPassResult logger (ep_dumpCoreSizes cfg) (ep_namePprCtx cfg) mb_flag (renderWithContext defaultSDocContext (ep_prettyPass cfg)) (ep_passDetails cfg) binds rules ; for_ (ep_lintPassResult cfg) $ \lp_cfg -> @@ -350,16 +350,16 @@ endPassIO logger cfg binds rules dumpPassResult :: Logger -> Bool -- dump core sizes? - -> PrintUnqualified + -> NamePprCtx -> Maybe DumpFlag -- Just df => show details in a file whose -- name is specified by df -> String -- Header -> SDoc -- Extra info to appear after header -> CoreProgram -> [CoreRule] -> IO () -dumpPassResult logger dump_core_sizes unqual mb_flag hdr extra_info binds rules +dumpPassResult logger dump_core_sizes name_ppr_ctx mb_flag hdr extra_info binds rules = do { forM_ mb_flag $ \flag -> do - logDumpFile logger (mkDumpStyle unqual) flag hdr FormatCore dump_doc + logDumpFile logger (mkDumpStyle name_ppr_ctx) flag hdr FormatCore dump_doc -- Report result size -- This has the side effect of forcing the intermediate to be evaluated 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 diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs index c7834a0b31..8be830dbeb 100644 --- a/compiler/GHC/Core/Opt/Pipeline.hs +++ b/compiler/GHC/Core/Opt/Pipeline.hs @@ -81,7 +81,7 @@ core2core hsc_env guts@(ModGuts { mg_module = mod uniq_mask = 's' ; (guts2, stats) <- runCoreM hsc_env hpt_rule_base uniq_mask mod - print_unqual loc $ + name_ppr_ctx loc $ do { hsc_env' <- getHscEnv ; all_passes <- withPlugins (hsc_plugins hsc_env') installCoreToDos @@ -101,7 +101,8 @@ core2core hsc_env guts@(ModGuts { mg_module = mod home_pkg_rules = hptRules hsc_env (moduleUnitId mod) (GWIB { gwib_mod = moduleName mod , gwib_isBoot = NotBoot }) hpt_rule_base = mkRuleBase home_pkg_rules - print_unqual = mkPrintUnqualified (hsc_unit_env hsc_env) rdr_env + name_ppr_ctx = mkNamePprCtx ptc (hsc_unit_env hsc_env) rdr_env + ptc = initPromotionTickContext dflags -- mod: get the module out of the current HscEnv so we can retrieve it from the monad. -- This is very convienent for the users of the monad (e.g. plugins do not have to -- consume the ModGuts to find the module) but somewhat ugly because mg_module may @@ -488,10 +489,15 @@ doCorePass pass guts = do let fam_envs = (p_fam_env, mg_fam_inst_env guts) let updateBinds f = return $ guts { mg_binds = f (mg_binds guts) } let updateBindsM f = f (mg_binds guts) >>= \b' -> return $ guts { mg_binds = b' } + let name_ppr_ctx = + mkNamePprCtx + (initPromotionTickContext dflags) + (hsc_unit_env hsc_env) + (mg_rdr_env guts) case pass of CoreDoSimplify opts -> {-# SCC "Simplify" #-} - liftIOWithCount $ simplifyPgm logger (hsc_unit_env hsc_env) opts guts + liftIOWithCount $ simplifyPgm logger (hsc_unit_env hsc_env) name_ppr_ctx opts guts CoreCSE -> {-# SCC "CommonSubExpr" #-} updateBinds cseProgram diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs index 0c8ec92f6c..0cc6d984e5 100644 --- a/compiler/GHC/Core/Opt/Simplify.hs +++ b/compiler/GHC/Core/Opt/Simplify.hs @@ -39,7 +39,6 @@ import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Tickish import GHC.Types.Unique.FM -import GHC.Types.Name.Ppr import Control.Monad import Data.Foldable ( for_ ) @@ -140,13 +139,13 @@ data SimplifyOpts = SimplifyOpts simplifyPgm :: Logger -> UnitEnv + -> NamePprCtx -- For dumping -> SimplifyOpts -> ModGuts -> IO (SimplCount, ModGuts) -- New bindings -simplifyPgm logger unit_env opts +simplifyPgm logger unit_env name_ppr_ctx opts guts@(ModGuts { mg_module = this_mod - , mg_rdr_env = rdr_env , mg_binds = binds, mg_rules = local_rules , mg_fam_inst_env = fam_inst_env }) = do { (termination_msg, it_count, counts_out, guts') @@ -168,7 +167,6 @@ simplifyPgm logger unit_env opts mode = so_mode opts max_iterations = so_iterations opts top_env_cfg = so_top_env_cfg opts - print_unqual = mkPrintUnqualified unit_env rdr_env active_rule = activeRule mode active_unf = activeUnfolding mode -- Note the bang in !guts_no_binds. If you don't force `guts_no_binds` @@ -275,7 +273,7 @@ simplifyPgm logger unit_env opts let { binds2 = {-# SCC "ZapInd" #-} shortOutIndirections binds1 } ; -- Dump the result of this iteration - dump_end_iteration logger dump_core_sizes print_unqual iteration_no counts1 binds2 rules1 ; + dump_end_iteration logger dump_core_sizes name_ppr_ctx iteration_no counts1 binds2 rules1 ; for_ (so_pass_result_cfg opts) $ \pass_result_cfg -> lintPassResult logger pass_result_cfg binds2 ; @@ -292,10 +290,10 @@ simplifyPgm logger unit_env opts totalise = foldr (\c acc -> acc `plusSimplCount` c) (zeroSimplCount $ logHasDumpFlag logger Opt_D_dump_simpl_stats) -dump_end_iteration :: Logger -> Bool -> PrintUnqualified -> Int +dump_end_iteration :: Logger -> Bool -> NamePprCtx -> Int -> SimplCount -> CoreProgram -> [CoreRule] -> IO () -dump_end_iteration logger dump_core_sizes print_unqual iteration_no counts binds rules - = dumpPassResult logger dump_core_sizes print_unqual mb_flag hdr pp_counts binds rules +dump_end_iteration logger dump_core_sizes name_ppr_ctx iteration_no counts binds rules + = dumpPassResult logger dump_core_sizes name_ppr_ctx mb_flag hdr pp_counts binds rules where mb_flag | logHasDumpFlag logger Opt_D_dump_simpl_iterations = Just Opt_D_dump_simpl_iterations | otherwise = Nothing diff --git a/compiler/GHC/Core/TyCon.hs b/compiler/GHC/Core/TyCon.hs index 2088de341f..2a26363c7b 100644 --- a/compiler/GHC/Core/TyCon.hs +++ b/compiler/GHC/Core/TyCon.hs @@ -2907,11 +2907,15 @@ tcFlavourIsOpen TypeSynonymFlavour = False pprPromotionQuote :: TyCon -> SDoc -- Promoted data constructors already have a tick in their OccName -pprPromotionQuote tc - -- Always quote promoted DataCons in types, unless they come - -- from "type data" declarations. - | isDataKindsPromotedDataCon tc = char '\'' - | otherwise = empty +pprPromotionQuote tc = + getPprStyle $ \sty -> + let + name = getOccName tc + ticked = isDataKindsPromotedDataCon tc && promTick sty (PromotedItemDataCon name) + in + if ticked + then char '\'' + else empty instance NamedThing TyCon where getName = tyConName diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs index cf94e0cf1d..042d0fe021 100644 --- a/compiler/GHC/Driver/Backpack.hs +++ b/compiler/GHC/Driver/Backpack.hs @@ -597,7 +597,9 @@ backpackStyle = mkUserStyle (QueryQualify neverQualifyNames alwaysQualifyModules - neverQualifyPackages) AllTheWay + neverQualifyPackages + alwaysPrintPromTick) + AllTheWay -- | Message when we initially process a Backpack unit. msgTopPackage :: (Int,Int) -> HsComponentId -> BkpM () diff --git a/compiler/GHC/Driver/Config/Core/Lint.hs b/compiler/GHC/Driver/Config/Core/Lint.hs index 8ea716a36c..533f029c7b 100644 --- a/compiler/GHC/Driver/Config/Core/Lint.hs +++ b/compiler/GHC/Driver/Config/Core/Lint.hs @@ -37,18 +37,18 @@ before and after core passes, and do Core Lint when necessary. endPass :: CoreToDo -> CoreProgram -> [CoreRule] -> CoreM () endPass pass binds rules = do { hsc_env <- getHscEnv - ; print_unqual <- getPrintUnqualified + ; name_ppr_ctx <- getNamePprCtx ; liftIO $ endPassHscEnvIO hsc_env - print_unqual pass binds rules + name_ppr_ctx pass binds rules } -endPassHscEnvIO :: HscEnv -> PrintUnqualified +endPassHscEnvIO :: HscEnv -> NamePprCtx -> CoreToDo -> CoreProgram -> [CoreRule] -> IO () -endPassHscEnvIO hsc_env print_unqual pass binds rules +endPassHscEnvIO hsc_env name_ppr_ctx pass binds rules = do { let dflags = hsc_dflags hsc_env ; endPassIO (hsc_logger hsc_env) - (initEndPassConfig dflags (interactiveInScope $ hsc_IC hsc_env) print_unqual pass) + (initEndPassConfig dflags (interactiveInScope $ hsc_IC hsc_env) name_ppr_ctx pass) binds rules } @@ -62,13 +62,13 @@ lintCoreBindings dflags coreToDo vars -- binds , l_vars = vars } -initEndPassConfig :: DynFlags -> [Var] -> PrintUnqualified -> CoreToDo -> EndPassConfig -initEndPassConfig dflags extra_vars print_unqual pass = EndPassConfig +initEndPassConfig :: DynFlags -> [Var] -> NamePprCtx -> CoreToDo -> EndPassConfig +initEndPassConfig dflags extra_vars name_ppr_ctx pass = EndPassConfig { ep_dumpCoreSizes = not (gopt Opt_SuppressCoreSizes dflags) , ep_lintPassResult = if gopt Opt_DoCoreLinting dflags then Just $ initLintPassResultConfig dflags extra_vars pass else Nothing - , ep_printUnqual = print_unqual + , ep_namePprCtx = name_ppr_ctx , ep_dumpFlag = coreDumpFlag pass , ep_prettyPass = ppr pass , ep_passDetails = pprPassDetails pass diff --git a/compiler/GHC/Driver/Errors.hs b/compiler/GHC/Driver/Errors.hs index 024820202d..dd6834046b 100644 --- a/compiler/GHC/Driver/Errors.hs +++ b/compiler/GHC/Driver/Errors.hs @@ -19,15 +19,15 @@ import qualified GHC.Driver.CmdLine as CmdLine printMessages :: forall a . Diagnostic a => Logger -> DiagnosticOpts a -> DiagOpts -> Messages a -> IO () printMessages logger msg_opts opts msgs - = sequence_ [ let style = mkErrStyle unqual + = sequence_ [ let style = mkErrStyle name_ppr_ctx ctx = (diag_ppr_ctx opts) { sdocStyle = style } in logMsg logger (MCDiagnostic sev (diagnosticReason dia) (diagnosticCode dia)) s $ withPprStyle style (messageWithHints ctx dia) - | MsgEnvelope { errMsgSpan = s, + | MsgEnvelope { errMsgSpan = s, errMsgDiagnostic = dia, - errMsgSeverity = sev, - errMsgContext = unqual } <- sortMsgBag (Just opts) - (getMessages msgs) ] + errMsgSeverity = sev, + errMsgContext = name_ppr_ctx } + <- sortMsgBag (Just opts) (getMessages msgs) ] where messageWithHints :: Diagnostic a => SDocContext -> a -> SDoc messageWithHints ctx e = diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs index 592b997b0f..b1154b6398 100644 --- a/compiler/GHC/Driver/Flags.hs +++ b/compiler/GHC/Driver/Flags.hs @@ -219,6 +219,7 @@ data GeneralFlag | Opt_PrintUnicodeSyntax | Opt_PrintExpandedSynonyms | Opt_PrintPotentialInstances + | Opt_PrintRedundantPromotionTicks | Opt_PrintTypecheckerElaboration -- optimisation opts diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs index 5ca7487c27..4a22645223 100644 --- a/compiler/GHC/Driver/Main.hs +++ b/compiler/GHC/Driver/Main.hs @@ -2473,9 +2473,10 @@ hscTidy hsc_env guts = do -- post tidy pretty-printing and linting... let tidy_rules = md_rules details let all_tidy_binds = cg_binds cgguts - let print_unqual = mkPrintUnqualified (hsc_unit_env hsc_env) (mg_rdr_env guts) + let name_ppr_ctx = mkNamePprCtx ptc (hsc_unit_env hsc_env) (mg_rdr_env guts) + ptc = initPromotionTickContext (hsc_dflags hsc_env) - endPassHscEnvIO hsc_env print_unqual CoreTidy all_tidy_binds tidy_rules + endPassHscEnvIO hsc_env name_ppr_ctx CoreTidy all_tidy_binds tidy_rules -- If the endPass didn't print the rules, but ddump-rules is -- on, print now diff --git a/compiler/GHC/Driver/Ppr.hs b/compiler/GHC/Driver/Ppr.hs index a61d1cae29..291be49065 100644 --- a/compiler/GHC/Driver/Ppr.hs +++ b/compiler/GHC/Driver/Ppr.hs @@ -26,14 +26,14 @@ showSDoc dflags sdoc = renderWithContext (initSDocContext dflags defaultUserStyl showPpr :: Outputable a => DynFlags -> a -> String showPpr dflags thing = showSDoc dflags (ppr thing) --- | Allows caller to specify the PrintUnqualified to use -showSDocForUser :: DynFlags -> UnitState -> PrintUnqualified -> SDoc -> String -showSDocForUser dflags unit_state unqual doc = renderWithContext (initSDocContext dflags sty) doc' +-- | Allows caller to specify the NamePprCtx to use +showSDocForUser :: DynFlags -> UnitState -> NamePprCtx -> SDoc -> String +showSDocForUser dflags unit_state name_ppr_ctx doc = renderWithContext (initSDocContext dflags sty) doc' where - sty = mkUserStyle unqual AllTheWay + sty = mkUserStyle name_ppr_ctx AllTheWay doc' = pprWithUnitState unit_state doc -printForUser :: DynFlags -> Handle -> PrintUnqualified -> Depth -> SDoc -> IO () -printForUser dflags handle unqual depth doc +printForUser :: DynFlags -> Handle -> NamePprCtx -> Depth -> SDoc -> IO () +printForUser dflags handle name_ppr_ctx depth doc = printSDocLn ctx (PageMode False) handle doc - where ctx = initSDocContext dflags (mkUserStyle unqual depth) + where ctx = initSDocContext dflags (mkUserStyle name_ppr_ctx depth) diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index 3e205402e9..168a204fbc 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -214,6 +214,7 @@ module GHC.Driver.Session ( -- * SDoc initSDocContext, initDefaultSDocContext, + initPromotionTickContext, ) where import GHC.Prelude @@ -3456,6 +3457,7 @@ fFlagsDeps = [ flagSpec "print-unicode-syntax" Opt_PrintUnicodeSyntax, flagSpec "print-expanded-synonyms" Opt_PrintExpandedSynonyms, flagSpec "print-potential-instances" Opt_PrintPotentialInstances, + flagSpec "print-redundant-promotion-ticks" Opt_PrintRedundantPromotionTicks, flagSpec "print-typechecker-elaboration" Opt_PrintTypecheckerElaboration, flagSpec "prof-cafs" Opt_AutoSccsOnIndividualCafs, flagSpec "prof-count-entries" Opt_ProfCountEntries, @@ -5042,6 +5044,13 @@ initSDocContext dflags style = SDC initDefaultSDocContext :: DynFlags -> SDocContext initDefaultSDocContext dflags = initSDocContext dflags defaultUserStyle +initPromotionTickContext :: DynFlags -> PromotionTickContext +initPromotionTickContext dflags = + PromTickCtx { + ptcListTuplePuns = True, + ptcPrintRedundantPromTicks = gopt Opt_PrintRedundantPromotionTicks dflags + } + outputFile :: DynFlags -> Maybe String outputFile dflags | dynamicNow dflags = dynOutputFile_ dflags diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs index 2ceb918fb1..05487e769e 100644 --- a/compiler/GHC/HsToCore.hs +++ b/compiler/GHC/HsToCore.hs @@ -146,7 +146,8 @@ deSugar hsc_env = do { let dflags = hsc_dflags hsc_env logger = hsc_logger hsc_env - print_unqual = mkPrintUnqualified (hsc_unit_env hsc_env) rdr_env + ptc = initPromotionTickContext (hsc_dflags hsc_env) + name_ppr_ctx = mkNamePprCtx ptc (hsc_unit_env hsc_env) rdr_env ; withTiming logger (text "Desugar"<+>brackets (ppr mod)) (const ()) $ @@ -212,7 +213,7 @@ deSugar hsc_env -- You might think it doesn't matter, but the simplifier brings all top-level -- things into the in-scope set before simplifying; so we get no unfolding for F#! - ; endPassHscEnvIO hsc_env print_unqual CoreDesugar final_pgm rules_for_imps + ; endPassHscEnvIO hsc_env name_ppr_ctx CoreDesugar final_pgm rules_for_imps ; let simpl_opts = initSimpleOpts dflags ; let (ds_binds, ds_rules_for_imps, occ_anald_binds) = simpleOptPgm simpl_opts mod final_pgm rules_for_imps @@ -221,7 +222,7 @@ deSugar hsc_env ; putDumpFileMaybe logger Opt_D_dump_occur_anal "Occurrence analysis" FormatCore (pprCoreBindings occ_anald_binds $$ pprRules ds_rules_for_imps ) - ; endPassHscEnvIO hsc_env print_unqual CoreDesugarOpt ds_binds ds_rules_for_imps + ; endPassHscEnvIO hsc_env name_ppr_ctx CoreDesugarOpt ds_binds ds_rules_for_imps ; let used_names = mkUsedNames tcg_env pluginModules = map lpModule (loadedPlugins (hsc_plugins hsc_env)) diff --git a/compiler/GHC/HsToCore/Monad.hs b/compiler/GHC/HsToCore/Monad.hs index 8723248f0a..17d9a3db94 100644 --- a/compiler/GHC/HsToCore/Monad.hs +++ b/compiler/GHC/HsToCore/Monad.hs @@ -23,7 +23,7 @@ module GHC.HsToCore.Monad ( newSysLocalsDs, newUniqueId, newFailLocalDs, newPredVarDs, getSrcSpanDs, putSrcSpanDs, putSrcSpanDsA, - mkPrintUnqualifiedDs, + mkNamePprCtxDs, newUnique, UniqSupply, newUniqueSupply, getGhcModeDs, dsGetFamInstEnvs, @@ -199,7 +199,7 @@ fixDs = fixM type DsWarning = (SrcSpan, SDoc) -- Not quite the same as a WarnMsg, we have an SDoc here - -- and we'll do the print_unqual stuff later on to turn it + -- and we'll do the name_ppr_ctx stuff later on to turn it -- into a Doc. -- | Run a 'DsM' action inside the 'TcM' monad. @@ -237,12 +237,13 @@ mkDsEnvsFromTcGbl hsc_env msg_var tcg_env type_env = tcg_type_env tcg_env rdr_env = tcg_rdr_env tcg_env fam_inst_env = tcg_fam_inst_env tcg_env + ptc = initPromotionTickContext (hsc_dflags hsc_env) complete_matches = hptCompleteSigs hsc_env -- from the home package ++ tcg_complete_matches tcg_env -- from the current module ++ eps_complete_matches eps -- from imports -- re-use existing next_wrapper_num to ensure uniqueness next_wrapper_num_var = tcg_next_wrapper_num tcg_env - ; return $ mkDsEnvs unit_env this_mod rdr_env type_env fam_inst_env + ; return $ mkDsEnvs unit_env this_mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var next_wrapper_num_var complete_matches } @@ -272,6 +273,7 @@ initDsWithModGuts hsc_env (ModGuts { mg_module = this_mod, mg_binds = binds ; eps <- liftIO $ hscEPS hsc_env ; let unit_env = hsc_unit_env hsc_env type_env = typeEnvFromEntities ids tycons patsyns fam_insts + ptc = initPromotionTickContext (hsc_dflags hsc_env) complete_matches = hptCompleteSigs hsc_env -- from the home package ++ local_complete_matches -- from the current module ++ eps_complete_matches eps -- from imports @@ -281,7 +283,7 @@ initDsWithModGuts hsc_env (ModGuts { mg_module = this_mod, mg_binds = binds ids = concatMap bindsToIds binds envs = mkDsEnvs unit_env this_mod rdr_env type_env - fam_inst_env msg_var cc_st_var + fam_inst_env ptc msg_var cc_st_var next_wrapper_num complete_matches ; runDs hsc_env envs thing_inside } @@ -320,10 +322,11 @@ initTcDsForSolver thing_inside Nothing -> pprPanic "initTcDsForSolver" (vcat $ pprMsgEnvelopeBagWithLocDefault (getErrorMessages msgs)) } mkDsEnvs :: UnitEnv -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv + -> PromotionTickContext -> IORef (Messages DsMessage) -> IORef CostCentreState -> IORef (ModuleEnv Int) -> CompleteMatches -> (DsGblEnv, DsLclEnv) -mkDsEnvs unit_env mod rdr_env type_env fam_inst_env msg_var cc_st_var +mkDsEnvs unit_env mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var next_wrapper_num complete_matches = let if_genv = IfGblEnv { if_doc = text "mkDsEnvs" -- Failing tests here are `ghci` and `T11985` if you get this wrong. @@ -340,7 +343,7 @@ mkDsEnvs unit_env mod rdr_env type_env fam_inst_env msg_var cc_st_var , ds_fam_inst_env = fam_inst_env , ds_gbl_rdr_env = rdr_env , ds_if_env = (if_genv, if_lenv) - , ds_unqual = mkPrintUnqualified unit_env rdr_env + , ds_name_ppr_ctx = mkNamePprCtx ptc unit_env rdr_env , ds_msgs = msg_var , ds_complete_matches = complete_matches , ds_cc_st = cc_st_var @@ -425,7 +428,7 @@ diagnosticDs dsMessage = do { env <- getGblEnv ; loc <- getSrcSpanDs ; !diag_opts <- initDiagOpts <$> getDynFlags - ; let msg = mkMsgEnvelope diag_opts loc (ds_unqual env) dsMessage + ; let msg = mkMsgEnvelope diag_opts loc (ds_name_ppr_ctx env) dsMessage ; updMutVar (ds_msgs env) (\ msgs -> msg `addMessage` msgs) } -- | Issue an error, but return the expression for (), so that we can continue @@ -443,8 +446,8 @@ failWithDs msg failDs :: DsM a failDs = failM -mkPrintUnqualifiedDs :: DsM PrintUnqualified -mkPrintUnqualifiedDs = ds_unqual <$> getGblEnv +mkNamePprCtxDs :: DsM NamePprCtx +mkNamePprCtxDs = ds_name_ppr_ctx <$> getGblEnv instance MonadThings (IOEnv (Env DsGblEnv DsLclEnv)) where lookupThing = dsLookupGlobal diff --git a/compiler/GHC/HsToCore/Pmc/Utils.hs b/compiler/GHC/HsToCore/Pmc/Utils.hs index 9e0a40a5f3..a2a73067a9 100644 --- a/compiler/GHC/HsToCore/Pmc/Utils.hs +++ b/compiler/GHC/HsToCore/Pmc/Utils.hs @@ -35,8 +35,8 @@ import Control.Monad tracePm :: String -> SDoc -> DsM () tracePm herald doc = do logger <- getLogger - printer <- mkPrintUnqualifiedDs - liftIO $ putDumpFileMaybe' logger printer + name_ppr_ctx <- mkNamePprCtxDs + liftIO $ putDumpFileMaybe' logger name_ppr_ctx Opt_D_dump_ec_trace "" FormatText (text herald $$ (nest 2 doc)) {-# INLINE tracePm #-} -- see Note [INLINE conditional tracing utilities] diff --git a/compiler/GHC/HsToCore/Types.hs b/compiler/GHC/HsToCore/Types.hs index 59db2c9372..f1c1f98bc6 100644 --- a/compiler/GHC/HsToCore/Types.hs +++ b/compiler/GHC/HsToCore/Types.hs @@ -49,7 +49,7 @@ data DsGblEnv , ds_gbl_rdr_env :: GlobalRdrEnv -- needed *only* to know what newtype -- constructors are in scope during -- pattern-match satisfiability checking - , ds_unqual :: PrintUnqualified + , ds_name_ppr_ctx :: NamePprCtx , ds_msgs :: IORef (Messages DsMessage) -- Diagnostic messages , ds_if_env :: (IfGblEnv, IfLclEnv) -- Used for looking up global, -- possibly-imported things diff --git a/compiler/GHC/Iface/Errors.hs b/compiler/GHC/Iface/Errors.hs index 6fecc023c5..743ce9a33a 100644 --- a/compiler/GHC/Iface/Errors.hs +++ b/compiler/GHC/Iface/Errors.hs @@ -46,7 +46,7 @@ hiModuleNameMismatchWarn requested_mod read_mod -- are the same withPprStyle (mkUserStyle alwaysQualify AllTheWay) $ -- we want the Modules below to be qualified with package names, - -- so reset the PrintUnqualified setting. + -- so reset the NamePprCtx setting. hsep [ text "Something is amiss; requested module " , ppr requested_mod , text "differs from name found in the interface file" diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs index 9bf2aaccc8..bf7ae8e005 100644 --- a/compiler/GHC/Iface/Load.hs +++ b/compiler/GHC/Iface/Load.hs @@ -1084,11 +1084,12 @@ showIface logger dflags unit_state name_cache filename = do qualifyImportedNames mod _ | mod == mi_module iface = NameUnqual | otherwise = NameNotInScope1 - print_unqual = QueryQualify qualifyImportedNames + name_ppr_ctx = QueryQualify qualifyImportedNames neverQualifyModules neverQualifyPackages + alwaysPrintPromTick logMsg logger MCDump noSrcSpan - $ withPprStyle (mkDumpStyle print_unqual) + $ withPprStyle (mkDumpStyle name_ppr_ctx) $ pprModIface unit_state iface -- | Show a ModIface but don't display details; suitable for ModIfaces stored in diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs index 3873b9133f..3e41a25132 100644 --- a/compiler/GHC/Iface/Type.hs +++ b/compiler/GHC/Iface/Type.hs @@ -1472,8 +1472,19 @@ pprIfaceTyList :: PprPrec -> IfaceType -> IfaceType -> SDoc pprIfaceTyList ctxt_prec ty1 ty2 = case gather ty2 of (arg_tys, Nothing) - -> char '\'' <> brackets (spaceIfSingleQuote (fsep - (punctuate comma (map (ppr_ty topPrec) (ty1:arg_tys))))) + -> + sdocWithContext $ \ctx -> + let + items = ty1:arg_tys + eos = isListEmptyOrSingleton items + ticked = promTick (sdocStyle ctx) (PromotedItemListSyntax eos) + (preBracket, postBracket) = + if ticked + then (char '\'', spaceIfSingleQuote) + else (empty, id) + in + preBracket <> brackets (postBracket (fsep + (punctuate comma (map (ppr_ty topPrec) items)))) (arg_tys, Just tl) -> maybeParen ctxt_prec funPrec $ hang (ppr_ty funPrec ty1) 2 (fsep [ colon <+> ppr_ty funPrec ty | ty <- arg_tys ++ [tl]]) @@ -1864,11 +1875,21 @@ instance Outputable IfaceTyConInfo where pprPromotionQuote :: IfaceTyCon -> SDoc pprPromotionQuote tc = - pprPromotionQuoteI $ ifaceTyConIsPromoted $ ifaceTyConInfo tc + getPprStyle $ \sty -> + let + name = getOccName (ifaceTyConName tc) + ticked = + case ifaceTyConIsPromoted (ifaceTyConInfo tc) of + NotPromoted -> False + IsPromoted -> promTick sty (PromotedItemDataCon name) + in + if ticked + then char '\'' + else empty pprPromotionQuoteI :: PromotionFlag -> SDoc pprPromotionQuoteI NotPromoted = empty -pprPromotionQuoteI IsPromoted = char '\'' +pprPromotionQuoteI IsPromoted = char '\'' instance Outputable IfaceCoercion where ppr = pprIfaceCoercion diff --git a/compiler/GHC/Runtime/Context.hs b/compiler/GHC/Runtime/Context.hs index 3ddb886a0d..388ae69aea 100644 --- a/compiler/GHC/Runtime/Context.hs +++ b/compiler/GHC/Runtime/Context.hs @@ -10,7 +10,7 @@ module GHC.Runtime.Context , icReaderEnv , icInteractiveModule , icInScopeTTs - , icPrintUnqual + , icNamePprCtx ) where @@ -349,9 +349,10 @@ icInScopeTTs ictxt = filter in_scope_unqualified (ic_tythings ictxt) ] --- | Get the PrintUnqualified function based on the flags and this InteractiveContext -icPrintUnqual :: UnitEnv -> InteractiveContext -> PrintUnqualified -icPrintUnqual unit_env ictxt = mkPrintUnqualified unit_env (icReaderEnv ictxt) +-- | Get the NamePprCtx function based on the flags and this InteractiveContext +icNamePprCtx :: UnitEnv -> InteractiveContext -> NamePprCtx +icNamePprCtx unit_env ictxt = mkNamePprCtx ptc unit_env (icReaderEnv ictxt) + where ptc = initPromotionTickContext (ic_dflags ictxt) -- | extendInteractiveContext is called with new TyThings recently defined to update the -- InteractiveContext to include them. By putting new things first, unqualified diff --git a/compiler/GHC/Runtime/Debugger.hs b/compiler/GHC/Runtime/Debugger.hs index 59fd31dc5b..a89227aada 100644 --- a/compiler/GHC/Runtime/Debugger.hs +++ b/compiler/GHC/Runtime/Debugger.hs @@ -97,8 +97,8 @@ pprintClosureCommand bindThings force str = do printSDocs :: GhcMonad m => [SDoc] -> m () printSDocs sdocs = do logger <- getLogger - unqual <- GHC.getPrintUnqual - liftIO $ printOutputForUser logger unqual $ vcat sdocs + name_ppr_ctx <- GHC.getNamePprCtx + liftIO $ printOutputForUser logger name_ppr_ctx $ vcat sdocs -- Do the obtainTerm--bindSuspensions-computeSubstitution dance go :: GhcMonad m => Subst -> Id -> m (Subst, Term) diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs index 2c34b15f6f..04fd3b0656 100644 --- a/compiler/GHC/Tc/Utils/Monad.hs +++ b/compiler/GHC/Tc/Utils/Monad.hs @@ -46,7 +46,7 @@ module GHC.Tc.Utils.Monad( -- * Debugging traceTc, traceRn, traceOptTcRn, dumpOptTcRn, dumpTcRn, - getPrintUnqualified, + getNamePprCtx, printForUserTcRn, traceIf, traceOptIf, debugTc, @@ -847,11 +847,11 @@ dumpOptTcRn flag title fmt doc = dumpTcRn :: Bool -> DumpFlag -> String -> DumpFormat -> SDoc -> TcRn () dumpTcRn useUserStyle flag title fmt doc = do logger <- getLogger - printer <- getPrintUnqualified + name_ppr_ctx <- getNamePprCtx real_doc <- wrapDocLoc doc let sty = if useUserStyle - then mkUserStyle printer AllTheWay - else mkDumpStyle printer + then mkUserStyle name_ppr_ctx AllTheWay + else mkDumpStyle name_ppr_ctx liftIO $ logDumpFile logger sty flag title fmt real_doc -- | Add current location if -dppr-debug @@ -866,18 +866,19 @@ wrapDocLoc doc = do else return doc -getPrintUnqualified :: TcRn PrintUnqualified -getPrintUnqualified - = do { rdr_env <- getGlobalRdrEnv +getNamePprCtx :: TcRn NamePprCtx +getNamePprCtx + = do { ptc <- initPromotionTickContext <$> getDynFlags + ; rdr_env <- getGlobalRdrEnv ; hsc_env <- getTopEnv - ; return $ mkPrintUnqualified (hsc_unit_env hsc_env) rdr_env } + ; return $ mkNamePprCtx ptc (hsc_unit_env hsc_env) rdr_env } -- | Like logInfoTcRn, but for user consumption printForUserTcRn :: SDoc -> TcRn () printForUserTcRn doc = do logger <- getLogger - printer <- getPrintUnqualified - liftIO (printOutputForUser logger printer doc) + name_ppr_ctx <- getNamePprCtx + liftIO (printOutputForUser logger name_ppr_ctx doc) {- traceIf works in the TcRnIf monad, where no RdrEnv is @@ -1117,9 +1118,9 @@ add_long_err_at loc msg = mk_long_err_at loc msg >>= reportDiagnostic where mk_long_err_at :: SrcSpan -> TcRnMessageDetailed -> TcRn (MsgEnvelope TcRnMessage) mk_long_err_at loc msg - = do { printer <- getPrintUnqualified ; + = do { name_ppr_ctx <- getNamePprCtx ; unit_state <- hsc_units <$> getTopEnv ; - return $ mkErrorMsgEnvelope loc printer + return $ mkErrorMsgEnvelope loc name_ppr_ctx $ TcRnMessageWithInfo unit_state msg } @@ -1127,9 +1128,9 @@ mkTcRnMessage :: SrcSpan -> TcRnMessage -> TcRn (MsgEnvelope TcRnMessage) mkTcRnMessage loc msg - = do { printer <- getPrintUnqualified ; + = do { name_ppr_ctx <- getNamePprCtx ; diag_opts <- initDiagOpts <$> getDynFlags ; - return $ mkMsgEnvelope diag_opts loc printer msg } + return $ mkMsgEnvelope diag_opts loc name_ppr_ctx msg } reportDiagnostics :: [MsgEnvelope TcRnMessage] -> TcM () reportDiagnostics = mapM_ reportDiagnostic @@ -1613,12 +1614,12 @@ addDiagnosticTcM (env0, msg) addDetailedDiagnostic :: (ErrInfo -> TcRnMessage) -> TcM () addDetailedDiagnostic mkMsg = do loc <- getSrcSpanM - printer <- getPrintUnqualified + name_ppr_ctx <- getNamePprCtx !diag_opts <- initDiagOpts <$> getDynFlags env0 <- tcInitTidyEnv ctxt <- getErrCtxt err_info <- mkErrInfo env0 ctxt - reportDiagnostic (mkMsgEnvelope diag_opts loc printer (mkMsg (ErrInfo err_info empty))) + reportDiagnostic (mkMsgEnvelope diag_opts loc name_ppr_ctx (mkMsg (ErrInfo err_info empty))) addTcRnDiagnostic :: TcRnMessage -> TcM () addTcRnDiagnostic msg = do diff --git a/compiler/GHC/Types/Error.hs b/compiler/GHC/Types/Error.hs index 3bc7937df0..695072e632 100644 --- a/compiler/GHC/Types/Error.hs +++ b/compiler/GHC/Types/Error.hs @@ -351,7 +351,7 @@ instance Outputable DiagnosticReason where data MsgEnvelope e = MsgEnvelope { errMsgSpan :: SrcSpan -- ^ The SrcSpan is used for sorting errors into line-number order - , errMsgContext :: PrintUnqualified + , errMsgContext :: NamePprCtx , errMsgDiagnostic :: e , errMsgSeverity :: Severity } deriving (Functor, Foldable, Traversable) diff --git a/compiler/GHC/Types/Name/Ppr.hs b/compiler/GHC/Types/Name/Ppr.hs index 3a4dfdc018..2670b27cd9 100644 --- a/compiler/GHC/Types/Name/Ppr.hs +++ b/compiler/GHC/Types/Name/Ppr.hs @@ -1,7 +1,7 @@ module GHC.Types.Name.Ppr - ( mkPrintUnqualified + ( mkNamePprCtx , mkQualModule , mkQualPackage , pkgQual @@ -9,6 +9,7 @@ module GHC.Types.Name.Ppr where import GHC.Prelude +import GHC.Data.FastString import GHC.Unit import GHC.Unit.Env @@ -52,7 +53,7 @@ There's one further subtlety: in case (3), what if there are two things around, P1:M.T and P2:M.T? Then we don't want to print both of them as M.T! However only one of the modules P1:M and P2:M can be exposed (say P2), so we use M.T for that, and P1:M.T for the other one. -This is handled by the qual_mod component of PrintUnqualified, inside +This is handled by the qual_mod component of NamePprCtx, inside the (ppr mod) of case (3), in Name.pprModulePrefix Note [Printing unit ids] @@ -66,14 +67,19 @@ with some holes, we should try to give the user some more useful information. -- | Creates some functions that work out the best ways to format -- names for the user according to a set of heuristics. -mkPrintUnqualified :: UnitEnv -> GlobalRdrEnv -> PrintUnqualified -mkPrintUnqualified unit_env env - = QueryQualify qual_name +mkNamePprCtx :: PromotionTickContext -> UnitEnv -> GlobalRdrEnv -> NamePprCtx +mkNamePprCtx ptc unit_env env + = QueryQualify + (mkQualName env) (mkQualModule unit_state home_unit) (mkQualPackage unit_state) + (mkPromTick ptc env) where unit_state = ue_units unit_env home_unit = ue_homeUnit unit_env + +mkQualName :: GlobalRdrEnv -> QueryQualifyName +mkQualName env = qual_name where qual_name mod occ | [gre] <- unqual_gres , right_name gre @@ -125,6 +131,35 @@ mkPrintUnqualified unit_env env -- "import M" would resolve unambiguously to P:M. (if P is the -- current package we can just assume it is unqualified). +mkPromTick :: PromotionTickContext -> GlobalRdrEnv -> QueryPromotionTick +mkPromTick ptc env + | ptcPrintRedundantPromTicks ptc = alwaysPrintPromTick + | otherwise = print_prom_tick + where + print_prom_tick (PromotedItemListSyntax (IsEmptyOrSingleton eos)) = + -- Ticked: '[], '[x] + -- Unticked: [x,y], [x,y,z], and so on + ptcListTuplePuns ptc && eos + print_prom_tick PromotedItemTupleSyntax = + ptcListTuplePuns ptc + print_prom_tick (PromotedItemDataCon occ) + | isPunnedDataConName occ -- '[], '(,), ''(,,) + = ptcListTuplePuns ptc + + | Just occ' <- promoteOccName occ + , [] <- lookupGRE_RdrName (mkRdrUnqual occ') env + = -- Could not find a corresponding type name in the environment, + -- so the data name is unambiguous. Promotion tick not needed. + False + | otherwise = True + +isPunnedDataConName :: OccName -> Bool +isPunnedDataConName occ = + isDataOcc occ && case unpackFS (occNameFS occ) of + '[':_ -> True + '(':_ -> True + _ -> False + {- Note [pretendNameIsInScopeForPpr] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ c.f. Note [pretendNameIsInScope] in GHC.Builtin.Names @@ -200,5 +235,5 @@ mkQualPackage pkgs uid -- | A function which only qualifies package names if necessary; but -- qualifies all other identifiers. -pkgQual :: UnitState -> PrintUnqualified +pkgQual :: UnitState -> NamePprCtx pkgQual pkgs = alwaysQualify { queryQualifyPackage = mkQualPackage pkgs } diff --git a/compiler/GHC/Utils/Error.hs b/compiler/GHC/Utils/Error.hs index def40ea728..8910dd4d38 100644 --- a/compiler/GHC/Utils/Error.hs +++ b/compiler/GHC/Utils/Error.hs @@ -141,12 +141,12 @@ mk_msg_envelope :: Diagnostic e => Severity -> SrcSpan - -> PrintUnqualified + -> NamePprCtx -> e -> MsgEnvelope e -mk_msg_envelope severity locn print_unqual err +mk_msg_envelope severity locn name_ppr_ctx err = MsgEnvelope { errMsgSpan = locn - , errMsgContext = print_unqual + , errMsgContext = name_ppr_ctx , errMsgDiagnostic = err , errMsgSeverity = severity } @@ -158,22 +158,22 @@ mkMsgEnvelope :: Diagnostic e => DiagOpts -> SrcSpan - -> PrintUnqualified + -> NamePprCtx -> e -> MsgEnvelope e -mkMsgEnvelope opts locn print_unqual err - = mk_msg_envelope (diagReasonSeverity opts (diagnosticReason err)) locn print_unqual err +mkMsgEnvelope opts locn name_ppr_ctx err + = mk_msg_envelope (diagReasonSeverity opts (diagnosticReason err)) locn name_ppr_ctx err -- | Wrap a 'Diagnostic' in a 'MsgEnvelope', recording its location. -- Precondition: the diagnostic is, in fact, an error. That is, -- @diagnosticReason msg == ErrorWithoutFlag@. mkErrorMsgEnvelope :: Diagnostic e => SrcSpan - -> PrintUnqualified + -> NamePprCtx -> e -> MsgEnvelope e -mkErrorMsgEnvelope locn unqual msg = - assert (diagnosticReason msg == ErrorWithoutFlag) $ mk_msg_envelope SevError locn unqual msg +mkErrorMsgEnvelope locn name_ppr_ctx msg = + assert (diagnosticReason msg == ErrorWithoutFlag) $ mk_msg_envelope SevError locn name_ppr_ctx msg -- | Variant that doesn't care about qualified/unqualified names. mkPlainMsgEnvelope :: Diagnostic e @@ -247,9 +247,9 @@ pprLocMsgEnvelope :: Diagnostic e => DiagnosticOpts e -> MsgEnvelope e -> SDoc pprLocMsgEnvelope opts (MsgEnvelope { errMsgSpan = s , errMsgDiagnostic = e , errMsgSeverity = sev - , errMsgContext = unqual }) + , errMsgContext = name_ppr_ctx }) = sdocWithContext $ \ctx -> - withErrStyle unqual $ + withErrStyle name_ppr_ctx $ mkLocMessage (MCDiagnostic sev (diagnosticReason e) (diagnosticCode e)) s @@ -430,13 +430,13 @@ debugTraceMsg logger val msg = putMsg :: Logger -> SDoc -> IO () putMsg logger msg = logInfo logger (withPprStyle defaultUserStyle msg) -printInfoForUser :: Logger -> PrintUnqualified -> SDoc -> IO () -printInfoForUser logger print_unqual msg - = logInfo logger (withUserStyle print_unqual AllTheWay msg) +printInfoForUser :: Logger -> NamePprCtx -> SDoc -> IO () +printInfoForUser logger name_ppr_ctx msg + = logInfo logger (withUserStyle name_ppr_ctx AllTheWay msg) -printOutputForUser :: Logger -> PrintUnqualified -> SDoc -> IO () -printOutputForUser logger print_unqual msg - = logOutput logger (withUserStyle print_unqual AllTheWay msg) +printOutputForUser :: Logger -> NamePprCtx -> SDoc -> IO () +printOutputForUser logger name_ppr_ctx msg + = logOutput logger (withUserStyle name_ppr_ctx AllTheWay msg) logInfo :: Logger -> SDoc -> IO () logInfo logger msg = logMsg logger MCInfo noSrcSpan msg diff --git a/compiler/GHC/Utils/Logger.hs b/compiler/GHC/Utils/Logger.hs index cb79b7320b..4603b42d7b 100644 --- a/compiler/GHC/Utils/Logger.hs +++ b/compiler/GHC/Utils/Logger.hs @@ -553,29 +553,29 @@ putDumpFileMaybe logger = putDumpFileMaybe' logger alwaysQualify -- | Dump if the given DumpFlag is set -- --- Unlike 'putDumpFileMaybe', has a PrintUnqualified argument +-- Unlike 'putDumpFileMaybe', has a NamePprCtx argument putDumpFileMaybe' :: Logger - -> PrintUnqualified + -> NamePprCtx -> DumpFlag -> String -> DumpFormat -> SDoc -> IO () -putDumpFileMaybe' logger printer flag hdr fmt doc +putDumpFileMaybe' logger name_ppr_ctx flag hdr fmt doc = when (logHasDumpFlag logger flag) $ - logDumpFile' logger printer flag hdr fmt doc + logDumpFile' logger name_ppr_ctx flag hdr fmt doc {-# INLINE putDumpFileMaybe' #-} -- see Note [INLINE conditional tracing utilities] -logDumpFile' :: Logger -> PrintUnqualified -> DumpFlag +logDumpFile' :: Logger -> NamePprCtx -> DumpFlag -> String -> DumpFormat -> SDoc -> IO () {-# NOINLINE logDumpFile' #-} -- NOINLINE: Now we are past the conditional, into the "cold" path, -- don't inline, to reduce code size at the call site -- See Note [INLINE conditional tracing utilities] -logDumpFile' logger printer flag hdr fmt doc - = logDumpFile logger (mkDumpStyle printer) flag hdr fmt doc +logDumpFile' logger name_ppr_ctx flag hdr fmt doc + = logDumpFile logger (mkDumpStyle name_ppr_ctx) flag hdr fmt doc -- | Ensure that a dump file is created even if it stays empty touchDumpFile :: Logger -> DumpFlag -> IO () diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs index 09be4b1c2d..812edf15cd 100644 --- a/compiler/GHC/Utils/Outputable.hs +++ b/compiler/GHC/Utils/Outputable.hs @@ -86,12 +86,15 @@ module GHC.Utils.Outputable ( -- * Controlling the style in which output is printed BindingSite(..), - PprStyle(..), PrintUnqualified(..), - QueryQualifyName, QueryQualifyModule, QueryQualifyPackage, + PprStyle(..), NamePprCtx(..), + QueryQualifyName, QueryQualifyModule, QueryQualifyPackage, QueryPromotionTick, + PromotedItem(..), IsEmptyOrSingleton(..), isListEmptyOrSingleton, + PromotionTickContext(..), reallyAlwaysQualify, reallyAlwaysQualifyNames, alwaysQualify, alwaysQualifyNames, alwaysQualifyModules, neverQualify, neverQualifyNames, neverQualifyModules, alwaysQualifyPackages, neverQualifyPackages, + alwaysPrintPromTick, QualifyName(..), queryQual, sdocOption, updSDocContext, @@ -100,7 +103,7 @@ module GHC.Utils.Outputable ( getPprStyle, withPprStyle, setStyleColoured, pprDeeper, pprDeeperList, pprSetDepth, codeStyle, userStyle, dumpStyle, - qualName, qualModule, qualPackage, + qualName, qualModule, qualPackage, promTick, mkErrStyle, defaultErrStyle, defaultDumpStyle, mkDumpStyle, defaultUserStyle, mkUserStyle, cmdlineParserStyle, Depth(..), withUserStyle, withErrStyle, @@ -163,14 +166,14 @@ import GHC.Exts (oneShot) -} data PprStyle - = PprUser PrintUnqualified Depth Coloured + = PprUser NamePprCtx Depth Coloured -- Pretty-print in a way that will make sense to the -- ordinary user; must be very close to Haskell -- syntax, etc. -- Assumes printing tidied code: non-system names are -- printed without uniques. - | PprDump PrintUnqualified + | PprDump NamePprCtx -- For -ddump-foo; less verbose than in ppr-debug mode, but more than PprUser -- Does not assume tidied code: non-external names -- are printed with uniques. @@ -193,10 +196,11 @@ data Coloured -- original names back to something the user understands. This is the -- purpose of the triple of functions that gets passed around -- when rendering 'SDoc'. -data PrintUnqualified = QueryQualify { +data NamePprCtx = QueryQualify { queryQualifyName :: QueryQualifyName, queryQualifyModule :: QueryQualifyModule, - queryQualifyPackage :: QueryQualifyPackage + queryQualifyPackage :: QueryQualifyPackage, + queryPromotionTick :: QueryPromotionTick } -- | Given a `Name`'s `Module` and `OccName`, decide whether and how to qualify @@ -211,6 +215,31 @@ type QueryQualifyModule = Module -> Bool -- the component id to disambiguate it. type QueryQualifyPackage = Unit -> Bool +-- | Given a promoted data constructor, +-- decide whether to print a tick to disambiguate the namespace. +type QueryPromotionTick = PromotedItem -> Bool + +-- | Flags that affect whether a promotion tick is printed. +data PromotionTickContext = + PromTickCtx { + ptcListTuplePuns :: !Bool, + ptcPrintRedundantPromTicks :: !Bool + } + +data PromotedItem = + PromotedItemListSyntax IsEmptyOrSingleton -- '[x] + | PromotedItemTupleSyntax -- '(x, y) + | PromotedItemDataCon OccName -- 'MkT + +newtype IsEmptyOrSingleton = IsEmptyOrSingleton Bool + +isListEmptyOrSingleton :: [a] -> IsEmptyOrSingleton +isListEmptyOrSingleton xs = + IsEmptyOrSingleton $ case xs of + [] -> True + [_] -> True + _ -> False + -- See Note [Printing original names] in GHC.Types.Name.Ppr data QualifyName -- Given P:M.T = NameUnqual -- It's in scope unqualified as "T" @@ -252,17 +281,23 @@ alwaysQualifyPackages _ = True neverQualifyPackages :: QueryQualifyPackage neverQualifyPackages _ = False -reallyAlwaysQualify, alwaysQualify, neverQualify :: PrintUnqualified +alwaysPrintPromTick :: QueryPromotionTick +alwaysPrintPromTick _ = True + +reallyAlwaysQualify, alwaysQualify, neverQualify :: NamePprCtx reallyAlwaysQualify = QueryQualify reallyAlwaysQualifyNames alwaysQualifyModules alwaysQualifyPackages + alwaysPrintPromTick alwaysQualify = QueryQualify alwaysQualifyNames alwaysQualifyModules alwaysQualifyPackages + alwaysPrintPromTick neverQualify = QueryQualify neverQualifyNames neverQualifyModules neverQualifyPackages + alwaysPrintPromTick defaultUserStyle :: PprStyle defaultUserStyle = mkUserStyle neverQualify AllTheWay @@ -271,31 +306,31 @@ defaultDumpStyle :: PprStyle -- Print without qualifiers to reduce verbosity, unless -dppr-debug defaultDumpStyle = PprDump neverQualify -mkDumpStyle :: PrintUnqualified -> PprStyle -mkDumpStyle print_unqual = PprDump print_unqual +mkDumpStyle :: NamePprCtx -> PprStyle +mkDumpStyle name_ppr_ctx = PprDump name_ppr_ctx --- | Default style for error messages, when we don't know PrintUnqualified +-- | Default style for error messages, when we don't know NamePprCtx -- It's a bit of a hack because it doesn't take into account what's in scope -- Only used for desugarer warnings, and typechecker errors in interface sigs defaultErrStyle :: PprStyle defaultErrStyle = mkErrStyle neverQualify -- | Style for printing error messages -mkErrStyle :: PrintUnqualified -> PprStyle -mkErrStyle unqual = mkUserStyle unqual DefaultDepth +mkErrStyle :: NamePprCtx -> PprStyle +mkErrStyle name_ppr_ctx = mkUserStyle name_ppr_ctx DefaultDepth cmdlineParserStyle :: PprStyle cmdlineParserStyle = mkUserStyle alwaysQualify AllTheWay -mkUserStyle :: PrintUnqualified -> Depth -> PprStyle -mkUserStyle unqual depth = PprUser unqual depth Uncoloured +mkUserStyle :: NamePprCtx -> Depth -> PprStyle +mkUserStyle name_ppr_ctx depth = PprUser name_ppr_ctx depth Uncoloured -withUserStyle :: PrintUnqualified -> Depth -> SDoc -> SDoc -withUserStyle unqual depth doc = withPprStyle (PprUser unqual depth Uncoloured) doc +withUserStyle :: NamePprCtx -> Depth -> SDoc -> SDoc +withUserStyle name_ppr_ctx depth doc = withPprStyle (PprUser name_ppr_ctx depth Uncoloured) doc -withErrStyle :: PrintUnqualified -> SDoc -> SDoc -withErrStyle unqual doc = - withPprStyle (mkErrStyle unqual) doc +withErrStyle :: NamePprCtx -> SDoc -> SDoc +withErrStyle name_ppr_ctx doc = + withPprStyle (mkErrStyle name_ppr_ctx) doc setStyleColoured :: Bool -> PprStyle -> PprStyle setStyleColoured col style = @@ -534,10 +569,16 @@ qualPackage (PprUser q _ _) m = queryQualifyPackage q m qualPackage (PprDump q) m = queryQualifyPackage q m qualPackage _other _m = True -queryQual :: PprStyle -> PrintUnqualified +promTick :: PprStyle -> QueryPromotionTick +promTick (PprUser q _ _) occ = queryPromotionTick q occ +promTick (PprDump q) occ = queryPromotionTick q occ +promTick _ _ = True + +queryQual :: PprStyle -> NamePprCtx queryQual s = QueryQualify (qualName s) (qualModule s) (qualPackage s) + (promTick s) codeStyle :: PprStyle -> Bool codeStyle PprCode = True diff --git a/docs/users_guide/using.rst b/docs/users_guide/using.rst index 645bea8ef2..388704388c 100644 --- a/docs/users_guide/using.rst +++ b/docs/users_guide/using.rst @@ -1252,6 +1252,53 @@ messages and in GHCi: Expected type: ST s Int Actual type: ST s Bool +.. ghc-flag:: -fprint-redundant-promotion-ticks + :shortdesc: Print redundant :extension:`DataKinds` promotion ticks + :type: dynamic + :reverse: -fno-print-redundant-promotion-ticks + :category: verbosity + + The :extension:`DataKinds` extension allows us to use data constructors at + the type level:: + + type B = True -- refers to the data constructor True (of type Bool) + + When there is a type constructor of the same name, it takes precedence + during name resolution:: + + data True = MkT + type B = True -- now refers to the type constructor (of kind Type) + + We can tell GHC to prefer the data constructor over the type constructor + using special namespace disambiguation syntax that we call a *promotion + tick*:: + + data True = MkT + type B = 'True + -- refers to the data constructor True (of type Bool) + -- even in the presence of a type constructor of the same name + + Note that the promotion tick is not a promotion operator. Its only purpose + is to instruct GHC to prefer the promoted data constructor over a type + constructor in case of a name conflict. Therefore, GHC will not print the + tick when the name conflict is absent: + + .. code-block:: none + + ghci> type B = False + ghci> :kind! B + B :: Bool + = False -- no promotion tick here + + ghci> data False -- introduce a name conflict + + ghci> :kind! B + B :: Bool + = 'False -- promotion tick resolves the name conflict + + The :ghc-flag:`-fprint-redundant-promotion-ticks` instructs GHC to print the + promotion tick unconditionally. + .. ghc-flag:: -fprint-typechecker-elaboration :shortdesc: Print extra information from typechecker. :type: dynamic diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index 9327ac6da7..a2d16080f8 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -302,8 +302,8 @@ showSDocForUser' :: GHC.GhcMonad m => SDoc -> m String showSDocForUser' doc = do dflags <- getDynFlags unit_state <- hsc_units <$> GHC.getSession - unqual <- GHC.getPrintUnqual - pure $ showSDocForUser dflags unit_state unqual doc + name_ppr_ctx <- GHC.getNamePprCtx + pure $ showSDocForUser dflags unit_state name_ppr_ctx doc showSDocForUserQualify :: GHC.GhcMonad m => SDoc -> m String showSDocForUserQualify doc = do diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs index 3e6b834e11..fdd083c47b 100644 --- a/ghc/GHCi/UI/Monad.hs +++ b/ghc/GHCi/UI/Monad.hs @@ -364,21 +364,21 @@ printForUserNeverQualify doc = do printForUserModInfo :: GhcMonad m => GHC.ModuleInfo -> SDoc -> m () printForUserModInfo info doc = do dflags <- GHC.getInteractiveDynFlags - mUnqual <- GHC.mkPrintUnqualifiedForModule info - unqual <- maybe GHC.getPrintUnqual return mUnqual - liftIO $ Ppr.printForUser dflags stdout unqual AllTheWay doc + m_name_ppr_ctx <- GHC.mkNamePprCtxForModule info + name_ppr_ctx <- maybe GHC.getNamePprCtx return m_name_ppr_ctx + liftIO $ Ppr.printForUser dflags stdout name_ppr_ctx AllTheWay doc printForUser :: GhcMonad m => SDoc -> m () printForUser doc = do - unqual <- GHC.getPrintUnqual + name_ppr_ctx <- GHC.getNamePprCtx dflags <- GHC.getInteractiveDynFlags - liftIO $ Ppr.printForUser dflags stdout unqual AllTheWay doc + liftIO $ Ppr.printForUser dflags stdout name_ppr_ctx AllTheWay doc printForUserPartWay :: GhcMonad m => SDoc -> m () printForUserPartWay doc = do - unqual <- GHC.getPrintUnqual + name_ppr_ctx <- GHC.getNamePprCtx dflags <- GHC.getInteractiveDynFlags - liftIO $ Ppr.printForUser dflags stdout unqual DefaultDepth doc + liftIO $ Ppr.printForUser dflags stdout name_ppr_ctx DefaultDepth doc -- | Run a single Haskell expression runStmt diff --git a/testsuite/tests/dependent/should_fail/T11471.stderr b/testsuite/tests/dependent/should_fail/T11471.stderr index c0292270cc..377d1da759 100644 --- a/testsuite/tests/dependent/should_fail/T11471.stderr +++ b/testsuite/tests/dependent/should_fail/T11471.stderr @@ -3,7 +3,7 @@ T11471.hs:15:10: error: [GHC-18872] • Couldn't match a lifted type with an unlifted type When matching types a :: * - Int# :: TYPE 'IntRep + Int# :: TYPE IntRep Expected: Proxy a Actual: Proxy Int# • In the first argument of ‘f’, namely ‘(undefined :: Proxy Int#)’ diff --git a/testsuite/tests/dependent/should_fail/T13135_simple.stderr b/testsuite/tests/dependent/should_fail/T13135_simple.stderr index 68f5dd3e30..0a3a4d578a 100644 --- a/testsuite/tests/dependent/should_fail/T13135_simple.stderr +++ b/testsuite/tests/dependent/should_fail/T13135_simple.stderr @@ -2,7 +2,7 @@ T13135_simple.hs:34:11: error: [GHC-83865] • Couldn't match type ‘SmartFun sig’ with ‘Bool’ Expected: Int -> Bool - Actual: SmartFun ('SigFun Int sig) + Actual: SmartFun (SigFun Int sig) The type variable ‘sig’ is ambiguous • In the expression: smartSym In an equation for ‘problem’: problem = smartSym diff --git a/testsuite/tests/dependent/should_fail/T17131.stderr b/testsuite/tests/dependent/should_fail/T17131.stderr index 3bc040f45b..e1bea915eb 100644 --- a/testsuite/tests/dependent/should_fail/T17131.stderr +++ b/testsuite/tests/dependent/should_fail/T17131.stderr @@ -2,8 +2,8 @@ T17131.hs:12:34: error: [GHC-83865] • Couldn't match kind: TypeReps xs with: '[LiftedRep] - Expected kind ‘TYPE ('TupleRep (TypeReps xs))’, - but ‘(# a #)’ has kind ‘TYPE ('TupleRep '[LiftedRep])’ + Expected kind ‘TYPE (TupleRep (TypeReps xs))’, + but ‘(# a #)’ has kind ‘TYPE (TupleRep '[LiftedRep])’ The type variable ‘xs’ is ambiguous • In the type ‘(# a #)’ In the type family declaration for ‘Tuple#’ diff --git a/testsuite/tests/dependent/should_fail/T17541.stderr b/testsuite/tests/dependent/should_fail/T17541.stderr index ed30993549..b37cf260b3 100644 --- a/testsuite/tests/dependent/should_fail/T17541.stderr +++ b/testsuite/tests/dependent/should_fail/T17541.stderr @@ -1,7 +1,7 @@ T17541.hs:19:17: error: [GHC-83865] - • Couldn't match kind ‘Rep rep’ with ‘'IntRep’ - Expected kind ‘TYPE (Rep rep)’, but ‘Int#’ has kind ‘TYPE 'IntRep’ + • Couldn't match kind ‘Rep rep’ with ‘IntRep’ + Expected kind ‘TYPE (Rep rep)’, but ‘Int#’ has kind ‘TYPE IntRep’ The type variable ‘rep’ is ambiguous • In the type ‘Int#’ In the type family declaration for ‘Unboxed’ diff --git a/testsuite/tests/ffi/should_fail/T21305_fail.stderr b/testsuite/tests/ffi/should_fail/T21305_fail.stderr index 542d401167..ada932f173 100644 --- a/testsuite/tests/ffi/should_fail/T21305_fail.stderr +++ b/testsuite/tests/ffi/should_fail/T21305_fail.stderr @@ -2,7 +2,7 @@ T21305_fail.hs:7:1: error: [GHC-64097] • Unacceptable argument type in foreign declaration: Expected kind ‘Type’ or ‘UnliftedType’, - but ‘Any’ has kind ‘TYPE ('BoxedRep l)’ + but ‘Any’ has kind ‘TYPE (BoxedRep l)’ • When checking declaration: foreign import prim safe "g" g :: forall (l :: Levity). Any @(TYPE (BoxedRep l)) -> Any @@ -10,6 +10,6 @@ T21305_fail.hs:7:1: error: [GHC-64097] T21305_fail.hs:9:1: error: [GHC-64097] • Unacceptable argument type in foreign declaration: Expected kind ‘Type’ or ‘UnliftedType’, - but ‘Any’ has kind ‘TYPE 'IntRep’ + but ‘Any’ has kind ‘TYPE IntRep’ • When checking declaration: foreign import prim safe "f" f :: Any @(TYPE IntRep) -> Any diff --git a/testsuite/tests/gadt/T7293.stderr b/testsuite/tests/gadt/T7293.stderr index deb1446127..8dcef1a732 100644 --- a/testsuite/tests/gadt/T7293.stderr +++ b/testsuite/tests/gadt/T7293.stderr @@ -5,8 +5,8 @@ T7293.hs:26:1: error: [GHC-53633] [-Woverlapping-patterns (in -Wdefault), Werror T7293.hs:26:5: error: [GHC-40564] [-Winaccessible-code (in -Wdefault), Werror=inaccessible-code] • Inaccessible code in - a pattern with constructor: Nil :: forall a. Vec a 'Zero, + a pattern with constructor: Nil :: forall a. Vec a Zero, in an equation for ‘nth’ - Couldn't match type ‘'False’ with ‘'True’ + Couldn't match type ‘False’ with ‘True’ • In the pattern: Nil In an equation for ‘nth’: nth Nil _ = undefined diff --git a/testsuite/tests/gadt/T7294.stderr b/testsuite/tests/gadt/T7294.stderr index 9d465fda69..6f770404c0 100644 --- a/testsuite/tests/gadt/T7294.stderr +++ b/testsuite/tests/gadt/T7294.stderr @@ -5,8 +5,8 @@ T7294.hs:27:1: warning: [GHC-53633] [-Woverlapping-patterns (in -Wdefault)] T7294.hs:27:5: warning: [GHC-40564] [-Winaccessible-code (in -Wdefault)] • Inaccessible code in - a pattern with constructor: Nil :: forall a. Vec a 'Zero, + a pattern with constructor: Nil :: forall a. Vec a Zero, in an equation for ‘nth’ - Couldn't match type ‘'False’ with ‘'True’ + Couldn't match type ‘False’ with ‘True’ • In the pattern: Nil In an equation for ‘nth’: nth Nil _ = undefined diff --git a/testsuite/tests/ghci/T18060/T18060.stdout b/testsuite/tests/ghci/T18060/T18060.stdout index f6a4ebb43d..f322bcb12c 100644 --- a/testsuite/tests/ghci/T18060/T18060.stdout +++ b/testsuite/tests/ghci/T18060/T18060.stdout @@ -1,5 +1,5 @@ type (->) :: * -> * -> * -type (->) = FUN 'Many :: * -> * -> * +type (->) = FUN Many :: * -> * -> * -- Defined in ‘GHC.Types’ infixr -1 -> instance Monoid b => Monoid (a -> b) -- Defined in ‘GHC.Base’ diff --git a/testsuite/tests/ghci/T18262/T18262.stdout b/testsuite/tests/ghci/T18262/T18262.stdout index 13868ead5a..dae6eebc4e 100644 --- a/testsuite/tests/ghci/T18262/T18262.stdout +++ b/testsuite/tests/ghci/T18262/T18262.stdout @@ -1 +1 @@ -instance [safe] Err 'B -- Defined at T18262.hs:11:10 +instance [safe] Err B -- Defined at T18262.hs:11:10 diff --git a/testsuite/tests/ghci/scripts/GhciKinds.stdout b/testsuite/tests/ghci/scripts/GhciKinds.stdout index b00c8650e6..6217619c9e 100644 --- a/testsuite/tests/ghci/scripts/GhciKinds.stdout +++ b/testsuite/tests/ghci/scripts/GhciKinds.stdout @@ -13,5 +13,5 @@ $(unboxedTupleT 2) :: forall (k0 :: RuntimeRep) (k1 :: RuntimeRep). TYPE k0 -> TYPE k1 -> TYPE - ('TupleRep - ((':) @RuntimeRep k0 ((':) @RuntimeRep k1 ('[] @RuntimeRep)))) + (TupleRep + ((:) @RuntimeRep k0 ((:) @RuntimeRep k1 ('[] @RuntimeRep)))) diff --git a/testsuite/tests/ghci/scripts/T20974.stdout b/testsuite/tests/ghci/scripts/T20974.stdout index 6cfee4e9a4..0918e83959 100644 --- a/testsuite/tests/ghci/scripts/T20974.stdout +++ b/testsuite/tests/ghci/scripts/T20974.stdout @@ -1 +1 @@ -test :: F '[Monad, A, B] m => m () +test :: F [Monad, A, B] m => m () diff --git a/testsuite/tests/ghci/scripts/T6018ghcifail.stderr b/testsuite/tests/ghci/scripts/T6018ghcifail.stderr index af3d7480eb..36398cc89a 100644 --- a/testsuite/tests/ghci/scripts/T6018ghcifail.stderr +++ b/testsuite/tests/ghci/scripts/T6018ghcifail.stderr @@ -19,8 +19,8 @@ <interactive>:34:15: error: [GHC-05175] Type family equation violates the family's injectivity annotation. RHS of injective type family equation is a bare type variable - but these LHS type and kind patterns are not bare variables: ‘'Z’ - P 'Z m = m -- Defined at <interactive>:34:15 + but these LHS type and kind patterns are not bare variables: ‘Z’ + P Z m = m -- Defined at <interactive>:34:15 <interactive>:40:15: error: [GHC-05175] Type family equation violates the family's injectivity annotation. @@ -32,7 +32,7 @@ Type family equation violates the family's injectivity annotation. Type variable ‘n’ cannot be inferred from the right-hand side. In the type family equation: - K ('S n) m = 'S m -- Defined at <interactive>:44:15 + K (S n) m = S m -- Defined at <interactive>:44:15 <interactive>:49:15: error: [GHC-05175] Type family equation violates the family's injectivity annotation. diff --git a/testsuite/tests/ghci/scripts/T7627.stdout b/testsuite/tests/ghci/scripts/T7627.stdout index d819079041..ba4640d01b 100644 --- a/testsuite/tests/ghci/scripts/T7627.stdout +++ b/testsuite/tests/ghci/scripts/T7627.stdout @@ -27,17 +27,17 @@ instance (Semigroup a, Semigroup b) => Semigroup (a, b) instance Foldable ((,) a) -- Defined in ‘Data.Foldable’ instance (Bounded a, Bounded b) => Bounded (a, b) -- Defined in ‘GHC.Enum’ +instance (Eq a, Eq b) => Eq (a, b) -- Defined in ‘GHC.Classes’ +instance (Ord a, Ord b) => Ord (a, b) -- Defined in ‘GHC.Classes’ instance (Read a, Read b) => Read (a, b) -- Defined in ‘GHC.Read’ +instance (Show a, Show b) => Show (a, b) -- Defined in ‘GHC.Show’ instance Monoid a => Applicative ((,) a) -- Defined in ‘GHC.Base’ instance Functor ((,) a) -- Defined in ‘GHC.Base’ instance Monoid a => Monad ((,) a) -- Defined in ‘GHC.Base’ -instance (Eq a, Eq b) => Eq (a, b) -- Defined in ‘GHC.Classes’ -instance (Ord a, Ord b) => Ord (a, b) -- Defined in ‘GHC.Classes’ -instance (Show a, Show b) => Show (a, b) -- Defined in ‘GHC.Show’ type (#,#) :: * -> * -> TYPE - ('GHC.Types.TupleRep '[GHC.Types.LiftedRep, GHC.Types.LiftedRep]) + (GHC.Types.TupleRep [GHC.Types.LiftedRep, GHC.Types.LiftedRep]) data (#,#) a b = (#,#) a b -- Defined in ‘GHC.Prim’ (,) :: a -> b -> (a, b) diff --git a/testsuite/tests/ghci/scripts/T7939.stdout b/testsuite/tests/ghci/scripts/T7939.stdout index 0d9e4d363c..6f0ab38948 100644 --- a/testsuite/tests/ghci/scripts/T7939.stdout +++ b/testsuite/tests/ghci/scripts/T7939.stdout @@ -16,18 +16,18 @@ type family G a where G :: * -> * type H :: Bool -> Bool type family H a where - H 'False = 'True + H False = True -- Defined at T7939.hs:15:1 H :: Bool -> Bool type J :: forall {k}. [k] -> Bool type family J a where - J '[] = 'False - forall k (h :: k) (t :: [k]). J (h : t) = 'True + J '[] = False + forall k (h :: k) (t :: [k]). J (h : t) = True -- Defined at T7939.hs:18:1 J :: [k] -> Bool type K :: forall {a}. [a] -> Maybe a type family K a1 where - K '[] = 'Nothing - forall a (h :: a) (t :: [a]). K (h : t) = 'Just h + K '[] = Nothing + forall a (h :: a) (t :: [a]). K (h : t) = Just h -- Defined at T7939.hs:22:1 K :: [a] -> Maybe a diff --git a/testsuite/tests/ghci/scripts/T8357.stdout b/testsuite/tests/ghci/scripts/T8357.stdout index 2f2cf22b47..d4ff79c366 100644 --- a/testsuite/tests/ghci/scripts/T8357.stdout +++ b/testsuite/tests/ghci/scripts/T8357.stdout @@ -1,3 +1,3 @@ foo :: Rec '["foo" ::: String] bar :: Rec '["bar" ::: String] -both :: Rec '["foo" ::: [Char], "bar" ::: String] +both :: Rec ["foo" ::: [Char], "bar" ::: String] diff --git a/testsuite/tests/ghci/scripts/T8535.stdout b/testsuite/tests/ghci/scripts/T8535.stdout index c6625fbcb8..a1b640f911 100644 --- a/testsuite/tests/ghci/scripts/T8535.stdout +++ b/testsuite/tests/ghci/scripts/T8535.stdout @@ -1,5 +1,5 @@ type (->) :: * -> * -> * -type (->) = FUN 'Many :: * -> * -> * +type (->) = FUN Many :: * -> * -> * -- Defined in ‘GHC.Types’ infixr -1 -> instance Monoid b => Monoid (a -> b) -- Defined in ‘GHC.Base’ diff --git a/testsuite/tests/ghci/scripts/T8917.stdout b/testsuite/tests/ghci/scripts/T8917.stdout index 8426b6ab10..1656fd7173 100644 --- a/testsuite/tests/ghci/scripts/T8917.stdout +++ b/testsuite/tests/ghci/scripts/T8917.stdout @@ -1,4 +1,4 @@ Zero + Succ Zero :: Nat -= 'Succ 'Zero += Succ Zero Succ (Zero + Zero) :: Nat -= 'Succ 'Zero += Succ Zero diff --git a/testsuite/tests/ghci/scripts/T9181.stdout b/testsuite/tests/ghci/scripts/T9181.stdout index f213526d8d..356d047a81 100644 --- a/testsuite/tests/ghci/scripts/T9181.stdout +++ b/testsuite/tests/ghci/scripts/T9181.stdout @@ -99,8 +99,7 @@ type (Data.Type.Ord.<=) x y = :: Constraint type (Data.Type.Ord.<=?) :: forall k. k -> k -> Bool type (Data.Type.Ord.<=?) m n = - Data.Type.Ord.OrdCond - (Data.Type.Ord.Compare m n) 'True 'True 'False + Data.Type.Ord.OrdCond (Data.Type.Ord.Compare m n) True True False :: Bool type GHC.TypeLits.Internal.CmpChar :: Char -> Char -> Ordering type family GHC.TypeLits.Internal.CmpChar a b @@ -143,13 +142,13 @@ type role Data.Type.Ord.OrderingI nominal nominal type Data.Type.Ord.OrderingI :: forall {k}. k -> k -> * data Data.Type.Ord.OrderingI a b where Data.Type.Ord.LTI :: forall {k} (a :: k) (b :: k). - (Data.Type.Ord.Compare a b ~ 'LT) => + (Data.Type.Ord.Compare a b ~ LT) => Data.Type.Ord.OrderingI a b Data.Type.Ord.EQI :: forall {k} (a :: k). - (Data.Type.Ord.Compare a a ~ 'EQ) => + (Data.Type.Ord.Compare a a ~ EQ) => Data.Type.Ord.OrderingI a a Data.Type.Ord.GTI :: forall {k} (a :: k) (b :: k). - (Data.Type.Ord.Compare a b ~ 'GT) => + (Data.Type.Ord.Compare a b ~ GT) => Data.Type.Ord.OrderingI a b pattern GHC.TypeNats.SNat :: () => GHC.TypeNats.KnownNat n => GHC.TypeNats.SNat n diff --git a/testsuite/tests/ghci/scripts/ghci020.stdout b/testsuite/tests/ghci/scripts/ghci020.stdout index c6625fbcb8..a1b640f911 100644 --- a/testsuite/tests/ghci/scripts/ghci020.stdout +++ b/testsuite/tests/ghci/scripts/ghci020.stdout @@ -1,5 +1,5 @@ type (->) :: * -> * -> * -type (->) = FUN 'Many :: * -> * -> * +type (->) = FUN Many :: * -> * -> * -- Defined in ‘GHC.Types’ infixr -1 -> instance Monoid b => Monoid (a -> b) -- Defined in ‘GHC.Base’ diff --git a/testsuite/tests/ghci/should_run/T10145.stdout b/testsuite/tests/ghci/should_run/T10145.stdout index c6625fbcb8..a1b640f911 100644 --- a/testsuite/tests/ghci/should_run/T10145.stdout +++ b/testsuite/tests/ghci/should_run/T10145.stdout @@ -1,5 +1,5 @@ type (->) :: * -> * -> * -type (->) = FUN 'Many :: * -> * -> * +type (->) = FUN Many :: * -> * -> * -- Defined in ‘GHC.Types’ infixr -1 -> instance Monoid b => Monoid (a -> b) -- Defined in ‘GHC.Base’ diff --git a/testsuite/tests/ghci/should_run/T18562.stdout b/testsuite/tests/ghci/should_run/T18562.stdout index 0f1937e33b..e569440a0d 100644 --- a/testsuite/tests/ghci/should_run/T18562.stdout +++ b/testsuite/tests/ghci/should_run/T18562.stdout @@ -1,3 +1,3 @@ CmpSymbol "a" "\0" :: Ordering -= 'GT += GT GT diff --git a/testsuite/tests/ghci/should_run/T18594.stdout b/testsuite/tests/ghci/should_run/T18594.stdout index 216186a632..4dbca53593 100644 --- a/testsuite/tests/ghci/should_run/T18594.stdout +++ b/testsuite/tests/ghci/should_run/T18594.stdout @@ -1,5 +1,5 @@ type (->) :: * -> * -> * -type (->) = FUN 'Many :: * -> * -> * +type (->) = FUN Many :: * -> * -> * -- Defined in ‘GHC.Types’ infixr -1 -> instance Monoid b => Monoid (a -> b) -- Defined in ‘GHC.Base’ diff --git a/testsuite/tests/indexed-types/should_fail/Overlap6.stderr b/testsuite/tests/indexed-types/should_fail/Overlap6.stderr index cf7d1d0591..727c0c2246 100644 --- a/testsuite/tests/indexed-types/should_fail/Overlap6.stderr +++ b/testsuite/tests/indexed-types/should_fail/Overlap6.stderr @@ -1,14 +1,14 @@ Overlap6.hs:15:7: error: [GHC-25897] - • Couldn't match type ‘x’ with ‘And x 'True’ - Expected: Proxy (And x 'True) + • Couldn't match type ‘x’ with ‘And x True’ + Expected: Proxy (And x True) Actual: Proxy x ‘x’ is a rigid type variable bound by the type signature for: - g :: forall (x :: Bool). Proxy x -> Proxy (And x 'True) + g :: forall (x :: Bool). Proxy x -> Proxy (And x True) at Overlap6.hs:14:1-34 • In the expression: x In an equation for ‘g’: g x = x • Relevant bindings include x :: Proxy x (bound at Overlap6.hs:15:3) - g :: Proxy x -> Proxy (And x 'True) (bound at Overlap6.hs:15:1) + g :: Proxy x -> Proxy (And x True) (bound at Overlap6.hs:15:1) diff --git a/testsuite/tests/indexed-types/should_fail/T12522a.stderr b/testsuite/tests/indexed-types/should_fail/T12522a.stderr index 5a10c33bb7..57c7bf060a 100644 --- a/testsuite/tests/indexed-types/should_fail/T12522a.stderr +++ b/testsuite/tests/indexed-types/should_fail/T12522a.stderr @@ -4,7 +4,7 @@ T12522a.hs:23:26: error: [GHC-39999] prevents the constraint ‘(Show a0)’ from being solved. Relevant bindings include n :: a0 (bound at T12522a.hs:23:15) - test :: Uncurried '[a0, [Char]] [Char] (bound at T12522a.hs:23:1) + test :: Uncurried [a0, [Char]] [Char] (bound at T12522a.hs:23:1) Probable fix: use a type annotation to specify what ‘a0’ should be. Potentially matching instances: instance Show Ordering -- Defined in ‘GHC.Show’ diff --git a/testsuite/tests/indexed-types/should_fail/T13877.stderr b/testsuite/tests/indexed-types/should_fail/T13877.stderr index d0c99376d2..559f2249c7 100644 --- a/testsuite/tests/indexed-types/should_fail/T13877.stderr +++ b/testsuite/tests/indexed-types/should_fail/T13877.stderr @@ -1,7 +1,7 @@ T13877.hs:65:41: error: [GHC-83865] • Expecting one more argument to ‘p’ - Expected kind ‘(-?>) [a] (*) (':->)’, but ‘p’ has kind ‘[a] ~> *’ + Expected kind ‘(-?>) [a] (*) (:->)’, but ‘p’ has kind ‘[a] ~> *’ • In the type ‘p’ In the expression: listElimPoly @(:->) @a @p @l In an equation for ‘listElimTyFun’: diff --git a/testsuite/tests/indexed-types/should_fail/T14246.stderr b/testsuite/tests/indexed-types/should_fail/T14246.stderr index 3374308a8f..91aebe9dc5 100644 --- a/testsuite/tests/indexed-types/should_fail/T14246.stderr +++ b/testsuite/tests/indexed-types/should_fail/T14246.stderr @@ -7,7 +7,7 @@ T14246.hs:19:5: error: [GHC-91510] T14246.hs:23:27: error: [GHC-83865] • Couldn't match kind ‘*’ with ‘L’ Expected kind ‘Vect (KLN f) L’, - but ‘Cons (Label (t :: v)) l’ has kind ‘Vect ('S (KLN (f t))) (*)’ + but ‘Cons (Label (t :: v)) l’ has kind ‘Vect (S (KLN (f t))) (*)’ • In the second argument of ‘Reveal’, namely ‘(Cons (Label (t :: v)) l)’ In the type family declaration for ‘Reveal’ @@ -21,7 +21,7 @@ T14246.hs:23:67: error: [GHC-83865] In the type family declaration for ‘Reveal’ T14246.hs:24:24: error: [GHC-83865] - • Couldn't match kind ‘'Z’ with ‘KLN a’ - Expected kind ‘Vect (KLN a) L’, but ‘Nil’ has kind ‘Vect 'Z L’ + • Couldn't match kind ‘Z’ with ‘KLN a’ + Expected kind ‘Vect (KLN a) L’, but ‘Nil’ has kind ‘Vect Z L’ • In the second argument of ‘Reveal’, namely ‘Nil’ In the type family declaration for ‘Reveal’ diff --git a/testsuite/tests/indexed-types/should_fail/T21896.stderr b/testsuite/tests/indexed-types/should_fail/T21896.stderr index b75aab8803..b61e6196cf 100644 --- a/testsuite/tests/indexed-types/should_fail/T21896.stderr +++ b/testsuite/tests/indexed-types/should_fail/T21896.stderr @@ -2,23 +2,23 @@ T21896.hs:8:5: error: [GHC-05175] • Type family equation right-hand sides overlap; this violates the family's injectivity annotation: - forall {k} {r :: k}. F 'Foo r = r -- Defined at T21896.hs:8:5 - forall {k} {r :: k}. F 'Bar r = r -- Defined at T21896.hs:9:5 + forall {k} {r :: k}. F Foo r = r -- Defined at T21896.hs:8:5 + forall {k} {r :: k}. F Bar r = r -- Defined at T21896.hs:9:5 • In the equations for closed type family ‘F’ In the type family declaration for ‘F’ T21896.hs:8:5: error: [GHC-05175] • Type family equation violates the family's injectivity annotation. RHS of injective type family equation is a bare type variable - but these LHS type and kind patterns are not bare variables: ‘'Foo’ - forall {k} {r :: k}. F 'Foo r = r -- Defined at T21896.hs:8:5 + but these LHS type and kind patterns are not bare variables: ‘Foo’ + forall {k} {r :: k}. F Foo r = r -- Defined at T21896.hs:8:5 • In the equations for closed type family ‘F’ In the type family declaration for ‘F’ T21896.hs:9:5: error: [GHC-05175] • Type family equation violates the family's injectivity annotation. RHS of injective type family equation is a bare type variable - but these LHS type and kind patterns are not bare variables: ‘'Bar’ - forall {k} {r :: k}. F 'Bar r = r -- Defined at T21896.hs:9:5 + but these LHS type and kind patterns are not bare variables: ‘Bar’ + forall {k} {r :: k}. F Bar r = r -- Defined at T21896.hs:9:5 • In the equations for closed type family ‘F’ In the type family declaration for ‘F’ diff --git a/testsuite/tests/indexed-types/should_fail/T7967.stderr b/testsuite/tests/indexed-types/should_fail/T7967.stderr index bd14d79780..aafc456952 100644 --- a/testsuite/tests/indexed-types/should_fail/T7967.stderr +++ b/testsuite/tests/indexed-types/should_fail/T7967.stderr @@ -3,6 +3,6 @@ T7967.hs:33:26: error: [GHC-83865] • Couldn't match type: h0 : t0 with: '[] Expected: Index n l - Actual: Index 'Zero (h0 : t0) + Actual: Index Zero (h0 : t0) • In the expression: IZero In an equation for ‘sNatToIndex’: sNatToIndex SZero HNil = IZero diff --git a/testsuite/tests/linear/should_fail/Linear1.stderr b/testsuite/tests/linear/should_fail/Linear1.stderr index 8d68aff479..eed8b735b8 100644 --- a/testsuite/tests/linear/should_fail/Linear1.stderr +++ b/testsuite/tests/linear/should_fail/Linear1.stderr @@ -1,10 +1,10 @@ Linear1.hs:10:14: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘x’ • In an equation for ‘incorrectDup’: incorrectDup x = (x, x) Linear1.hs:14:15: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘x’ • In an equation for ‘incorrectDrop’: incorrectDrop x = () diff --git a/testsuite/tests/linear/should_fail/Linear11.stderr b/testsuite/tests/linear/should_fail/Linear11.stderr index 2ab0f3f162..7a2ceda350 100644 --- a/testsuite/tests/linear/should_fail/Linear11.stderr +++ b/testsuite/tests/linear/should_fail/Linear11.stderr @@ -1,12 +1,12 @@ Linear11.hs:9:23: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘a’ • In an equation for ‘incorrectUnrestricted’: incorrectUnrestricted a = Unrestricted a Linear11.hs:14:43: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘a’ • In the pattern: NotUnrestricted a In an equation for ‘incorrectUnrestrictedDup’: diff --git a/testsuite/tests/linear/should_fail/Linear13.stderr b/testsuite/tests/linear/should_fail/Linear13.stderr index 62c0097b68..f4c0d79429 100644 --- a/testsuite/tests/linear/should_fail/Linear13.stderr +++ b/testsuite/tests/linear/should_fail/Linear13.stderr @@ -1,12 +1,12 @@ Linear13.hs:6:14: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘a’ • In an equation for ‘incorrectLet’: incorrectLet a = let x = a in () Linear13.hs:9:27: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘x’ • In an equation for ‘incorrectLetWithSignature’: incorrectLetWithSignature x @@ -16,13 +16,13 @@ Linear13.hs:9:27: error: [GHC-18872] in () Linear13.hs:12:20: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘x’ • In an equation for ‘incorrectLazyMatch’: incorrectLazyMatch x = let (a, b) = x in b Linear13.hs:15:24: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘x’ • In an equation for ‘incorrectCasePromotion’: incorrectCasePromotion x = case x of (a, b) -> b diff --git a/testsuite/tests/linear/should_fail/Linear17.stderr b/testsuite/tests/linear/should_fail/Linear17.stderr index 1329db16e3..41f4d209fa 100644 --- a/testsuite/tests/linear/should_fail/Linear17.stderr +++ b/testsuite/tests/linear/should_fail/Linear17.stderr @@ -1,6 +1,6 @@ Linear17.hs:17:3: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘x’ • In a stmt of a 'do' block: x <- () In the expression: @@ -17,7 +17,7 @@ Linear17.hs:17:3: error: [GHC-18872] .... Linear17.hs:25:6: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘z’ • In the pattern: (y, z) In a stmt of a 'do' block: (y, z) <- ((), x) @@ -28,7 +28,7 @@ Linear17.hs:25:6: error: [GHC-18872] () Linear17.hs:30:3: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘x’ • In a stmt of a 'do' block: x <- () In the expression: diff --git a/testsuite/tests/linear/should_fail/Linear2.stderr b/testsuite/tests/linear/should_fail/Linear2.stderr index b659915b9a..d7275d19ec 100644 --- a/testsuite/tests/linear/should_fail/Linear2.stderr +++ b/testsuite/tests/linear/should_fail/Linear2.stderr @@ -1,16 +1,16 @@ Linear2.hs:9:15: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘x’ • In an equation for ‘incorrectApp1’: incorrectApp1 x = dup (x, 0) Linear2.hs:12:17: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘x’ • In an equation for ‘incorrectApp2’: incorrectApp2 f x = f x Linear2.hs:15:15: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘n’ • In an equation for ‘incorrectIf’: incorrectIf x n = if x then n else 0 diff --git a/testsuite/tests/linear/should_fail/Linear5.stderr b/testsuite/tests/linear/should_fail/Linear5.stderr index d6856c1174..b6e4b5a82c 100644 --- a/testsuite/tests/linear/should_fail/Linear5.stderr +++ b/testsuite/tests/linear/should_fail/Linear5.stderr @@ -1,5 +1,5 @@ Linear5.hs:7:20: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘n’ • In an equation for ‘incorrectEqn’: incorrectEqn False n = 0 diff --git a/testsuite/tests/linear/should_fail/Linear7.stderr b/testsuite/tests/linear/should_fail/Linear7.stderr index fe7b58ac6a..6a89467b90 100644 --- a/testsuite/tests/linear/should_fail/Linear7.stderr +++ b/testsuite/tests/linear/should_fail/Linear7.stderr @@ -1,6 +1,6 @@ Linear7.hs:7:16: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘n’ • In an equation for ‘incorrectLCase’: incorrectLCase n diff --git a/testsuite/tests/linear/should_fail/Linear9.stderr b/testsuite/tests/linear/should_fail/Linear9.stderr index 34148b5817..87092b13b7 100644 --- a/testsuite/tests/linear/should_fail/Linear9.stderr +++ b/testsuite/tests/linear/should_fail/Linear9.stderr @@ -1,33 +1,33 @@ Linear9.hs:9:17: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from a non-linear pattern • In the pattern: _ In the pattern: (a, _) In an equation for ‘incorrectFst’: incorrectFst (a, _) = a Linear9.hs:12:20: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘b’ • In the pattern: (a, b) In an equation for ‘incorrectFstVar’: incorrectFstVar (a, b) = a Linear9.hs:15:20: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘a’ • In the pattern: (a, b) In an equation for ‘incorrectFirstDup’: incorrectFirstDup (a, b) = ((a, a), b) Linear9.hs:18:21: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from a non-linear pattern • In the pattern: _ In the pattern: (a, _) In the pattern: ((a, _), _) Linear9.hs:18:24: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from a non-linear pattern • In the pattern: _ In the pattern: ((a, _), _) @@ -35,7 +35,7 @@ Linear9.hs:18:24: error: [GHC-18872] incorrectFstFst ((a, _), _) = a Linear9.hs:25:25: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from a non-linear pattern • In the pattern: _ In the pattern: Foo a _ diff --git a/testsuite/tests/linear/should_fail/LinearAsPat.stderr b/testsuite/tests/linear/should_fail/LinearAsPat.stderr index ef13389074..987993d897 100644 --- a/testsuite/tests/linear/should_fail/LinearAsPat.stderr +++ b/testsuite/tests/linear/should_fail/LinearAsPat.stderr @@ -1,5 +1,5 @@ LinearAsPat.hs:6:12: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from a non-linear pattern • In an equation for ‘shouldFail’: shouldFail x@True = x diff --git a/testsuite/tests/linear/should_fail/LinearBottomMult.stderr b/testsuite/tests/linear/should_fail/LinearBottomMult.stderr index aa6dab87d9..e620843652 100644 --- a/testsuite/tests/linear/should_fail/LinearBottomMult.stderr +++ b/testsuite/tests/linear/should_fail/LinearBottomMult.stderr @@ -1,6 +1,6 @@ LinearBottomMult.hs:13:3: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘x’ • In an equation for ‘f’: f x = elim (U (\ (a :: Void) -> case a of {})) diff --git a/testsuite/tests/linear/should_fail/LinearConfusedDollar.stderr b/testsuite/tests/linear/should_fail/LinearConfusedDollar.stderr index 55022acd61..709b3b4c65 100644 --- a/testsuite/tests/linear/should_fail/LinearConfusedDollar.stderr +++ b/testsuite/tests/linear/should_fail/LinearConfusedDollar.stderr @@ -1,6 +1,6 @@ LinearConfusedDollar.hs:12:7: error: [GHC-83865] - • Couldn't match type ‘'One’ with ‘'Many’ + • Couldn't match type ‘One’ with ‘Many’ Expected: a -> a Actual: a %1 -> a • In the first argument of ‘($)’, namely ‘f’ diff --git a/testsuite/tests/linear/should_fail/LinearIf.stderr b/testsuite/tests/linear/should_fail/LinearIf.stderr index 122d1f9a8e..1291e40a78 100644 --- a/testsuite/tests/linear/should_fail/LinearIf.stderr +++ b/testsuite/tests/linear/should_fail/LinearIf.stderr @@ -1,15 +1,15 @@ LinearIf.hs:13:3: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘b’ • In an equation for ‘f’: f b x y = if b then x else y LinearIf.hs:13:5: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘x’ • In an equation for ‘f’: f b x y = if b then x else y LinearIf.hs:13:7: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘y’ • In an equation for ‘f’: f b x y = if b then x else y diff --git a/testsuite/tests/linear/should_fail/LinearLazyPat.stderr b/testsuite/tests/linear/should_fail/LinearLazyPat.stderr index cb923f9416..82fb02725b 100644 --- a/testsuite/tests/linear/should_fail/LinearLazyPat.stderr +++ b/testsuite/tests/linear/should_fail/LinearLazyPat.stderr @@ -1,6 +1,6 @@ LinearLazyPat.hs:5:3: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from a non-linear pattern • In the pattern: ~(x, y) In an equation for ‘f’: f ~(x, y) = (y, x) diff --git a/testsuite/tests/linear/should_fail/LinearLet.stderr b/testsuite/tests/linear/should_fail/LinearLet.stderr index de1771f89f..5ee468376b 100644 --- a/testsuite/tests/linear/should_fail/LinearLet.stderr +++ b/testsuite/tests/linear/should_fail/LinearLet.stderr @@ -1,5 +1,5 @@ LinearLet.hs:5:3: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘x’ • In an equation for ‘f’: f x = let y = x in (y, y) diff --git a/testsuite/tests/linear/should_fail/LinearPartialSig.stderr b/testsuite/tests/linear/should_fail/LinearPartialSig.stderr index 175462f917..372be25feb 100644 --- a/testsuite/tests/linear/should_fail/LinearPartialSig.stderr +++ b/testsuite/tests/linear/should_fail/LinearPartialSig.stderr @@ -1,6 +1,6 @@ LinearPartialSig.hs:5:9: error: [GHC-88464] • Found type wildcard ‘_’ - standing for ‘'Many :: GHC.Types.Multiplicity’ + standing for ‘Many :: GHC.Types.Multiplicity’ To use the inferred type, enable PartialTypeSignatures • In the type signature: f :: a %_ -> a diff --git a/testsuite/tests/linear/should_fail/LinearPatSyn.stderr b/testsuite/tests/linear/should_fail/LinearPatSyn.stderr index bda38f7765..965cd086a2 100644 --- a/testsuite/tests/linear/should_fail/LinearPatSyn.stderr +++ b/testsuite/tests/linear/should_fail/LinearPatSyn.stderr @@ -1,6 +1,6 @@ LinearPatSyn.hs:13:4: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from a non-linear pattern • In the pattern: P y x In an equation for ‘s’: s (P y x) = (y, x) diff --git a/testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.stderr b/testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.stderr index 05aea0087b..a282502d3c 100644 --- a/testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.stderr +++ b/testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.stderr @@ -1,5 +1,5 @@ LinearPatternGuardWildcard.hs:7:15: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘x’ • In an equation for ‘unsafeConsume’: unsafeConsume x | _ <- x = () diff --git a/testsuite/tests/linear/should_fail/LinearRecordUpdate.stderr b/testsuite/tests/linear/should_fail/LinearRecordUpdate.stderr index faf82f690e..aedea4cdf1 100644 --- a/testsuite/tests/linear/should_fail/LinearRecordUpdate.stderr +++ b/testsuite/tests/linear/should_fail/LinearRecordUpdate.stderr @@ -1,5 +1,5 @@ LinearRecordUpdate.hs:8:12: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘r’ • In an equation for ‘shouldFail’: shouldFail r = r {y = False} diff --git a/testsuite/tests/linear/should_fail/LinearRole.stderr b/testsuite/tests/linear/should_fail/LinearRole.stderr index edeb98d84d..61af066460 100644 --- a/testsuite/tests/linear/should_fail/LinearRole.stderr +++ b/testsuite/tests/linear/should_fail/LinearRole.stderr @@ -1,6 +1,6 @@ LinearRole.hs:12:7: error: [GHC-18872] - • Couldn't match type ‘'One’ with ‘'Many’ + • Couldn't match type ‘One’ with ‘Many’ arising from a use of ‘coerce’ • In the expression: coerce x In an equation for ‘f’: f x = coerce x diff --git a/testsuite/tests/linear/should_fail/LinearSeq.stderr b/testsuite/tests/linear/should_fail/LinearSeq.stderr index 2ed15de260..2b47ecc915 100644 --- a/testsuite/tests/linear/should_fail/LinearSeq.stderr +++ b/testsuite/tests/linear/should_fail/LinearSeq.stderr @@ -1,5 +1,5 @@ LinearSeq.hs:6:5: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘x’ • In an equation for ‘bad’: bad x = seq x () diff --git a/testsuite/tests/linear/should_fail/LinearSequenceExpr.stderr b/testsuite/tests/linear/should_fail/LinearSequenceExpr.stderr index 9c04ee212a..b6cb36f8b7 100644 --- a/testsuite/tests/linear/should_fail/LinearSequenceExpr.stderr +++ b/testsuite/tests/linear/should_fail/LinearSequenceExpr.stderr @@ -1,10 +1,10 @@ LinearSequenceExpr.hs:7:3: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘x’ • In an equation for ‘f’: f x y = [x .. y] LinearSequenceExpr.hs:7:5: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘y’ • In an equation for ‘f’: f x y = [x .. y] diff --git a/testsuite/tests/linear/should_fail/LinearTHFail.stderr b/testsuite/tests/linear/should_fail/LinearTHFail.stderr index 90ddb47e38..7570fcb546 100644 --- a/testsuite/tests/linear/should_fail/LinearTHFail.stderr +++ b/testsuite/tests/linear/should_fail/LinearTHFail.stderr @@ -1,6 +1,6 @@ LinearTHFail.hs:8:3: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘x’ • In an equation for ‘f’: f x @@ -8,6 +8,6 @@ LinearTHFail.hs:8:3: error: [GHC-18872] pending(rn) [<spn, x>] LinearTHFail.hs:11:3: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘x’ • In an equation for ‘g’: g x = [|| Just $$x ||] diff --git a/testsuite/tests/linear/should_fail/LinearVar.stderr b/testsuite/tests/linear/should_fail/LinearVar.stderr index e327454936..bb01d563f3 100644 --- a/testsuite/tests/linear/should_fail/LinearVar.stderr +++ b/testsuite/tests/linear/should_fail/LinearVar.stderr @@ -1,6 +1,6 @@ LinearVar.hs:5:5: error: [GHC-25897] - • Couldn't match type ‘m’ with ‘'Many’ + • Couldn't match type ‘m’ with ‘Many’ Expected: a %m -> b Actual: a -> b ‘m’ is a rigid type variable bound by diff --git a/testsuite/tests/linear/should_fail/LinearViewPattern.stderr b/testsuite/tests/linear/should_fail/LinearViewPattern.stderr index d923a5eefd..cbd3cd9595 100644 --- a/testsuite/tests/linear/should_fail/LinearViewPattern.stderr +++ b/testsuite/tests/linear/should_fail/LinearViewPattern.stderr @@ -1,6 +1,6 @@ LinearViewPattern.hs:11:4: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from a non-linear pattern • In the pattern: not -> True In an equation for ‘f’: f (not -> True) = True diff --git a/testsuite/tests/linear/should_fail/T19120.stderr b/testsuite/tests/linear/should_fail/T19120.stderr index 8ab12c00b1..e66d3de2cb 100644 --- a/testsuite/tests/linear/should_fail/T19120.stderr +++ b/testsuite/tests/linear/should_fail/T19120.stderr @@ -1,5 +1,5 @@ T19120.hs:9:3: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from multiplicity of ‘x’ • In an equation for ‘z’: z x | notL x = True diff --git a/testsuite/tests/linear/should_fail/T19361.stderr b/testsuite/tests/linear/should_fail/T19361.stderr index 31770a96e5..cf697071fe 100644 --- a/testsuite/tests/linear/should_fail/T19361.stderr +++ b/testsuite/tests/linear/should_fail/T19361.stderr @@ -1,6 +1,6 @@ T19361.hs:6:3: error: [GHC-25897] - • Couldn't match type ‘m’ with ‘'Many’ + • Couldn't match type ‘m’ with ‘Many’ arising from multiplicity of ‘x’ ‘m’ is a rigid type variable bound by the type signature for: diff --git a/testsuite/tests/linear/should_fail/T20083.stderr b/testsuite/tests/linear/should_fail/T20083.stderr index 32968a4e7d..e923aaf2fe 100644 --- a/testsuite/tests/linear/should_fail/T20083.stderr +++ b/testsuite/tests/linear/should_fail/T20083.stderr @@ -1,6 +1,6 @@ T20083.hs:6:6: error: [GHC-25897] - • Couldn't match type ‘m’ with ‘'Many’ + • Couldn't match type ‘m’ with ‘Many’ arising from multiplicity of ‘x’ ‘m’ is a rigid type variable bound by the type signature for: @@ -12,7 +12,7 @@ T20083.hs:6:6: error: [GHC-25897] ap :: (a -> b) -> a %m -> b (bound at T20083.hs:6:1) T20083.hs:9:5: error: [GHC-18872] - • Couldn't match type ‘'Many’ with ‘'One’ + • Couldn't match type ‘Many’ with ‘One’ arising from a non-linear pattern • In the pattern: _ In an equation for ‘ap2’: ap2 _ = () diff --git a/testsuite/tests/linear/should_fail/TypeClass.stderr b/testsuite/tests/linear/should_fail/TypeClass.stderr index ae7419f970..e0aef606ae 100644 --- a/testsuite/tests/linear/should_fail/TypeClass.stderr +++ b/testsuite/tests/linear/should_fail/TypeClass.stderr @@ -1,5 +1,5 @@ TypeClass.hs:45:7: error: [GHC-39999] - • No instance for ‘Iden (FUN 'One)’ arising from a use of ‘iden’ + • No instance for ‘Iden (FUN One)’ arising from a use of ‘iden’ • In the expression: iden In an equation for ‘foo’: foo = iden diff --git a/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr b/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr index 9f79b9e34d..7e8648e9cd 100644 --- a/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr +++ b/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr @@ -1,5 +1,5 @@ TYPE SIGNATURES - foo :: Sing 'A + foo :: Sing A TYPE CONSTRUCTORS data type MyKind{0} :: * data family Sing{2} :: forall k. k -> * @@ -10,9 +10,9 @@ COERCION AXIOMS DATA CONSTRUCTORS A :: MyKind B :: MyKind - SingA :: Sing 'A - SingB :: Sing 'B + SingA :: Sing A + SingB :: Sing B FAMILY INSTANCES data instance Sing _ -- Defined at DataFamilyInstanceLHS.hs:8:15 Dependent modules: [] -Dependent packages: [base-4.16.0.0] +Dependent packages: [base-4.17.0.0] diff --git a/testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr b/testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr index fbaff8ffb4..837a82a207 100644 --- a/testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr +++ b/testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr @@ -8,10 +8,10 @@ COERCION AXIOMS DATA CONSTRUCTORS A :: MyKind B :: MyKind - SingA :: Sing 'A - SingB :: Sing 'B + SingA :: Sing A + SingB :: Sing B FAMILY INSTANCES data instance Sing _a -- Defined at NamedWildcardInDataFamilyInstanceLHS.hs:8:15 Dependent modules: [] -Dependent packages: [base-4.16.0.0] +Dependent packages: [base-4.17.0.0] diff --git a/testsuite/tests/patsyn/should_fail/T15695.stderr b/testsuite/tests/patsyn/should_fail/T15695.stderr index 6753d8bb9c..f7f065b024 100644 --- a/testsuite/tests/patsyn/should_fail/T15695.stderr +++ b/testsuite/tests/patsyn/should_fail/T15695.stderr @@ -1,27 +1,27 @@ T15695.hs:40:14: warning: [GHC-25897] [-Wdeferred-type-errors (in -Wdefault)] - • Could not deduce ‘a2 ~ NA 'VO’ + • Could not deduce ‘a2 ~ NA VO’ from the context: ((* -> * -> *) ~ (k -> k1 -> *), Either ~~ f, - ctx ~~ (a2 ':&: (a3 ':&: 'E)), f a2 ~~ f1, f1 a3 ~~ a4) + ctx ~~ (a2 :&: (a3 :&: E)), f a2 ~~ f1, f1 a3 ~~ a4) bound by a pattern with pattern synonym: ASSO :: forall kind (a :: kind) (b :: Ctx kind). () => forall ks k (f :: k -> ks) (a1 :: k) ks1 k1 (f1 :: k1 -> ks1) (a2 :: k1) a3. - (kind ~ (k -> k1 -> *), a ~~ f, b ~~ (a1 ':&: (a2 ':&: 'E)), + (kind ~ (k -> k1 -> *), a ~~ f, b ~~ (a1 :&: (a2 :&: E)), f a1 ~~ f1, f1 a2 ~~ a3) => a3 -> ApplyT kind a b, in an equation for ‘from'’ at T15695.hs:40:8-21 Expected: a4 - Actual: Either (NA 'VO) a3 + Actual: Either (NA VO) a3 ‘a2’ is a rigid type variable bound by a pattern with pattern synonym: ASSO :: forall kind (a :: kind) (b :: Ctx kind). () => forall ks k (f :: k -> ks) (a1 :: k) ks1 k1 (f1 :: k1 -> ks1) (a2 :: k1) a3. - (kind ~ (k -> k1 -> *), a ~~ f, b ~~ (a1 ':&: (a2 ':&: 'E)), + (kind ~ (k -> k1 -> *), a ~~ f, b ~~ (a1 :&: (a2 :&: E)), f a1 ~~ f1, f1 a2 ~~ a3) => a3 -> ApplyT kind a b, in an equation for ‘from'’ @@ -30,7 +30,7 @@ T15695.hs:40:14: warning: [GHC-25897] [-Wdeferred-type-errors (in -Wdefault)] In the pattern: ASSO (Left a) In an equation for ‘from'’: from' (ASSO (Left a)) = Here (a :* Nil) • Relevant bindings include - from' :: ApplyT (* -> * -> *) Either ctx -> NS (NP NA) '[ '[ 'VO]] + from' :: ApplyT (* -> * -> *) Either ctx -> NS (NP NA) '[ '[VO]] (bound at T15695.hs:40:1) T15695.hs:41:33: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] @@ -43,5 +43,5 @@ T15695.hs:41:33: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] In an equation for ‘from'’: from' (ASSO (Right b)) = There (Here undefined) • Relevant bindings include - from' :: ApplyT (* -> * -> *) Either ctx -> NS (NP NA) '[ '[ 'VO]] + from' :: ApplyT (* -> * -> *) Either ctx -> NS (NP NA) '[ '[VO]] (bound at T15695.hs:40:1) diff --git a/testsuite/tests/perf/compiler/T13035.stderr b/testsuite/tests/perf/compiler/T13035.stderr index a3d4e4fded..e728f51d80 100644 --- a/testsuite/tests/perf/compiler/T13035.stderr +++ b/testsuite/tests/perf/compiler/T13035.stderr @@ -1,5 +1,5 @@ T13035.hs:144:28: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘'[ 'Author] :: [Fields]’ + • Found type wildcard ‘_’ standing for ‘'[Author] :: [Fields]’ • In the second argument of ‘MyRec’, namely ‘_’ In the type signature: g :: MyRec RecipeFormatter _ diff --git a/testsuite/tests/perf/compiler/T9872b.stderr b/testsuite/tests/perf/compiler/T9872b.stderr index ec6549917e..73f490d2b7 100644 --- a/testsuite/tests/perf/compiler/T9872b.stderr +++ b/testsuite/tests/perf/compiler/T9872b.stderr @@ -2,22 +2,22 @@ T9872b.hs:19:8: error: [GHC-39999] • No instance for ‘Show (Proxy - '[ '[ 'Cube 'G 'B 'W 'R 'B 'G, 'Cube 'W 'G 'B 'W 'R 'R, - 'Cube 'R 'W 'R 'B 'G 'R, 'Cube 'B 'R 'G 'G 'W 'W], - '[ 'Cube 'G 'B 'R 'W 'B 'G, 'Cube 'R 'R 'W 'B 'G 'W, - 'Cube 'R 'G 'B 'R 'W 'R, 'Cube 'W 'W 'G 'G 'R 'B], - '[ 'Cube 'G 'W 'R 'B 'B 'G, 'Cube 'W 'B 'W 'R 'G 'R, - 'Cube 'R 'R 'B 'G 'W 'R, 'Cube 'B 'G 'G 'W 'R 'W], - '[ 'Cube 'G 'R 'W 'B 'B 'G, 'Cube 'R 'W 'B 'G 'R 'W, - 'Cube 'R 'B 'R 'W 'G 'R, 'Cube 'W 'G 'G 'R 'W 'B], - '[ 'Cube 'G 'R 'B 'B 'W 'G, 'Cube 'W 'W 'R 'G 'B 'R, - 'Cube 'R 'B 'G 'W 'R 'R, 'Cube 'B 'G 'W 'R 'G 'W], - '[ 'Cube 'G 'W 'B 'B 'R 'G, 'Cube 'R 'B 'G 'R 'W 'W, - 'Cube 'R 'R 'W 'G 'B 'R, 'Cube 'W 'G 'R 'W 'G 'B], - '[ 'Cube 'G 'B 'B 'W 'R 'G, 'Cube 'W 'R 'G 'B 'W 'R, - 'Cube 'R 'G 'W 'R 'B 'R, 'Cube 'B 'W 'R 'G 'G 'W], - '[ 'Cube 'G 'B 'B 'R 'W 'G, 'Cube 'R 'G 'R 'W 'B 'W, - 'Cube 'R 'W 'G 'B 'R 'R, 'Cube 'W 'R 'W 'G 'G 'B]])’ + [['Cube G B W R B G, 'Cube W G B W R R, 'Cube R W R B G R, + 'Cube B R G G W W], + ['Cube G B R W B G, 'Cube R R W B G W, 'Cube R G B R W R, + 'Cube W W G G R B], + ['Cube G W R B B G, 'Cube W B W R G R, 'Cube R R B G W R, + 'Cube B G G W R W], + ['Cube G R W B B G, 'Cube R W B G R W, 'Cube R B R W G R, + 'Cube W G G R W B], + ['Cube G R B B W G, 'Cube W W R G B R, 'Cube R B G W R R, + 'Cube B G W R G W], + ['Cube G W B B R G, 'Cube R B G R W W, 'Cube R R W G B R, + 'Cube W G R W G B], + ['Cube G B B W R G, 'Cube W R G B W R, 'Cube R G W R B R, + 'Cube B W R G G W], + ['Cube G B B R W G, 'Cube R G R W B W, 'Cube R W G B R R, + 'Cube W R W G G B]])’ arising from a use of ‘print’ • In the expression: print (Proxy :: Proxy (Solutions Cubes)) In an equation for ‘main’: diff --git a/testsuite/tests/perf/compiler/T9872b_defer.stderr b/testsuite/tests/perf/compiler/T9872b_defer.stderr index e9dda29c31..b242aedc8f 100644 --- a/testsuite/tests/perf/compiler/T9872b_defer.stderr +++ b/testsuite/tests/perf/compiler/T9872b_defer.stderr @@ -2,22 +2,22 @@ T9872b_defer.hs:19:8: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)] • No instance for ‘Show (Proxy - '[ '[ 'Cube 'G 'B 'W 'R 'B 'G, 'Cube 'W 'G 'B 'W 'R 'R, - 'Cube 'R 'W 'R 'B 'G 'R, 'Cube 'B 'R 'G 'G 'W 'W], - '[ 'Cube 'G 'B 'R 'W 'B 'G, 'Cube 'R 'R 'W 'B 'G 'W, - 'Cube 'R 'G 'B 'R 'W 'R, 'Cube 'W 'W 'G 'G 'R 'B], - '[ 'Cube 'G 'W 'R 'B 'B 'G, 'Cube 'W 'B 'W 'R 'G 'R, - 'Cube 'R 'R 'B 'G 'W 'R, 'Cube 'B 'G 'G 'W 'R 'W], - '[ 'Cube 'G 'R 'W 'B 'B 'G, 'Cube 'R 'W 'B 'G 'R 'W, - 'Cube 'R 'B 'R 'W 'G 'R, 'Cube 'W 'G 'G 'R 'W 'B], - '[ 'Cube 'G 'R 'B 'B 'W 'G, 'Cube 'W 'W 'R 'G 'B 'R, - 'Cube 'R 'B 'G 'W 'R 'R, 'Cube 'B 'G 'W 'R 'G 'W], - '[ 'Cube 'G 'W 'B 'B 'R 'G, 'Cube 'R 'B 'G 'R 'W 'W, - 'Cube 'R 'R 'W 'G 'B 'R, 'Cube 'W 'G 'R 'W 'G 'B], - '[ 'Cube 'G 'B 'B 'W 'R 'G, 'Cube 'W 'R 'G 'B 'W 'R, - 'Cube 'R 'G 'W 'R 'B 'R, 'Cube 'B 'W 'R 'G 'G 'W], - '[ 'Cube 'G 'B 'B 'R 'W 'G, 'Cube 'R 'G 'R 'W 'B 'W, - 'Cube 'R 'W 'G 'B 'R 'R, 'Cube 'W 'R 'W 'G 'G 'B]])’ + [['Cube G B W R B G, 'Cube W G B W R R, 'Cube R W R B G R, + 'Cube B R G G W W], + ['Cube G B R W B G, 'Cube R R W B G W, 'Cube R G B R W R, + 'Cube W W G G R B], + ['Cube G W R B B G, 'Cube W B W R G R, 'Cube R R B G W R, + 'Cube B G G W R W], + ['Cube G R W B B G, 'Cube R W B G R W, 'Cube R B R W G R, + 'Cube W G G R W B], + ['Cube G R B B W G, 'Cube W W R G B R, 'Cube R B G W R R, + 'Cube B G W R G W], + ['Cube G W B B R G, 'Cube R B G R W W, 'Cube R R W G B R, + 'Cube W G R W G B], + ['Cube G B B W R G, 'Cube W R G B W R, 'Cube R G W R B R, + 'Cube B W R G G W], + ['Cube G B B R W G, 'Cube R G R W B W, 'Cube R W G B R R, + 'Cube W R W G G B]])’ arising from a use of ‘print’ • In the expression: print (Proxy :: Proxy (Solutions Cubes)) In an equation for ‘main’: diff --git a/testsuite/tests/plugins/test-defaulting-plugin.stderr b/testsuite/tests/plugins/test-defaulting-plugin.stderr index c50aaa1aa3..a60f2add87 100644 --- a/testsuite/tests/plugins/test-defaulting-plugin.stderr +++ b/testsuite/tests/plugins/test-defaulting-plugin.stderr @@ -1,36 +1,36 @@ test-defaulting-plugin.hs:28:11: warning: [GHC-18042] [-Wtype-defaults (in -Wall)] - Defaulting the type variable ‘a0’ to type ‘0’ in the following constraint + • Defaulting the type variable ‘a0’ to type ‘0’ in the following constraint KnownNat a0 arising from a use of ‘q’ - In the first argument of ‘(+)’, namely ‘q’ + • In the first argument of ‘(+)’, namely ‘q’ In the second argument of ‘($)’, namely ‘q + w’ In a stmt of a 'do' block: print $ q + w test-defaulting-plugin.hs:28:15: warning: [GHC-18042] [-Wtype-defaults (in -Wall)] - Defaulting the type variable ‘a0’ to type ‘2’ in the following constraints + • Defaulting the type variable ‘a0’ to type ‘2’ in the following constraints (KnownNat a0) arising from a use of ‘w’ at test-defaulting-plugin.hs:28:15 (GHC.TypeError.Assert - (Data.Type.Ord.OrdCond (CmpNat 2 a0) 'True 'True 'False) + (Data.Type.Ord.OrdCond (CmpNat 2 a0) True True False) (TypeError ...)) arising from a use of ‘w’ at test-defaulting-plugin.hs:28:15 - In the second argument of ‘(+)’, namely ‘w’ + • In the second argument of ‘(+)’, namely ‘w’ In the second argument of ‘($)’, namely ‘q + w’ In a stmt of a 'do' block: print $ q + w test-defaulting-plugin.hs:29:11: warning: [GHC-18042] [-Wtype-defaults (in -Wall)] - Defaulting the type variable ‘b0’ to type ‘0’ in the following constraint + • Defaulting the type variable ‘b0’ to type ‘0’ in the following constraint KnownNat b0 arising from a use of ‘mc’ - In the second argument of ‘($)’, namely ‘mc Proxy Proxy’ + • In the second argument of ‘($)’, namely ‘mc Proxy Proxy’ In a stmt of a 'do' block: print $ mc Proxy Proxy In the expression: do print $ q + w print $ mc Proxy Proxy test-defaulting-plugin.hs:29:11: warning: [GHC-18042] [-Wtype-defaults (in -Wall)] - Defaulting the type variable ‘a0’ to type ‘0’ in the following constraint + • Defaulting the type variable ‘a0’ to type ‘0’ in the following constraint KnownNat a0 arising from a use of ‘mc’ - In the second argument of ‘($)’, namely ‘mc Proxy Proxy’ + • In the second argument of ‘($)’, namely ‘mc Proxy Proxy’ In a stmt of a 'do' block: print $ mc Proxy Proxy In the expression: do print $ q + w diff --git a/testsuite/tests/pmcheck/should_compile/EmptyCase010.stderr b/testsuite/tests/pmcheck/should_compile/EmptyCase010.stderr index e394e4b5d4..668f8082f1 100644 --- a/testsuite/tests/pmcheck/should_compile/EmptyCase010.stderr +++ b/testsuite/tests/pmcheck/should_compile/EmptyCase010.stderr @@ -9,7 +9,7 @@ EmptyCase010.hs:24:7: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)] EmptyCase010.hs:28:7: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)] Pattern match(es) are non-exhaustive In a \case alternative: - Patterns of type ‘Baz GC 'T1’ not matched: Baz MkGC1 + Patterns of type ‘Baz GC T1’ not matched: Baz MkGC1 EmptyCase010.hs:37:7: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)] Pattern match(es) are non-exhaustive diff --git a/testsuite/tests/pmcheck/should_compile/T12957a.stderr b/testsuite/tests/pmcheck/should_compile/T12957a.stderr index 9e2160672c..318463d713 100644 --- a/testsuite/tests/pmcheck/should_compile/T12957a.stderr +++ b/testsuite/tests/pmcheck/should_compile/T12957a.stderr @@ -1,9 +1,9 @@ T12957a.hs:25:35: warning: [GHC-40564] [-Winaccessible-code (in -Wdefault)] • Inaccessible code in - a pattern with constructor: BFields :: [()] -> Fields 'B, + a pattern with constructor: BFields :: [()] -> Fields B, in a case alternative - Couldn't match type ‘'A’ with ‘'B’ + Couldn't match type ‘A’ with ‘B’ • In a record update at field ‘list’, with type constructor ‘Fields’ and data constructor ‘BFields’. @@ -13,9 +13,9 @@ T12957a.hs:25:35: warning: [GHC-40564] [-Winaccessible-code (in -Wdefault)] and data constructor ‘S’. T12957a.hs:25:35: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘'B’ with ‘'A’ - Expected: Fields 'A - Actual: Fields 'B + • Couldn't match type ‘B’ with ‘A’ + Expected: Fields A + Actual: Fields B • In a record update at field ‘list’, with type constructor ‘Fields’ and data constructor ‘BFields’. diff --git a/testsuite/tests/pmcheck/should_compile/T17646.stderr b/testsuite/tests/pmcheck/should_compile/T17646.stderr index e13bb88856..bf359e7b2b 100644 --- a/testsuite/tests/pmcheck/should_compile/T17646.stderr +++ b/testsuite/tests/pmcheck/should_compile/T17646.stderr @@ -5,11 +5,11 @@ T17646.hs:11:1: warning: [GHC-62161] [-Wincomplete-patterns (in -Wextra)] T17646.hs:11:5: warning: [GHC-40564] [-Winaccessible-code (in -Wdefault)] • Inaccessible code in - a pattern with constructor: B :: T 'False, + a pattern with constructor: B :: T False, in a pattern binding in a pattern guard for an equation for ‘g’ - Couldn't match type ‘'True’ with ‘'False’ + Couldn't match type ‘True’ with ‘False’ • In the pattern: B In a stmt of a pattern guard for an equation for ‘g’: diff --git a/testsuite/tests/pmcheck/should_compile/T18572.stderr b/testsuite/tests/pmcheck/should_compile/T18572.stderr index c0f9807b94..c733e53fe3 100644 --- a/testsuite/tests/pmcheck/should_compile/T18572.stderr +++ b/testsuite/tests/pmcheck/should_compile/T18572.stderr @@ -1,16 +1,16 @@ T18572.hs:12:1: warning: [GHC-40564] [-Winaccessible-code (in -Wdefault)] • Inaccessible code in - a pattern with constructor: STrue :: SBool 'True, + a pattern with constructor: STrue :: SBool True, in a pattern binding - Couldn't match type ‘'False’ with ‘'True’ + Couldn't match type ‘False’ with ‘True’ • In the pattern: STrue In a pattern binding: STrue = SFalse T18572.hs:12:1: warning: [GHC-62161] [-Wincomplete-uni-patterns (in -Wall)] Pattern match(es) are non-exhaustive In a pattern binding: - Patterns of type ‘SBool 'False’ not matched: SFalse + Patterns of type ‘SBool False’ not matched: SFalse T18572.hs:12:1: warning: [GHC-53633] [-Woverlapping-patterns (in -Wdefault)] Pattern match is redundant diff --git a/testsuite/tests/polykinds/T12444.stderr b/testsuite/tests/polykinds/T12444.stderr index e6403aa82b..80b77efcb3 100644 --- a/testsuite/tests/polykinds/T12444.stderr +++ b/testsuite/tests/polykinds/T12444.stderr @@ -1,16 +1,16 @@ T12444.hs:19:11: error: [GHC-25897] - • Couldn't match type ‘b’ with ‘'Succ (c :+: b)’ - Expected: SNat ('Succ (c :+: b)) + • Couldn't match type ‘b’ with ‘Succ (c :+: b)’ + Expected: SNat (Succ (c :+: b)) Actual: SNat b ‘b’ is a rigid type variable bound by the type signature for: foo :: forall (c :: Nat) (b :: Nat). - SNat ('Succ c) -> SNat b -> SNat ('Succ (c :+: b)) + SNat (Succ c) -> SNat b -> SNat (Succ (c :+: b)) at T12444.hs:18:1-55 • In the expression: x In an equation for ‘foo’: foo _ x = x • Relevant bindings include x :: SNat b (bound at T12444.hs:19:7) - foo :: SNat ('Succ c) -> SNat b -> SNat ('Succ (c :+: b)) + foo :: SNat (Succ c) -> SNat b -> SNat (Succ (c :+: b)) (bound at T12444.hs:19:1) diff --git a/testsuite/tests/polykinds/T7230.stderr b/testsuite/tests/polykinds/T7230.stderr index 696a4f0d1c..a18aaeda3b 100644 --- a/testsuite/tests/polykinds/T7230.stderr +++ b/testsuite/tests/polykinds/T7230.stderr @@ -1,10 +1,10 @@ T7230.hs:48:32: error: [GHC-05617] - • Could not deduce ‘(x :<<= x1) ~ 'True’ - from the context: Increasing xs ~ 'True + • Could not deduce ‘(x :<<= x1) ~ True’ + from the context: Increasing xs ~ True bound by the type signature for: crash :: forall (xs :: [Nat]). - (Increasing xs ~ 'True) => + (Increasing xs ~ True) => SList xs -> SBool (Increasing xs) at T7230.hs:47:1-68 or from: xs ~ (x : xs1) diff --git a/testsuite/tests/polykinds/T8566.stderr b/testsuite/tests/polykinds/T8566.stderr index a5df878b27..478359f2c1 100644 --- a/testsuite/tests/polykinds/T8566.stderr +++ b/testsuite/tests/polykinds/T8566.stderr @@ -1,19 +1,18 @@ T8566.hs:35:9: error: [GHC-39999] - • Could not deduce ‘C ('AA (t (I a ps)) as) ps fs0’ + • Could not deduce ‘C (AA (t (I a ps)) as) ps fs0’ arising from a use of ‘c’ - from the context: C ('AA (t (I a ps)) as) ps fs + from the context: C (AA (t (I a ps)) as) ps fs bound by the instance declaration at T8566.hs:33:10-67 - or from: 'AA t (a : as) ~ 'AA t1 as1 + or from: AA t (a : as) ~ AA t1 as1 bound by a pattern with constructor: - A :: forall {v} (t :: v) (as :: [U (*)]) (r :: [*]). - I ('AA t as) r, + A :: forall {v} (t :: v) (as :: [U (*)]) (r :: [*]). I (AA t as) r, in an equation for ‘c’ at T8566.hs:35:5 The type variable ‘fs0’ is ambiguous Relevant bindings include - c :: I ('AA t (a : as)) ps -> I ('AA t (a : as)) ps + c :: I (AA t (a : as)) ps -> I (AA t (a : as)) ps (bound at T8566.hs:35:3) • In the expression: c undefined In an equation for ‘c’: c A = c undefined - In the instance declaration for ‘C ('AA t (a : as)) ps fs’ + In the instance declaration for ‘C (AA t (a : as)) ps fs’ diff --git a/testsuite/tests/printer/T14343.stderr b/testsuite/tests/printer/T14343.stderr index 16d67dd9eb..dff9250b9b 100644 --- a/testsuite/tests/printer/T14343.stderr +++ b/testsuite/tests/printer/T14343.stderr @@ -1,14 +1,14 @@ T14343.hs:10:9: error: [GHC-88464] - • Found hole: _ :: Proxy '[ 'True] + • Found hole: _ :: Proxy '[True] • In the expression: _ :: Proxy '[ 'True] In an equation for ‘test1’: test1 = _ :: Proxy '[ 'True] • Relevant bindings include - test1 :: Proxy '[ 'True] (bound at T14343.hs:10:1) + test1 :: Proxy '[True] (bound at T14343.hs:10:1) Valid hole fits include - test1 :: Proxy '[ 'True] (defined at T14343.hs:10:1) + test1 :: Proxy '[True] (defined at T14343.hs:10:1) Proxy :: forall {k1} (k2 :: k1). Proxy k2 - with Proxy @'[ 'True] + with Proxy @'[True] (defined at T14343.hs:8:16) T14343.hs:11:9: error: [GHC-88464] diff --git a/testsuite/tests/printer/T14343b.stderr b/testsuite/tests/printer/T14343b.stderr index c19039ec7e..48b3481de8 100644 --- a/testsuite/tests/printer/T14343b.stderr +++ b/testsuite/tests/printer/T14343b.stderr @@ -1,39 +1,38 @@ T14343b.hs:10:9: error: [GHC-88464] - • Found hole: _ :: Proxy '( 'True, 'False) + • Found hole: _ :: Proxy '(True, False) • In the expression: _ :: Proxy '( 'True, 'False) In an equation for ‘test1’: test1 = _ :: Proxy '( 'True, 'False) • Relevant bindings include - test1 :: Proxy '( 'True, 'False) (bound at T14343b.hs:10:1) + test1 :: Proxy '(True, False) (bound at T14343b.hs:10:1) Valid hole fits include - test1 :: Proxy '( 'True, 'False) (defined at T14343b.hs:10:1) + test1 :: Proxy '(True, False) (defined at T14343b.hs:10:1) Proxy :: forall {k1} (k2 :: k1). Proxy k2 - with Proxy @'( 'True, 'False) + with Proxy @'(True, False) (defined at T14343b.hs:8:16) T14343b.hs:11:9: error: [GHC-88464] - • Found hole: _ :: Proxy '( '( 'True, 'False), 'False) + • Found hole: _ :: Proxy '( '(True, False), False) • In the expression: _ :: Proxy '( '( 'True, 'False), 'False) In an equation for ‘test2’: test2 = _ :: Proxy '( '( 'True, 'False), 'False) • Relevant bindings include - test2 :: Proxy '( '( 'True, 'False), 'False) - (bound at T14343b.hs:11:1) + test2 :: Proxy '( '(True, False), False) (bound at T14343b.hs:11:1) Valid hole fits include - test2 :: Proxy '( '( 'True, 'False), 'False) + test2 :: Proxy '( '(True, False), False) (defined at T14343b.hs:11:1) Proxy :: forall {k1} (k2 :: k1). Proxy k2 - with Proxy @'( '( 'True, 'False), 'False) + with Proxy @'( '(True, False), False) (defined at T14343b.hs:8:16) T14343b.hs:12:9: error: [GHC-88464] - • Found hole: _ :: Proxy '( '[1], 'False) + • Found hole: _ :: Proxy '( '[1], False) • In the expression: _ :: Proxy '( '[1], 'False) In an equation for ‘test3’: test3 = _ :: Proxy '( '[1], 'False) • Relevant bindings include - test3 :: Proxy '( '[1], 'False) (bound at T14343b.hs:12:1) + test3 :: Proxy '( '[1], False) (bound at T14343b.hs:12:1) Valid hole fits include - test3 :: Proxy '( '[1], 'False) (defined at T14343b.hs:12:1) + test3 :: Proxy '( '[1], False) (defined at T14343b.hs:12:1) Proxy :: forall {k1} (k2 :: k1). Proxy k2 - with Proxy @'( '[1], 'False) + with Proxy @'( '[1], False) (defined at T14343b.hs:8:16) diff --git a/testsuite/tests/printer/T20531.script b/testsuite/tests/printer/T20531.script new file mode 100644 index 0000000000..8654040219 --- /dev/null +++ b/testsuite/tests/printer/T20531.script @@ -0,0 +1,18 @@ +:set -XNoStarIsType +:load T20531_defs +:kind! L0 +:kind! L1 +:kind! L2 +:kind! Tup0 +:kind! Tup2 +:kind! S +:kind! I +data MkT -- introduce ambiguity +data a :& b -- introduce ambiguity +:kind! L0 +:kind! L1 +:kind! L2 +:kind! Tup0 +:kind! Tup2 +:kind! S +:kind! I
\ No newline at end of file diff --git a/testsuite/tests/printer/T20531.stdout b/testsuite/tests/printer/T20531.stdout new file mode 100644 index 0000000000..bf61077357 --- /dev/null +++ b/testsuite/tests/printer/T20531.stdout @@ -0,0 +1,28 @@ +L0 :: [T] += '[] +L1 :: [T] += '[MkT] +L2 :: [T] += [MkT, MkT] +Tup0 :: () += '() +Tup2 :: (T, T) += '(MkT, MkT) +S :: T += MkT +I :: And Type T += T :& MkT +L0 :: [T] += '[] +L1 :: [T] += '[ 'MkT] +L2 :: [T] += ['MkT, 'MkT] +Tup0 :: () += '() +Tup2 :: (T, T) += '( 'MkT, 'MkT) +S :: T += 'MkT +I :: And Type T += T ':& 'MkT diff --git a/testsuite/tests/printer/T20531_defs.hs b/testsuite/tests/printer/T20531_defs.hs new file mode 100644 index 0000000000..529b59de09 --- /dev/null +++ b/testsuite/tests/printer/T20531_defs.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE DataKinds #-} + +module T20531_defs where + +-- Definitions to be used in GHCi scripts +data T = MkT +type L0 = '[] :: [T] +type L1 = '[ 'MkT] +type L2 = '[ 'MkT, 'MkT ] +type Tup0 = '() +type Tup2 = '( 'MkT, 'MkT ) +type S = MkT +data And a b = a :& b +type I = T :& MkT
\ No newline at end of file diff --git a/testsuite/tests/printer/T20531_red_ticks.script b/testsuite/tests/printer/T20531_red_ticks.script new file mode 100644 index 0000000000..3511c4a07c --- /dev/null +++ b/testsuite/tests/printer/T20531_red_ticks.script @@ -0,0 +1,9 @@ +:set -fprint-redundant-promotion-ticks -XNoStarIsType +:load T20531_defs +:kind! L0 +:kind! L1 +:kind! L2 +:kind! Tup0 +:kind! Tup2 +:kind! S +:kind! I
\ No newline at end of file diff --git a/testsuite/tests/printer/T20531_red_ticks.stdout b/testsuite/tests/printer/T20531_red_ticks.stdout new file mode 100644 index 0000000000..47223db4ee --- /dev/null +++ b/testsuite/tests/printer/T20531_red_ticks.stdout @@ -0,0 +1,14 @@ +L0 :: [T] += '[] +L1 :: [T] += '[ 'MkT] +L2 :: [T] += '[ 'MkT, 'MkT] +Tup0 :: () += '() +Tup2 :: (T, T) += '( 'MkT, 'MkT) +S :: T += 'MkT +I :: And Type T += T ':& 'MkT diff --git a/testsuite/tests/printer/Test20315.stderr b/testsuite/tests/printer/Test20315.stderr index 258abc1fda..690b68fcdd 100644 --- a/testsuite/tests/printer/Test20315.stderr +++ b/testsuite/tests/printer/Test20315.stderr @@ -1,6 +1,6 @@ Test20315.hs:3:5: error: [GHC-83865] - • Couldn't match type ‘'Many’ with ‘m1 n1’ + • Couldn't match type ‘Many’ with ‘m1 n1’ Expected: a1 %(m1 n1) -> a1 Actual: a1 -> a1 • In the expression: id :: a %(m n) -> a diff --git a/testsuite/tests/printer/all.T b/testsuite/tests/printer/all.T index 5acd8867ab..620c92d5ba 100644 --- a/testsuite/tests/printer/all.T +++ b/testsuite/tests/printer/all.T @@ -183,4 +183,6 @@ test('Test21355', [ignore_stderr, req_ppr_deps], makefile_test, ['Test21355']) test('Test21805', [ignore_stderr, req_ppr_deps], makefile_test, ['Test21805']) test('T22488', normal, ghci_script, ['T22488.script']) -test('T22488_docHead', normal, compile_and_run, ['-package ghc'])
\ No newline at end of file +test('T22488_docHead', normal, compile_and_run, ['-package ghc']) +test('T20531', extra_files(['T20531_defs.hs']), ghci_script, ['T20531.script']) +test('T20531_red_ticks', extra_files(['T20531_defs.hs']), ghci_script, ['T20531_red_ticks.script'])
\ No newline at end of file diff --git a/testsuite/tests/rep-poly/LevPolyLet.stderr b/testsuite/tests/rep-poly/LevPolyLet.stderr index 95e606cf7e..fe56b3d840 100644 --- a/testsuite/tests/rep-poly/LevPolyLet.stderr +++ b/testsuite/tests/rep-poly/LevPolyLet.stderr @@ -2,6 +2,6 @@ LevPolyLet.hs:17:7: error: [GHC-55287] • The binder ‘x’ does not have a fixed runtime representation. Its type is: - a :: TYPE ('BoxedRep v) + a :: TYPE (BoxedRep v) • In the expression: let x = f 42 in undefined In an equation for ‘example’: example f = let x = f 42 in undefined diff --git a/testsuite/tests/rep-poly/RepPolyRule3.stderr b/testsuite/tests/rep-poly/RepPolyRule3.stderr index fb6b135b72..6752fa60e0 100644 --- a/testsuite/tests/rep-poly/RepPolyRule3.stderr +++ b/testsuite/tests/rep-poly/RepPolyRule3.stderr @@ -3,7 +3,7 @@ RepPolyRule3.hs:17:57: error: [GHC-55287] • The argument ‘x’ of ‘g’ does not have a fixed runtime representation. Its kind is: - TYPE (F 'WordRep) + TYPE (F WordRep) (Use -fprint-explicit-coercions to see the full type.) • In the expression: g x When checking the rewrite rule "g_id" @@ -12,7 +12,7 @@ RepPolyRule3.hs:23:52: error: [GHC-55287] • The argument ‘x’ of ‘h’ does not have a fixed runtime representation. Its kind is: - TYPE (F 'WordRep) + TYPE (F WordRep) (Use -fprint-explicit-coercions to see the full type.) • In the expression: h x When checking the rewrite rule "h_id" diff --git a/testsuite/tests/rep-poly/RepPolySum.stderr b/testsuite/tests/rep-poly/RepPolySum.stderr index 89a8ef85a9..88cb9978cc 100644 --- a/testsuite/tests/rep-poly/RepPolySum.stderr +++ b/testsuite/tests/rep-poly/RepPolySum.stderr @@ -2,7 +2,7 @@ RepPolySum.hs:11:9: error: [GHC-55287] • The unboxed sum does not have a fixed runtime representation. Its type is: - (# Int# | a #) :: TYPE ('SumRep '[ 'IntRep, rep]) + (# Int# | a #) :: TYPE (SumRep [IntRep, rep]) • In the expression: (# | bar () #) In an equation for ‘foo’: foo _ @@ -14,6 +14,6 @@ RepPolySum.hs:11:9: error: [GHC-55287] RepPolySum.hs:20:9: error: [GHC-55287] • The unboxed sum does not have a fixed runtime representation. Its type is: - (# Int# | a #) :: TYPE ('SumRep '[ 'IntRep, rep]) + (# Int# | a #) :: TYPE (SumRep [IntRep, rep]) • In the expression: (# 17# | #) In an equation for ‘baz’: baz _ = (# 17# | #) diff --git a/testsuite/tests/rep-poly/RepPolyUnboxedPatterns.stderr b/testsuite/tests/rep-poly/RepPolyUnboxedPatterns.stderr index a84d9d89f8..495a4fc1d8 100644 --- a/testsuite/tests/rep-poly/RepPolyUnboxedPatterns.stderr +++ b/testsuite/tests/rep-poly/RepPolyUnboxedPatterns.stderr @@ -3,10 +3,10 @@ RepPolyUnboxedPatterns.hs:8:1: error: [GHC-55287] The first pattern in the equation for ‘foo’ does not have a fixed runtime representation. Its type is: - (# a, b #) :: TYPE ('TupleRep '[rep1, rep2]) + (# a, b #) :: TYPE (TupleRep [rep1, rep2]) RepPolyUnboxedPatterns.hs:11:1: error: [GHC-55287] The first pattern in the equations for ‘bar’ does not have a fixed runtime representation. Its type is: - (# a | b #) :: TYPE ('SumRep '[rep1, rep2]) + (# a | b #) :: TYPE (SumRep [rep1, rep2]) diff --git a/testsuite/tests/rep-poly/RepPolyWrappedVar.stderr b/testsuite/tests/rep-poly/RepPolyWrappedVar.stderr index abdafcf070..bdfc215389 100644 --- a/testsuite/tests/rep-poly/RepPolyWrappedVar.stderr +++ b/testsuite/tests/rep-poly/RepPolyWrappedVar.stderr @@ -4,6 +4,6 @@ RepPolyWrappedVar.hs:15:10: error: [GHC-55287] The first argument of ‘mkWeak#’ does not have a fixed runtime representation. Its type is: - a :: TYPE ('BoxedRep l) + a :: TYPE (BoxedRep l) • In the expression: mkWeak# @a @Int @Bool In an equation for ‘primop’: primop = mkWeak# @a @Int @Bool diff --git a/testsuite/tests/rep-poly/T13929.stderr b/testsuite/tests/rep-poly/T13929.stderr index 5ad878794c..5c4a61b80d 100644 --- a/testsuite/tests/rep-poly/T13929.stderr +++ b/testsuite/tests/rep-poly/T13929.stderr @@ -10,20 +10,20 @@ T13929.hs:29:24: error: [GHC-55287] In an equation for ‘gunbox’: gunbox (x :*: y) = (# gunbox x, gunbox y #) In the instance declaration for - ‘GUnbox (f :*: g) ('TupleRep '[rf, rg])’ + ‘GUnbox (f :*: g) (TupleRep [rf, rg])’ • Relevant bindings include x :: f p (bound at T13929.hs:29:13) - gunbox :: (:*:) f g p -> GUnboxed (f :*: g) ('TupleRep '[rf, rg]) + gunbox :: (:*:) f g p -> GUnboxed (f :*: g) (TupleRep [rf, rg]) (bound at T13929.hs:29:5) T13929.hs:34:21: error: [GHC-55287] • • The unboxed sum does not have a fixed runtime representation. Its type is: - GUnboxed (f :+: g) ('SumRep '[rf, rg]) :: TYPE ('SumRep '[rf, rg]) + GUnboxed (f :+: g) (SumRep [rf, rg]) :: TYPE (SumRep [rf, rg]) • The unboxed sum does not have a fixed runtime representation. Its type is: - GUnboxed (f :+: g) ('SumRep '[rf, rg]) :: TYPE ('SumRep '[rf, rg]) + GUnboxed (f :+: g) (SumRep [rf, rg]) :: TYPE (SumRep [rf, rg]) • In the expression: (# | gunbox r #) In an equation for ‘gunbox’: gunbox (R1 r) = (# | gunbox r #) In the instance declaration for - ‘GUnbox (f :+: g) ('SumRep '[rf, rg])’ + ‘GUnbox (f :+: g) (SumRep [rf, rg])’ diff --git a/testsuite/tests/rep-poly/T17817.stderr b/testsuite/tests/rep-poly/T17817.stderr index 4d3cb94343..4ce33c9a08 100644 --- a/testsuite/tests/rep-poly/T17817.stderr +++ b/testsuite/tests/rep-poly/T17817.stderr @@ -4,6 +4,6 @@ T17817.hs:16:10: error: [GHC-55287] The first argument of ‘mkWeak#’ does not have a fixed runtime representation. Its type is: - a :: TYPE ('BoxedRep l) + a :: TYPE (BoxedRep l) • In the expression: mkWeak# In an equation for ‘primop’: primop = mkWeak# diff --git a/testsuite/tests/rep-poly/T20277.stderr b/testsuite/tests/rep-poly/T20277.stderr index e55d2846f8..d6245ba381 100644 --- a/testsuite/tests/rep-poly/T20277.stderr +++ b/testsuite/tests/rep-poly/T20277.stderr @@ -2,6 +2,6 @@ T20277.hs:14:9: error: [GHC-55287] • The unboxed sum does not have a fixed runtime representation. Its type is: - (# Int# | a #) :: TYPE ('SumRep '[ 'IntRep, rep]) + (# Int# | a #) :: TYPE (SumRep [IntRep, rep]) • In the expression: (# 17# | #) In an equation for ‘baz’: baz _ = (# 17# | #) diff --git a/testsuite/tests/rep-poly/T20363b.stderr b/testsuite/tests/rep-poly/T20363b.stderr index e730bc62e0..a06cd16741 100644 --- a/testsuite/tests/rep-poly/T20363b.stderr +++ b/testsuite/tests/rep-poly/T20363b.stderr @@ -3,20 +3,20 @@ T20363b.hs:48:10: error: [GHC-55287] • • The newtype constructor pattern does not have a fixed runtime representation. Its type is: - NestedTuple ('Suc 'Zero) Addr# :: TYPE - (NestedTupleRep ('Suc 'Zero) 'AddrRep) + NestedTuple (Suc Zero) Addr# :: TYPE + (NestedTupleRep (Suc Zero) AddrRep) • The argument ‘(# nullAddr#, (##) #)’ of ‘MkNT’ does not have a fixed runtime representation. Its type is: - NestedTuple ('Suc 'Zero) Addr# :: TYPE - (NestedTupleRep ('Suc 'Zero) 'AddrRep) + NestedTuple (Suc Zero) Addr# :: TYPE + (NestedTupleRep (Suc Zero) AddrRep) • The newtype constructor pattern does not have a fixed runtime representation. Its type is: - NestedTuple 'Zero Addr# :: TYPE (NestedTupleRep 'Zero 'AddrRep) + NestedTuple Zero Addr# :: TYPE (NestedTupleRep Zero AddrRep) • The argument ‘(##)’ of ‘MkNT’ does not have a fixed runtime representation. Its type is: - NestedTuple 'Zero Addr# :: TYPE (NestedTupleRep 'Zero 'AddrRep) + NestedTuple Zero Addr# :: TYPE (NestedTupleRep Zero AddrRep) • In the pattern: MkNT (# i, (##) #) In an equation for ‘test2b’: test2b (MkNT (# i, (##) #)) = i diff --git a/testsuite/tests/rep-poly/T20423.stderr b/testsuite/tests/rep-poly/T20423.stderr index e9f7f7263e..c54142ccc1 100644 --- a/testsuite/tests/rep-poly/T20423.stderr +++ b/testsuite/tests/rep-poly/T20423.stderr @@ -1,4 +1,4 @@ T20423.hs:11:1: error: [GHC-18478] The pattern synonym scrutinee does not have a fixed runtime representation: - • LPInt lev :: TYPE ('BoxedRep lev) + • LPInt lev :: TYPE (BoxedRep lev) diff --git a/testsuite/tests/rep-poly/T20423b.stderr b/testsuite/tests/rep-poly/T20423b.stderr index e76697fcfe..ffecc14b63 100644 --- a/testsuite/tests/rep-poly/T20423b.stderr +++ b/testsuite/tests/rep-poly/T20423b.stderr @@ -1,4 +1,4 @@ T20423b.hs:17:1: error: [GHC-18478] The pattern synonym scrutinee does not have a fixed runtime representation: - • LPGADT l :: TYPE ('BoxedRep l) + • LPGADT l :: TYPE (BoxedRep l) diff --git a/testsuite/tests/rep-poly/T20426.stderr b/testsuite/tests/rep-poly/T20426.stderr index e1dfe0a5a8..a1757ba835 100644 --- a/testsuite/tests/rep-poly/T20426.stderr +++ b/testsuite/tests/rep-poly/T20426.stderr @@ -3,4 +3,4 @@ T20426.hs:15:1: error: [GHC-55287] The first pattern in the equations for ‘getInt#’ does not have a fixed runtime representation. Its type is: - LPGADT l :: TYPE ('BoxedRep l) + LPGADT l :: TYPE (BoxedRep l) diff --git a/testsuite/tests/roles/should_compile/Roles13.stderr b/testsuite/tests/roles/should_compile/Roles13.stderr index 1a5a04b37f..1f1f46214e 100644 --- a/testsuite/tests/roles/should_compile/Roles13.stderr +++ b/testsuite/tests/roles/should_compile/Roles13.stderr @@ -14,7 +14,7 @@ convert :: Wrap Age -> Int convert = convert1 `cast` (<Wrap Age>_R - %<'Many>_N ->_R Roles13.N:Wrap[0] (Roles13.N:Age[0]) + %<Many>_N ->_R Roles13.N:Wrap[0] (Roles13.N:Age[0]) :: (Wrap Age -> Wrap Age) ~R# (Wrap Age -> Int)) -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} @@ -69,8 +69,8 @@ Roles13.$tcAge :: GHC.Types.TyCon [GblId, Unf=OtherCon []] Roles13.$tcAge = GHC.Types.TyCon - 3456257068627873222## - 14056710845110756026## + 3456257068627873222##64 + 14056710845110756026##64 Roles13.$trModule $tcAge2 0# @@ -103,8 +103,8 @@ Roles13.$tc'MkAge :: GHC.Types.TyCon [GblId, Unf=OtherCon []] Roles13.$tc'MkAge = GHC.Types.TyCon - 18264039750958872441## - 1870189534242358050## + 18264039750958872441##64 + 1870189534242358050##64 Roles13.$trModule $tc'MkAge2 0# @@ -125,8 +125,8 @@ Roles13.$tcWrap :: GHC.Types.TyCon [GblId, Unf=OtherCon []] Roles13.$tcWrap = GHC.Types.TyCon - 13773534096961634492## - 15591525585626702988## + 13773534096961634492##64 + 15591525585626702988##64 Roles13.$trModule $tcWrap2 0# @@ -164,8 +164,8 @@ Roles13.$tc'MkWrap :: GHC.Types.TyCon [GblId, Unf=OtherCon []] Roles13.$tc'MkWrap = GHC.Types.TyCon - 15580677875333883466## - 808508687714473149## + 15580677875333883466##64 + 808508687714473149##64 Roles13.$trModule $tc'MkWrap2 1# diff --git a/testsuite/tests/saks/should_fail/saks007_fail.stderr b/testsuite/tests/saks/should_fail/saks007_fail.stderr index 1ceefa9ee3..a299c5be4a 100644 --- a/testsuite/tests/saks/should_fail/saks007_fail.stderr +++ b/testsuite/tests/saks/should_fail/saks007_fail.stderr @@ -1,6 +1,6 @@ saks007_fail.hs:15:10: error: [GHC-83865] - • Couldn't match kind ‘'True’ with ‘'False’ + • Couldn't match kind ‘True’ with ‘False’ Expected: G (*) Actual: F (*) • In the type ‘X Integer String’ diff --git a/testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr b/testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr index 00a0421915..3996f89f2b 100644 --- a/testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr +++ b/testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr @@ -14,7 +14,7 @@ unsafeToInteger :: forall (n :: Nat). Signed n -> Integer unsafeToInteger = unsafeToInteger1 `cast` (forall (n :: <Nat>_N). - <Signed n>_R %<'Many>_N ->_R OpaqueNoCastWW.N:Signed[0] <n>_P + <Signed n>_R %<Many>_N ->_R OpaqueNoCastWW.N:Signed[0] <n>_P :: (forall {n :: Nat}. Signed n -> Signed n) ~R# (forall {n :: Nat}. Signed n -> Integer)) @@ -36,8 +36,8 @@ times `cast` (OpaqueNoCastWW.N:Signed[0] <n>_P :: Signed n ~R# Integer))) `cast` (forall (m :: <Nat>_N) (n :: <Nat>_N). <Signed m>_R - %<'Many>_N ->_R <Signed n>_R - %<'Many>_N ->_R Sym (OpaqueNoCastWW.N:Signed[0] <m + n>_P) + %<Many>_N ->_R <Signed n>_R + %<Many>_N ->_R Sym (OpaqueNoCastWW.N:Signed[0] <m + n>_P) :: (forall {m :: Nat} {n :: Nat}. Signed m -> Signed n -> Integer) ~R# (forall {m :: Nat} {n :: Nat}. Signed m -> Signed n -> Signed (m + n))) @@ -106,8 +106,8 @@ OpaqueNoCastWW.$tcSigned :: GHC.Types.TyCon [GblId, Unf=OtherCon []] OpaqueNoCastWW.$tcSigned = GHC.Types.TyCon - 12374680438872388605## - 16570143229152367467## + 12374680438872388605##64 + 16570143229152367467##64 OpaqueNoCastWW.$trModule $tcSigned2 0# @@ -145,9 +145,12 @@ OpaqueNoCastWW.$tc'S :: GHC.Types.TyCon [GblId, Unf=OtherCon []] OpaqueNoCastWW.$tc'S = GHC.Types.TyCon - 9801584576887380300## - 5757617350287545124## + 9801584576887380300##64 + 5757617350287545124##64 OpaqueNoCastWW.$trModule $tc'S2 1# $krep6 + + + diff --git a/testsuite/tests/tcplugins/TcPlugin_RewritePerf.stderr b/testsuite/tests/tcplugins/TcPlugin_RewritePerf.stderr index 0d6f7ed4f0..37cd981b72 100644 --- a/testsuite/tests/tcplugins/TcPlugin_RewritePerf.stderr +++ b/testsuite/tests/tcplugins/TcPlugin_RewritePerf.stderr @@ -5,22 +5,22 @@ TcPlugin_RewritePerf.hs:25:8: error: [GHC-39999] • No instance for ‘Show (Proxy - '[ '[ 'Cube 'G 'B 'W 'R 'B 'G, 'Cube 'W 'G 'B 'W 'R 'R, - 'Cube 'R 'W 'R 'B 'G 'R, 'Cube 'B 'R 'G 'G 'W 'W], - '[ 'Cube 'G 'B 'R 'W 'B 'G, 'Cube 'R 'R 'W 'B 'G 'W, - 'Cube 'R 'G 'B 'R 'W 'R, 'Cube 'W 'W 'G 'G 'R 'B], - '[ 'Cube 'G 'W 'R 'B 'B 'G, 'Cube 'W 'B 'W 'R 'G 'R, - 'Cube 'R 'R 'B 'G 'W 'R, 'Cube 'B 'G 'G 'W 'R 'W], - '[ 'Cube 'G 'R 'W 'B 'B 'G, 'Cube 'R 'W 'B 'G 'R 'W, - 'Cube 'R 'B 'R 'W 'G 'R, 'Cube 'W 'G 'G 'R 'W 'B], - '[ 'Cube 'G 'R 'B 'B 'W 'G, 'Cube 'W 'W 'R 'G 'B 'R, - 'Cube 'R 'B 'G 'W 'R 'R, 'Cube 'B 'G 'W 'R 'G 'W], - '[ 'Cube 'G 'W 'B 'B 'R 'G, 'Cube 'R 'B 'G 'R 'W 'W, - 'Cube 'R 'R 'W 'G 'B 'R, 'Cube 'W 'G 'R 'W 'G 'B], - '[ 'Cube 'G 'B 'B 'W 'R 'G, 'Cube 'W 'R 'G 'B 'W 'R, - 'Cube 'R 'G 'W 'R 'B 'R, 'Cube 'B 'W 'R 'G 'G 'W], - '[ 'Cube 'G 'B 'B 'R 'W 'G, 'Cube 'R 'G 'R 'W 'B 'W, - 'Cube 'R 'W 'G 'B 'R 'R, 'Cube 'W 'R 'W 'G 'G 'B]])’ + [['Cube G B W R B G, 'Cube W G B W R R, 'Cube R W R B G R, + 'Cube B R G G W W], + ['Cube G B R W B G, 'Cube R R W B G W, 'Cube R G B R W R, + 'Cube W W G G R B], + ['Cube G W R B B G, 'Cube W B W R G R, 'Cube R R B G W R, + 'Cube B G G W R W], + ['Cube G R W B B G, 'Cube R W B G R W, 'Cube R B R W G R, + 'Cube W G G R W B], + ['Cube G R B B W G, 'Cube W W R G B R, 'Cube R B G W R R, + 'Cube B G W R G W], + ['Cube G W B B R G, 'Cube R B G R W W, 'Cube R R W G B R, + 'Cube W G R W G B], + ['Cube G B B W R G, 'Cube W R G B W R, 'Cube R G W R B R, + 'Cube B W R G G W], + ['Cube G B B R W G, 'Cube R G R W B W, 'Cube R W G B R R, + 'Cube W R W G G B]])’ arising from a use of ‘print’ • In the expression: print (Proxy :: Proxy (Solutions Cubes)) In an equation for ‘main’: diff --git a/testsuite/tests/typecheck/no_skolem_info/T20063.stderr b/testsuite/tests/typecheck/no_skolem_info/T20063.stderr index 3f2e0d490b..31c88b98a6 100644 --- a/testsuite/tests/typecheck/no_skolem_info/T20063.stderr +++ b/testsuite/tests/typecheck/no_skolem_info/T20063.stderr @@ -1,7 +1,7 @@ T20063.hs:25:21: error: [GHC-25897] • Could not deduce ‘ctx4 ~ (ctx0 :*& l0)’ - from the context: (ctx1 ~ 'Extend ctx7, ctx2 ~ 'Extend ctx8) + from the context: (ctx1 ~ Extend ctx7, ctx2 ~ Extend ctx8) bound by a pattern with constructor: U :: forall {k} (ctx1 :: Context) (ctx2 :: Context) (l :: k). Rn ctx1 ctx2 -> Rn (ctx1 :*& l) (ctx2 :*& l), diff --git a/testsuite/tests/typecheck/no_skolem_info/T20232.stderr b/testsuite/tests/typecheck/no_skolem_info/T20232.stderr index e6688cc5c7..e1b4568f3f 100644 --- a/testsuite/tests/typecheck/no_skolem_info/T20232.stderr +++ b/testsuite/tests/typecheck/no_skolem_info/T20232.stderr @@ -1,6 +1,6 @@ T20232.hs:7:5: error: [GHC-25897] - • Couldn't match type ‘p’ with ‘'One’ + • Couldn't match type ‘p’ with ‘One’ arising from multiplicity of ‘x’ ‘p’ is a rigid type variable bound by a pattern with constructor: C :: forall a. (a -> a) -> C a, diff --git a/testsuite/tests/typecheck/should_compile/T17024.stderr b/testsuite/tests/typecheck/should_compile/T17024.stderr index 2073631d69..9d8c119377 100644 --- a/testsuite/tests/typecheck/should_compile/T17024.stderr +++ b/testsuite/tests/typecheck/should_compile/T17024.stderr @@ -2,6 +2,6 @@ T17024.hs:18:42: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘c’ Where: ‘c’ is a rigid type variable bound by - the inferred type of foo :: (a -> b -> c) -> HList '[a, b] -> c + the inferred type of foo :: (a -> b -> c) -> HList [a, b] -> c at T17024.hs:18:1-42 • In the type signature: foo :: (a -> b -> c) -> HList '[a, b] -> _ diff --git a/testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.stderr index 3d06a058a3..77b178aa18 100644 --- a/testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.stderr +++ b/testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.stderr @@ -1,81 +1,81 @@ type_in_type_hole_fits.hs:79:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)] • Found hole: - _a :: [Integer] -> Sorted (O ('NLogN 2 0)) (O N) 'True Integer + _a :: [Integer] -> Sorted (O (NLogN 2 0)) (O N) True Integer Or perhaps ‘_a’ is mis-spelled, or not in scope • In the expression: _a [3, 1, 2] In an equation for ‘mySortA’: mySortA = _a [3, 1, 2] • Relevant bindings include - mySortA :: Sorted (O (N ^. 2)) (O N) 'True Integer + mySortA :: Sorted (O (N ^. 2)) (O N) True Integer (bound at type_in_type_hole_fits.hs:79:1) Valid hole fits include Sorted :: forall (cpu :: AsympPoly) (mem :: AsympPoly) (stable :: Bool) a. [a] -> Sorted cpu mem stable a - with Sorted @(O ('NLogN 2 0)) @(O N) @'True @Integer + with Sorted @(O (NLogN 2 0)) @(O N) @True @Integer (defined at type_in_type_hole_fits.hs:54:18) mergeSort :: forall a (n :: AsympPoly) (m :: AsympPoly) (s :: Bool). (Ord a, n >=. O (N *. LogN), m >=. O N, IsStable s) => [a] -> Sorted n m s a - with mergeSort @Integer @(O ('NLogN 2 0)) @(O N) @'True + with mergeSort @Integer @(O (NLogN 2 0)) @(O N) @True (defined at type_in_type_hole_fits.hs:61:1) insertionSort :: forall a (n :: AsympPoly) (m :: AsympPoly) (s :: Bool). (Ord a, n >=. O (N ^. 2), m >=. O One, IsStable s) => [a] -> Sorted n m s a - with insertionSort @Integer @(O ('NLogN 2 0)) @(O N) @'True + with insertionSort @Integer @(O (NLogN 2 0)) @(O N) @True (defined at type_in_type_hole_fits.hs:65:1) type_in_type_hole_fits.hs:82:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)] • Found hole: - _b :: [Integer] -> Sorted (O ('NLogN 1 1)) (O N) 'False Integer + _b :: [Integer] -> Sorted (O (NLogN 1 1)) (O N) False Integer Or perhaps ‘_b’ is mis-spelled, or not in scope • In the expression: _b [3, 1, 2] In an equation for ‘mySortB’: mySortB = _b [3, 1, 2] • Relevant bindings include - mySortB :: Sorted (O (N *. LogN)) (O N) 'False Integer + mySortB :: Sorted (O (N *. LogN)) (O N) False Integer (bound at type_in_type_hole_fits.hs:82:1) Valid hole fits include quickSort :: forall a (n :: AsympPoly) (m :: AsympPoly). (Ord a, n >=. O (N *. LogN), m >=. O N) => - [a] -> Sorted n m 'False a - with quickSort @Integer @(O ('NLogN 1 1)) @(O N) + [a] -> Sorted n m False a + with quickSort @Integer @(O (NLogN 1 1)) @(O N) (defined at type_in_type_hole_fits.hs:71:1) heapSort :: forall a (n :: AsympPoly) (m :: AsympPoly). (Ord a, n >=. O (N *. LogN), m >=. O One) => - [a] -> Sorted n m 'False a - with heapSort @Integer @(O ('NLogN 1 1)) @(O N) + [a] -> Sorted n m False a + with heapSort @Integer @(O (NLogN 1 1)) @(O N) (defined at type_in_type_hole_fits.hs:74:1) Sorted :: forall (cpu :: AsympPoly) (mem :: AsympPoly) (stable :: Bool) a. [a] -> Sorted cpu mem stable a - with Sorted @(O ('NLogN 1 1)) @(O N) @'False @Integer + with Sorted @(O (NLogN 1 1)) @(O N) @False @Integer (defined at type_in_type_hole_fits.hs:54:18) mergeSort :: forall a (n :: AsympPoly) (m :: AsympPoly) (s :: Bool). (Ord a, n >=. O (N *. LogN), m >=. O N, IsStable s) => [a] -> Sorted n m s a - with mergeSort @Integer @(O ('NLogN 1 1)) @(O N) @'False + with mergeSort @Integer @(O (NLogN 1 1)) @(O N) @False (defined at type_in_type_hole_fits.hs:61:1) type_in_type_hole_fits.hs:85:11: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)] • Found hole: - _c :: [Integer] -> Sorted (O ('NLogN 1 1)) (O One) 'False Integer + _c :: [Integer] -> Sorted (O (NLogN 1 1)) (O One) False Integer Or perhaps ‘_c’ is mis-spelled, or not in scope • In the expression: _c [3, 1, 2] In an equation for ‘mySortC’: mySortC = _c [3, 1, 2] • Relevant bindings include - mySortC :: Sorted (O (N *. LogN)) (O One) 'False Integer + mySortC :: Sorted (O (N *. LogN)) (O One) False Integer (bound at type_in_type_hole_fits.hs:85:1) Valid hole fits include heapSort :: forall a (n :: AsympPoly) (m :: AsympPoly). (Ord a, n >=. O (N *. LogN), m >=. O One) => - [a] -> Sorted n m 'False a - with heapSort @Integer @(O ('NLogN 1 1)) @(O One) + [a] -> Sorted n m False a + with heapSort @Integer @(O (NLogN 1 1)) @(O One) (defined at type_in_type_hole_fits.hs:74:1) Sorted :: forall (cpu :: AsympPoly) (mem :: AsympPoly) (stable :: Bool) a. [a] -> Sorted cpu mem stable a - with Sorted @(O ('NLogN 1 1)) @(O One) @'False @Integer + with Sorted @(O (NLogN 1 1)) @(O One) @False @Integer (defined at type_in_type_hole_fits.hs:54:18) diff --git a/testsuite/tests/typecheck/should_compile/valid_hole_fits_interactions.stderr b/testsuite/tests/typecheck/should_compile/valid_hole_fits_interactions.stderr index a6f557bee7..08ec14474d 100644 --- a/testsuite/tests/typecheck/should_compile/valid_hole_fits_interactions.stderr +++ b/testsuite/tests/typecheck/should_compile/valid_hole_fits_interactions.stderr @@ -1,10 +1,10 @@ valid_hole_fits_interactions.hs:15:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)] - • Found hole: _ :: SBool 'True + • Found hole: _ :: SBool True • In an equation for ‘f’: f = _ • Relevant bindings include - f :: SBool 'True (bound at valid_hole_fits_interactions.hs:15:1) + f :: SBool True (bound at valid_hole_fits_interactions.hs:15:1) Valid hole fits include - f :: SBool 'True (bound at valid_hole_fits_interactions.hs:15:1) - STrue :: SBool 'True + f :: SBool True (bound at valid_hole_fits_interactions.hs:15:1) + STrue :: SBool True (defined at valid_hole_fits_interactions.hs:12:3) diff --git a/testsuite/tests/typecheck/should_fail/T12102b.stderr b/testsuite/tests/typecheck/should_fail/T12102b.stderr index 57ba1395b6..cecd4aa7ee 100644 --- a/testsuite/tests/typecheck/should_fail/T12102b.stderr +++ b/testsuite/tests/typecheck/should_fail/T12102b.stderr @@ -1,6 +1,6 @@ T12102b.hs:21:25: error: [GHC-83865] - • Couldn't match expected kind ‘'True’ + • Couldn't match expected kind ‘True’ with actual kind ‘IsTypeLit a’ • In the first argument of ‘Show’, namely ‘(T a)’ In the stand-alone deriving instance for ‘Show (T a)’ diff --git a/testsuite/tests/typecheck/should_fail/T12729.stderr b/testsuite/tests/typecheck/should_fail/T12729.stderr index 7bb0aedc12..d638aa7e7c 100644 --- a/testsuite/tests/typecheck/should_fail/T12729.stderr +++ b/testsuite/tests/typecheck/should_fail/T12729.stderr @@ -1,5 +1,5 @@ T12729.hs:7:1: error: [GHC-55233] - • Newtype has non-* return kind ‘TYPE 'IntRep’ + • Newtype has non-* return kind ‘TYPE IntRep’ • In the newtype declaration for ‘A’ Suggested fix: Perhaps you intended to use UnliftedNewtypes diff --git a/testsuite/tests/typecheck/should_fail/T12785b.stderr b/testsuite/tests/typecheck/should_fail/T12785b.stderr index ee1158ce9e..abcdee7619 100644 --- a/testsuite/tests/typecheck/should_fail/T12785b.stderr +++ b/testsuite/tests/typecheck/should_fail/T12785b.stderr @@ -1,11 +1,11 @@ T12785b.hs:30:65: error: [GHC-25897] - • Could not deduce ‘Payload ('S n) (Payload n s1) ~ s’ + • Could not deduce ‘Payload (S n) (Payload n s1) ~ s’ arising from a use of ‘SBranchX’ - from the context: m ~ 'S n + from the context: m ~ S n bound by a pattern with constructor: Branch :: forall a (n :: Peano). - a -> HTree n (HTree ('S n) a) -> HTree ('S n) a, + a -> HTree n (HTree (S n) a) -> HTree (S n) a, in an equation for ‘nest’ at T12785b.hs:30:7-51 ‘s’ is a rigid type variable bound by @@ -20,8 +20,8 @@ T12785b.hs:30:65: error: [GHC-25897] nest (Hide a `Branch` (nest . hmap nest -> Hide tr)) = Hide $ a `SBranchX` tr • Relevant bindings include - tr :: STree n (STree ('S n) (STree ('S ('S n)) f)) s1 + tr :: STree n (STree (S n) (STree (S (S n)) f)) s1 (bound at T12785b.hs:30:49) - a :: STree ('S m) f s (bound at T12785b.hs:30:12) - nest :: HTree m (Hidden ('S m) f) -> Hidden m (STree ('S m) f) + a :: STree (S m) f s (bound at T12785b.hs:30:12) + nest :: HTree m (Hidden (S m) f) -> Hidden m (STree (S m) f) (bound at T12785b.hs:28:1) diff --git a/testsuite/tests/typecheck/should_fail/T13530.stderr b/testsuite/tests/typecheck/should_fail/T13530.stderr index 31c294d654..25100b827b 100644 --- a/testsuite/tests/typecheck/should_fail/T13530.stderr +++ b/testsuite/tests/typecheck/should_fail/T13530.stderr @@ -3,7 +3,7 @@ T13530.hs:11:7: error: [GHC-18872] • Couldn't match a lifted type with an unlifted type When matching types a0 :: * - Int# :: TYPE 'IntRep + Int# :: TYPE IntRep Expected: (# Int#, Int# #) Actual: (# Int#, a0 #) • In the expression: g x diff --git a/testsuite/tests/typecheck/should_fail/T15067.stderr b/testsuite/tests/typecheck/should_fail/T15067.stderr index 64d322f927..efa7373b8f 100644 --- a/testsuite/tests/typecheck/should_fail/T15067.stderr +++ b/testsuite/tests/typecheck/should_fail/T15067.stderr @@ -6,6 +6,6 @@ T15067.hs:9:14: error: [GHC-39999] Typeable ((# | #) :: * -> * -> TYPE - ('GHC.Types.SumRep '[GHC.Types.LiftedRep, GHC.Types.LiftedRep])) + (GHC.Types.SumRep [GHC.Types.LiftedRep, GHC.Types.LiftedRep])) • In the expression: typeRep In an equation for ‘floopadoop’: floopadoop = typeRep diff --git a/testsuite/tests/typecheck/should_fail/T15330.stderr b/testsuite/tests/typecheck/should_fail/T15330.stderr index 19ec29e90f..7c91463570 100644 --- a/testsuite/tests/typecheck/should_fail/T15330.stderr +++ b/testsuite/tests/typecheck/should_fail/T15330.stderr @@ -1,18 +1,18 @@ T15330.hs:12:6: error: [GHC-83865] • Couldn't match type: [Char] - with: Proxy (T 'True) - Expected: Proxy (T 'True) + with: Proxy (T True) + Expected: Proxy (T True) Actual: String • In the expression: "foo" In an equation for ‘f1’: f1 = "foo" T15330.hs:16:6: error: [GHC-83865] • Couldn't match type: [Char] - with: Proxy (t 'True) - Expected: Proxy (t 'True) + with: Proxy (t True) + Expected: Proxy (t True) Actual: String • In the expression: "foo" In an equation for ‘f2’: f2 = "foo" • Relevant bindings include - f2 :: Proxy (t 'True) (bound at T15330.hs:16:1) + f2 :: Proxy (t True) (bound at T15330.hs:16:1) diff --git a/testsuite/tests/typecheck/should_fail/T15962.stderr b/testsuite/tests/typecheck/should_fail/T15962.stderr index a6f4034277..912ac13c42 100644 --- a/testsuite/tests/typecheck/should_fail/T15962.stderr +++ b/testsuite/tests/typecheck/should_fail/T15962.stderr @@ -15,4 +15,4 @@ T15962.hs:28:11: error: [GHC-88464] (bound at T15962.hs:28:1) T15962.hs:34:12: error: [GHC-88464] - Variable not in scope: iDontExist :: Big ('Conjunction : ks) + Variable not in scope: iDontExist :: Big (Conjunction : ks) diff --git a/testsuite/tests/typecheck/should_fail/T16829a.stderr b/testsuite/tests/typecheck/should_fail/T16829a.stderr index f98154f9d0..8634344108 100644 --- a/testsuite/tests/typecheck/should_fail/T16829a.stderr +++ b/testsuite/tests/typecheck/should_fail/T16829a.stderr @@ -1,5 +1,5 @@ T16829a.hs:9:1: error: [GHC-55233] - • Newtype has non-* return kind ‘TYPE 'IntRep’ + • Newtype has non-* return kind ‘TYPE IntRep’ • In the newtype declaration for ‘T’ Suggested fix: Perhaps you intended to use UnliftedNewtypes diff --git a/testsuite/tests/typecheck/should_fail/T16829b.stderr b/testsuite/tests/typecheck/should_fail/T16829b.stderr index 9aad973311..711a2c7951 100644 --- a/testsuite/tests/typecheck/should_fail/T16829b.stderr +++ b/testsuite/tests/typecheck/should_fail/T16829b.stderr @@ -1,5 +1,5 @@ T16829b.hs:10:1: error: [GHC-55233] - • Newtype instance has non-* return kind ‘TYPE 'IntRep’ + • Newtype instance has non-* return kind ‘TYPE IntRep’ • In the newtype instance declaration for ‘T’ Suggested fix: Perhaps you intended to use UnliftedNewtypes diff --git a/testsuite/tests/typecheck/should_fail/T17301.stderr b/testsuite/tests/typecheck/should_fail/T17301.stderr index 7c7e20f005..4c1c693bc1 100644 --- a/testsuite/tests/typecheck/should_fail/T17301.stderr +++ b/testsuite/tests/typecheck/should_fail/T17301.stderr @@ -1,5 +1,5 @@ T17301.hs:22:3: error: • Uninferrable type variable (a0 :: A) in - type family equation right-hand side: 'MkATySing @(B a0) ('SB @a0) + type family equation right-hand side: MkATySing @(B a0) (SB @a0) • In the type family declaration for ‘Forget’ diff --git a/testsuite/tests/typecheck/should_fail/T21327.stderr b/testsuite/tests/typecheck/should_fail/T21327.stderr index 98ea237018..1a82cd95f3 100644 --- a/testsuite/tests/typecheck/should_fail/T21327.stderr +++ b/testsuite/tests/typecheck/should_fail/T21327.stderr @@ -3,6 +3,6 @@ T21327.hs:7:11: error: [GHC-18872] • Couldn't match a lifted type with an unlifted type When matching types t0 :: * - Int# :: TYPE 'IntRep + Int# :: TYPE IntRep • In the expression: ?p :: Int# In an equation for ‘foo’: foo () = (?p :: Int#) diff --git a/testsuite/tests/typecheck/should_fail/T6018fail.stderr b/testsuite/tests/typecheck/should_fail/T6018fail.stderr index 4171226794..0c352199e1 100644 --- a/testsuite/tests/typecheck/should_fail/T6018fail.stderr +++ b/testsuite/tests/typecheck/should_fail/T6018fail.stderr @@ -24,14 +24,14 @@ T6018fail.hs:30:15: error: [GHC-05175] T6018fail.hs:38:15: error: [GHC-05175] Type family equation violates the family's injectivity annotation. RHS of injective type family equation is a bare type variable - but these LHS type and kind patterns are not bare variables: ‘'Z’ - P 'Z m = m -- Defined at T6018fail.hs:38:15 + but these LHS type and kind patterns are not bare variables: ‘Z’ + P Z m = m -- Defined at T6018fail.hs:38:15 T6018fail.hs:39:15: error: [GHC-05175] Type family equation right-hand sides overlap; this violates the family's injectivity annotation: - P ('S n) m = 'S (P n m) -- Defined at T6018fail.hs:39:15 - P 'Z m = m -- Defined at T6018fail.hs:38:15 + P (S n) m = S (P n m) -- Defined at T6018fail.hs:39:15 + P Z m = m -- Defined at T6018fail.hs:38:15 T6018fail.hs:44:15: error: [GHC-05175] Type family equation violates the family's injectivity annotation. @@ -43,7 +43,7 @@ T6018fail.hs:48:15: error: [GHC-05175] Type family equation violates the family's injectivity annotation. Type variable ‘n’ cannot be inferred from the right-hand side. In the type family equation: - K ('S n) m = 'S m -- Defined at T6018fail.hs:48:15 + K (S n) m = S m -- Defined at T6018fail.hs:48:15 T6018fail.hs:53:15: error: [GHC-05175] Type family equation violates the family's injectivity annotation. diff --git a/testsuite/tests/typecheck/should_fail/T6018failclosed.stderr b/testsuite/tests/typecheck/should_fail/T6018failclosed.stderr index b7f9b3fd63..9ebad2c55f 100644 --- a/testsuite/tests/typecheck/should_fail/T6018failclosed.stderr +++ b/testsuite/tests/typecheck/should_fail/T6018failclosed.stderr @@ -9,8 +9,8 @@ T6018failclosed.hs:11:5: error: [GHC-05175] T6018failclosed.hs:19:5: error: [GHC-05175] • Type family equation right-hand sides overlap; this violates the family's injectivity annotation: - PClosed 'Z m = m -- Defined at T6018failclosed.hs:19:5 - PClosed ('S n) m = 'S (PClosed n m) + PClosed Z m = m -- Defined at T6018failclosed.hs:19:5 + PClosed (S n) m = S (PClosed n m) -- Defined at T6018failclosed.hs:20:5 • In the equations for closed type family ‘PClosed’ In the type family declaration for ‘PClosed’ @@ -18,8 +18,8 @@ T6018failclosed.hs:19:5: error: [GHC-05175] T6018failclosed.hs:19:5: error: [GHC-05175] • Type family equation violates the family's injectivity annotation. RHS of injective type family equation is a bare type variable - but these LHS type and kind patterns are not bare variables: ‘'Z’ - PClosed 'Z m = m -- Defined at T6018failclosed.hs:19:5 + but these LHS type and kind patterns are not bare variables: ‘Z’ + PClosed Z m = m -- Defined at T6018failclosed.hs:19:5 • In the equations for closed type family ‘PClosed’ In the type family declaration for ‘PClosed’ @@ -38,7 +38,7 @@ T6018failclosed.hs:30:5: error: [GHC-05175] • Type family equation violates the family's injectivity annotation. Type variable ‘n’ cannot be inferred from the right-hand side. In the type family equation: - KClosed ('S n) m = 'S m -- Defined at T6018failclosed.hs:30:5 + KClosed (S n) m = S m -- Defined at T6018failclosed.hs:30:5 • In the equations for closed type family ‘KClosed’ In the type family declaration for ‘KClosed’ @@ -69,8 +69,8 @@ T6018failclosed.hs:43:5: error: [GHC-05175] T6018failclosed.hs:49:3: error: [GHC-05175] • Type family equation right-hand sides overlap; this violates the family's injectivity annotation: - E2 'True = 'False -- Defined at T6018failclosed.hs:49:3 - E2 a = 'False -- Defined at T6018failclosed.hs:50:3 + E2 True = False -- Defined at T6018failclosed.hs:49:3 + E2 a = False -- Defined at T6018failclosed.hs:50:3 • In the equations for closed type family ‘E2’ In the type family declaration for ‘E2’ @@ -78,7 +78,7 @@ T6018failclosed.hs:50:3: error: [GHC-05175] • Type family equation violates the family's injectivity annotation. Type variable ‘a’ cannot be inferred from the right-hand side. In the type family equation: - E2 a = 'False -- Defined at T6018failclosed.hs:50:3 + E2 a = False -- Defined at T6018failclosed.hs:50:3 • In the equations for closed type family ‘E2’ In the type family declaration for ‘E2’ diff --git a/testsuite/tests/typecheck/should_fail/T8262.stderr b/testsuite/tests/typecheck/should_fail/T8262.stderr index c9baa5315a..c6798595ea 100644 --- a/testsuite/tests/typecheck/should_fail/T8262.stderr +++ b/testsuite/tests/typecheck/should_fail/T8262.stderr @@ -3,7 +3,7 @@ T8262.hs:5:15: error: [GHC-18872] • Couldn't match a lifted type with an unlifted type When matching types a :: * - GHC.Prim.Int# :: TYPE 'GHC.Types.IntRep + GHC.Prim.Int# :: TYPE GHC.Types.IntRep • In the first argument of ‘Just’, namely ‘(1#)’ In the expression: Just (1#) In an equation for ‘foo’: foo x = Just (1#) diff --git a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInfinite.stderr b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInfinite.stderr index e1b4b5e461..6f932839bd 100644 --- a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInfinite.stderr +++ b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInfinite.stderr @@ -1,10 +1,10 @@ UnliftedNewtypesInfinite.hs:9:20: error: [GHC-27958] • Couldn't match kind ‘t0’ - with ‘'GHC.Types.TupleRep '[ 'GHC.Types.IntRep, t0]’ + with ‘GHC.Types.TupleRep [GHC.Types.IntRep, t0]’ Expected kind ‘TYPE t0’, but ‘(# Int#, Foo #)’ has kind ‘TYPE - ('GHC.Types.TupleRep '[ 'GHC.Types.IntRep, t0])’ + (GHC.Types.TupleRep [GHC.Types.IntRep, t0])’ • In the type ‘(# Int#, Foo #)’ In the definition of data constructor ‘FooC’ In the newtype declaration for ‘Foo’ diff --git a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesNotEnabled.stderr b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesNotEnabled.stderr index a4bd2f9980..27652f03fa 100644 --- a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesNotEnabled.stderr +++ b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesNotEnabled.stderr @@ -1,5 +1,5 @@ UnliftedNewtypesNotEnabled.hs:9:1: error: [GHC-55233] - • Newtype has non-* return kind ‘TYPE 'GHC.Types.IntRep’ + • Newtype has non-* return kind ‘TYPE GHC.Types.IntRep’ • In the newtype declaration for ‘Baz’ Suggested fix: Perhaps you intended to use UnliftedNewtypes diff --git a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.stderr b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.stderr index 546b8537a0..bbcfd0f303 100644 --- a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.stderr +++ b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesUnassociatedFamilyFail.stderr @@ -1,7 +1,7 @@ UnliftedNewtypesUnassociatedFamilyFail.hs:21:30: error: [GHC-25897] - • Couldn't match kind ‘t’ with ‘'IntRep’ - Expected a type, but ‘Int#’ has kind ‘TYPE 'IntRep’ + • Couldn't match kind ‘t’ with ‘IntRep’ + Expected a type, but ‘Int#’ has kind ‘TYPE IntRep’ ‘t’ is a rigid type variable bound by a family instance declaration at UnliftedNewtypesUnassociatedFamilyFail.hs:21:1-33 @@ -10,8 +10,8 @@ UnliftedNewtypesUnassociatedFamilyFail.hs:21:30: error: [GHC-25897] In the newtype instance declaration for ‘DF’ UnliftedNewtypesUnassociatedFamilyFail.hs:22:30: error: [GHC-25897] - • Couldn't match kind ‘t’ with ‘'WordRep’ - Expected a type, but ‘Word#’ has kind ‘TYPE 'WordRep’ + • Couldn't match kind ‘t’ with ‘WordRep’ + Expected a type, but ‘Word#’ has kind ‘TYPE WordRep’ ‘t’ is a rigid type variable bound by a family instance declaration at UnliftedNewtypesUnassociatedFamilyFail.hs:22:1-34 @@ -20,10 +20,10 @@ UnliftedNewtypesUnassociatedFamilyFail.hs:22:30: error: [GHC-25897] In the newtype instance declaration for ‘DF’ UnliftedNewtypesUnassociatedFamilyFail.hs:23:30: error: [GHC-25897] - • Couldn't match kind ‘t’ with ‘'TupleRep '[ 'IntRep, 'WordRep]’ + • Couldn't match kind ‘t’ with ‘TupleRep [IntRep, WordRep]’ Expected a type, but ‘(# Int#, Word# #)’ has kind ‘TYPE - ('TupleRep '[ 'IntRep, 'WordRep])’ + (TupleRep [IntRep, WordRep])’ ‘t’ is a rigid type variable bound by a family instance declaration at UnliftedNewtypesUnassociatedFamilyFail.hs:23:1-46 diff --git a/testsuite/tests/typecheck/should_fail/tcfail079.stderr b/testsuite/tests/typecheck/should_fail/tcfail079.stderr index a5c82e99f9..b9e7a8390f 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail079.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail079.stderr @@ -1,5 +1,5 @@ tcfail079.hs:9:1: error: [GHC-55233] - • Newtype has non-* return kind ‘TYPE 'GHC.Types.IntRep’ + • Newtype has non-* return kind ‘TYPE GHC.Types.IntRep’ • In the newtype declaration for ‘Unboxed’ Suggested fix: Perhaps you intended to use UnliftedNewtypes diff --git a/testsuite/tests/typecheck/should_fail/tcfail123.stderr b/testsuite/tests/typecheck/should_fail/tcfail123.stderr index 19c611b55a..97e99a2ab4 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail123.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail123.stderr @@ -3,7 +3,7 @@ tcfail123.hs:11:9: error: [GHC-18872] • Couldn't match a lifted type with an unlifted type When matching types p0 :: * - GHC.Prim.Int# :: TYPE 'GHC.Types.IntRep + GHC.Prim.Int# :: TYPE GHC.Types.IntRep • In the first argument of ‘f’, namely ‘3#’ In the expression: f 3# In an equation for ‘h’: h v = f 3# diff --git a/testsuite/tests/typecheck/should_fail/tcfail159.stderr b/testsuite/tests/typecheck/should_fail/tcfail159.stderr index c6b64cde1e..bb4f0b7dd2 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail159.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail159.stderr @@ -3,7 +3,7 @@ tcfail159.hs:9:11: error: [GHC-83865] • Couldn't match a lifted type with an unlifted type Expected: * Actual: TYPE - ('GHC.Types.TupleRep '[GHC.Types.LiftedRep, GHC.Types.LiftedRep]) + (GHC.Types.TupleRep [GHC.Types.LiftedRep, GHC.Types.LiftedRep]) • In the pattern: ~(# p, q #) In a case alternative: ~(# p, q #) -> p In the expression: case h x of ~(# p, q #) -> p diff --git a/testsuite/tests/typecheck/should_fail/tcfail200.stderr b/testsuite/tests/typecheck/should_fail/tcfail200.stderr index fb92433276..c0e86d2078 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail200.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail200.stderr @@ -3,7 +3,7 @@ tcfail200.hs:5:15: error: [GHC-18872] • Couldn't match a lifted type with an unlifted type When matching types a1 :: * - GHC.Prim.Int# :: TYPE 'GHC.Types.IntRep + GHC.Prim.Int# :: TYPE GHC.Types.IntRep • In the expression: 1# In the expression: (1#, 'c') In an equation for ‘x’: x = (1#, 'c') diff --git a/testsuite/tests/unboxedsums/T12711.stdout b/testsuite/tests/unboxedsums/T12711.stdout index 2db54da01b..605a71eb85 100644 --- a/testsuite/tests/unboxedsums/T12711.stdout +++ b/testsuite/tests/unboxedsums/T12711.stdout @@ -1,2 +1,2 @@ (# _ | _ #) :: TYPE - ('GHC.Types.SumRep '[GHC.Types.LiftedRep, GHC.Types.LiftedRep]) + (GHC.Types.SumRep [GHC.Types.LiftedRep, GHC.Types.LiftedRep]) diff --git a/testsuite/tests/unboxedsums/T20858.stdout b/testsuite/tests/unboxedsums/T20858.stdout index 2c50fc3e80..6f87ee7602 100644 --- a/testsuite/tests/unboxedsums/T20858.stdout +++ b/testsuite/tests/unboxedsums/T20858.stdout @@ -1,18 +1,18 @@ -S1 :: TYPE 'GHC.Types.WordRep +S1 :: TYPE GHC.Types.WordRep -> TYPE - ('GHC.Types.SumRep - '[ 'GHC.Types.IntRep, 'GHC.Types.DoubleRep, 'GHC.Types.WordRep]) + (GHC.Types.SumRep + [GHC.Types.IntRep, GHC.Types.DoubleRep, GHC.Types.WordRep]) = (# | | #) Int# Double# -S2 :: TYPE 'GHC.Types.DoubleRep - -> TYPE 'GHC.Types.WordRep +S2 :: TYPE GHC.Types.DoubleRep + -> TYPE GHC.Types.WordRep -> TYPE - ('GHC.Types.SumRep - '[ 'GHC.Types.IntRep, 'GHC.Types.DoubleRep, 'GHC.Types.WordRep]) + (GHC.Types.SumRep + [GHC.Types.IntRep, GHC.Types.DoubleRep, GHC.Types.WordRep]) = (# | | #) Int# -S3 :: TYPE 'GHC.Types.IntRep - -> TYPE 'GHC.Types.DoubleRep - -> TYPE 'GHC.Types.WordRep +S3 :: TYPE GHC.Types.IntRep + -> TYPE GHC.Types.DoubleRep + -> TYPE GHC.Types.WordRep -> TYPE - ('GHC.Types.SumRep - '[ 'GHC.Types.IntRep, 'GHC.Types.DoubleRep, 'GHC.Types.WordRep]) + (GHC.Types.SumRep + [GHC.Types.IntRep, GHC.Types.DoubleRep, GHC.Types.WordRep]) = (# | | #) diff --git a/testsuite/tests/unboxedsums/T20858b.stdout b/testsuite/tests/unboxedsums/T20858b.stdout index e9818ad468..ed0af7a804 100644 --- a/testsuite/tests/unboxedsums/T20858b.stdout +++ b/testsuite/tests/unboxedsums/T20858b.stdout @@ -1,52 +1,52 @@ -S1 :: TYPE 'GHC.Types.WordRep +S1 :: TYPE GHC.Types.WordRep -> TYPE - ('GHC.Types.SumRep - ((':) + (GHC.Types.SumRep + ((:) @GHC.Types.RuntimeRep - 'GHC.Types.IntRep - ((':) + GHC.Types.IntRep + ((:) @GHC.Types.RuntimeRep - 'GHC.Types.DoubleRep - ((':) + GHC.Types.DoubleRep + ((:) @GHC.Types.RuntimeRep - 'GHC.Types.WordRep + GHC.Types.WordRep ('[] @GHC.Types.RuntimeRep))))) = (# | | #) - @'GHC.Types.IntRep - @'GHC.Types.DoubleRep - @'GHC.Types.WordRep + @GHC.Types.IntRep + @GHC.Types.DoubleRep + @GHC.Types.WordRep Int# Double# -S2 :: TYPE 'GHC.Types.DoubleRep - -> TYPE 'GHC.Types.WordRep +S2 :: TYPE GHC.Types.DoubleRep + -> TYPE GHC.Types.WordRep -> TYPE - ('GHC.Types.SumRep - ((':) + (GHC.Types.SumRep + ((:) @GHC.Types.RuntimeRep - 'GHC.Types.IntRep - ((':) + GHC.Types.IntRep + ((:) @GHC.Types.RuntimeRep - 'GHC.Types.DoubleRep - ((':) + GHC.Types.DoubleRep + ((:) @GHC.Types.RuntimeRep - 'GHC.Types.WordRep + GHC.Types.WordRep ('[] @GHC.Types.RuntimeRep))))) = (# | | #) - @'GHC.Types.IntRep @'GHC.Types.DoubleRep @'GHC.Types.WordRep Int# -S3 :: TYPE 'GHC.Types.IntRep - -> TYPE 'GHC.Types.DoubleRep - -> TYPE 'GHC.Types.WordRep + @GHC.Types.IntRep @GHC.Types.DoubleRep @GHC.Types.WordRep Int# +S3 :: TYPE GHC.Types.IntRep + -> TYPE GHC.Types.DoubleRep + -> TYPE GHC.Types.WordRep -> TYPE - ('GHC.Types.SumRep - ((':) + (GHC.Types.SumRep + ((:) @GHC.Types.RuntimeRep - 'GHC.Types.IntRep - ((':) + GHC.Types.IntRep + ((:) @GHC.Types.RuntimeRep - 'GHC.Types.DoubleRep - ((':) + GHC.Types.DoubleRep + ((:) @GHC.Types.RuntimeRep - 'GHC.Types.WordRep + GHC.Types.WordRep ('[] @GHC.Types.RuntimeRep))))) = (# | | #) - @'GHC.Types.IntRep @'GHC.Types.DoubleRep @'GHC.Types.WordRep + @GHC.Types.IntRep @GHC.Types.DoubleRep @GHC.Types.WordRep diff --git a/testsuite/tests/unlifted-datatypes/should_fail/UnlDataInvalidResKind1.stderr b/testsuite/tests/unlifted-datatypes/should_fail/UnlDataInvalidResKind1.stderr index cf1f93a795..3478d59ad7 100644 --- a/testsuite/tests/unlifted-datatypes/should_fail/UnlDataInvalidResKind1.stderr +++ b/testsuite/tests/unlifted-datatypes/should_fail/UnlDataInvalidResKind1.stderr @@ -1,4 +1,4 @@ UnlDataInvalidResKind1.hs:9:1: error: [GHC-55233] - • Data type has non-'BoxedRep return kind ‘TYPE 'IntRep’ + • Data type has non-BoxedRep return kind ‘TYPE IntRep’ • In the data declaration for ‘T’ diff --git a/testsuite/tests/unlifted-datatypes/should_fail/UnlDataNullaryPoly.stderr b/testsuite/tests/unlifted-datatypes/should_fail/UnlDataNullaryPoly.stderr index 98c2dbe0ea..e64f0bfad7 100644 --- a/testsuite/tests/unlifted-datatypes/should_fail/UnlDataNullaryPoly.stderr +++ b/testsuite/tests/unlifted-datatypes/should_fail/UnlDataNullaryPoly.stderr @@ -2,6 +2,6 @@ UnlDataNullaryPoly.hs:10:10: error: [GHC-31147] • Quantified type's kind mentions quantified type variable type: ‘forall (l :: Levity). T’ - where the body of the forall has this kind: ‘TYPE ('BoxedRep l)’ + where the body of the forall has this kind: ‘TYPE (BoxedRep l)’ • In the definition of data constructor ‘MkT’ In the data type declaration for ‘T’ |