base: add Numeric.{readBin, showBin} (fix #19036)

8 files changed, 34 insertions, 14 deletions

diff --git a/docs/users_guide/9.2.1-notes.rst b/docs/users_guide/9.2.1-notes.rst
index e46019848d..4de092a525 100644
--- a/docs/users_guide/9.2.1-notes.rst
+++ b/docs/users_guide/9.2.1-notes.rst
@@ -137,3 +137,6 @@ Compiler
   ``Natural``. As a consequence, one must enable ``TypeSynonymInstances``
   in order to define instances for ``Nat``.
 
+  The ``Numeric`` module recieves ``showBin`` and ``readBin`` to show and
+  read integer numbers in binary.
+
diff --git a/libraries/base/Numeric.hs b/libraries/base/Numeric.hs
index 00e5f674de..58004d17e8 100644
--- a/libraries/base/Numeric.hs
+++ b/libraries/base/Numeric.hs
@@ -24,6 +24,7 @@ module Numeric (
 
         showIntAtBase,
         showInt,
+        showBin,
         showHex,
         showOct,
 
@@ -46,6 +47,7 @@ module Numeric (
         readSigned,
 
         readInt,
+        readBin,
         readDec,
         readOct,
         readHex,
@@ -82,6 +84,13 @@ readInt :: Num a
   -> ReadS a
 readInt base isDigit valDigit = readP_to_S (L.readIntP base isDigit valDigit)
 
+-- | Read an unsigned number in binary notation.
+--
+-- >>> readBin "10011"
+-- [(19,"")]
+readBin :: (Eq a, Num a) => ReadS a
+readBin = readP_to_S L.readBinP
+
 -- | Read an unsigned number in octal notation.
 --
 -- >>> readOct "0644"
@@ -287,3 +296,7 @@ showHex = showIntAtBase 16 intToDigit
 -- | Show /non-negative/ 'Integral' numbers in base 8.
 showOct :: (Integral a, Show a) => a -> ShowS
 showOct = showIntAtBase 8  intToDigit
+
+-- | Show /non-negative/ 'Integral' numbers in base 2.
+showBin :: (Integral a, Show a) => a -> ShowS
+showBin = showIntAtBase 2  intToDigit
diff --git a/libraries/base/Text/Read/Lex.hs b/libraries/base/Text/Read/Lex.hs
index 7da09164fb..3b8f9ba399 100644
--- a/libraries/base/Text/Read/Lex.hs
+++ b/libraries/base/Text/Read/Lex.hs
@@ -26,6 +26,7 @@ module Text.Read.Lex
   , hsLex
   , lexChar
 
+  , readBinP
   , readIntP
   , readOctP
   , readDecP
@@ -541,6 +542,10 @@ fracExp exp mant (d:ds) = exp' `seq` mant' `seq` fracExp exp' mant' ds
     mant' = mant * 10 + fromIntegral d
 
 valDig :: (Eq a, Num a) => a -> Char -> Maybe Int
+valDig 2 c
+  | '0' <= c && c <= '1' = Just (ord c - ord '0')
+  | otherwise            = Nothing
+
 valDig 8 c
   | '0' <= c && c <= '7' = Just (ord c - ord '0')
   | otherwise            = Nothing
@@ -577,10 +582,12 @@ readIntP' base = readIntP base isDigit valDigit
   valDigit c = maybe 0     id           (valDig base c)
 {-# SPECIALISE readIntP' :: Integer -> ReadP Integer #-}
 
-readOctP, readDecP, readHexP :: (Eq a, Num a) => ReadP a
+readBinP, readOctP, readDecP, readHexP :: (Eq a, Num a) => ReadP a
+readBinP = readIntP' 2
 readOctP = readIntP' 8
 readDecP = readIntP' 10
 readHexP = readIntP' 16
+{-# SPECIALISE readBinP :: ReadP Integer #-}
 {-# SPECIALISE readOctP :: ReadP Integer #-}
 {-# SPECIALISE readDecP :: ReadP Integer #-}
 {-# SPECIALISE readHexP :: ReadP Integer #-}
diff --git a/libraries/base/tests/Numeric/num006.hs b/libraries/base/tests/Numeric/num006.hs
index 65347dd8aa..56b8a568f7 100644
--- a/libraries/base/tests/Numeric/num006.hs
+++ b/libraries/base/tests/Numeric/num006.hs
@@ -7,22 +7,13 @@ import Data.Char
 
 --showDec :: Integral a => a -> ShowS
 showDec = showInt
-
-{-
---showBinary :: Integral a => a -> ShowS
-showBinary n r =
- showString "0b" $
- showIntAtBase 2 (toChr) n r
- where toChr d = chr (ord '0' + fromIntegral d)
--}
-
 main =
  do
   print (map (\ x -> showOct x []) [1..32])
   print (map (\ x -> showDec x []) [1..32])
   print (map (\ x -> showHex x []) [1..32])
---  print (map (\ x -> showBinary x []) [1..32])
+  print (map (\ x -> showBin x []) [1..32])
   putStrLn (showOct (241324784::Int) [])
   putStrLn (showDec (241324784::Int) [])
   putStrLn (showHex (241324784::Int) [])
----  putStrLn (showBinary (241324784::Int) [])
+  putStrLn (showBin (241324784::Int) [])
diff --git a/libraries/base/tests/Numeric/num006.stdout b/libraries/base/tests/Numeric/num006.stdout
index e0c45403ec..39b435351e 100644
--- a/libraries/base/tests/Numeric/num006.stdout
+++ b/libraries/base/tests/Numeric/num006.stdout
@@ -1,6 +1,8 @@
 ["1","2","3","4","5","6","7","10","11","12","13","14","15","16","17","20","21","22","23","24","25","26","27","30","31","32","33","34","35","36","37","40"]
 ["1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16","17","18","19","20","21","22","23","24","25","26","27","28","29","30","31","32"]
 ["1","2","3","4","5","6","7","8","9","a","b","c","d","e","f","10","11","12","13","14","15","16","17","18","19","1a","1b","1c","1d","1e","1f","20"]
+["1","10","11","100","101","110","111","1000","1001","1010","1011","1100","1101","1110","1111","10000","10001","10010","10011","10100","10101","10110","10111","11000","11001","11010","11011","11100","11101","11110","11111","100000"]
 1630451360
 241324784
 e6252f0
+1110011000100101001011110000
diff --git a/libraries/base/tests/Numeric/num007.hs b/libraries/base/tests/Numeric/num007.hs
index e02bd41d64..d248d3a08c 100644
--- a/libraries/base/tests/Numeric/num007.hs
+++ b/libraries/base/tests/Numeric/num007.hs
@@ -6,12 +6,15 @@ import Numeric
 
 main =
  do
+  putStrLn (show (readBin "00000111"))
   putStrLn (show (readOct "00000111"))
   putStrLn (show (readDec "00000111"))
   putStrLn (show (readHex "00000111"))
+  putStrLn (show (readBin "-24"))
   putStrLn (show (readOct "-24"))
   putStrLn (show (readDec "-24"))
   putStrLn (show (readHex "-24"))
+  putStrLn (show ((readBin ::ReadS Integer) "1011784372843778438743"))
   putStrLn (show ((readOct ::ReadS Integer) "3248784372843778438743"))
   putStrLn (show ((readDec ::ReadS Integer) "3248784372843778438743"))
   putStrLn (show ((readHex ::ReadS Integer) "3248784372843778438743"))
diff --git a/libraries/base/tests/Numeric/num007.stdout b/libraries/base/tests/Numeric/num007.stdout
index ef60021827..b26c636f2c 100644
--- a/libraries/base/tests/Numeric/num007.stdout
+++ b/libraries/base/tests/Numeric/num007.stdout
@@ -1,9 +1,12 @@
+[(7,"")]
 [(73,"")]
 [(111,"")]
 [(273,"")]
 []
 []
 []
+[]
+[(11,"784372843778438743")]
 [(212,"8784372843778438743")]
 [(3248784372843778438743,"")]
 [(60788519836879239998834499,"")]
diff --git a/testsuite/tests/numeric/should_run/arith012.hs b/testsuite/tests/numeric/should_run/arith012.hs
index e23b2f72ed..bab60201bc 100644
--- a/testsuite/tests/numeric/should_run/arith012.hs
+++ b/testsuite/tests/numeric/should_run/arith012.hs
@@ -64,8 +64,6 @@ test_showBin = do
   putStrLn (show integers)
   putStrLn (showList' (map showBin integers))
 
-showBin i = showIntAtBase 2 intToDigit i
-
 showList' :: [ShowS] -> String
 showList' [] = "[]"
 showList' (x:xs) = showChar '[' . x $ showl xs ""