[Git][ghc/ghc][master] Make read accepts binary integer formats
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Apr 30 03:16:52 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
e2094df3 by damhiya at 2024-04-28T23:52:00+09:00
Make read accepts binary integer formats
CLC proposal : https://github.com/haskell/core-libraries-committee/issues/177
- - - - -
7 changed files:
- docs/users_guide/bugs.rst
- libraries/base/changelog.md
- libraries/base/tests/char001.hs
- libraries/base/tests/char001.stdout
- libraries/base/tests/lex001.hs
- libraries/base/tests/lex001.stdout
- libraries/ghc-internal/src/GHC/Internal/Text/Read/Lex.hs
Changes:
=====================================
docs/users_guide/bugs.rst
=====================================
@@ -445,15 +445,15 @@ In ``Prelude`` support
``Read``\ ing integers
GHC's implementation of the ``Read`` class for integral types
- accepts hexadecimal and octal literals (the code in the Haskell 98
+ accepts hexadecimal, octal and binary literals (the code in the Haskell 98
report doesn't). So, for example, ::
read "0xf00" :: Int
works in GHC.
- A possible reason for this is that ``readLitChar`` accepts hex and
- octal escapes, so it seems inconsistent not to do so for integers
+ This is to maintain consistency with the language's syntax. Haskell98
+ accepts hexadecimal and octal formats, and GHC2021 accepts binary formats
too.
``isAlpha``
=====================================
libraries/base/changelog.md
=====================================
@@ -3,6 +3,7 @@
## 4.21.0.0 *TBA*
* Add the `MonadFix` instance for `(,) a`, similar to the one for `Writer a` ([CLC proposal #238](https://github.com/haskell/core-libraries-committee/issues/238))
* Improve `toInteger :: Word32 -> Integer` on 64-bit platforms ([CLC proposal #259](https://github.com/haskell/core-libraries-committee/issues/259))
+ * Make `read` accept binary integer notation ([CLC proposal #177](https://github.com/haskell/core-libraries-committee/issues/177))
## 4.20.0.0 *TBA*
* Deprecate `GHC.Pack` ([#21461](https://gitlab.haskell.org/ghc/ghc/-/issues/21461))
=====================================
libraries/base/tests/char001.hs
=====================================
@@ -1,7 +1,8 @@
-- !!! Testing the behaviour of Char.lexLitChar a little..
--- [March 2003] We now allow \X and \O as escapes although the
--- spec only permits \x and \o. Seems more consistent.
+-- [March 2003] We now allow \X and \O as escapes although the
+-- spec only permits \x and \o. Seems more consistent.
+-- [January 2024] Binary character literals, something like '\b100' are not permitted.
module Main where
@@ -33,9 +34,15 @@ octs = do
lex' "'\\o14b'"
lex' "'\\0a4bg'"
+-- Binaries are NOT supported. '\b' stands for backspace.
+bins = do
+ lex' "'\\b'"
+ lex' "'\\b00'"
+
main = do
hexes
octs
+ bins
=====================================
libraries/base/tests/char001.stdout
=====================================
@@ -16,3 +16,5 @@ lex '\O000024' = [("'\\O000024'","")]
lex '\024b' = []
lex '\o14b' = []
lex '\0a4bg' = []
+lex '\b' = [("'\\b'","")]
+lex '\b00' = []
=====================================
libraries/base/tests/lex001.hs
=====================================
@@ -27,7 +27,23 @@ testStrings
"035e-3x",
"35e+3y",
"83.3e-22",
- "083.3e-22"
+ "083.3e-22",
+
+ "0b001",
+ "0b100",
+ "0b110",
+ "0B001",
+ "0B100",
+ "0B110",
+
+ "78_91",
+ "678_346",
+ "0x23d_fa4",
+ "0X23d_fa4",
+ "0o01_253",
+ "0O304_367",
+ "0b0101_0110",
+ "0B11_010_0110"
]
main = mapM test testStrings
=====================================
libraries/base/tests/lex001.stdout
=====================================
@@ -82,3 +82,58 @@
[("083.3e-22","")]
[(Number (MkDecimal [0,8,3] (Just [3]) (Just (-22))),"")]
+"0b001"
+[("0b001","")]
+[(Number (MkNumber 2 [0,0,1]),"")]
+
+"0b100"
+[("0b100","")]
+[(Number (MkNumber 2 [1,0,0]),"")]
+
+"0b110"
+[("0b110","")]
+[(Number (MkNumber 2 [1,1,0]),"")]
+
+"0B001"
+[("0B001","")]
+[(Number (MkNumber 2 [0,0,1]),"")]
+
+"0B100"
+[("0B100","")]
+[(Number (MkNumber 2 [1,0,0]),"")]
+
+"0B110"
+[("0B110","")]
+[(Number (MkNumber 2 [1,1,0]),"")]
+
+"78_91"
+[("78","_91")]
+[(Number (MkDecimal [7,8] Nothing Nothing),"_91")]
+
+"678_346"
+[("678","_346")]
+[(Number (MkDecimal [6,7,8] Nothing Nothing),"_346")]
+
+"0x23d_fa4"
+[("0x23d","_fa4")]
+[(Number (MkNumber 16 [2,3,13]),"_fa4")]
+
+"0X23d_fa4"
+[("0X23d","_fa4")]
+[(Number (MkNumber 16 [2,3,13]),"_fa4")]
+
+"0o01_253"
+[("0o01","_253")]
+[(Number (MkNumber 8 [0,1]),"_253")]
+
+"0O304_367"
+[("0O304","_367")]
+[(Number (MkNumber 8 [3,0,4]),"_367")]
+
+"0b0101_0110"
+[("0b0101","_0110")]
+[(Number (MkNumber 2 [0,1,0,1]),"_0110")]
+
+"0B11_010_0110"
+[("0B11","_010_0110")]
+[(Number (MkNumber 2 [1,1]),"_010_0110")]
=====================================
libraries/ghc-internal/src/GHC/Internal/Text/Read/Lex.hs
=====================================
@@ -300,6 +300,17 @@ lexCharE =
n <- lexInteger base
guard (n <= toInteger (ord maxBound))
return (chr (fromInteger n))
+ where
+ -- Slightly different variant of lexBaseChar that denies binary format.
+ -- Binary formats are not allowed for character/string literal.
+ lexBaseChar = do
+ c <- get
+ case c of
+ 'o' -> return 8
+ 'O' -> return 8
+ 'x' -> return 16
+ 'X' -> return 16
+ _ -> pfail
lexCntrlChar =
do _ <- char '^'
@@ -415,27 +426,28 @@ type Digits = [Int]
lexNumber :: ReadP Lexeme
lexNumber
- = lexHexOct <++ -- First try for hex or octal 0x, 0o etc
+ = lexHexOctBin <++ -- First try for hex, octal or binary 0x, 0o, 0b etc
-- If that fails, try for a decimal number
lexDecNumber -- Start with ordinary digits
-lexHexOct :: ReadP Lexeme
-lexHexOct
+lexHexOctBin :: ReadP Lexeme
+lexHexOctBin
= do _ <- char '0'
base <- lexBaseChar
digits <- lexDigits base
return (Number (MkNumber base digits))
-
-lexBaseChar :: ReadP Int
--- Lex a single character indicating the base; fail if not there
-lexBaseChar = do
- c <- get
- case c of
- 'o' -> return 8
- 'O' -> return 8
- 'x' -> return 16
- 'X' -> return 16
- _ -> pfail
+ where
+ -- Lex a single character indicating the base; fail if not there
+ lexBaseChar = do
+ c <- get
+ case c of
+ 'b' -> return 2
+ 'B' -> return 2
+ 'o' -> return 8
+ 'O' -> return 8
+ 'x' -> return 16
+ 'X' -> return 16
+ _ -> pfail
lexDecNumber :: ReadP Lexeme
lexDecNumber =
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e2094df3ff64fa043d990d33592982cf61330c27
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e2094df3ff64fa043d990d33592982cf61330c27
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/20240429/b52d6518/attachment-0001.html>
More information about the ghc-commits
mailing list