[Git][ghc/ghc][master] Fixes around primitive literals
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Dec 9 03:50:39 UTC 2022
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
b0cc2fcf by Krzysztof Gogolewski at 2022-12-08T22:50:21-05:00
Fixes around primitive 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 changed files:
- compiler/GHC/Hs/Lit.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Types/SourceText.hs
- testsuite/tests/ghc-api/annotations-literals/literals.stdout
- testsuite/tests/ghc-api/annotations-literals/parsed.stdout
- testsuite/tests/th/T14681.hs
- testsuite/tests/th/T14681.stderr
Changes:
=====================================
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 at .
+--
+-- 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
=====================================
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))
=====================================
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
=====================================
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,[]),
=====================================
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
=====================================
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)))) |])
=====================================
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#
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b0cc2fcfc485da772c5ffef1b625af9e7ae73129
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b0cc2fcfc485da772c5ffef1b625af9e7ae73129
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/20221208/1f1a49b6/attachment-0001.html>
More information about the ghc-commits
mailing list