diff options
author | Takenobu Tani <takenobu.hs@gmail.com> | 2018-01-21 12:08:59 -0500 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2018-01-21 12:09:00 -0500 |
commit | 4a13c5b1f4beb53cbf1f3529acdf3ba37528e694 (patch) | |
tree | cfce02f26d602175f99699763b0c654b4b65033e | |
parent | 180ca65ff6d1b4f3f4cdadc569fd4de107be14db (diff) | |
download | haskell-4a13c5b1f4beb53cbf1f3529acdf3ba37528e694.tar.gz |
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
21 files changed, 469 insertions, 45 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 3324d5532e..77837e6d3d 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -4057,6 +4057,7 @@ xFlagsDeps = [ flagSpec "MonomorphismRestriction" LangExt.MonomorphismRestriction, flagSpec "MultiParamTypeClasses" LangExt.MultiParamTypeClasses, flagSpec "MultiWayIf" LangExt.MultiWayIf, + flagSpec "NumericUnderscores" LangExt.NumericUnderscores, flagSpec "NPlusKPatterns" LangExt.NPlusKPatterns, flagSpec "NamedFieldPuns" LangExt.RecordPuns, flagSpec "NamedWildCards" LangExt.NamedWildCards, diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 76cc4ee6e6..d8a670e7fb 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -177,12 +177,14 @@ $docsym = [\| \^ \* \$] @varsym = ($symbol # \:) $symbol* -- variable (operator) symbol @consym = \: $symbol* -- constructor (operator) symbol -@decimal = $decdigit+ -@binary = $binit+ -@octal = $octit+ -@hexadecimal = $hexit+ -@exponent = [eE] [\-\+]? @decimal -@bin_exponent = [pP] [\-\+]? @decimal +-- See Note [Lexing NumericUnderscores extension] and #14473 +@numspc = _* -- numeric spacer (#14473) +@decimal = $decdigit(@numspc $decdigit)* +@binary = $binit(@numspc $binit)* +@octal = $octit(@numspc $octit)* +@hexadecimal = $hexit(@numspc $hexit)* +@exponent = @numspc [eE] [\-\+]? @decimal +@bin_exponent = @numspc [pP] [\-\+]? @decimal @qual = (@conid \.)+ @qvarid = @qual @varid @@ -190,8 +192,8 @@ $docsym = [\| \^ \* \$] @qvarsym = @qual @varsym @qconsym = @qual @consym -@floating_point = @decimal \. @decimal @exponent? | @decimal @exponent -@hex_floating_point = @hexadecimal \. @hexadecimal @bin_exponent? | @hexadecimal @bin_exponent +@floating_point = @numspc @decimal \. @decimal @exponent? | @numspc @decimal @exponent +@hex_floating_point = @numspc @hexadecimal \. @hexadecimal @bin_exponent? | @numspc @hexadecimal @bin_exponent -- normal signed numerical literals can only be explicitly negative, -- not explicitly positive (contrast @exponent) @@ -485,24 +487,34 @@ $tab { warnTab } -- For the normal boxed literals we need to be careful -- when trying to be close to Haskell98 + +-- Note [Lexing NumericUnderscores extension] (#14473) +-- +-- NumericUnderscores extension allows underscores in numeric literals. +-- Multiple underscores are represented with @numspc macro. +-- 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. +-- If extensions are not enabled, check that there are no underscores. +-- <0> { -- Normal integral literals (:: Num a => a, from Integer) @decimal { tok_num positive 0 0 decimal } - 0[bB] @binary / { ifExtension binaryLiteralsEnabled } { tok_num positive 2 2 binary } - 0[oO] @octal { tok_num positive 2 2 octal } - 0[xX] @hexadecimal { tok_num positive 2 2 hexadecimal } + 0[bB] @numspc @binary / { ifExtension binaryLiteralsEnabled } { tok_num positive 2 2 binary } + 0[oO] @numspc @octal { tok_num positive 2 2 octal } + 0[xX] @numspc @hexadecimal { tok_num positive 2 2 hexadecimal } @negative @decimal / { ifExtension negativeLiteralsEnabled } { tok_num negative 1 1 decimal } - @negative 0[bB] @binary / { ifExtension negativeLiteralsEnabled `alexAndPred` - ifExtension binaryLiteralsEnabled } { tok_num negative 3 3 binary } - @negative 0[oO] @octal / { ifExtension negativeLiteralsEnabled } { tok_num negative 3 3 octal } - @negative 0[xX] @hexadecimal / { ifExtension negativeLiteralsEnabled } { tok_num negative 3 3 hexadecimal } + @negative 0[bB] @numspc @binary / { ifExtension negativeLiteralsEnabled `alexAndPred` + ifExtension binaryLiteralsEnabled } { tok_num negative 3 3 binary } + @negative 0[oO] @numspc @octal / { ifExtension negativeLiteralsEnabled } { tok_num negative 3 3 octal } + @negative 0[xX] @numspc @hexadecimal / { ifExtension negativeLiteralsEnabled } { tok_num negative 3 3 hexadecimal } -- Normal rational literals (:: Fractional a => a, from Rational) - @floating_point { strtoken tok_float } - @negative @floating_point / { ifExtension negativeLiteralsEnabled } { strtoken tok_float } - 0[xX] @hex_floating_point / { ifExtension hexFloatLiteralsEnabled } { strtoken tok_hex_float } - @negative 0[xX]@hex_floating_point / { ifExtension hexFloatLiteralsEnabled `alexAndPred` - ifExtension negativeLiteralsEnabled } { strtoken tok_hex_float } + @floating_point { tok_frac 0 tok_float } + @negative @floating_point / { ifExtension negativeLiteralsEnabled } { tok_frac 0 tok_float } + 0[xX] @numspc @hex_floating_point / { ifExtension hexFloatLiteralsEnabled } { tok_frac 0 tok_hex_float } + @negative 0[xX] @numspc @hex_floating_point / { ifExtension hexFloatLiteralsEnabled `alexAndPred` + ifExtension negativeLiteralsEnabled } { tok_frac 0 tok_hex_float } } <0> { @@ -510,26 +522,26 @@ $tab { warnTab } -- It's simpler (and faster?) to give separate cases to the negatives, -- especially considering octal/hexadecimal prefixes. @decimal \# / { ifExtension magicHashEnabled } { tok_primint positive 0 1 decimal } - 0[bB] @binary \# / { ifExtension magicHashEnabled `alexAndPred` + 0[bB] @numspc @binary \# / { ifExtension magicHashEnabled `alexAndPred` ifExtension binaryLiteralsEnabled } { tok_primint positive 2 3 binary } - 0[oO] @octal \# / { ifExtension magicHashEnabled } { tok_primint positive 2 3 octal } - 0[xX] @hexadecimal \# / { ifExtension magicHashEnabled } { tok_primint positive 2 3 hexadecimal } + 0[oO] @numspc @octal \# / { ifExtension magicHashEnabled } { tok_primint positive 2 3 octal } + 0[xX] @numspc @hexadecimal \# / { ifExtension magicHashEnabled } { tok_primint positive 2 3 hexadecimal } @negative @decimal \# / { ifExtension magicHashEnabled } { tok_primint negative 1 2 decimal } - @negative 0[bB] @binary \# / { ifExtension magicHashEnabled `alexAndPred` - ifExtension binaryLiteralsEnabled } { tok_primint negative 3 4 binary } - @negative 0[oO] @octal \# / { ifExtension magicHashEnabled } { tok_primint negative 3 4 octal } - @negative 0[xX] @hexadecimal \# / { ifExtension magicHashEnabled } { tok_primint negative 3 4 hexadecimal } + @negative 0[bB] @numspc @binary \# / { ifExtension magicHashEnabled `alexAndPred` + ifExtension binaryLiteralsEnabled } { tok_primint negative 3 4 binary } + @negative 0[oO] @numspc @octal \# / { ifExtension magicHashEnabled } { tok_primint negative 3 4 octal } + @negative 0[xX] @numspc @hexadecimal \# / { ifExtension magicHashEnabled } { tok_primint negative 3 4 hexadecimal } @decimal \# \# / { ifExtension magicHashEnabled } { tok_primword 0 2 decimal } - 0[bB] @binary \# \# / { ifExtension magicHashEnabled `alexAndPred` + 0[bB] @numspc @binary \# \# / { ifExtension magicHashEnabled `alexAndPred` ifExtension binaryLiteralsEnabled } { tok_primword 2 4 binary } - 0[oO] @octal \# \# / { ifExtension magicHashEnabled } { tok_primword 2 4 octal } - 0[xX] @hexadecimal \# \# / { ifExtension magicHashEnabled } { tok_primword 2 4 hexadecimal } + 0[oO] @numspc @octal \# \# / { ifExtension magicHashEnabled } { tok_primword 2 4 octal } + 0[xX] @numspc @hexadecimal \# \# / { ifExtension magicHashEnabled } { tok_primword 2 4 hexadecimal } -- Unboxed floats and doubles (:: Float#, :: Double#) -- prim_{float,double} work with signed literals - @signed @floating_point \# / { ifExtension magicHashEnabled } { init_strtoken 1 tok_primfloat } - @signed @floating_point \# \# / { ifExtension magicHashEnabled } { init_strtoken 2 tok_primdouble } + @signed @floating_point \# / { ifExtension magicHashEnabled } { tok_frac 1 tok_primfloat } + @signed @floating_point \# \# / { ifExtension magicHashEnabled } { tok_frac 2 tok_primdouble } } -- Strings and chars are lexed by hand-written code. The reason is @@ -943,11 +955,6 @@ strtoken :: (String -> Token) -> Action strtoken f span buf len = return (L span $! (f $! lexemeToString buf len)) -init_strtoken :: Int -> (String -> Token) -> Action --- like strtoken, but drops the last N character(s) -init_strtoken drop f span buf len = - return (L span $! (f $! lexemeToString buf (len-drop))) - begin :: Int -> Action begin code _span _str _len = do pushLexState code; lexToken @@ -1277,8 +1284,12 @@ tok_integral :: (SourceText -> Integer -> Token) -> Int -> Int -> (Integer, (Char -> Int)) -> Action -tok_integral itint transint transbuf translen (radix,char_to_int) span buf len - = return $ L span $ itint (SourceText $ lexemeToString buf len) +tok_integral itint transint transbuf translen (radix,char_to_int) span buf len = do + numericUnderscores <- extension numericUnderscoresEnabled -- #14473 + let src = lexemeToString buf len + if (not numericUnderscores) && ('_' `elem` src) + then failMsgP "Use NumericUnderscores to allow underscores in integer literals" + else return $ L span $ itint (SourceText src) $! transint $ parseUnsignedInteger (offsetBytes transbuf buf) (subtract translen len) radix char_to_int @@ -1310,6 +1321,14 @@ octal = (8,octDecDigit) hexadecimal = (16,hexDigit) -- readRational can understand negative rationals, exponents, everything. +tok_frac :: Int -> (String -> Token) -> Action +tok_frac drop f span buf len = do + numericUnderscores <- extension numericUnderscoresEnabled -- #14473 + let src = lexemeToString buf (len-drop) + if (not numericUnderscores) && ('_' `elem` src) + then failMsgP "Use NumericUnderscores to allow underscores in floating literals" + else return (L span $! (f $! src)) + tok_float, tok_primfloat, tok_primdouble :: String -> Token tok_float str = ITrational $! readFractionalLit str tok_hex_float str = ITrational $! readHexFractionalLit str @@ -2221,6 +2240,7 @@ data ExtBits | HexFloatLiteralsBit | TypeApplicationsBit | StaticPointersBit + | NumericUnderscoresBit deriving Enum @@ -2289,6 +2309,8 @@ typeApplicationEnabled :: ExtsBitmap -> Bool typeApplicationEnabled = xtest TypeApplicationsBit staticPointersEnabled :: ExtsBitmap -> Bool staticPointersEnabled = xtest StaticPointersBit +numericUnderscoresEnabled :: ExtsBitmap -> Bool +numericUnderscoresEnabled = xtest NumericUnderscoresBit -- PState for parsing options pragmas -- @@ -2344,6 +2366,7 @@ mkParserFlags flags = .|. PatternSynonymsBit `setBitIf` xopt LangExt.PatternSynonyms flags .|. TypeApplicationsBit `setBitIf` xopt LangExt.TypeApplications flags .|. StaticPointersBit `setBitIf` xopt LangExt.StaticPointers flags + .|. NumericUnderscoresBit `setBitIf` xopt LangExt.NumericUnderscores flags setBitIf :: ExtBits -> Bool -> ExtsBitmap b `setBitIf` cond | cond = xbit b 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 diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 4125c33b24..7d79222bfa 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -553,6 +553,93 @@ by one bit left (negative) or right (positive). Here are some examples: +.. _numeric-underscores: + +Numeric underscores +------------------- + +.. ghc-flag:: -XNumericUnderscores + :shortdesc: Enable support for :ref:`numeric underscores <numeric-underscores>`. + :type: dynamic + :reverse: -XNoNumericUnderscores + :category: + + :since: 8.6.1 + + Allow the use of underscores in numeric literals. + +GHC allows for numeric literals to be given in decimal, octal, hexadecimal, +binary, or float notation. + +The language extension :ghc-flag:`-XNumericUnderscores` adds support for expressing +underscores in numeric literals. +For instance, the numeric literal ``1_000_000`` will be parsed into +``1000000`` when :ghc-flag:`-XNumericUnderscores` is enabled. +That is, underscores in numeric literals are ignored when +:ghc-flag:`-XNumericUnderscores` is enabled. +See also :ghc-ticket:`14473`. + +For example: :: + + -- decimal + million = 1_000_000 + billion = 1_000_000_000 + lightspeed = 299_792_458 + version = 8_04_1 + date = 2017_12_31 + + -- hexadecimal + red_mask = 0xff_00_00 + size1G = 0x3fff_ffff + + -- binary + bit8th = 0b01_0000_0000 + packbits = 0b1_11_01_0000_0_111 + bigbits = 0b1100_1011__1110_1111__0101_0011 + + -- float + pi = 3.141_592_653_589_793 + faraday = 96_485.332_89 + avogadro = 6.022_140_857e+23 + + -- function + isUnderMillion = (< 1_000_000) + + clip64M x + | x > 0x3ff_ffff = 0x3ff_ffff + | otherwise = x + + test8bit x = (0b01_0000_0000 .&. x) /= 0 + +About validity: :: + + x0 = 1_000_000 -- valid + x1 = 1__000000 -- valid + x2 = 1000000_ -- invalid + x3 = _1000000 -- invalid + + e0 = 0.0001 -- valid + e1 = 0.000_1 -- valid + e2 = 0_.0001 -- invalid + e3 = _0.0001 -- invalid + e4 = 0._0001 -- invalid + e5 = 0.0001_ -- invalid + + f0 = 1e+23 -- valid + f1 = 1_e+23 -- valid + f2 = 1__e+23 -- valid + f3 = 1e_+23 -- invalid + + g0 = 1e+23 -- valid + g1 = 1e+_23 -- invalid + g2 = 1e+23_ -- invalid + + h0 = 0xffff -- valid + h1 = 0xff_ff -- valid + h2 = 0x_ffff -- valid + h3 = 0x__ffff -- valid + h4 = _0xffff -- invalid + .. _pattern-guards: Pattern guards diff --git a/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs b/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs index 3e8c2a0e15..2b06c851a8 100644 --- a/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs +++ b/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs @@ -133,4 +133,5 @@ data Extension | StrictData | MonadFailDesugaring | EmptyDataDeriving + | NumericUnderscores deriving (Eq, Enum, Show, Generic) diff --git a/testsuite/tests/driver/T4437.hs b/testsuite/tests/driver/T4437.hs index 27f5e1aaba..6a46e52ad6 100644 --- a/testsuite/tests/driver/T4437.hs +++ b/testsuite/tests/driver/T4437.hs @@ -39,7 +39,8 @@ expectedGhcOnlyExtensions :: [String] expectedGhcOnlyExtensions = ["RelaxedLayout", "AlternativeLayoutRule", "AlternativeLayoutRuleTransitional", - "EmptyDataDeriving"] + "EmptyDataDeriving", + "NumericUnderscores"] expectedCabalOnlyExtensions :: [String] expectedCabalOnlyExtensions = ["Generics", diff --git a/testsuite/tests/parser/should_fail/NoNumericUnderscores0.hs b/testsuite/tests/parser/should_fail/NoNumericUnderscores0.hs new file mode 100644 index 0000000000..5e6821124a --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoNumericUnderscores0.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE NoNumericUnderscores #-} + +-- Test for NumericUnderscores extension. +-- See Trac #14473 +-- This is a testcase for integer literal +-- in NO NumericUnderscores extension. + +module NoNumericUnderscores0 where + +f :: Int -> () +f 1_000 = () +f _ = () diff --git a/testsuite/tests/parser/should_fail/NoNumericUnderscores0.stderr b/testsuite/tests/parser/should_fail/NoNumericUnderscores0.stderr new file mode 100644 index 0000000000..af59581c14 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoNumericUnderscores0.stderr @@ -0,0 +1,3 @@ + +NoNumericUnderscores0.hs:11:3: error: + Use NumericUnderscores to allow underscores in integer literals diff --git a/testsuite/tests/parser/should_fail/NoNumericUnderscores1.hs b/testsuite/tests/parser/should_fail/NoNumericUnderscores1.hs new file mode 100644 index 0000000000..017f20528b --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoNumericUnderscores1.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE NoNumericUnderscores #-} + +-- Test for NumericUnderscores extension. +-- See Trac #14473 +-- This is a testcase for floating literal +-- in NO NumericUnderscores extension. + +module NoNumericUnderscores1 where + +f :: Float -> () +f 1_000.0_1 = () +f _ = () diff --git a/testsuite/tests/parser/should_fail/NoNumericUnderscores1.stderr b/testsuite/tests/parser/should_fail/NoNumericUnderscores1.stderr new file mode 100644 index 0000000000..0dfbaa409e --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoNumericUnderscores1.stderr @@ -0,0 +1,3 @@ + +NoNumericUnderscores1.hs:11:3: error: + Use NumericUnderscores to allow underscores in floating literals diff --git a/testsuite/tests/parser/should_fail/NumericUnderscoresFail0.hs b/testsuite/tests/parser/should_fail/NumericUnderscoresFail0.hs new file mode 100644 index 0000000000..1f04184365 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NumericUnderscoresFail0.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE NumericUnderscores #-} + +-- Test for NumericUnderscores extension. +-- See Trac #14473 +-- This is a testcase for invalid case of NumericUnderscores. + +main :: IO () +main = do + print [ + -- integer + 1000000_, + _1000000 + ] diff --git a/testsuite/tests/parser/should_fail/NumericUnderscoresFail0.stderr b/testsuite/tests/parser/should_fail/NumericUnderscoresFail0.stderr new file mode 100644 index 0000000000..8c872575a5 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NumericUnderscoresFail0.stderr @@ -0,0 +1,4 @@ +NumericUnderscoresFail0.hs:9:5: error: +NumericUnderscoresFail0.hs:11:13: error: +NumericUnderscoresFail0.hs:11:20: error: +NumericUnderscoresFail0.hs:12:13: error: diff --git a/testsuite/tests/parser/should_fail/NumericUnderscoresFail1.hs b/testsuite/tests/parser/should_fail/NumericUnderscoresFail1.hs new file mode 100644 index 0000000000..0a6a3051d6 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NumericUnderscoresFail1.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE NumericUnderscores #-} + +-- Test for NumericUnderscores extension. +-- See Trac #14473 +-- This is a testcase for invalid case of NumericUnderscores. + +main :: IO () +main = do + print [ + -- float + 0_.0001, + _0.0001, + 0.0001_, + 0._0001, + + -- float with exponent + 1e_+23, + 1e+23_, + 1e+_23 + ] diff --git a/testsuite/tests/parser/should_fail/NumericUnderscoresFail1.stderr b/testsuite/tests/parser/should_fail/NumericUnderscoresFail1.stderr new file mode 100644 index 0000000000..e1c91de091 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NumericUnderscoresFail1.stderr @@ -0,0 +1,7 @@ +NumericUnderscoresFail1.hs:11:14: error: +NumericUnderscoresFail1.hs:13:19: error: +NumericUnderscoresFail1.hs:14:15: error: +NumericUnderscoresFail1.hs:17:14: error: Variable not in scope: e_ +NumericUnderscoresFail1.hs:18:18: error: +NumericUnderscoresFail1.hs:19:14: error: Variable not in scope: e +NumericUnderscoresFail1.hs:19:16: error: diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T index 483e5fe511..c16a988c2f 100644 --- a/testsuite/tests/parser/should_fail/all.T +++ b/testsuite/tests/parser/should_fail/all.T @@ -103,3 +103,10 @@ test('T8501b', normal, compile_fail, ['']) test('T8501c', normal, compile_fail, ['']) test('T12610', normal, compile_fail, ['']) test('T14588', normal, compile_fail, ['']) + +test('NoNumericUnderscores0', normal, compile_fail, ['']) +test('NoNumericUnderscores1', normal, compile_fail, ['']) +test('NumericUnderscoresFail0', + grep_errmsg(r'^NumericUnderscoresFail0.hs:'), compile_fail, ['']) +test('NumericUnderscoresFail1', + grep_errmsg(r'^NumericUnderscoresFail1.hs:'), compile_fail, ['']) diff --git a/testsuite/tests/parser/should_run/NumericUnderscores0.hs b/testsuite/tests/parser/should_run/NumericUnderscores0.hs new file mode 100644 index 0000000000..7aefce95c6 --- /dev/null +++ b/testsuite/tests/parser/should_run/NumericUnderscores0.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE BinaryLiterals #-} +{-# LANGUAGE HexFloatLiterals #-} +{-# LANGUAGE NegativeLiterals #-} + +-- Test for NumericUnderscores extension. +-- See Trac #14473 +-- This is a testcase for boxed literals. + +main :: IO () +main = do + -- Each case corresponds to the definition of Lexer.x + -- + -- Normal integral literals + -- decimal + print [ 1_000_000 == 1000000, + 1__0 == 10, + 299_792_458 == 299792458, + 8_04_1 == 8041, + 2017_12_31 == 20171231 + ] + + -- binary + print [ 0b01_0000_0000 == 0b0100000000, + 0b1_11_01_0000_0_111 == 0b1110100000111, + 0b1100_1011__1110_1111__0101_0011 == + 0b110010111110111101010011 + ] + + -- octal + print [ 0o1_000_000 == 0o1000000, + 0O1__0 == 0O10 + ] + + -- hexadecimal + print [ 0x1_000_000 == 0x1000000, + 0x1__0 == 0x10, + 0xff_00_00 == 0xff0000, + 0X3fff_ffff == 0x3fffffff + ] + + -- negative decimal + print [ -1_0 == -10 + ] + + -- negative binary + print [ -0b1_0 == -0b10 + ] + + -- negative octal + print [ -0o1_0 == -0o10 + ] + + -- negative hexadecimal + print [ -0x1_0 == -0x10 + ] + + ---- Normal rational literals + -- float + print [ 3.141_592_653_589_793 == 3.141592653589793, + 96_485.332_89 == 96485.33289, + 6.022_140_857e+23 == 6.022140857e+23 + ] + + -- negative float + print [ -1_0.0_1 == -10.01, + -1_0e+2 == -10e+2, + -1_0.0_1e+3 == -10.01e+3 + ] + + -- hexadecimal float + print [ 0xF_F.1F == 0xFF.1F, + 0xF_01p-8 == 0xF01p-8, + 0x0.F_1p4 == 0x0.F1p4 + ] + + -- negative hexadecimal float + print [ -0xF_F.F == -0xFF.F, + -0xF_01p-1 == -0xF01p-1, + -0x0.F_1p1 == -0x0.F1p1 + ] + + -- Additional testcase + -- + -- Validity + print [ 0.000_1 == 0.0001, + 1_0.000_1 == 10.0001, + 1e+23 == 1e+23, + 1_e+23 == 1e+23, + 1__e+23 == 1e+23, + 1.0_e+23 == 1.0e+23, + 1.0_e+2_3 == 1.0e+23, + 1_e23 == 1e23, + 1_e-23 == 1e-23, + 1_0_e23 == 10e23, + 1_0_e-23 == 10e-23, + 0b_01 == 0b01, + 0b__11 == 0b11, + 0x_ff == 0xff, + 0x__ff == 0xff + ] diff --git a/testsuite/tests/parser/should_run/NumericUnderscores0.stdout b/testsuite/tests/parser/should_run/NumericUnderscores0.stdout new file mode 100644 index 0000000000..76f19a8ad9 --- /dev/null +++ b/testsuite/tests/parser/should_run/NumericUnderscores0.stdout @@ -0,0 +1,13 @@ +[True,True,True,True,True] +[True,True,True] +[True,True] +[True,True,True,True] +[True] +[True] +[True] +[True] +[True,True,True] +[True,True,True] +[True,True,True] +[True,True,True] +[True,True,True,True,True,True,True,True,True,True,True,True,True,True,True] diff --git a/testsuite/tests/parser/should_run/NumericUnderscores1.hs b/testsuite/tests/parser/should_run/NumericUnderscores1.hs new file mode 100644 index 0000000000..b9d0dca725 --- /dev/null +++ b/testsuite/tests/parser/should_run/NumericUnderscores1.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE BinaryLiterals #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE NegativeLiterals #-} + +-- Test for NumericUnderscores extension. +-- See Trac #14473 +-- This is a testcase for unboxed literals. + +import GHC.Types + +main :: IO () +main = do + -- Each case corresponds to the definition of Lexer.x + -- + -- Unboxed ints and words + -- decimal int + print [ (I# 1_000_000#) == 1000000, + (I# 299_792_458#) == 299792458 + ] + + -- binary int + print [ (I# 0b01_0000_0000#) == 0b0100000000, + (I# 0b1_11_01_0000_0_111#) == 0b1110100000111 + ] + + -- octal int + print [ (I# 0o1_000_000#) == 0o1000000, + (I# 0O1__0#) == 0O10 + ] + + -- hexadecimal int + print [ (I# 0x1_000_000#) == 0x1000000, + (I# 0X3fff_ffff#) == 0x3fffffff + ] + + -- negative decimal int + print [ (I# -1_000_000#) == -1000000 + ] + + -- negative binary int + print [ (I# -0b01_0000_0000#) == -0b0100000000 + ] + + -- negative octal int + print [ (I# -0o1_000_000#) == -0o1000000 + ] + + -- negative hexadecimal int + print [ (I# -0x1_000_000#) == -0x1000000 + ] + + -- decimal word + print [ (W# 1_000_000##) == 1000000, + (W# 299_792_458##) == 299792458 + ] + + -- binary word + print [ (W# 0b1_0##) == 0b10 + ] + + -- octal word + print [ (W# 0o1_0##) == 0o10 + ] + + -- hexadecimal word + print [ (W# 0x1_0##) == 0x10 + ] + + -- Unboxed floats and doubles + -- float + print [ (F# 3.141_592_653_589_793#) == 3.141592653589793, + (F# 3_14e-2#) == 314e-2, + (F# 96_485.332_89#) == 96485.33289, + (F# 6.022_140_857e+23#) == 6.022140857e+23, + (F# -3.141_592#) == -3.141592, + (F# -3_14e-2#) == -314e-2, + (F# -6.022_140e+23#) == -6.022140e+23 + ] + + -- double + print [ (D# 3_14e-2##) == 314e-2, + (D# 96_485.332_89##) == 96485.33289, + (D# 6.022_140_857e+23##) == 6.022140857e+23, + (D# -3.141_592##) == -3.141592, + (D# -3_14e-2##) == -314e-2, + (D# -6.022_140e+23##) == -6.022140e+23 + ] diff --git a/testsuite/tests/parser/should_run/NumericUnderscores1.stdout b/testsuite/tests/parser/should_run/NumericUnderscores1.stdout new file mode 100644 index 0000000000..bddde5bccb --- /dev/null +++ b/testsuite/tests/parser/should_run/NumericUnderscores1.stdout @@ -0,0 +1,14 @@ +[True,True] +[True,True] +[True,True] +[True,True] +[True] +[True] +[True] +[True] +[True,True] +[True] +[True] +[True] +[True,True,True,True,True,True,True] +[True,True,True,True,True,True] diff --git a/testsuite/tests/parser/should_run/all.T b/testsuite/tests/parser/should_run/all.T index bcf0bc83f3..0c9e65fd14 100644 --- a/testsuite/tests/parser/should_run/all.T +++ b/testsuite/tests/parser/should_run/all.T @@ -12,3 +12,5 @@ test('BinaryLiterals2', [], compile_and_run, ['']) test('T10807', normal, compile_and_run, ['']) test('NegativeZero', normal, compile_and_run, ['']) test('HexFloatLiterals', normal, compile_and_run, ['']) +test('NumericUnderscores0', normal, compile_and_run, ['']) +test('NumericUnderscores1', normal, compile_and_run, ['']) |