GitLab

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

 +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

No preview for this file type

testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs

No preview for this file type

testsuite/tests/interface-stability/base-exports.stdout-mingw32

No preview for this file type

testsuite/tests/typecheck/should_compile/WarnDefaultedCallStack.hs

 +{-# 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

 +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, [''])