Callstacks change when constraints are substituted with type aliases in GHC 9.8
Summary
If a type alias is defined like this:
type MyConstraints = (HasCallStack, ?myImplicitParam :: ())
Then functions defined like myFunction :: MyConstraints => a
will produce different call stacks than functions defined like myFunction :: (HasCallStack, ?myImplicitParam :: ()) => a
.
Running git bisect
between ghc-9.7-start
(fc3a2232) and ghc-9.8.1-release
(443e870d) points to e1590ddc as the change which introduced this regression.
Steps to reproduce
The following sample program calls a wrapper function which prints a callstack and then runs an action. On GHC 9.6 it produces the following output:
============================================================
run, called at 14:3
============================================================
run, called at 19:10
action, called at 14:7
On GHC 9.8 it produces the following output:
============================================================
run, called at 11:7
============================================================
run, called at 16:10
run, called at 11:7
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ImplicitParams #-}
module Main where
import GHC.Stack (HasCallStack, CallStack, SrcLoc(srcLocStartLine, srcLocStartCol), callStack, getCallStack)
main :: IO ()
main =
let ?myImplicitParam = ()
in run action
type MyConstraints = (HasCallStack, ?myImplicitParam :: ())
action :: MyConstraints => IO ()
action = run $ pure ()
-- | Print the current call stack and then run an action.
run ::
MyConstraints =>
IO a ->
IO a
run action = do
let prettyCallStack = unlines $ map prettyCallStackEntry $ getCallStack callStack
prettyCallStackEntry (name, loc) =
name
<> ", called at "
<> show (srcLocStartLine loc)
<> ":"
<> show (srcLocStartCol loc)
putStrLn "============================================================"
putStrLn prettyCallStack
action
If we apply the following patch, substituting the MyConstraints
type alias for its definition, the generated call stacks on GHC 9.8 once again match the call stacks for GHC 9.6:
diff --git a/app/Main.hs b/app/Main.hs
index ef769e0..387116d 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -10,14 +10,12 @@ main =
let ?myImplicitParam = ()
in run action
-type MyConstraints = (HasCallStack, ?myImplicitParam :: ())
-
-action :: MyConstraints => IO ()
+action :: (HasCallStack, ?myImplicitParam :: ()) => IO ()
action = run $ pure ()
-- | Print the current call stack and then run an action.
run ::
- MyConstraints =>
+ (HasCallStack, ?myImplicitParam :: ()) =>
IO a ->
IO a
run action = do
Expected behavior
Generate the same call stacks regardless of if a type alias is used or if the underlying constraints are expanded directly.
Environment
- GHC version used: GHC 9.6.6, GHC 9.8.2
Optional:
- Operating System: macOS 15.1.1 (24B91)
- System Architecture: aarch64