Always display inferred variables using braces

We now always show "forall {a}. T" for inferred variables,
previously this was controlled by -fprint-explicit-foralls.

This implements part 1 of https://github.com/ghc-proposals/ghc-proposals/pull/179.

Part of GHC ticket #16320.

Furthermore, when printing a levity restriction error, we now display
the HsWrap of the expression. This lets users see the full elaboration with
-fprint-typechecker-elaboration (see also #17670)

4 files changed, 64 insertions, 4 deletions

diff --git a/testsuite/tests/codeGen/should_fail/T13233.stderr b/testsuite/tests/codeGen/should_fail/T13233.stderr
index 08f1f62a88..a3d77d0b73 100644
--- a/testsuite/tests/codeGen/should_fail/T13233.stderr
+++ b/testsuite/tests/codeGen/should_fail/T13233.stderr
@@ -1,16 +1,22 @@
 
 T13233.hs:14:11: error:
     Cannot use function with levity-polymorphic arguments:
-      GHC.Prim.(#,#) :: a -> a -> (# a, a #)
+      (#,#) :: a -> a -> (# a, a #)
+    (Note that levity-polymorphic primops such as 'coerce' and unboxed tuples
+    are eta-expanded internally because they must occur fully saturated.
+    Use -fprint-typechecker-elaboration to display the full expression.)
     Levity-polymorphic arguments:
       a :: TYPE rep
       a :: TYPE rep
 
 T13233.hs:22:16: error:
     Cannot use function with levity-polymorphic arguments:
-      GHC.Prim.(#,#) :: forall (rep1 :: RuntimeRep) (rep2 :: RuntimeRep)
-                               (a :: TYPE rep1) (b :: TYPE rep2).
-                        a -> b -> (# a, b #)
+      (#,#) :: forall {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}
+                      {a :: TYPE rep1} {b :: TYPE rep2}.
+               a -> b -> (# a, b #)
+    (Note that levity-polymorphic primops such as 'coerce' and unboxed tuples
+    are eta-expanded internally because they must occur fully saturated.
+    Use -fprint-typechecker-elaboration to display the full expression.)
     Levity-polymorphic arguments:
       a :: TYPE rep1
       b :: TYPE rep2
diff --git a/testsuite/tests/codeGen/should_fail/T13233_elab.hs b/testsuite/tests/codeGen/should_fail/T13233_elab.hs
new file mode 100644
index 0000000000..87269769d9
--- /dev/null
+++ b/testsuite/tests/codeGen/should_fail/T13233_elab.hs
@@ -0,0 +1,33 @@
+-- Same as T13233, but we compile with -fprint-typechecker-elaboration.
+-- The error message should show an eta-expanded call to (#,#).
+-- See comments at https://gitlab.haskell.org/ghc/ghc/merge_requests/2540
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE MagicHash #-}
+module Bug where
+
+import GHC.Exts (TYPE, RuntimeRep, Weak#, State#, RealWorld, mkWeak# )
+
+class Foo (a :: TYPE rep) where
+  bar :: forall rep2 (b :: TYPE rep2). (a -> a -> b) -> a -> a -> b
+
+baz :: forall rep (a :: TYPE rep). Foo a => a -> a -> (# a, a #)
+baz = bar (#,#)
+
+obscure :: (forall (rep1 :: RuntimeRep) (rep2 :: RuntimeRep)
+                   (a :: TYPE rep1) (b :: TYPE rep2).
+                   a -> b -> (# a, b #)) -> ()
+obscure _ = ()
+
+quux :: ()
+quux = obscure (#,#)
+
+-- It used to be that primops has no binding. However, as described in
+-- Note [Primop wrappers] in PrimOp we now rewrite unsaturated primop
+-- applications to their wrapper, which allows safe use of levity polymorphism.
+primop :: forall (rep :: RuntimeRep) (a :: TYPE rep) b c.
+          a -> b -> (State# RealWorld -> (# State# RealWorld, c #))
+       -> State# RealWorld -> (# State# RealWorld, Weak# b #)
+primop = mkWeak#
diff --git a/testsuite/tests/codeGen/should_fail/T13233_elab.stderr b/testsuite/tests/codeGen/should_fail/T13233_elab.stderr
new file mode 100644
index 0000000000..214e982222
--- /dev/null
+++ b/testsuite/tests/codeGen/should_fail/T13233_elab.stderr
@@ -0,0 +1,20 @@
+
+T13233_elab.hs:17:11: error:
+    Cannot use function with levity-polymorphic arguments:
+      (#,#) @rep @rep @a @a :: a -> a -> (# a, a #)
+    Levity-polymorphic arguments:
+      a :: TYPE rep
+      a :: TYPE rep
+
+T13233_elab.hs:25:16: error:
+    Cannot use function with levity-polymorphic arguments:
+      /\(@(rep1 :: RuntimeRep)).
+      /\(@(rep2 :: RuntimeRep)).
+      /\(@(a :: TYPE rep1)).
+      /\(@(b :: TYPE rep2)).
+      (#,#) @rep1 @rep2 @a @b :: forall {rep1 :: RuntimeRep}
+                                        {rep2 :: RuntimeRep} {a :: TYPE rep1} {b :: TYPE rep2}.
+                                 a -> b -> (# a, b #)
+    Levity-polymorphic arguments:
+      a :: TYPE rep1
+      b :: TYPE rep2
diff --git a/testsuite/tests/codeGen/should_fail/all.T b/testsuite/tests/codeGen/should_fail/all.T
index 1fe2141caf..aae2dcee31 100644
--- a/testsuite/tests/codeGen/should_fail/all.T
+++ b/testsuite/tests/codeGen/should_fail/all.T
@@ -4,3 +4,4 @@
 # memcpy operations
 test('T8131', [cmm_src, only_ways(llvm_ways)], compile_fail, [''])
 test('T13233', normal, compile_fail, [''])
+test('T13233_elab', normal, compile_fail, ['-fprint-typechecker-elaboration'])