Improve NegativeLiterals (#18022, GHC Proposal #344)wip/negative-literals

Before this patch, NegativeLiterals used to parse x-1 as x (-1).

This may not be what the user expects, and now it is fixed:
x-1 is parsed as (-) x 1.

We achieve this by the following requirement:

  * When lexing a negative literal,
    it must not be preceded by a 'closing token'.

This also applies to unboxed literals, e.g. -1#.

See GHC Proposal #229 for the definition of a closing token.

A nice consequence of this change is that -XNegativeLiterals becomes a
subset of -XLexicalNegation. In other words, enabling both of those
extensions has the same effect as enabling -XLexicalNegation alone.

7 files changed, 149 insertions, 39 deletions

diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x
index 7265e1dffb..7395c53b80 100644
--- a/compiler/GHC/Parser/Lexer.x
+++ b/compiler/GHC/Parser/Lexer.x
@@ -199,7 +199,6 @@ $docsym    = [\| \^ \* \$]
 -- normal signed numerical literals can only be explicitly negative,
 -- not explicitly positive (contrast @exponent)
 @negative = \-
-@signed = @negative ?
 
 
 -- -----------------------------------------------------------------------------
@@ -531,12 +530,12 @@ $tab          { warnTab }
                                            ifExtension BinaryLiteralsBit }   { tok_primint positive 2 3 binary }
   0[oO] @numspc @octal              \# / { ifExtension MagicHashBit }        { tok_primint positive 2 3 octal }
   0[xX] @numspc @hexadecimal        \# / { ifExtension MagicHashBit }        { tok_primint positive 2 3 hexadecimal }
-  @negative @decimal                \# / { ifExtension MagicHashBit }        { tok_primint negative 1 2 decimal }
-  @negative 0[bB] @numspc @binary   \# / { ifExtension MagicHashBit `alexAndPred`
+  @negative @decimal                \# / { negHashLitPred }                  { tok_primint negative 1 2 decimal }
+  @negative 0[bB] @numspc @binary   \# / { negHashLitPred `alexAndPred`
                                            ifExtension BinaryLiteralsBit }   { tok_primint negative 3 4 binary }
-  @negative 0[oO] @numspc @octal    \# / { ifExtension MagicHashBit }        { tok_primint negative 3 4 octal }
+  @negative 0[oO] @numspc @octal    \# / { negHashLitPred }                  { tok_primint negative 3 4 octal }
   @negative 0[xX] @numspc @hexadecimal \#
-                                       / { ifExtension MagicHashBit }        { tok_primint negative 3 4 hexadecimal }
+                                       / { negHashLitPred }                  { tok_primint negative 3 4 hexadecimal }
 
   @decimal                       \# \# / { ifExtension MagicHashBit }        { tok_primword 0 2 decimal }
   0[bB] @numspc @binary          \# \# / { ifExtension MagicHashBit `alexAndPred`
@@ -546,8 +545,11 @@ $tab          { warnTab }
 
   -- Unboxed floats and doubles (:: Float#, :: Double#)
   -- prim_{float,double} work with signed literals
-  @signed @floating_point           \# / { ifExtension MagicHashBit }        { tok_frac 1 tok_primfloat }
-  @signed @floating_point        \# \# / { ifExtension MagicHashBit }        { tok_frac 2 tok_primdouble }
+  @floating_point                  \# / { ifExtension MagicHashBit }        { tok_frac 1 tok_primfloat }
+  @floating_point               \# \# / { ifExtension MagicHashBit }        { tok_frac 2 tok_primdouble }
+
+  @negative @floating_point        \# / { negHashLitPred }                  { tok_frac 1 tok_primfloat }
+  @negative @floating_point     \# \# / { negHashLitPred }                  { tok_frac 2 tok_primdouble }
 }
 
 -- Strings and chars are lexed by hand-written code.  The reason is
@@ -1192,8 +1194,8 @@ atEOL _ _ _ (AI _ buf) = atEnd buf || currentChar buf == '\n'
 -- Check if we should parse a negative literal (e.g. -123) as a single token.
 negLitPred :: AlexAccPred ExtsBitmap
 negLitPred =
-    negative_literals `alexOrPred`
-    (lexical_negation `alexAndPred` prefix_minus)
+    prefix_minus `alexAndPred`
+    (negative_literals `alexOrPred` lexical_negation)
   where
     negative_literals = ifExtension NegativeLiteralsBit
 
@@ -1202,14 +1204,33 @@ negLitPred =
       alexNotPred (ifExtension NoLexicalNegationBit)
 
     prefix_minus =
