Fixes around primitive literalswip/fix-literals

* The SourceText of primitive characters 'a'# did not include
  the #, unlike for other primitive literals 1#, 1##, 1.0#, 1.0##, "a"#.
  We can now remove the function pp_st_suffix, which was a hack
  to add the # back.
* Negative primitive literals shouldn't use parentheses, as described in
  Note [Printing of literals in Core]. Added a testcase to T14681.

7 files changed, 37 insertions, 23 deletions

diff --git a/compiler/GHC/Hs/Lit.hs b/compiler/GHC/Hs/Lit.hs
index 838e3348dd..7d2df811ee 100644
--- a/compiler/GHC/Hs/Lit.hs
+++ b/compiler/GHC/Hs/Lit.hs
@@ -117,6 +117,9 @@ hsOverLitNeedsParens _ (XOverLit { }) = False
 
 -- | @'hsLitNeedsParens' p l@ returns 'True' if a literal @l@ needs
 -- to be parenthesized under precedence @p@.
+--
+-- See Note [Printing of literals in Core] in GHC.Types.Literal
+-- for the reasoning.
 hsLitNeedsParens :: PprPrec -> HsLit x -> Bool
 hsLitNeedsParens p = go
   where
@@ -125,14 +128,14 @@ hsLitNeedsParens p = go
     go (HsString {})      = False
     go (HsStringPrim {})  = False
     go (HsInt _ x)        = p > topPrec && il_neg x
-    go (HsIntPrim _ x)    = p > topPrec && x < 0
+    go (HsIntPrim {})     = False
     go (HsWordPrim {})    = False
-    go (HsInt64Prim _ x)  = p > topPrec && x < 0
+    go (HsInt64Prim {})   = False
     go (HsWord64Prim {})  = False
     go (HsInteger _ x _)  = p > topPrec && x < 0
     go (HsRat _ x _)      = p > topPrec && fl_neg x
-    go (HsFloatPrim _ x)  = p > topPrec && fl_neg x
-    go (HsDoublePrim _ x) = p > topPrec && fl_neg x
+    go (HsFloatPrim {})   = False
+    go (HsDoublePrim {})  = False
     go (XLit _)           = False
 
 -- | Convert a literal from one index type to another
@@ -169,7 +172,7 @@ Equivalently it's True if
 -- Instance specific to GhcPs, need the SourceText
 instance Outputable (HsLit (GhcPass p)) where
     ppr (HsChar st c)       = pprWithSourceText st (pprHsChar c)
-    ppr (HsCharPrim st c)   = pp_st_suffix st primCharSuffix (pprPrimChar c)
+    ppr (HsCharPrim st c)   = pprWithSourceText st (pprPrimChar c)
     ppr (HsString st s)     = pprWithSourceText st (pprHsString s)
     ppr (HsStringPrim st s) = pprWithSourceText st (pprHsBytes s)
     ppr (HsInt _ i)
@@ -180,12 +183,8 @@ instance Outputable (HsLit (GhcPass p)) where
     ppr (HsDoublePrim _ d)  = ppr d <> primDoubleSuffix
     ppr (HsIntPrim st i)    = pprWithSourceText st (pprPrimInt i)
     ppr (HsWordPrim st w)   = pprWithSourceText st (pprPrimWord w)
-    ppr (HsInt64Prim st i)  = pp_st_suffix st primInt64Suffix  (pprPrimInt64 i)
-    ppr (HsWord64Prim st w) = pp_st_suffix st primWord64Suffix (pprPrimWord64 w)
-
-pp_st_suffix :: SourceText -> SDoc -> SDoc -> SDoc
-pp_st_suffix NoSourceText         _ doc = doc
-pp_st_suffix (SourceText st) suffix _   = text st <> suffix
+    ppr (HsInt64Prim st i)  = pprWithSourceText st (pprPrimInt64 i)
+    ppr (HsWord64Prim st w) = pprWithSourceText st (pprPrimWord64 w)
 
 -- in debug mode, print the expression that it's resolved to, too
 instance OutputableBndrId p
diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x
index 8b3c4eccea..a116aec66c 100644
--- a/compiler/GHC/Parser/Lexer.x
+++ b/compiler/GHC/Parser/Lexer.x
@@ -2172,10 +2172,12 @@ finish_char_tok buf loc ch  -- We've already seen the closing quote
         let src = lexemeToString buf (cur bufEnd - cur buf)
         if magicHash then do
             case alexGetChar' i of
