pprLHsContext special-cases empty contexts for no good reason
Currently, there are two functions in GHC.Hs.Type which pretty-print LHsContexts, pprLHsContext and pprLHsContextAlways:
pprLHsContext :: (OutputableBndrId p) => Maybe (LHsContext (GhcPass p)) -> SDoc
pprLHsContextAlways :: (OutputableBndrId p) => LHsContext (GhcPass p) -> SDocThere's something funny about pprLHsContext, however. It has a special case for empty LHsContexts that causes them not to be pretty-printed at all:
pprLHsContext Nothing = empty
pprLHsContext (Just lctxt)
| null (unLoc lctxt) = empty
| otherwise = pprLHsContextAlways lctxtThis is unusual, since if we have Just of an empty context, surely we should print it as () =>! Not only is the design of this strange, but it's not clear how this function should interact with the new design for HsContext put forth in #19623 (comment 354576).
I propose we simplify things by removing the null (unLoc lctxt) = empty case altogether. This has one knock-on consequence, however: it will cause Template Haskell–spliced data types to be pretty-printed with empty datatype contexts, as shown by these failing test cases
=====> 1 of 15 [0, 0, 0]
Actual stderr output differs from expected:
--- TH_genEx.run/TH_genEx.stderr.normalised 2021-06-17 17:21:27.687479524 -0400
+++ TH_genEx.run/TH_genEx.comp.stderr.normalised 2021-06-17 17:21:27.687479524 -0400
@@ -1,5 +1,5 @@
TH_genEx.hs:13:2-31: Splicing declarations
genAny (reify ''MyInterface)
======>
- data AnyMyInterface1111
+ data () => AnyMyInterface1111
= forall a. MyInterface a => AnyMyInterface1111 a
*** unexpected failure for TH_genEx(normal)
=====> 1 of 15 [0, 1, 0]
Actual stderr output differs from expected:
--- TH_genEx.run/TH_genEx.stderr.normalised 2021-06-17 17:21:28.163456494 -0400
+++ TH_genEx.run/TH_genEx.comp.stderr.normalised 2021-06-17 17:21:28.163456494 -0400
@@ -1,5 +1,5 @@
TH_genEx.hs:13:2-31: Splicing declarations
genAny (reify ''MyInterface)
======>
- data AnyMyInterface1111
+ data () => AnyMyInterface1111
= forall a. MyInterface a => AnyMyInterface1111 a
*** unexpected failure for TH_genEx(ext-interp)
=====> 2 of 15 [0, 2, 0]
Actual stderr output differs from expected:
--- T5217.run/T5217.stderr.normalised 2021-06-17 17:21:28.507439849 -0400
+++ T5217.run/T5217.comp.stderr.normalised 2021-06-17 17:21:28.507439849 -0400
@@ -6,7 +6,7 @@
T3 :: a -> T [a] a
T4 :: a -> b -> T b [a] |]
======>
- data T a b
+ data () => T a b
where
T1 :: Int -> T Int Char
T2 :: a -> T a a
*** unexpected failure for T5217(normal)
=====> 2 of 15 [0, 3, 0]
Actual stderr output differs from expected:
--- T5217.run/T5217.stderr.normalised 2021-06-17 17:21:28.939418944 -0400
+++ T5217.run/T5217.comp.stderr.normalised 2021-06-17 17:21:28.939418944 -0400
@@ -6,7 +6,7 @@
T3 :: a -> T [a] a
T4 :: a -> b -> T b [a] |]
======>
- data T a b
+ data () => T a b
where
T1 :: Int -> T Int Char
T2 :: a -> T a a
*** unexpected failure for T5217(ext-interp)
=====> 3 of 15 [0, 4, 0]
Actual stderr output differs from expected:
--- T5290.run/T5290.stderr.normalised 2021-06-17 17:21:29.239404426 -0400
+++ T5290.run/T5290.comp.stderr.normalised 2021-06-17 17:21:29.239404426 -0400
@@ -6,4 +6,4 @@
[] n [] Nothing
[NormalC n [(Bang SourceUnpack SourceStrict, ConT ''Int)]] []]
======>
- data T = T {-# UNPACK #-} !Int
+ data () => T = T {-# UNPACK #-} !Int
*** unexpected failure for T5290(normal)
=====> 3 of 15 [0, 5, 0]
Actual stderr output differs from expected:
--- T5290.run/T5290.stderr.normalised 2021-06-17 17:21:29.619386035 -0400
+++ T5290.run/T5290.comp.stderr.normalised 2021-06-17 17:21:29.619386035 -0400
@@ -6,4 +6,4 @@
[] n [] Nothing
[NormalC n [(Bang SourceUnpack SourceStrict, ConT ''Int)]] []]
======>
- data T = T {-# UNPACK #-} !Int
+ data () => T = T {-# UNPACK #-} !Int
*** unexpected failure for T5290(ext-interp)
=====> 4 of 15 [0, 6, 0]
Actual stderr output differs from expected:
--- T5883.run/T5883.stderr.normalised 2021-06-17 17:21:29.935370741 -0400
+++ T5883.run/T5883.comp.stderr.normalised 2021-06-17 17:21:29.935370741 -0400
@@ -5,7 +5,7 @@
show _ = ""
{-# INLINE show #-} |]
======>
- data Unit = Unit
+ data () => Unit = Unit
instance Show Unit where
{-# INLINE show #-}
show _ = ""
*** unexpected failure for T5883(normal)
=====> 4 of 15 [0, 7, 0]
Actual stderr output differs from expected:
--- T5883.run/T5883.stderr.normalised 2021-06-17 17:21:30.347350799 -0400
+++ T5883.run/T5883.comp.stderr.normalised 2021-06-17 17:21:30.347350799 -0400
@@ -5,7 +5,7 @@
show _ = ""
{-# INLINE show #-} |]
======>
- data Unit = Unit
+ data () => Unit = Unit
instance Show Unit where
{-# INLINE show #-}
show _ = ""
*** unexpected failure for T5883(ext-interp)
=====> 5 of 15 [0, 8, 0]
Actual stderr output differs from expected:
--- T5984.run/T5984.stderr.normalised 2021-06-17 17:21:30.795329114 -0400
+++ T5984.run/T5984.comp.stderr.normalised 2021-06-17 17:21:30.795329114 -0400
@@ -1,3 +1,4 @@
T5984.hs:7:2-3: Splicing declarations
- nt ======> newtype Foo = Foo Int
-T5984.hs:8:2-3: Splicing declarations dt ======> data Bar = Bar Int
+ nt ======> newtype () => Foo = Foo Int
+T5984.hs:8:2-3: Splicing declarations
+ dt ======> data () => Bar = Bar Int
*** unexpected failure for T5984(normal)
=====> 5 of 15 [0, 9, 0]
Actual stderr output differs from expected:
--- T5984.run/T5984.stderr.normalised 2021-06-17 17:21:31.231308006 -0400
+++ T5984.run/T5984.comp.stderr.normalised 2021-06-17 17:21:31.231308006 -0400
@@ -1,3 +1,4 @@
T5984.hs:7:2-3: Splicing declarations
- nt ======> newtype Foo = Foo Int
-T5984.hs:8:2-3: Splicing declarations dt ======> data Bar = Bar Int
+ nt ======> newtype () => Foo = Foo Int
+T5984.hs:8:2-3: Splicing declarations
+ dt ======> data () => Bar = Bar Int
*** unexpected failure for T5984(ext-interp)
=====> 6 of 15 [0, 10, 0]
Actual stderr output differs from expected:
--- T7532.run/T7532.stderr.normalised 2021-06-17 17:21:31.623289028 -0400
+++ T7532.run/T7532.comp.stderr.normalised 2021-06-17 17:21:31.623289028 -0400
@@ -3,12 +3,13 @@
instance C Bool where
data D Bool = T7532.MkD
+
T7532.hs:11:2-8: Splicing declarations
bang'
======>
instance C Int where
- data D Int = T
+ data () => D Int = T
==================== Renamer ====================
instance C Int where
- data D Int = T7532.T
+ data () => D Int = T7532.T
*** unexpected failure for T7532(normal)
=====> 6 of 15 [0, 11, 0]
Actual stderr output differs from expected:
--- T7532.run/T7532.stderr.normalised 2021-06-17 17:21:32.051268306 -0400
+++ T7532.run/T7532.comp.stderr.normalised 2021-06-17 17:21:32.051268306 -0400
@@ -3,12 +3,13 @@
instance C Bool where
data D Bool = T7532.MkD
+
T7532.hs:11:2-8: Splicing declarations
bang'
======>
instance C Int where
- data D Int = T
+ data () => D Int = T
==================== Renamer ====================
instance C Int where
- data D Int = T7532.T
+ data () => D Int = T7532.T
*** unexpected failure for T7532(ext-interp)
=====> 7 of 15 [0, 12, 0]
Actual stdout output differs from expected:
--- T8624.run/T8624.stdout.normalised 2021-06-17 17:21:32.419250485 -0400
+++ T8624.run/T8624.run.stdout.normalised 2021-06-17 17:21:32.419250485 -0400
@@ -1,2 +1,2 @@
-- T8624.hs:(7,2)-(8,44): Splicing declarations
-data THDec = THDec
+data () => THDec = THDec
*** unexpected failure for T8624(normal)
=====> 8 of 15 [0, 13, 0]
Actual stderr output differs from expected:
--- T10598_TH.run/T10598_TH.stderr.normalised 2021-06-17 17:21:32.863228985 -0400
+++ T10598_TH.run/T10598_TH.comp.stderr.normalised 2021-06-17 17:21:32.863228985 -0400
@@ -25,7 +25,7 @@
[t| Show $(fooType) |]
pending(rn) [<splice, fooType>]]
======>
- newtype Foo
+ newtype () => Foo
= MkFoo Int
deriving stock Eq
deriving anyclass C
*** unexpected failure for T10598_TH(normal)
=====> 8 of 15 [0, 14, 0]
Actual stderr output differs from expected:
--- T10598_TH.run/T10598_TH.stderr.normalised 2021-06-17 17:21:33.399203026 -0400
+++ T10598_TH.run/T10598_TH.comp.stderr.normalised 2021-06-17 17:21:33.399203026 -0400
@@ -25,7 +25,7 @@
[t| Show $(fooType) |]
pending(rn) [<splice, fooType>]]
======>
- newtype Foo
+ newtype () => Foo
= MkFoo Int
deriving stock Eq
deriving anyclass C
*** unexpected failure for T10598_TH(ext-interp)
=====> 9 of 15 [0, 15, 0]
Actual stderr output differs from expected:
--- T10810.run/T10810.stderr.normalised 2021-06-17 17:21:33.691188883 -0400
+++ T10810.run/T10810.comp.stderr.normalised 2021-06-17 17:21:33.691188883 -0400
@@ -1,2 +1,2 @@
T10810.hs:6:2-25: Splicing declarations
- [d| data Foo = (:!) |] ======> data Foo = (:!)
+ [d| data Foo = (:!) |] ======> data () => Foo = (:!)
*** unexpected failure for T10810(normal)
=====> 9 of 15 [0, 16, 0]
Actual stderr output differs from expected:
--- T10810.run/T10810.stderr.normalised 2021-06-17 17:21:34.067170673 -0400
+++ T10810.run/T10810.comp.stderr.normalised 2021-06-17 17:21:34.067170673 -0400
@@ -1,2 +1,2 @@
T10810.hs:6:2-25: Splicing declarations
- [d| data Foo = (:!) |] ======> data Foo = (:!)
+ [d| data Foo = (:!) |] ======> data () => Foo = (:!)
*** unexpected failure for T10810(ext-interp)
=====> 10 of 15 [0, 17, 0]
Actual stderr output differs from expected:
--- T12045TH1.run/T12045TH1.stderr.normalised 2021-06-17 17:21:34.391154977 -0400
+++ T12045TH1.run/T12045TH1.comp.stderr.normalised 2021-06-17 17:21:34.391154977 -0400
@@ -11,8 +11,8 @@
T12045TH1.hs:16:2-41: Splicing declarations
[d| data instance D @Type a = DBool |]
======>
- data instance D @Type a = DBool
+ data instance () => D @Type a = DBool
T12045TH1.hs:18:2-51: Splicing declarations
[d| data instance D @(Type -> Type) b = DChar |]
======>
- data instance D @(Type -> Type) b = DChar
+ data instance () => D @(Type -> Type) b = DChar
*** unexpected failure for T12045TH1(normal)
=====> 10 of 15 [0, 18, 0]
Actual stderr output differs from expected:
--- T12045TH1.run/T12045TH1.stderr.normalised 2021-06-17 17:21:34.803135019 -0400
+++ T12045TH1.run/T12045TH1.comp.stderr.normalised 2021-06-17 17:21:34.803135019 -0400
@@ -11,8 +11,8 @@
T12045TH1.hs:16:2-41: Splicing declarations
[d| data instance D @Type a = DBool |]
======>
- data instance D @Type a = DBool
+ data instance () => D @Type a = DBool
T12045TH1.hs:18:2-51: Splicing declarations
[d| data instance D @(Type -> Type) b = DChar |]
======>
- data instance D @(Type -> Type) b = DChar
+ data instance () => D @(Type -> Type) b = DChar
*** unexpected failure for T12045TH1(ext-interp)
=====> 11 of 15 [0, 19, 0]
Actual stderr output differs from expected:
--- T14817.run/T14817.stderr.normalised 2021-06-17 17:21:35.087121260 -0400
+++ T14817.run/T14817.comp.stderr.normalised 2021-06-17 17:21:35.087121260 -0400
@@ -4,4 +4,4 @@
data instance Foo :: Type |]
======>
data family Foo :: Type
- data instance Foo :: Type
+ data instance () => Foo :: Type
*** unexpected failure for T14817(normal)
=====> 11 of 15 [0, 20, 0]
Actual stderr output differs from expected:
--- T14817.run/T14817.stderr.normalised 2021-06-17 17:21:35.467102850 -0400
+++ T14817.run/T14817.comp.stderr.normalised 2021-06-17 17:21:35.467102850 -0400
@@ -4,4 +4,4 @@
data instance Foo :: Type |]
======>
data family Foo :: Type
- data instance Foo :: Type
+ data instance () => Foo :: Type
*** unexpected failure for T14817(ext-interp)
=====> 12 of 15 [0, 21, 0]
Actual stderr output differs from expected:
--- T15365.run/T15365.stderr.normalised 2021-06-17 17:21:35.827085407 -0400
+++ T15365.run/T15365.comp.stderr.normalised 2021-06-17 17:21:35.827085407 -0400
@@ -22,11 +22,11 @@
(&&&) :: Bool -> Bool -> Bool
(&&&) = (&&)
type role (***)
- data (***)
- class (???)
+ data () => (***)
+ class () => (???)
instance (???)
data family ($$$)
- data instance ($$$)
+ data instance () => ($$$)
type family (^^^)
type instance (^^^) = Int
type family (###) where
*** unexpected failure for T15365(normal)
=====> 12 of 15 [0, 22, 0]
Actual stderr output differs from expected:
--- T15365.run/T15365.stderr.normalised 2021-06-17 17:21:36.259064475 -0400
+++ T15365.run/T15365.comp.stderr.normalised 2021-06-17 17:21:36.259064475 -0400
@@ -22,11 +22,11 @@
(&&&) :: Bool -> Bool -> Bool
(&&&) = (&&)
type role (***)
- data (***)
- class (???)
+ data () => (***)
+ class () => (???)
instance (???)
data family ($$$)
- data instance ($$$)
+ data instance () => ($$$)
type family (^^^)
type instance (^^^) = Int
type family (###) where
*** unexpected failure for T15365(ext-interp)
=====> 13 of 15 [0, 23, 0]
Actual stderr output differs from expected:
--- T16183.run/T16183.stderr.normalised 2021-06-17 17:21:36.563049742 -0400
+++ T16183.run/T16183.comp.stderr.normalised 2021-06-17 17:21:36.563049742 -0400
@@ -9,4 +9,4 @@
type F2 = (Int :: Type) -> (Int :: Type)
type family F3 a where
F3 (a :: Type) = Int
- newtype F4 = MkF4 (Int :: Type)
+ newtype () => F4 = MkF4 (Int :: Type)
*** unexpected failure for T16183(normal)
=====> 13 of 15 [0, 24, 0]
Actual stderr output differs from expected:
--- T16183.run/T16183.stderr.normalised 2021-06-17 17:21:36.967030166 -0400
+++ T16183.run/T16183.comp.stderr.normalised 2021-06-17 17:21:36.967030166 -0400
@@ -9,4 +9,4 @@
type F2 = (Int :: Type) -> (Int :: Type)
type family F3 a where
F3 (a :: Type) = Int
- newtype F4 = MkF4 (Int :: Type)
+ newtype () => F4 = MkF4 (Int :: Type)
*** unexpected failure for T16183(ext-interp)
=====> 14 of 15 [0, 25, 0]
Actual stderr output differs from expected:
--- T16326_TH.run/T16326_TH.stderr.normalised 2021-06-17 17:21:37.347011748 -0400
+++ T16326_TH.run/T16326_TH.comp.stderr.normalised 2021-06-17 17:21:37.347011748 -0400
@@ -17,6 +17,6 @@
liftIO $ hPutStrLn stderr $ pprint dec
pure dec
======>
- data Nested :: forall a.
+ data () => Nested :: forall a.
forall b ->
forall c. forall d -> forall e. Proxy '[a, b, c, d, e] -> Type
*** unexpected failure for T16326_TH(normal)
=====> 14 of 15 [0, 26, 0]
Actual stderr output differs from expected:
--- T16326_TH.run/T16326_TH.stderr.normalised 2021-06-17 17:21:37.778990810 -0400
+++ T16326_TH.run/T16326_TH.comp.stderr.normalised 2021-06-17 17:21:37.778990810 -0400
@@ -17,6 +17,6 @@
liftIO $ hPutStrLn stderr $ pprint dec
pure dec
======>
- data Nested :: forall a.
+ data () => Nested :: forall a.
forall b ->
forall c. forall d -> forall e. Proxy '[a, b, c, d, e] -> Type
*** unexpected failure for T16326_TH(ext-interp)
=====> 15 of 15 [0, 27, 0]
Actual stderr output differs from expected:
--- T17608.run/T17608.stderr.normalised 2021-06-17 17:21:38.102975105 -0400
+++ T17608.run/T17608.comp.stderr.normalised 2021-06-17 17:21:38.102975105 -0400
@@ -30,7 +30,7 @@
g :: () -> () -> Bool
g _ _ = True
infixl 4 `n`
- class C a where
+ class () => C a where
infixl 4 `m`
m :: a -> a -> a
n :: a -> a -> a
*** unexpected failure for T17608(normal)
=====> 15 of 15 [0, 28, 0]
Actual stderr output differs from expected:
--- T17608.run/T17608.stderr.normalised 2021-06-17 17:21:38.514955132 -0400
+++ T17608.run/T17608.comp.stderr.normalised 2021-06-17 17:21:38.514955132 -0400
@@ -30,7 +30,7 @@
g :: () -> () -> Bool
g _ _ = True
infixl 4 `n`
- class C a where
+ class () => C a where
infixl 4 `m`
m :: a -> a -> a
n :: a -> a -> a
*** unexpected failure for T17608(ext-interp)
Performance Metrics (test environment: local):
None collected.
Unexpected results from:
TEST="T10598_TH T10810 T12045TH1 T14817 T15365 T16183 T16326_TH T17608 T5217 T5290 T5883 T5984 T7532 T8624 TH_genEx"
SUMMARY for test run started at Thu Jun 17 17:21:27 2021
0:00:11.302325 spent to go through
15 total tests, which gave rise to
83 test cases, of which
50 were skipped
0 had missing libraries
0 expected passes
0 expected failures
0 caused framework failures
0 caused framework warnings
0 unexpected passes
29 unexpected failures
0 unexpected stat failures
0 fragile tests
Unexpected failures:
T10598_TH.run T10598_TH [stderr mismatch] (ext-interp)
T10598_TH.run T10598_TH [stderr mismatch] (normal)
T10810.run T10810 [stderr mismatch] (ext-interp)
T10810.run T10810 [stderr mismatch] (normal)
T12045TH1.run T12045TH1 [stderr mismatch] (ext-interp)
T12045TH1.run T12045TH1 [stderr mismatch] (normal)
T14817.run T14817 [stderr mismatch] (ext-interp)
T14817.run T14817 [stderr mismatch] (normal)
T15365.run T15365 [stderr mismatch] (ext-interp)
T15365.run T15365 [stderr mismatch] (normal)
T16183.run T16183 [stderr mismatch] (ext-interp)
T16183.run T16183 [stderr mismatch] (normal)
T16326_TH.run T16326_TH [stderr mismatch] (ext-interp)
T16326_TH.run T16326_TH [stderr mismatch] (normal)
T17608.run T17608 [stderr mismatch] (ext-interp)
T17608.run T17608 [stderr mismatch] (normal)
T5217.run T5217 [stderr mismatch] (ext-interp)
T5217.run T5217 [stderr mismatch] (normal)
T5290.run T5290 [stderr mismatch] (ext-interp)
T5290.run T5290 [stderr mismatch] (normal)
T5883.run T5883 [stderr mismatch] (ext-interp)
T5883.run T5883 [stderr mismatch] (normal)
T5984.run T5984 [stderr mismatch] (ext-interp)
T5984.run T5984 [stderr mismatch] (normal)
T7532.run T7532 [stderr mismatch] (ext-interp)
T7532.run T7532 [stderr mismatch] (normal)
T8624.run T8624 [bad stdout] (normal)
TH_genEx.run TH_genEx [stderr mismatch] (ext-interp)
TH_genEx.run TH_genEx [stderr mismatch] (normal)This is because TH represents datatype contexts in DataD/NewtypeD/etc. as a simple list of constraints, and thus it is unable to distinguish between data () => Foo (i.e., a datatype context of Just ()) and data Foo (i.e., a datatype context of Nothing).
There is a similar issue in ForallT, which is unable to distinguish between user-written empty contexts (e.g., f :: forall a. () => a) and the absence of a context (e.g., f :: forall a. a). To work around this, the TH machinery uses the following heuristic to determine if a ForallT should be converted to an HsQualTy or not:
mkHsQualTy ctxt loc ctxt' ty
| null ctxt = ty
| otherwise = L loc $ HsQualTy { hst_xqual = noExtField
, hst_ctxt = ctxt'
, hst_body = ty }I propose that we use this same heuristic for datatype contexts. Not only would this make things more consistent, it would make the issue above moot.