Use pprSigmaType to print GHCi debugger Suspension Terms (Fix #19355)

In the GHCi debugger use the function `pprSigmaType` to print out
Suspension Terms. The function `pprSigmaType` respect the flag
`-f(no-)print-explicit-foralls` and so it fixes #19355.

Switch back output of existing tests to default mode (no explicit foralls).

8 files changed, 33 insertions, 23 deletions

diff --git a/compiler/GHC/Runtime/Heap/Inspect.hs b/compiler/GHC/Runtime/Heap/Inspect.hs
index 10f22b5a3e..73d5ce743b 100644
--- a/compiler/GHC/Runtime/Heap/Inspect.hs
+++ b/compiler/GHC/Runtime/Heap/Inspect.hs
@@ -266,10 +266,9 @@ ppr_termM1 :: Monad m => Term -> m SDoc
 ppr_termM1 Prim{valRaw=words, ty=ty} =
     return $ repPrim (tyConAppTyCon ty) words
 ppr_termM1 Suspension{ty=ty, bound_to=Nothing} =
-    return (char '_' <+> whenPprDebug (dcolon <> ppr ty))
+    return (char '_' <+> whenPprDebug (dcolon <> pprSigmaType ty))
 ppr_termM1 Suspension{ty=ty, bound_to=Just n}
---  | Just _ <- splitFunTy_maybe ty = return$ text "<function>"
-  | otherwise = return$ parens$ ppr n <> dcolon <> ppr ty
+  | otherwise = return$ parens$ ppr n <> dcolon <> pprSigmaType ty
 ppr_termM1 Term{}        = panic "ppr_termM1 - Term"
 ppr_termM1 RefWrap{}     = panic "ppr_termM1 - RefWrap"
 ppr_termM1 NewtypeWrap{} = panic "ppr_termM1 - NewtypeWrap"
diff --git a/testsuite/tests/ghci.debugger/scripts/T19355.script b/testsuite/tests/ghci.debugger/scripts/T19355.script
new file mode 100644
index 0000000000..3bbac17bda
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T19355.script
@@ -0,0 +1,6 @@
+:print fmap
+:set -fprint-explicit-foralls
+:print fmap
+:print (<*>)
+:set -fno-print-explicit-foralls
+:print (<*>)
diff --git a/testsuite/tests/ghci.debugger/scripts/T19355.stdout b/testsuite/tests/ghci.debugger/scripts/T19355.stdout
new file mode 100644
index 0000000000..6c03a221f5
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T19355.stdout
@@ -0,0 +1,8 @@
+fmap = (_t1::Functor f => (a -> b) -> f a -> f b)
+fmap = (_t2::forall (f :: * -> *) a b.
+             Functor f =>
+             (a -> b) -> f a -> f b)
+<*> = (_t3::forall (f :: * -> *) a b.
+            Applicative f =>
+            f (a -> b) -> f a -> f b)
+<*> = (_t4::Applicative f => f (a -> b) -> f a -> f b)
diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T
index d6de0b3151..8e50e6b35f 100644
--- a/testsuite/tests/ghci.debugger/scripts/all.T
+++ b/testsuite/tests/ghci.debugger/scripts/all.T
@@ -127,3 +127,4 @@ test('break029', extra_files(['break029.hs']), ghci_script, ['break029.script'])
 test('T2215', normal, ghci_script, ['T2215.script'])
 test('T17989', normal, ghci_script, ['T17989.script'])
 test('T19157', normal, ghci_script, ['T19157.script'])
+test('T19355', normal, ghci_script, ['T19355.script'])
diff --git a/testsuite/tests/ghci.debugger/scripts/break012.stdout b/testsuite/tests/ghci.debugger/scripts/break012.stdout
index 0726b3357d..5d478ae04e 100644
--- a/testsuite/tests/ghci.debugger/scripts/break012.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/break012.stdout
@@ -9,6 +9,6 @@ b :: a3 -> a3
 c :: ()
 d :: a -> a -> a
 a = (_t1::a1)
-b = (_t2::forall {a3}. a3 -> a3)
+b = (_t2::a3 -> a3)
 c = (_t3::())
 d = (_t4::a -> a -> a)
diff --git a/testsuite/tests/ghci.debugger/scripts/print027.stdout b/testsuite/tests/ghci.debugger/scripts/print027.stdout
index 38c46a9118..9426ba8365 100644
--- a/testsuite/tests/ghci.debugger/scripts/print027.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/print027.stdout
@@ -1,6 +1,6 @@
-+ = (_t1::forall a. Num a => a -> a -> a)
-print = (_t2::forall a. Show a => a -> IO ())
-log = (_t3::forall a. Floating a => a -> a)
-head = (_t4::forall a. [a] -> a)
-tail = (_t5::forall a. [a] -> [a])
-fst = (_t6::forall a b. (a, b) -> a)
++ = (_t1::Num a => a -> a -> a)
+print = (_t2::Show a => a -> IO ())
+log = (_t3::Floating a => a -> a)
+head = (_t4::[a] -> a)
+tail = (_t5::[a] -> [a])
+fst = (_t6::(a, b) -> a)
diff --git a/testsuite/tests/ghci.debugger/scripts/print033.stdout b/testsuite/tests/ghci.debugger/scripts/print033.stdout
index 0e5780318e..62b39bbaea 100644
--- a/testsuite/tests/ghci.debugger/scripts/print033.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/print033.stdout
@@ -1 +1 @@
-u = (_t1::forall {s} {a}. ST s (forall s'. ST s' a))
+u = (_t1::ST s (forall s'. ST s' a))
diff --git a/testsuite/tests/ghci/scripts/T14828.stdout b/testsuite/tests/ghci/scripts/T14828.stdout
index c7b100a137..aeab49d226 100644
--- a/testsuite/tests/ghci/scripts/T14828.stdout
+++ b/testsuite/tests/ghci/scripts/T14828.stdout
@@ -1,16 +1,12 @@
 foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b
-foldl = (_t1::forall (t :: * -> *) b a.
-              Foldable t =>
-              (b -> a -> b) -> b -> t a -> b)
+foldl = (_t1::Foldable t => (b -> a -> b) -> b -> t a -> b)
 fmap :: Functor f => (a -> b) -> f a -> f b
-fmap = (_t2::forall (f :: * -> *) a b.
-             Functor f =>
-             (a -> b) -> f a -> f b)
+fmap = (_t2::Functor f => (a -> b) -> f a -> f b)
 return :: Monad m => a -> m a
-return = (_t3::forall (m :: * -> *) a. Monad m => a -> m a)
+return = (_t3::Monad m => a -> m a)
 pure :: Applicative f => a -> f a
-pure = (_t4::forall (f :: * -> *) a. Applicative f => a -> f a)
-mempty = (_t5::forall a. Monoid a => a)
-mappend = (_t6::forall a. Monoid a => a -> a -> a)
-foldl' = (_t7::forall a b. (b -> a -> b) -> b -> [a] -> b)
-f = (_t8::forall b. (forall a. a -> a) -> b -> b)
+pure = (_t4::Applicative f => a -> f a)
+mempty = (_t5::Monoid a => a)
+mappend = (_t6::Monoid a => a -> a -> a)
+foldl' = (_t7::(b -> a -> b) -> b -> [a] -> b)
+f = (_t8::(forall a. a -> a) -> b -> b)