-              Just ('#',i@(AI end _)) -> do
+              Just ('#',i@(AI end bufEnd')) -> do
                 setInput i
+                -- Include the trailing # in SourceText
+                let src' = lexemeToString buf (cur bufEnd' - cur buf)
                 return (L (mkPsSpan loc end)
-                          (ITprimchar (SourceText src) ch))
+                          (ITprimchar (SourceText src') ch))
               _other ->
                 return (L (mkPsSpan loc end)
                           (ITchar (SourceText src) ch))
diff --git a/compiler/GHC/Types/SourceText.hs b/compiler/GHC/Types/SourceText.hs
index 725637e9d7..72c77dec95 100644
--- a/compiler/GHC/Types/SourceText.hs
+++ b/compiler/GHC/Types/SourceText.hs
@@ -76,15 +76,15 @@ text is stored in literals where this can occur.
 
 Motivating examples for HsLit
 
-  HsChar          '\n'       == '\x20`
-  HsCharPrim      '\x41`#    == `A`
+  HsChar          '\n'       == '\x20'
+  HsCharPrim      '\x41'#    == 'A'#
   HsString        "\x20\x41" == " A"
   HsStringPrim    "\x20"#    == " "#
   HsInt           001        == 1
   HsIntPrim       002#       == 2#
   HsWordPrim      003##      == 3##
-  HsInt64Prim     004##      == 4##
-  HsWord64Prim    005##      == 5##
+  HsInt64Prim     004#Int64  == 4#Int64
+  HsWord64Prim    005#Word64 == 5#Word64
   HsInteger       006        == 6
 
 For OverLitVal
@@ -293,7 +293,7 @@ instance Outputable FractionalLit where
 -- source to source manipulation tools.
 data StringLiteral = StringLiteral
                        { sl_st :: SourceText, -- literal raw source.
-                                              -- See not [Literal source text]
+                                              -- See Note [Literal source text]
                          sl_fs :: FastString, -- literal string value
                          sl_tc :: Maybe RealSrcSpan -- Location of
                                                     -- possible
diff --git a/testsuite/tests/ghc-api/annotations-literals/literals.stdout b/testsuite/tests/ghc-api/annotations-literals/literals.stdout
index eb87a80162..46f5643ff3 100644
--- a/testsuite/tests/ghc-api/annotations-literals/literals.stdout
+++ b/testsuite/tests/ghc-api/annotations-literals/literals.stdout
@@ -98,7 +98,7 @@
 
 (LiteralsTest.hs:19:11,ITequal,[=]),
 
-(LiteralsTest.hs:19:13-19,ITprimchar (SourceText "'\\x41'") 'A',['\x41'#]),
+(LiteralsTest.hs:19:13-19,ITprimchar (SourceText "'\\x41'#") 'A',['\x41'#]),
 
 (LiteralsTest.hs:20:5,ITsemi,[]),
 
diff --git a/testsuite/tests/ghc-api/annotations-literals/parsed.stdout b/testsuite/tests/ghc-api/annotations-literals/parsed.stdout
index 12c0c7192c..4e50d78a73 100644
--- a/testsuite/tests/ghc-api/annotations-literals/parsed.stdout
+++ b/testsuite/tests/ghc-api/annotations-literals/parsed.stdout
@@ -2,7 +2,7 @@ HsIntegral [0003] 3
 HsIntegral [0x04] 4
 HsString ["\x20"] " "
 HsChar ['\x20'] ' '
-HsCharPrim ['\x41'] 'A'
+HsCharPrim ['\x41'#] 'A'
 HsIntPrim [0004#] 4
 HsWordPrim [005##] 5
 HsIntegral [1] 1
diff --git a/testsuite/tests/th/T14681.hs b/testsuite/tests/th/T14681.hs
index 341a1a66b1..a83e9fb713 100644
--- a/testsuite/tests/th/T14681.hs
+++ b/testsuite/tests/th/T14681.hs
@@ -1,9 +1,12 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell, MagicHash #-}
 module T14681 where
 
 import Data.Functor.Identity
 import Language.Haskell.TH
+import GHC.Exts
 
 $([d| f = \(Identity x) -> x |])
 $([d| g = $(pure $ VarE '(+) `AppE` LitE (IntegerL (-1))
                              `AppE` (LitE (IntegerL (-1)))) |])
+$([d| h _ = $(pure $ VarE '(+#) `AppE` LitE (IntPrimL (-1))
+                                `AppE` (LitE (IntPrimL (-1)))) |])
diff --git a/testsuite/tests/th/T14681.stderr b/testsuite/tests/th/T14681.stderr
index f9838186ca..8be521ff01 100644
--- a/testsuite/tests/th/T14681.stderr
+++ b/testsuite/tests/th/T14681.stderr
@@ -1,6 +1,6 @@
-T14681.hs:7:2-32: Splicing declarations
+T14681.hs:8:2-32: Splicing declarations
     [d| f = \ (Identity x) -> x |] ======> f = \ (Identity x) -> x
-T14681.hs:(8,2)-(9,63): Splicing declarations
+T14681.hs:(9,2)-(10,63): Splicing declarations
     [d| g = $(pure
                 $ VarE '(+) `AppE` LitE (IntegerL (- 1))
                     `AppE` (LitE (IntegerL (- 1)))) |]
@@ -9,3 +9,13 @@ T14681.hs:(8,2)-(9,63): Splicing declarations
                              `AppE` (LitE (IntegerL (- 1)))>]
   ======>
     g = (+) (-1) (-1)
+T14681.hs:(11,2)-(12,66): Splicing declarations
+    [d| h _
+          = $(pure
+                $ VarE '(+#) `AppE` LitE (IntPrimL (- 1))
+                    `AppE` (LitE (IntPrimL (- 1)))) |]
+    pending(rn) [<spn, pure
+                         $ VarE '(+#) `AppE` LitE (IntPrimL (- 1))
+                             `AppE` (LitE (IntPrimL (- 1)))>]
+  ======>
+    h _ = (+#) -1# -1#