-      -- The condition for a prefix occurrence of an operator is:
-      --
-      --   not precededByClosingToken && followedByOpeningToken
-      --
-      -- but we don't check followedByOpeningToken here as it holds
-      -- simply because we immediately lex a literal after the minus.
+      -- Note [prefix_minus in negLitPred and negHashLitPred]
+      alexNotPred precededByClosingToken
+
+-- Check if we should parse an unboxed negative literal (e.g. -123#) as a single token.
+negHashLitPred :: AlexAccPred ExtsBitmap
+negHashLitPred = prefix_minus `alexAndPred` magic_hash
+  where
+    magic_hash = ifExtension MagicHashBit
+    prefix_minus =
+      -- Note [prefix_minus in negLitPred and negHashLitPred]
       alexNotPred precededByClosingToken
 
+{- Note [prefix_minus in negLitPred and negHashLitPred]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We want to parse -1 as a single token, but x-1 as three tokens.
+So in negLitPred (and negHashLitPred) we require that we have a prefix
+occurrence of the minus sign. See Note [Whitespace-sensitive operator parsing]
+for a detailed definition of a prefix occurrence.
+
+The condition for a prefix occurrence of an operator is:
+
+  not precededByClosingToken && followedByOpeningToken
+
+but we don't check followedByOpeningToken when parsing a negative literal.
+It holds simply because we immediately lex a literal after the minus.
+-}
+
 ifExtension :: ExtBits -> AlexAccPred ExtsBitmap
 ifExtension extBits bits _ _ _ = extBits `xtest` bits
 
diff --git a/docs/users_guide/8.12.1-notes.rst b/docs/users_guide/8.12.1-notes.rst
index dd429c22d4..ea198f5167 100644
--- a/docs/users_guide/8.12.1-notes.rst
+++ b/docs/users_guide/8.12.1-notes.rst
@@ -224,6 +224,13 @@ Language
     f = (- x)  -- operator section
     c = (-x)   -- negation
 
+* The behavior of :extension:`NegativeLiterals` changed, and now we require
+  that a negative literal must not be preceded by a closing token (see
+  `GHC Proposal #229 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0229-whitespace-bang-patterns.rst>`__
+  for the definition of a closing token). In other words, we parse ``f -123``
+  as ``f (-123)``, but ``x-123`` as ``(-) x 123``. Before this amendment,
+  :extension:`NegativeLiterals` caused ``x-123`` to be parsed as ``x(-123)``.
+
 Compiler
 ~~~~~~~~
 
diff --git a/docs/users_guide/exts/negative_literals.rst b/docs/users_guide/exts/negative_literals.rst
index 237fabf044..c2dbc1eff4 100644
--- a/docs/users_guide/exts/negative_literals.rst
+++ b/docs/users_guide/exts/negative_literals.rst
@@ -24,9 +24,11 @@ will elicit an unexpected integer-literal-overflow message.
 Whitespace can be inserted, as in ``- 123``, to force interpretation
 as two tokens.
 
-One pitfall is that with :extension:`NegativeLiterals`, ``x-1`` will
-be parsed as ``x`` applied to the argument ``-1``, which is usually
-not what you want.  ``x - 1`` or even ``x- 1`` can be used instead
-for subtraction. To avoid this, consider using :extension:`LexicalNegation`
-instead.
-
+In 8.12, the behavior of this extension changed, and now we require that a negative literal must not be preceded by a closing token (see
+`GHC Proposal #229 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0229-whitespace-bang-patterns.rst>`__
+for the definition of a closing token). In other words, we parse ``f -123`` as ``f (-123)``, but ``x-123`` as ``(-) x
+123``. Before this amendment, :extension:`NegativeLiterals` caused ``x-123`` to be parsed as ``x(-123)``.
+
+:extension:`NegativeLiterals` is a subset of :extension:`LexicalNegation`. That
+is, enabling both of those extensions has the same effect as enabling
+:extension:`LexicalNegation` alone.
diff --git a/testsuite/tests/parser/should_compile/LexNegVsNegLit.hs b/testsuite/tests/parser/should_compile/LexNegVsNegLit.hs
deleted file mode 100644
index 665893e95b..0000000000
--- a/testsuite/tests/parser/should_compile/LexNegVsNegLit.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-{-# LANGUAGE NegativeLiterals, LexicalNegation #-}
-
-module LexNegVsNegLit where
-
--- NegativeLiterals specifies that we parse x-1 as x (-1), even though it's
--- considered a shortcoming.
---
--- LexicalNegation does not change that.
---
-b :: Bool
-b = even-1  -- parsed as: even (-1)
-            -- so it is well-typed.
-            --
-            -- with LexicalNegation alone, we'd get (-) even 1,
-            -- but NegativeLiterals takes precedence here.
-
--- See also: GHC Proposal #344
diff --git a/testsuite/tests/parser/should_compile/NegativeLiterals.hs b/testsuite/tests/parser/should_compile/NegativeLiterals.hs
new file mode 100644
index 0000000000..62d14ab678
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/NegativeLiterals.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE NegativeLiterals, MagicHash, BinaryLiterals #-}
+
+module NegativeLiterals where
+
+import GHC.Exts
+
+------------------------------------
+-- Prefix occurrence of the minus --
+------------------------------------
+
+p1 :: Bool
+p1 = even -2     -- parsed as:  even (-2)
+
+p2 :: Int
+p2 = I# -1#      -- parsed as:  I# (-1#)
+
+p3 :: Int
+p3 = floor -2.4  -- parsed as:  floor (-2.4)
+
+p4 :: Float
+p4 = F# -0.01#   -- parsed as:  F# (-0.01#)
+
+p5 :: Double
+p5 = D# -0.01##  -- parsed as:  D# (-0.01##)
+
+p6 :: Bool
+p6 =   even -0b10  -- parsed as: even (-2)
+    || even -0o10  -- parsed as: even (-8)
+    || even -0x10  -- parsed as: even (-16)
+
+-----------------------------------------
+-- Tight infix occurrence of the minus --
+-----------------------------------------
+
+ti1 :: Integer -> Integer
+ti1 x = x-2       -- parsed as:  (-) x 1
+
+ti2 :: Int# -> Int#
+ti2 x = x-1#      -- parsed as:  (-) x 1#
+  where (-) = (-#)
+
+ti3 :: Double -> Double
+ti3 x = x-2.4     -- parsed as:  (-) x 2.4
+
+ti4 :: Float# -> Float#
+ti4 x = x-0.1#    -- parsed as:  (-) x 0.1#
+  where (-) = minusFloat#
+
+ti5 :: Double# -> Double#
+ti5 x = x-0.1##   -- parsed as:  (-) x 0.1##
+  where (-) = (-##)
+
+ti6 :: Integer -> [Integer]
+ti6 x =
+  [ x-0b10,    -- parsed as: (-) x 2
+    x-0o10,    -- parsed as: (-) x 8
+    x-0x10  ]  -- parsed as: (-) x 16
diff --git a/testsuite/tests/parser/should_compile/NegativeLiteralsNoExt.hs b/testsuite/tests/parser/should_compile/NegativeLiteralsNoExt.hs
new file mode 100644
index 0000000000..9c23514d7d
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/NegativeLiteralsNoExt.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE NoNegativeLiterals, MagicHash, BinaryLiterals #-}
+
+-- Even when NegativeLiterals are disabled,
+-- we parse unboxed literals appropriately.
+module NegativeLiteralsNoExt where
+
+import GHC.Exts
+
+------------------------------------
+-- Prefix occurrence of the minus --
+------------------------------------
+
+p2 :: Int
+p2 = I# -1#      -- parsed as:  I# (-1#)
+
+p4 :: Float
+p4 = F# -0.01#   -- parsed as:  F# (-0.01#)
+
+p5 :: Double
+p5 = D# -0.01##  -- parsed as:  D# (-0.01##)
+
+-----------------------------------------
+-- Tight infix occurrence of the minus --
+-----------------------------------------
+
+ti2 :: Int# -> Int#
+ti2 x = x-1#      -- parsed as:  (-) x 1#
+  where (-) = (-#)
+
+ti3 :: Double -> Double
+ti3 x = x-2.4     -- parsed as:  (-) x 2.4
+
+ti4 :: Float# -> Float#
+ti4 x = x-0.1#    -- parsed as:  (-) x 0.1#
+  where (-) = minusFloat#
+
+ti5 :: Double# -> Double#
+ti5 x = x-0.1##   -- parsed as:  (-) x 0.1##
+  where (-) = (-##)
diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T
index fb2bd6b587..48e1136daa 100644
--- a/testsuite/tests/parser/should_compile/all.T
+++ b/testsuite/tests/parser/should_compile/all.T
@@ -153,7 +153,8 @@ test('proposal-229b', normal, compile, [''])
 test('proposal-229d', normal, compile, [''])
 test('proposal-229e', normal, compile, [''])
 test('LexicalNegation', normal, compile, [''])
-test('LexNegVsNegLit', normal, compile, [''])
+test('NegativeLiterals', normal, compile, [''])
+test('NegativeLiteralsNoExt', normal, compile, [''])
 
 # We omit 'profasm' because it fails with:
 # Cannot load -prof objects when GHC is built with -dynamic