[Git][ghc/ghc][wip/T24911] Print namespace specifiers in FixitySig's Outputable instance
Ryan Scott (@RyanGlScott)
gitlab at gitlab.haskell.org
Fri May 31 10:35:49 UTC 2024
Ryan Scott pushed to branch wip/T24911 at Glasgow Haskell Compiler / GHC
Commits:
70c792e4 by Ryan Scott at 2024-05-31T06:27:39-04:00
Print namespace specifiers in FixitySig's Outputable instance
For whatever reason, the `Outputable` instance for `FixitySig` simply did not
print out namespace specifiers, leading to the confusing `-ddump-splices`
output seen in #24911. This patch corrects this oversight.
Fixes #24911.
- - - - -
5 changed files:
- compiler/GHC/Hs/Binds.hs
- testsuite/tests/rename/should_fail/T14032c.stderr
- + testsuite/tests/th/T24911.hs
- + testsuite/tests/th/T24911.stderr
- testsuite/tests/th/all.T
Changes:
=====================================
compiler/GHC/Hs/Binds.hs
=====================================
@@ -898,8 +898,13 @@ extractSpecPragName srcTxt = case (words $ show srcTxt) of
instance OutputableBndrId p
=> Outputable (FixitySig (GhcPass p)) where
- ppr (FixitySig _ names fixity) = sep [ppr fixity, pprops]
+ ppr (FixitySig ns_spec names fixity) = sep [ppr fixity, ppr_ns_spec, pprops]
where
+ ppr_ns_spec =
+ case ghcPass @p of
+ GhcPs -> ppr ns_spec
+ GhcRn -> ppr ns_spec
+ GhcTc -> empty
pprops = hsep $ punctuate comma (map (pprInfixOcc . unLoc) names)
pragBrackets :: SDoc -> SDoc
=====================================
testsuite/tests/rename/should_fail/T14032c.stderr
=====================================
@@ -1,14 +1,14 @@
-
T14032c.hs:1:1: error: [GHC-78534]
Illegal use of the ‘type’ keyword:
- infix 0 $
+ infix 0 type $
in a fixity signature
Suggested fix:
Perhaps you intended to use the ‘ExplicitNamespaces’ extension (implied by ‘TypeFamilies’ and ‘TypeOperators’)
T14032c.hs:1:1: error: [GHC-78534]
Illegal use of the ‘data’ keyword:
- infix 0 $
+ infix 0 data $
in a fixity signature
Suggested fix:
Perhaps you intended to use the ‘ExplicitNamespaces’ extension (implied by ‘TypeFamilies’ and ‘TypeOperators’)
+
=====================================
testsuite/tests/th/T24911.hs
=====================================
@@ -0,0 +1,12 @@
+{-# LANGUAGE ExplicitNamespaces #-}
+{-# LANGUAGE TemplateHaskell #-}
+module T24911 where
+
+$([d| infixl 4 data ###
+ (###) :: a -> a -> a
+ x ### y = x
+
+ infixl 4 type ###
+ type (###) :: a -> a -> a
+ type x ### y = x
+ |])
=====================================
testsuite/tests/th/T24911.stderr
=====================================
@@ -0,0 +1,17 @@
+T24911.hs:(5,2)-(12,7): Splicing declarations
+ [d| infixl 4 type ###
+ infixl 4 data ###
+
+ (###) :: a -> a -> a
+ x ### y = x
+
+ type (###) :: a -> a -> a
+
+ type x ### y = x |]
+ ======>
+ infixl 4 data ###
+ (###) :: a -> a -> a
+ (###) x y = x
+ infixl 4 type ###
+ type (###) :: a -> a -> a
+ type (###) x y = x
=====================================
testsuite/tests/th/all.T
=====================================
@@ -615,3 +615,4 @@ test('T24557e', normal, compile, [''])
test('T24702a', normal, compile, [''])
test('T24702b', normal, compile, [''])
test('T24837', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
+test('T24911', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/70c792e4af265079bf355ae6d0176ac1aa71b491
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/70c792e4af265079bf355ae6d0176ac1aa71b491
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/20240531/e4480f14/attachment-0001.html>
More information about the ghc-commits
mailing list