Float/double unboxed literal support for HexFloatLiterals (fix #22155)

compiler/GHC/Parser/Lexer.x

@@ -565,9 +565,12 @@ $unigraphic / { isSmartQuote } { smart_quote_error }
   -- prim_{float,double} work with signed literals
   @floating_point                  \# / { ifExtension MagicHashBit }        { tok_frac 1 tok_primfloat }
   @floating_point               \# \# / { ifExtension MagicHashBit }        { tok_frac 2 tok_primdouble }
-
   @negative @floating_point        \# / { negHashLitPred MagicHashBit }     { tok_frac 1 tok_primfloat }
   @negative @floating_point     \# \# / { negHashLitPred MagicHashBit }     { tok_frac 2 tok_primdouble }
+  0[xX] @numspc @hex_floating_point \# / { ifExtension MagicHashBit `alexAndPred` ifExtension HexFloatLiteralsBit } { tok_frac 1 tok_prim_hex_float }
+  0[xX] @numspc @hex_floating_point \# \# / { ifExtension MagicHashBit `alexAndPred` ifExtension HexFloatLiteralsBit } { tok_frac 2 tok_prim_hex_double }
+  @negative 0[xX] @numspc @hex_floating_point \# / { ifExtension HexFloatLiteralsBit `alexAndPred` negHashLitPred MagicHashBit } { tok_frac 1 tok_prim_hex_float }
+  @negative 0[xX] @numspc @hex_floating_point \# \# / { ifExtension HexFloatLiteralsBit `alexAndPred` negHashLitPred MagicHashBit } { tok_frac 2 tok_prim_hex_double }
 
   @decimal                  \#"Int8"   / { ifExtension ExtendedLiteralsBit } { tok_primint8 positive 0 decimal }
   @binarylit                \#"Int8"   / { ifExtension ExtendedLiteralsBit `alexAndPred`
@@ -1989,11 +1992,13 @@ tok_frac drop f span buf len _buf2 = do
     addError $ mkPlainErrorMsgEnvelope (mkSrcSpanPs (last_loc pState)) msg
   return (L span $! (f $! src))
 
-tok_float, tok_primfloat, tok_primdouble :: String -> Token
+tok_float, tok_primfloat, tok_primdouble, tok_prim_hex_float, tok_prim_hex_double :: String -> Token
 tok_float        str = ITrational   $! readFractionalLit str
 tok_hex_float    str = ITrational   $! readHexFractionalLit str
 tok_primfloat    str = ITprimfloat  $! readFractionalLit str
 tok_primdouble   str = ITprimdouble $! readFractionalLit str
+tok_prim_hex_float  str = ITprimfloat $! readHexFractionalLit str
+tok_prim_hex_double str = ITprimdouble $! readHexFractionalLit str
 
 readFractionalLit, readHexFractionalLit :: String -> FractionalLit
 readHexFractionalLit = readFractionalLitX readHexSignificandExponentPair Base2

docs/users_guide/9.12.1-notes.rst

@@ -29,6 +29,8 @@ Language
   This means that code using :extension:`UnliftedDatatypes` or
   :extension:`UnliftedNewtypes` can now use :extension:`OverloadedRecordDot`.
 
+- Unboxed Float#/Double# literals now support the HexFloatLiterals extension
+  (`#22155 <https://gitlab.haskell.org/ghc/ghc/-/issues/22155>`_).
 
 Compiler
 ~~~~~~~~

testsuite/tests/parser/should_compile/T22155.hs

+{-# language HexFloatLiterals, MagicHash, NegativeLiterals #-}
+module T22155 where
+
+import GHC.Types
+
+a = D# 0x0.1p12##
+b = D# -0x0.1p12##
+c = F# 0x0.1p12#
+d = F# -0x0.1p12#

testsuite/tests/parser/should_compile/T22155.stderr

+
+==================== Tidy Core ====================
+Result size of Tidy Core
+  = {terms: 12, types: 4, coercions: 0, joins: 0/0}
+
+a = D# 256.0##
+
+b = D# -256.0##
+
+c = F# 256.0#
+
+d = F# -256.0#
+
+
+

testsuite/tests/parser/should_compile/all.T

@@ -199,3 +199,6 @@ test('T19372consym', normal, compile, [''])
 test('ListTuplePunsSuccess1', extra_files(['ListTuplePunsSuccess1.hs']), ghci_script, ['ListTuplePunsSuccess1.script'])
 test('ListTuplePunsFamiliesCompat', expect_broken(23135), compile, [''])
 test('ListTuplePunsFamilies', [expect_broken(23135), extra_files(['ListTuplePunsFamilies.hs'])], ghci_script, ['ListTuplePunsFamilies.script'])
+
+
+test('T22155', normal, compile, ['-dsuppress-uniques -ddump-simpl -dsuppress-all -dno-typeable-binds'])