Implement underscores in numeric literals (NumericUnderscores extension)

Implement the proposal of underscores in numeric literals.
Underscores in numeric literals are simply ignored.

The specification of the feature is available here:
https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/000
9-numeric-underscores.rst

For a discussion of the various choices:
https://github.com/ghc-proposals/ghc-proposals/pull/76

Implementation detail:

* Added dynamic flag
  * `NumericUnderscores` extension flag is added for this feature.

* Alex "Regular expression macros" in Lexer.x
  * Add `@numspc` (numeric spacer) macro to represent multiple
    underscores.
  * Modify `@decimal`, `@decimal`, `@binary`, `@octal`, `@hexadecimal`,
    `@exponent`, and `@bin_exponent` macros to include `@numspc`.

* Alex "Rules" in Lexer.x
  * To be simpler, we have only the definitions with underscores.
    And then we have a separate function (`tok_integral` and `tok_frac`)
    that validates the literals.

* Validation functions in Lexer.x
  * `tok_integral` and `tok_frac` functions validate
    whether contain underscores or not.
    If `NumericUnderscores` extensions are not enabled,
    check that there are no underscores.
  * `tok_frac` function is created by merging `strtoken` and
    `init_strtoken`.
  * `init_strtoken` is deleted. Because it is no longer used.

* Remove underscores from target literal string
  * `parseUnsignedInteger`, `readRational__`, and `readHexRational} use
    the customized `span'` function to remove underscores.

* Added Testcase
  * testcase for NumericUnderscores enabled.
      NumericUnderscores0.hs and NumericUnderscores1.hs
  * testcase for NumericUnderscores disabled.
      NoNumericUnderscores0.hs and NoNumericUnderscores1.hs
  * testcase to invalid pattern for NumericUnderscores enabled.
      NumericUnderscoresFail0.hs and NumericUnderscoresFail1.hs

Test Plan: `validate` including the above testcase

Reviewers: goldfire, bgamari

Reviewed By: bgamari

Subscribers: carter, rwbarton, thomie

GHC Trac Issues: #14473

Differential Revision: https://phabricator.haskell.org/D4235

2 files changed, 17 insertions, 5 deletions

diff --git a/compiler/utils/StringBuffer.hs b/compiler/utils/StringBuffer.hs
index 39941e2f7a..a5fc4e7f12 100644
--- a/compiler/utils/StringBuffer.hs
+++ b/compiler/utils/StringBuffer.hs
@@ -323,5 +323,6 @@ parseUnsignedInteger (StringBuffer buf _ cur) len radix char_to_int
   = inlinePerformIO $ withForeignPtr buf $ \ptr -> return $! let
     go i x | i == len  = x
            | otherwise = case fst (utf8DecodeChar (ptr `plusPtr` (cur + i))) of
+               '_'  -> go (i + 1) x    -- skip "_" (#14473)
                char -> go (i + 1) (x * radix + toInteger (char_to_int char))
   in go 0 0
diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs
index 7a46db7665..a4520ed679 100644
--- a/compiler/utils/Util.hs
+++ b/compiler/utils/Util.hs
@@ -1142,12 +1142,18 @@ readRational__ r = do
 
      lexDecDigits = nonnull isDigit
 
-     lexDotDigits ('.':s) = return (span isDigit s)
+     lexDotDigits ('.':s) = return (span' isDigit s)
      lexDotDigits s       = return ("",s)
 
-     nonnull p s = do (cs@(_:_),t) <- return (span p s)
+     nonnull p s = do (cs@(_:_),t) <- return (span' p s)
                       return (cs,t)
 
+     span' _ xs@[]         =  (xs, xs)
+     span' p xs@(x:xs')
+               | x == '_'  = span' p xs'   -- skip "_" (#14473)
+               | p x       =  let (ys,zs) = span' p xs' in (x:ys,zs)
+               | otherwise =  ([],xs)
+
 readRational :: String -> Rational -- NB: *does* handle a leading "-"
 readRational top_s
   = case top_s of
@@ -1176,12 +1182,12 @@ readHexRational str =
 readHexRational__ :: String -> Maybe Rational
 readHexRational__ ('0' : x : rest)
   | x == 'X' || x == 'x' =
-  do let (front,rest2) = span isHexDigit rest
+  do let (front,rest2) = span' isHexDigit rest
      guard (not (null front))
      let frontNum = steps 16 0 front
      case rest2 of
        '.' : rest3 ->
-          do let (back,rest4) = span isHexDigit rest3
+          do let (back,rest4) = span' isHexDigit rest3
              guard (not (null back))
              let backNum = steps 16 frontNum back
                  exp1    = -4 * length back
@@ -1201,13 +1207,18 @@ readHexRational__ ('0' : x : rest)
   mk :: Integer -> Int -> Rational
   mk n e = fromInteger n * 2^^e
 
-  dec cs = case span isDigit cs of
+  dec cs = case span' isDigit cs of
              (ds,"") | not (null ds) -> Just (steps 10 0 ds)
              _ -> Nothing
 
   steps base n ds = foldl' (step base) n ds
   step  base n d  = base * n + fromIntegral (digitToInt d)
 
+  span' _ xs@[]         =  (xs, xs)
+  span' p xs@(x:xs')
+            | x == '_'  = span' p xs'   -- skip "_"  (#14473)
+            | p x       =  let (ys,zs) = span' p xs' in (x:ys,zs)
+            | otherwise =  ([],xs)
 
 readHexRational__ _ = Nothing