[Git][ghc/ghc][wip/T25675] Deal correctly with Given CallStack constraints
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Tue Feb 11 16:22:25 UTC 2025
Simon Peyton Jones pushed to branch wip/T25675 at Glasgow Haskell Compiler / GHC
Commits:
e22a14fc by Simon Peyton Jones at 2025-02-11T16:21:10+00:00
Deal correctly with Given CallStack constraints
As #25675 showed, the CallStack solving mechanism was failing
to account for Given CallStack constraints.
This small patch fixes it and improves the Notes.
Small improvement to GHCi debugger output in break011, break024,
which is discussed on the MR !13883
- - - - -
9 changed files:
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/Types.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Types/Origin.hs
- testsuite/tests/ghci.debugger/scripts/break011.stdout
- testsuite/tests/ghci.debugger/scripts/break024.stdout
- + testsuite/tests/profiling/should_run/T25675.hs
- + testsuite/tests/profiling/should_run/T25675.stdout
- testsuite/tests/profiling/should_run/all.T
Changes:
=====================================
compiler/GHC/Tc/Solver/Dict.hs
=====================================
@@ -140,7 +140,7 @@ canDictCt ev cls tys
| CtWanted { ctev_rewriters = rewriters } <- ev
, Just ip_name <- isCallStackPred cls tys
- , isPushCallStackOrigin orig
+ , 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.
@@ -159,8 +159,7 @@ canDictCt ev cls tys
-- Then we solve the wanted by pushing the call-site
-- onto the newly emitted CallStack
- ; let ev_cs = EvCsPushCall (callStackOriginFS orig)
- (ctLocSpan loc) (ctEvExpr new_ev)
+ ; let ev_cs = EvCsPushCall fun_fs (ctLocSpan loc) (ctEvExpr new_ev)
; solveCallStack ev ev_cs
; continueWith (DictCt { di_ev = new_ev, di_cls = cls
=====================================
compiler/GHC/Tc/Solver/Types.hs
=====================================
@@ -134,7 +134,7 @@ emptyDictMap = emptyTcAppMap
findDict :: DictMap a -> CtLoc -> Class -> [Type] -> Maybe a
findDict m loc cls tys
| Just {} <- isCallStackPred cls tys
- , isPushCallStackOrigin (ctLocOrigin loc)
+ , Just {} <- isPushCallStackOrigin_maybe (ctLocOrigin loc)
= Nothing -- See Note [Solving CallStack constraints]
| otherwise
@@ -156,7 +156,7 @@ foldDicts = foldTcAppMap
{- Note [Solving CallStack constraints]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-See also Note [Overview of implicit CallStacks] in GHc.Tc.Types.Evidence.
+See Note [Overview of implicit CallStacks] in GHc.Tc.Types.Evidence.
Suppose f :: HasCallStack => blah. Then
=====================================
compiler/GHC/Tc/Types/Evidence.hs
=====================================
@@ -655,7 +655,6 @@ Conclusion: a new wanted coercion variable should be made mutable.
[Notice though that evidence variables that bind coercion terms
from super classes will be "given" and hence rigid]
-
Note [Overview of implicit CallStacks]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(See https://gitlab.haskell.org/ghc/ghc/wikis/explicit-call-stack/implicit-locations)
@@ -667,12 +666,13 @@ to constraints of type GHC.Stack.Types.HasCallStack, an alias
type HasCallStack = (?callStack :: CallStack)
-Implicit parameters of type GHC.Stack.Types.CallStack (the name is not
-important) are solved in three steps:
+Implicit parameters of type GHC.Stack.Types.CallStack (the /name/ of the
+implicit parameter is not important, see (CS5) below) are solved as follows:
-1. Explicit, user-written occurrences of `?stk :: CallStack`
- which have IPOccOrigin, are solved directly from the given IP,
- just like a regular IP; see GHC.Tc.Solver.Dict.tryInertDicts.
+1. Plan NORMAL. Explicit, user-written occurrences of `?stk :: CallStack`, which
+ have IPOccOrigin, are solved directly from the given IP, just like any other
+ implicit-parameter constraint; see GHC.Tc.Solver.Dict.tryInertDicts. We can
+ solve it from a Given or from another Wanted, if the two have the same type.
For example, the occurrence of `?stk` in
@@ -681,44 +681,35 @@ important) are solved in three steps:
will be solved for the `?stk` in `error`s context as before.
-2. In a function call, instead of simply passing the given IP, we first
- append the current call-site to it. For example, consider a
- call to the callstack-aware `error` above.
-
- foo :: (?stk :: CallStack) => a
- foo = error "undefined!"
-
- Here we want to take the given `?stk` and append the current
- call-site, before passing it to `error`. In essence, we want to
- rewrite `foo "undefined!"` to
+2. Plan PUSH. A /function call/ with a CallStack constraint, such as
+ a call to `foo` where
+ foo :: (?stk :: CallStack) => a
+ will give rise to a Wanted constraint
+ [W] d :: (?stk :: CallStack) CtOrigin = OccurrenceOf "foo"
- let ?stk = pushCallStack <foo's location> ?stk
- in foo "undefined!"
+ 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
- We achieve this as follows:
+ 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 in two
+ places:
+ - In GHC.Tc.Solver.Dict.canDictNC we do the pushing.
+ - In GHC.Tc.Solver.Types.findDict we arrrange /not/ to solve a plan-PUSH
+ constraint by forcing a "miss" in the lookup in the inert set
- * At a call of foo :: (?stk :: CallStack) => blah
- we emit a Wanted
- [W] d1 : IP "stk" CallStack
- with CtOrigin = OccurrenceOf "foo"
+3. For a CallStack constraint, we choose how to solve it based on its CtOrigin:
- * We /solve/ this constraint, in GHC.Tc.Solver.Dict.canDictNC
- by emitting a NEW Wanted
- [W] d2 :: IP "stk" CallStack
- with CtOrigin = IPOccOrigin
+ * solve it normally (plan NORMAL above)
+ - IPOccOrigin (discussed above)
+ - GivenOrigin (see (CS1) below)
- and solve d1 = EvCsPushCall "foo" <foo's location> (EvId d1)
+ * push an item on the stack and emit a new constraint (plan PUSH above)
+ - OccurrenceOf "foo" (discused above)
+ - anything else (see (CS1) below)
- * The new Wanted, for `d2` will be solved per rule (1), ie as a regular IP.
-
-3. We use the predicate isPushCallStackOrigin to identify whether we
- want to do (1) solve directly, or (2) push and then solve directly.
- Key point (see #19918): the CtOrigin where we want to push an item on the
- call stack can include IfThenElseOrigin etc, when RebindableSyntax is
- involved. See the defn of fun_orig in GHC.Tc.Gen.App.tcInstFun; it is
- this CtOrigin that is pinned on the constraints generated by functions
- in the "expansion" for rebindable syntax. c.f. GHC.Rename.Expr
- Note [Handling overloaded and rebindable constructs]
+ This choice is by the predicate isPushCallStackOrigin_maybe
4. We default any insoluble CallStacks to the empty CallStack. Suppose
`undefined` did not request a CallStack, ie
@@ -754,21 +745,38 @@ and the call to `error` in `undefined`, but *not* the call to `head`
in `g`, because `head` did not explicitly request a CallStack.
-Important Details:
-- GHC should NEVER report an insoluble CallStack constraint.
+Wrinkles
+
+(CS1) Which CtOrigins should qualify for plan PUSH? Certainly ones that arise
+ from a function call like (f a b).
-- GHC should NEVER infer a CallStack constraint unless one was requested
+ But (see #19918) when RebindableSyntax is involved we can function call whose
+ CtOrigin is somethign like `IfThenElseOrigin`. See the defn of fun_orig in
+ GHC.Tc.Gen.App.tcInstFun; it is this CtOrigin that is pinned on the
+ constraints generated by functions in the "expansion" for rebindable
+ syntax. c.f. GHC.Rename.Expr Note [Handling overloaded and rebindable
+ constructs].
+
+ So isPushCallStackOrigin_maybe has a fall-through for "anything else", and
+ assumes that we should adopt plan PUSH for it.
+
+ However we should /not/ take this fall-through for Given constraints
+ (#25675). So isPushCallStackOrigin_maybe identifies Givens as plan NORMAL.
+
+(CS2) GHC should NEVER report an insoluble CallStack constraint.
+
+(CS3) GHC should NEVER infer a CallStack constraint unless one was requested
with a partial type signature (See GHC.Tc.Solver..pickQuantifiablePreds).
-- A CallStack (defined in GHC.Stack.Types) is a [(String, SrcLoc)],
+(CS4)- A CallStack (defined in GHC.Stack.Types) is a [(String, SrcLoc)],
where the String is the name of the binder that is used at the
SrcLoc. SrcLoc is also defined in GHC.Stack.Types and contains the
package/module/file name, as well as the full source-span. Both
CallStack and SrcLoc are kept abstract so only GHC can construct new
values.
-- We will automatically solve any wanted CallStack regardless of the
- name of the IP, i.e.
+(CS5) We will automatically solve any wanted CallStack regardless of the
+ /name/ of the IP, i.e.
f = show (?stk :: CallStack)
g = show (?loc :: CallStack)
@@ -782,17 +790,16 @@ Important Details:
the printed CallStack will NOT include head's call-site. This reflects the
standard scoping rules of implicit-parameters.
-- An EvCallStack term desugars to a CoreExpr of type `IP "some str" CallStack`.
+(CS6) An EvCallStack term desugars to a CoreExpr of type `IP "some str" CallStack`.
The desugarer will need to unwrap the IP newtype before pushing a new
call-site onto a given stack (See GHC.HsToCore.Binds.dsEvCallStack)
-- When we emit a new wanted CallStack from rule (2) we set its origin to
+(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.
-
-}
mkEvCast :: EvExpr -> TcCoercion -> EvTerm
=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -27,7 +27,7 @@ module GHC.Tc.Types.Origin (
TypedThing(..), TyVarBndrs(..),
-- * CallStack
- isPushCallStackOrigin, callStackOriginFS,
+ isPushCallStackOrigin_maybe,
-- * FixedRuntimeRep origin
FixedRuntimeRepOrigin(..),
@@ -984,18 +984,22 @@ pprNonLinearPatternReason OtherPatternReason = empty
* *
********************************************************************* -}
-isPushCallStackOrigin :: CtOrigin -> Bool
--- Do we want to solve this IP constraint directly (return False)
--- or push the call site (return True)
--- See Note [Overview of implicit CallStacks] in GHc.Tc.Types.Evidence
-isPushCallStackOrigin (IPOccOrigin {}) = False
-isPushCallStackOrigin _ = True
-
-
-callStackOriginFS :: CtOrigin -> FastString
--- This is the string that appears in the CallStack
-callStackOriginFS (OccurrenceOf fun) = occNameFS (getOccName fun)
-callStackOriginFS orig = mkFastString (showSDocUnsafe (pprCtO orig))
+isPushCallStackOrigin_maybe :: CtOrigin -> Maybe FastString
+-- Do we want to solve this IP constraint normally (return Nothing)
+-- or push the call site (returning the name of the function being called)
+-- See Note [Overview of implicit CallStacks] esp (CS1) in GHC.Tc.Types.Evidence
+isPushCallStackOrigin_maybe (GivenOrigin {}) = Nothing
+isPushCallStackOrigin_maybe (GivenSCOrigin {}) = Nothing
+isPushCallStackOrigin_maybe (IPOccOrigin {}) = 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
+ -- that arise from rebindable syntax (#19919)
+ -- Here the "name of the function being called" is approximated as
+ -- the result of prettty-printing the CtOrigin; a bit messy,
+ -- but we can perhaps improve it in the light of user feedback
+ where
+ orig_fs = mkFastString (showSDocUnsafe (pprCtO orig))
{-
************************************************************************
=====================================
testsuite/tests/ghci.debugger/scripts/break011.stdout
=====================================
@@ -29,9 +29,9 @@ HasCallStack backtrace:
error, called at Test7.hs:2:18 in main:Main
Stopped in <exception thrown>, <unknown>
-_exception :: e = _
+_exception :: e = SomeException (ErrorCall "foo")
Stopped in <exception thrown>, <unknown>
-_exception :: e = _
+_exception :: e = SomeException (ErrorCall "foo")
*** Exception: foo
HasCallStack backtrace:
=====================================
testsuite/tests/ghci.debugger/scripts/break024.stdout
=====================================
@@ -17,7 +17,9 @@ _exception = SomeException
Nothing GHC.Internal.IO.Exception.UserError [] "error" Nothing
Nothing)
Stopped in <exception thrown>, <unknown>
-_exception :: e = _
+_exception :: e = SomeException
+ (GHC.Internal.IO.Exception.IOError
+ Nothing GHC.Internal.IO.Exception.UserError ....)
Stopped in <exception thrown>, <unknown>
_exception :: e = _
_exception = SomeException
=====================================
testsuite/tests/profiling/should_run/T25675.hs
=====================================
@@ -0,0 +1,21 @@
+{-# LANGUAGE ImplicitParams #-}
+
+module Main where
+
+import Data.Maybe
+import Debug.Trace
+import GHC.IsList
+import GHC.Stack
+
+hd (c:cs) = c
+hd [] = error "urk"
+
+what :: (HasCallStack) => Int
+what =
+ let cs = getCallStack callStack
+ in srcLocStartCol (snd (hd cs))
+
+main :: IO ()
+main =
+ let ?callStack = fromList []
+ in print (what, what)
=====================================
testsuite/tests/profiling/should_run/T25675.stdout
=====================================
@@ -0,0 +1 @@
+(14,20)
=====================================
testsuite/tests/profiling/should_run/all.T
=====================================
@@ -232,3 +232,5 @@ test('scc-prof-overloaded-calls002',
# Need optimizations to get rid of unwanted overloaded calls
['-O -fno-prof-auto -fprof-late-overloaded-calls']
)
+
+test('T25675', [], compile_and_run, ['-dcore-lint'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e22a14fc163552a257ee2273b35dd42f665066c5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e22a14fc163552a257ee2273b35dd42f665066c5
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20250211/15d9b729/attachment-0001.html>
More information about the ghc-commits
mailing list