[Git][ghc/ghc][wip/T25675] Deal correctly with Given CallStack constraints
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Thu Jan 30 10:48:14 UTC 2025
Simon Peyton Jones pushed to branch wip/T25675 at Glasgow Haskell Compiler / GHC
Commits:
bcb23bb0 by Simon Peyton Jones at 2025-01-30T10:47:49+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.
- - - - -
7 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/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(..),
@@ -983,18 +983,19 @@ pprNonLinearPatternReason OtherPatternReason = empty
* *
********************************************************************* -}
-isPushCallStackOrigin :: CtOrigin -> Bool
--- Do we want to solve this IP constraint directly (return False)
+isPushCallStackOrigin_maybe :: CtOrigin -> Maybe FastString
+-- Do we want to solve this IP constraint normally (return Nothing)
-- 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))
+-- 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)
+ where
+ orig_fs = mkFastString (showSDocUnsafe (pprCtO orig))
{-
************************************************************************
=====================================
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/bcb23bb07d85b83ba055218c63a1c959ccc0e9db
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bcb23bb07d85b83ba055218c63a1c959ccc0e9db
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/20250130/711bc0d3/attachment-0001.html>
More information about the ghc-commits
mailing list