Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 815149f3 by Andrzej Rybczak at 2026-07-25T15:06:43+00:00 Add -Wdefaulted-callstack Adds a new warning, -Wdefaulted-callstack, which warns when an implicit CallStack parameter is defaulted to the empty stack. In particular, this includes call sites where a function with a HasCallStack constraint is called from a definition that does *not* provide one. At such call sites the call stack is cut off and does not include the enclosing definition's callers, which can be a source of surprise if the user wants complete call stacks. Closes #27077. - - - - - 21 changed files: - + changelog.d/warn-defaulted-callstack - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/using-warnings.rst - libraries/base/changelog.md - libraries/base/src/GHC/Stack.hs - libraries/ghc-internal/src/GHC/Internal/Stack.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - + testsuite/tests/typecheck/should_compile/WarnDefaultedCallStack.hs - + testsuite/tests/typecheck/should_compile/WarnDefaultedCallStack.stderr - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== changelog.d/warn-defaulted-callstack ===================================== @@ -0,0 +1,12 @@ +section: compiler +issues: #27077 +mrs: !16174 +synopsis: Add ``-Wdefaulted-callstack`` +description: + GHC now supports a new warning, ``-Wdefaulted-callstack``, which warns when an + implicit ``CallStack`` parameter is defaulted to the empty stack. In + particular, this includes call sites where a function with a ``HasCallStack`` + constraint is called from a definition that does *not* provide one. At such + call sites the call stack is cut off and does not include the enclosing + definition's callers, which can be a source of surprise if the user wants + complete call stacks. ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -1135,6 +1135,7 @@ data WarningFlag = | Opt_WarnPatternNamespaceSpecifier -- ^ @since 9.14 | Opt_WarnUnrecognisedModifiers -- ^ @since 10.0 | Opt_WarnSemaphoreOpenFailure -- Since 10.0.1 + | Opt_WarnDefaultedCallStack -- ^ @since 10.2 deriving (Eq, Ord, Show, Enum, Bounded) -- | Return the names of a WarningFlag @@ -1258,6 +1259,7 @@ warnFlagNames wflag = case wflag of Opt_WarnPatternNamespaceSpecifier -> "pattern-namespace-specifier" :| [] Opt_WarnUnrecognisedModifiers -> "unrecognised-modifiers" :| [] Opt_WarnSemaphoreOpenFailure -> "semaphore-open-failure" :| [] + Opt_WarnDefaultedCallStack -> "defaulted-callstack" :| [] -- ----------------------------------------------------------------------------- -- Standard sets of warning options ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2446,6 +2446,7 @@ wWarningFlagsDeps = [minBound..maxBound] >>= \x -> case x of Opt_WarnPatternNamespaceSpecifier -> warnSpec x Opt_WarnUnrecognisedModifiers -> warnSpec x Opt_WarnSemaphoreOpenFailure -> warnSpec x + Opt_WarnDefaultedCallStack -> warnSpec x warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)] warningGroupsDeps = map mk warningGroups ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1941,6 +1941,19 @@ instance Diagnostic TcRnMessage where = vcat [ text "Future versions of GHC will turn this warning into an error." ] proposal = vcat [ text "See GHC Proposal #330." ] + TcRnDefaultedCallStack ct_loc + -> mkSimpleDecorated $ case ctLocOrigin ct_loc of + -- Suggestion makes sense only for this particular case. + PushedCallStackOrigin{} -> vcat [ header, suggestion ] + _ -> header + where + header, suggestion :: SDoc + header + = vcat [ text "Defaulting to the empty call stack" + , nest 2 $ pprCtOrigin (ctLocOrigin ct_loc) <> text "." ] + suggestion + = text "Add a" <+> quotes (text "HasCallStack") <+> + text "constraint to the enclosing definition to extend the call stack." TcRnImplicitImportOfPrelude -> mkSimpleDecorated $ text "Module" <+> quotes (text "Prelude") <+> text "implicitly imported." @@ -2671,6 +2684,8 @@ instance Diagnostic TcRnMessage where -> WarningWithFlag Opt_WarnNonCanonicalMonadInstances TcRnDefaultedExceptionContext{} -> WarningWithFlag Opt_WarnDefaultedExceptionContext + TcRnDefaultedCallStack{} + -> WarningWithFlag Opt_WarnDefaultedCallStack TcRnImplicitImportOfPrelude {} -> WarningWithFlag Opt_WarnImplicitPrelude TcRnMissingMain {} @@ -3404,6 +3419,8 @@ instance Diagnostic TcRnMessage where -> suggestNonCanonicalDefinition reason TcRnDefaultedExceptionContext _ -> noHints + TcRnDefaultedCallStack{} + -> noHints TcRnImplicitImportOfPrelude {} -> noHints TcRnMissingMain {} ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -4426,6 +4426,17 @@ data TcRnMessage where -} TcRnDefaultedExceptionContext :: CtLoc -> TcRnMessage + {-| TcRnDefaultedCallStack is a warning that is triggered when an implicit + @CallStack@ constraint is defaulted to the empty call stack because there + is no enclosing @HasCallStack@ constraint to solve it from. The 'CtLoc' is + the location and origin of the defaulted constraint. + + See Note [Warn about defaulted CallStacks] in GHC.Tc.Solver.Dict. + + Test cases: WarnDefaultedCallStack + -} + TcRnDefaultedCallStack :: CtLoc -> TcRnMessage + {-| TcRnOutOfArityTyVar is an error raised when the arity of a type synonym (as determined by the SAKS and the LHS) is insufficiently high to accommodate an implicit binding for a free variable that occurs in the ===================================== compiler/GHC/Tc/Solver/Default.hs ===================================== @@ -461,7 +461,12 @@ defaultCallStack :: CtDefaultingStrategy defaultCallStack ct | ClassPred cls tys <- classifyPredType (ctPred ct) , isJust (isCallStackPred cls tys) - = do { solveCallStack (ctEvidence ct) EvCsEmpty + = do { dflags <- getDynFlags + -- See Note [Warn about defaulted CallStacks] in GHC.Tc.Solver.Dict. + ; when (wopt Opt_WarnDefaultedCallStack dflags) $ + do { let loc = ctLoc ct + ; ctLocWarnTcS loc (TcRnDefaultedCallStack loc) } + ; solveCallStack (ctEvidence ct) EvCsEmpty ; return emptyWC } | otherwise = noDefaulting ct ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -25,8 +25,6 @@ import GHC.Tc.Solver.Types import GHC.Tc.Utils.TcType import GHC.Tc.Utils.Unify( uType, mightEqualLater ) -import GHC.Hs.Type( HsIPName(..) ) - import GHC.Core import GHC.Core.Make import GHC.Core.Type @@ -55,7 +53,6 @@ import GHC.Utils.Misc import GHC.Unit.Module import GHC.Data.Bag -import GHC.Data.FastString import GHC.Driver.DynFlags @@ -121,8 +118,8 @@ canDictCt ev cls tys -- so set the fuel to doNotExpand to avoid repeating expansion | CtWanted (WantedCt { ctev_rewriters = rws }) <- ev - , Just ip_name <- isCallStackPred cls tys - , Just fun_fs <- isPushCallStackOrigin_maybe orig + , isJust (isCallStackPred cls tys) + , Just fun_fs <- isPushCallStackOrigin_maybe orig -- If we're given a CallStack constraint that arose from a function -- call, we need to push the current call-site onto the stack instead -- of solving it directly from a given. @@ -132,11 +129,13 @@ canDictCt ev cls tys do { -- First we emit a new constraint that will capture the -- given CallStack. - let new_loc = setCtLocOrigin loc (IPOccOrigin (HsIPName $ fastStringToShortText ip_name)) - -- We change the origin to IPOccOrigin so - -- this rule does not fire again. + let new_loc = setCtLocOrigin loc (PushedCallStackOrigin fun_fs) + -- PushedCallStackOrigin solves like IPOccOrigin, so + -- this rule does not fire again, but retains fun_fs + -- for -Wdefaulted-callstack. -- See Note [Overview of implicit CallStacks] -- in GHC.Tc.Types.Evidence + -- and Note [Warn about defaulted CallStacks] ; new_ev <- CtWanted <$> newWantedEvVarNC new_loc rws pred @@ -214,6 +213,80 @@ evCallStack pred (EvCsPushCall fs loc tm) ; return (mkCoreApps (Var push_cs_id) [mkCoreTup [name_expr, loc_expr], outer_stk]) } +{- Note [Warn about defaulted CallStacks] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A call stack only records the chain of calls as long as every function in the +chain carries a HasCallStack constraint. When a function with a HasCallStack +constraint is called from a definition that does /not/ have one, the implicit +CallStack parameter emitted for the call cannot be solved from any enclosing +Given and is defaulted to the empty call stack (see Note [Overview of implicit +CallStacks] in GHC.Tc.Types.Evidence, point 4): the stack stops at this call +site, omitting the caller and everything above it. + +This can be just what you want; e.g. perhaps you selectively add some +HasCallStack constraints to help you isolate the caller of a failing call to +`head`. But it can also be a source of surprise if you want complete call +stacks. Hence, `-Wdefaulted-callstack` reports every such defaulting point +(including a bare use of an implicit parameter of type CallStack that defaults). + +Examples: + + bad :: Int + bad = error "boom" -- -Wdefaulted-callstack fires: `bad` has no + -- HasCallStack constraint, so the call stack for the + -- call to `error` is defaulted to the empty stack + + good :: HasCallStack => Int + good = error "boom" + x -- no warning: the call extends `good`'s call stack + where + x = error "splat" -- no warning either, even though `x` has no + -- HasCallStack constraint of its own: `good`'s + -- HasCallStack brings a `?callStack` Given into scope + -- over the whole of `good`, including its where/let + -- bindings, so this call is solved from that Given + -- (it floats up to it) and extends `good`'s stack + + stk :: CallStack + stk = ?stk -- -Wdefaulted-callstack fires: implicit parameters + -- of type CallStack default too + +We emit the warning from `defaultCallStack` (in GHC.Tc.Solver.Default), the one +and only place a CallStack is solved with the empty stack `EvCsEmpty`. +Defaulting runs once, at the top level (`simplifyTopWanteds`), after every +constraint has had the chance to float up and be solved against all enclosing +Givens, so a constraint that reaches it really is defaulted. + +The message renders the defaulted constraint's `CtOrigin` (just like +`-Wdefaulted-exception-context`): for a function call (plan PUSH, see Note +[Overview of implicit CallStacks] in GHC.Tc.Types.Evidence, point 2) that origin +is `PushedCallStackOrigin fun_fs`, naming the called function; for a bare use of +an implicit parameter of type `CallStack` it is `IPOccOrigin`. Either way the +`CtLoc` points at the use site. + +In cases when a HasCallStack constraint cannot be supplied using a type +signature (e.g. the body of `main` or a method in an instance of a class whose +type signature lacks a HasCallStack constraint) the user can silence the warning +by bringing an empty stack into scope explicitly with +`GHC.Stack.withEmptyCallStack`: + +main :: IO () +main = withEmptyCallStack $ do + ... + error "oops" -- no warning here + ... + +Caveat (under-reporting within a single definition): identical Wanted CallStack +constraints are CSE'd by the constraint solver, so several defaulting call sites +within the /same/ definition collapse to a single warning: + + twoErrors :: Int + twoErrors = error "a" + error "b" -- one -Wdefaulted-callstack warning + +We do, however, report defaulting in /every/ top-level definition (see Note +[When to build an implication] in GHC.Tc.Utils.Unify). This is what counts, +because it allows the user to take action on all affected bindings at once. +-} + {- Note [Solving CallStack constraints] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ See Note [Overview of implicit CallStacks] in GHc.Tc.Types.Evidence. @@ -231,7 +304,7 @@ Suppose f :: HasCallStack => blah. Then pushing the call-site info on the stack, and changing the CtOrigin to record that has been done. Bind: s1 = pushCallStack <site-info> s2 - [W] s2 :: IP "callStack" CallStack -- CtOrigin = IPOccOrigin + [W] s2 :: IP "callStack" CallStack -- CtOrigin = PushedCallStackOrigin f * Then, and only then, we can solve the constraint from an enclosing Given. ===================================== compiler/GHC/Tc/Types/Evidence.hs ===================================== @@ -1137,7 +1137,7 @@ implicit parameter is not important, see (CS5) below) are solved as follows: We do /not/ solve this constraint from Givens, or from other Wanteds. Rather, have a built-in mechanism in that solves it thus: d := EvCsPushCall "foo" <details of call-site of `foo`> d2 - [W] d2 :: (?stk :: CallStack) CtOrigin = IPOccOrigin + [W] d2 :: (?stk :: CallStack) CtOrigin = PushedCallStackOrigin "foo" That is, `d` is a call-stack that has the `foo` call-site pushed on top of `d2`, which can now be solved normally (as in (1) above). This is done as follows: @@ -1148,6 +1148,9 @@ implicit parameter is not important, see (CS5) below) are solved as follows: * solve it normally (plan NORMAL above) - IPOccOrigin (discussed above) + - PushedCallStackOrigin (the new Wanted emitted by plan PUSH; behaves + like IPOccOrigin but retains the function name for + -Wdefaulted-callstack, see Note [Warn about defaulted CallStacks]) - GivenOrigin (see (CS1) below) * push an item on the stack and emit a new constraint (plan PUSH above) @@ -1189,6 +1192,10 @@ the resulting CallStack will include the call to `undefined` in `head` and the call to `error` in `undefined`, but *not* the call to `head` in `g`, because `head` did not explicitly request a CallStack. +The `-Wdefaulted-callstack` warning flags exactly these points where the stack +is defaulted to empty (here, the call to `undefined` in `head`). See +Note [Warn about defaulted CallStacks] in GHC.Tc.Solver.Dict. + Wrinkles @@ -1240,11 +1247,14 @@ Wrinkles call-site onto a given stack (See GHC.HsToCore.Binds.dsEvCallStack) (CS7) When we emit a new wanted CallStack in plan PUSH we set its origin to - `IPOccOrigin ip_name` instead of the original `OccurrenceOf func` - (see GHC.Tc.Solver.Dict.tryInertDicts). - - This is a bit shady, but is how we ensure that the new wanted is - solved like a regular IP. + `PushedCallStackOrigin func` instead of the original `OccurrenceOf func` + (see GHC.Tc.Solver.Dict.canDictCt). + + This is a bit shady, but is how we ensure that the new wanted is solved like + a regular IP (isPushCallStackOrigin_maybe returns Nothing for it, as for + IPOccOrigin). Unlike IPOccOrigin it retains the called function's name, which + -Wdefaulted-callstack uses if the stack is ultimately defaulted to empty. + See Note [Warn about defaulted CallStacks] in GHC.Tc.Solver.Dict. -} mkEvScSelectors -- Assume class (..., D ty, ...) => C a b ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -412,6 +412,13 @@ data CtOrigin CtOrigin -- CtOrigin of the original type equality | IPOccOrigin HsIPName -- Occurrence of an implicit parameter + | PushedCallStackOrigin FastString + -- ^ The Wanted CallStack emitted by plan PUSH (see Note [Overview of + -- implicit CallStacks] in GHC.Tc.Types.Evidence) when a call site for the + -- named function is pushed onto the call stack. Solved like + -- 'IPOccOrigin', but retains the function name so that + -- @-Wdefaulted-callstack@ can report which call had its stack defaulted. + -- See Note [Warn about defaulted CallStacks] in GHC.Tc.Solver.Dict. | OverLabelOrigin FastString -- Occurrence of an overloaded label | LiteralOrigin (HsOverLit GhcRn) -- Occurrence of a literal @@ -786,6 +793,7 @@ ppr_br (OccurrenceOf name) = hsep [text "a use of", quotes (ppr name)] ppr_br (OccurrenceOfRecSel name) = hsep [text "a use of", quotes (ppr name)] ppr_br AppOrigin = text "an application" ppr_br (IPOccOrigin name) = hsep [text "a use of implicit parameter", quotes (ppr name)] +ppr_br (PushedCallStackOrigin fs) = hsep [text "a use of", quotes (ftext fs)] ppr_br (OverLabelOrigin l) = hsep [text "the overloaded label" ,quotes (char '#' <> ppr l)] ppr_br (RecordUpdOrigin {}) = text "a record update" @@ -897,6 +905,7 @@ foldMapCtOrigin f = go SpecPragOrigin {} -> f orig TypeEqOrigin {}-> f orig IPOccOrigin {} -> f orig + PushedCallStackOrigin {} -> f orig OverLabelOrigin {} -> f orig LiteralOrigin {} -> f orig QualLiteralOrigin {} -> f orig @@ -978,6 +987,7 @@ isPushCallStackOrigin_maybe :: CtOrigin -> Maybe FastString isPushCallStackOrigin_maybe (GivenOrigin {}) = Nothing isPushCallStackOrigin_maybe (GivenSCOrigin {}) = Nothing isPushCallStackOrigin_maybe (IPOccOrigin {}) = Nothing +isPushCallStackOrigin_maybe (PushedCallStackOrigin {}) = Nothing isPushCallStackOrigin_maybe (OccurrenceOf fun) = Just (occNameFS (getOccName fun)) isPushCallStackOrigin_maybe orig = Just orig_fs -- This fall-through case is important to deal with call stacks ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -587,7 +587,8 @@ implicationNeeded skol_info skol_tvs given -- we must build an implication ; return (gopt Opt_DeferTypeErrors dflags || gopt Opt_DeferTypedHoles dflags || - gopt Opt_DeferOutOfScopeVariables dflags) } } + gopt Opt_DeferOutOfScopeVariables dflags || + wopt Opt_WarnDefaultedCallStack dflags ) } } | otherwise -- Non-empty skolems or givens = return True -- Definitely need an implication @@ -676,6 +677,14 @@ take care: literally nothing to do with each other. #14185 is an example. Building an implication keeps them separate. +* If -Wdefaulted-callstack is on, we build an implication around each top-level + binding so that their implicit CallStack parameters are solved (and hence + defaulted) in isolation. Otherwise each top-level binding's wanteds float + into a single pool and end up CSE'd, so only one of them reaches + `defaultCallStack` where the warning is generated; the per-binding implication + lets us report every top-level definition that defaults its call stack. See + also Note [Warn about defaulted CallStacks] in GHC.Tc.Solver.Dict. + Note [Herald for matchExpectedFunTys] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The 'herald' always looks like: ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -676,6 +676,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "NonCanonicalMonoid" = 50928 GhcDiagnosticCode "NonCanonicalMonad" = 22705 GhcDiagnosticCode "TcRnDefaultedExceptionContext" = 46235 + GhcDiagnosticCode "TcRnDefaultedCallStack" = 39361 GhcDiagnosticCode "TcRnImplicitImportOfPrelude" = 20540 GhcDiagnosticCode "TcRnMissingMain" = 67120 GhcDiagnosticCode "TcRnGhciUnliftedBind" = 17999 ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -2619,7 +2619,7 @@ of ``-W(no-)*``. implicit parameter is defaulted to :base-ref:`Control.Exception.Context.emptyExceptionContext`. :type: dynamic - :reverse: -Wnop-defaulted-exception-context + :reverse: -Wno-defaulted-exception-context :since: 9.10.1 @@ -2631,6 +2631,42 @@ of ``-W(no-)*``. evidence is available. As this behavior may result in dropped exception context this warning is provided to give notice when defaulting occurs. +.. ghc-flag:: -Wdefaulted-callstack + :shortdesc: warn when an implicit :base-ref:`GHC.Stack.CallStack` parameter + is defaulted to the empty stack. + :type: dynamic + :reverse: -Wno-defaulted-callstack + + :since: 10.2.1 + + When a function with a :base-ref:`GHC.Stack.HasCallStack` constraint is + called from a definition that does *not* provide one, the implicit + :base-ref:`GHC.Stack.CallStack` parameter is defaulted to the empty stack, + so at such call sites the call stack is cut off and does not include the + enclosing definition's callers. + + This might be desirable; e.g. perhaps the user selectively added some + :base-ref:`GHC.Stack.HasCallStack` constraints to help isolate the caller of + a failing call to ``head``. But it can also be a source of surprise if the + user wants complete call stacks. Hence, ``-Wdefaulted-callstack`` (off by + default) reports every such defaulting point (including a bare use of an + implicit parameter of type :base-ref:`GHC.Stack.CallStack` that defaults). + + In cases when a :base-ref:`GHC.Stack.HasCallStack` constraint cannot be + supplied using a type signature (e.g. the body of ``main`` or a method in an + instance of a class whose type signature lacks a + :base-ref:`GHC.Stack.HasCallStack` constraint), the user can silence the + warning by bringing an empty stack into scope explicitly with + :base-ref:`GHC.Stack.withEmptyCallStack`: + + .. code-block:: haskell + + main :: IO () + main = withEmptyCallStack $ do + ... + error "oops" -- no warning here + ... + .. ghc-flag:: -Wview-pattern-signatures :shortdesc: warn when a view pattern is used with type signature without explicit parens ===================================== libraries/base/changelog.md ===================================== @@ -8,6 +8,7 @@ * Ensure that `Data.List.elem` and `notElem` can be specialized even when no list fusion happens. ([CLC proposal #412)(https://github.com/haskell/core-libraries-committee/issues/412)) * Introduce `Data.Double` and `Data.Float` modules. ([CLC proposal #378](https://github.com/haskell/core-libraries-committee/issues/378)) * Change `Generically a`'s `Monoid` definition to require a `Semigroup` constraint, and define its `mconcat` using `(<>)` from that constraint. ([CLC proposal #413](https://github.com/haskell/core-libraries-committee/issues/413)) + * Add `withEmptyCallStack` to `GHC.Stack`. ([CLC proposal #428](https://github.com/haskell/core-libraries-committee/issues/428)) ## 4.23.0.0 *TBA* * Add `System.IO.hGetNewlineMode`. ([CLC proposal #370](https://github.com/haskell/core-libraries-committee/issues/370)) ===================================== libraries/base/src/GHC/Stack.hs ===================================== @@ -31,6 +31,7 @@ module GHC.Stack prettyCallStack, pushCallStack, withFrozenCallStack, + withEmptyCallStack, -- * Source locations SrcLoc(..), prettySrcLoc, @@ -49,4 +50,4 @@ module GHC.Stack renderStack ) where -import GHC.Internal.Stack \ No newline at end of file +import GHC.Internal.Stack ===================================== libraries/ghc-internal/src/GHC/Internal/Stack.hs ===================================== @@ -29,7 +29,7 @@ module GHC.Internal.Stack ( -- * HasCallStack call stacks CallStack, HasCallStack, callStack, emptyCallStack, freezeCallStack, fromCallSiteList, getCallStack, popCallStack, - pushCallStack, withFrozenCallStack, + pushCallStack, withFrozenCallStack, withEmptyCallStack, prettyCallStackLines, prettyCallStack, -- * Source locations @@ -105,6 +105,23 @@ withFrozenCallStack do_this = let ?callStack = freezeCallStack (popCallStack callStack) in do_this +-- | Explicitly bring the empty call stack into scope. +-- +-- Mostly useful for silencing warnings generated by @-Wdefaulted-callstack@ in +-- places such as: +-- +-- - The body of a class method in an instance of an externally defined type +-- class whose type signature doesn't contain a 'HasCallStack' constraint. +-- +-- - The body of the @main@ function. +-- +-- @since 4.24.0.0 +withEmptyCallStack :: (HasCallStack => a) -> a +withEmptyCallStack do_this = + -- See Note [Warn about defaulted CallStacks] + let ?callStack = emptyCallStack + in do_this + -- prettySrcLoc and prettyCallStack are defined here to avoid hs-boot -- files. See Note [Definition of CallStack] ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -9047,6 +9047,7 @@ module GHC.Stack where pushCallStack :: ([GHC.Internal.Types.Char], SrcLoc) -> CallStack -> CallStack renderStack :: [GHC.Internal.Base.String] -> GHC.Internal.Base.String whoCreated :: forall a. a -> GHC.Internal.Types.IO [GHC.Internal.Base.String] + withEmptyCallStack :: forall a. (HasCallStack => a) -> a withFrozenCallStack :: forall a. HasCallStack => (HasCallStack => a) -> a module GHC.Stack.CCS where ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -9085,6 +9085,7 @@ module GHC.Stack where pushCallStack :: ([GHC.Internal.Types.Char], SrcLoc) -> CallStack -> CallStack renderStack :: [GHC.Internal.Base.String] -> GHC.Internal.Base.String whoCreated :: forall a. a -> GHC.Internal.Types.IO [GHC.Internal.Base.String] + withEmptyCallStack :: forall a. (HasCallStack => a) -> a withFrozenCallStack :: forall a. HasCallStack => (HasCallStack => a) -> a module GHC.Stack.CCS where ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -9265,6 +9265,7 @@ module GHC.Stack where pushCallStack :: ([GHC.Internal.Types.Char], SrcLoc) -> CallStack -> CallStack renderStack :: [GHC.Internal.Base.String] -> GHC.Internal.Base.String whoCreated :: forall a. a -> GHC.Internal.Types.IO [GHC.Internal.Base.String] + withEmptyCallStack :: forall a. (HasCallStack => a) -> a withFrozenCallStack :: forall a. HasCallStack => (HasCallStack => a) -> a module GHC.Stack.CCS where ===================================== testsuite/tests/typecheck/should_compile/WarnDefaultedCallStack.hs ===================================== @@ -0,0 +1,44 @@ +{-# LANGUAGE ImplicitParams #-} +module WarnDefaultedCallStack where + +import GHC.Stack + +intCs :: HasCallStack => Int +intCs = 0 + +topLevelNoWarning :: HasCallStack => Int +topLevelNoWarning = intCs + +outerNoWarning :: HasCallStack => IO () +outerNoWarning = innerNoWarning (1000::Int) + where + innerNoWarning = \case + 0 -> error "inner" -- gets CallStack from outerNoWarning + n -> innerNoWarning $ n - 1 + +topLevelExplicitEmptyCallStackNoWarning :: IO () +topLevelExplicitEmptyCallStackNoWarning = withEmptyCallStack $ do + print $ intCs + localWarns + where + -- No enclosing CallStack, intCs warns. + localWarns = intCs + localNoWarning + + -- Implicit parameters of type CallStack also default. + implicitWarns :: CallStack + implicitWarns = ?other + + localNoWarning :: HasCallStack => Int + localNoWarning = intCs + nestedNoWarning + where + nestedNoWarning = intCs -- gets CallStack from localNoWarn + +topLevelWarns :: IO () +topLevelWarns = print intCs + +separateTopLevelWarns :: Int +separateTopLevelWarns = topLevelNoWarning + +withinDefUnderReports :: Int +withinDefUnderReports = + -- Only one warning reported here, the other absent due to a CSE'd wanted. + intCs + intCs ===================================== testsuite/tests/typecheck/should_compile/WarnDefaultedCallStack.stderr ===================================== @@ -0,0 +1,23 @@ +WarnDefaultedCallStack.hs:24:18: warning: [GHC-39361] [-Wdefaulted-callstack] + Defaulting to the empty call stack + arising from a use of ‘intCs’. + Add a ‘HasCallStack’ constraint to the enclosing definition to extend the call stack. + +WarnDefaultedCallStack.hs:28:21: warning: [GHC-39361] [-Wdefaulted-callstack] + Defaulting to the empty call stack + arising from a use of implicit parameter ‘?other’. + +WarnDefaultedCallStack.hs:36:23: warning: [GHC-39361] [-Wdefaulted-callstack] + Defaulting to the empty call stack + arising from a use of ‘intCs’. + Add a ‘HasCallStack’ constraint to the enclosing definition to extend the call stack. + +WarnDefaultedCallStack.hs:39:25: warning: [GHC-39361] [-Wdefaulted-callstack] + Defaulting to the empty call stack + arising from a use of ‘topLevelNoWarning’. + Add a ‘HasCallStack’ constraint to the enclosing definition to extend the call stack. + +WarnDefaultedCallStack.hs:44:3: warning: [GHC-39361] [-Wdefaulted-callstack] + Defaulting to the empty call stack + arising from a use of ‘intCs’. + Add a ‘HasCallStack’ constraint to the enclosing definition to extend the call stack. ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -926,6 +926,7 @@ test('T21206', normal, compile, ['']) test('T17594a', req_th, compile, ['']) test('T17594f', normal, compile, ['']) test('WarnDefaultedExceptionContext', normal, compile, ['-Wdefaulted-exception-context']) +test('WarnDefaultedCallStack', normal, compile, ['-Wdefaulted-callstack']) test('T24470b', normal, compile, ['']) test('T24566', [], makefile_test, []) test('T23764', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/815149f39fd18a353528cff2c61b5d78... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/815149f39fd18a353528cff2c61b5d78... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help