[Git][ghc/ghc][wip/lexical-negation] Implement -XLexicalNegation (GHC Proposal #229)
Vladislav Zavialov
gitlab at gitlab.haskell.org
Fri Jun 19 15:28:30 UTC 2020
Vladislav Zavialov pushed to branch wip/lexical-negation at Glasgow Haskell Compiler / GHC
Commits:
98a8a3b4 by Vladislav Zavialov at 2020-06-19T18:27:43+03:00
Implement -XLexicalNegation (GHC Proposal #229)
This patch introduces a new extension, -XLexicalNegation, which detects
whether the minus sign stands for negation or subtraction using the
whitespace-based rules described in GHC Proposal #229.
- - - - -
14 changed files:
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Lexer.x
- docs/users_guide/8.12.1-notes.rst
- + docs/users_guide/exts/lexical_negation.rst
- docs/users_guide/exts/syntax.rst
- libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
- testsuite/tests/driver/T4437.hs
- + testsuite/tests/parser/should_compile/LexicalNegation.hs
- testsuite/tests/parser/should_compile/all.T
- + testsuite/tests/parser/should_run/LexNegVsNegLit.hs
- + testsuite/tests/parser/should_run/LexNegVsNegLit.stdout
- testsuite/tests/parser/should_run/all.T
- utils/haddock
Changes:
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -3794,6 +3794,7 @@ xFlagsDeps = [
flagSpec "JavaScriptFFI" LangExt.JavaScriptFFI,
flagSpec "KindSignatures" LangExt.KindSignatures,
flagSpec "LambdaCase" LangExt.LambdaCase,
+ flagSpec "LexicalNegation" LangExt.LexicalNegation,
flagSpec "LiberalTypeSynonyms" LangExt.LiberalTypeSynonyms,
flagSpec "LinearTypes" LangExt.LinearTypes,
flagSpec "MagicHash" LangExt.MagicHash,
=====================================
compiler/GHC/Parser.y
=====================================
@@ -93,7 +93,7 @@ import GHC.Builtin.Types ( unitTyCon, unitDataCon, tupleTyCon, tupleDataCon, nil
manyDataConTyCon)
}
-%expect 232 -- shift/reduce conflicts
+%expect 234 -- shift/reduce conflicts
{- Last updated: 04 June 2018
@@ -547,6 +547,7 @@ are the most common patterns, rewritten as regular expressions for clarity:
'-' { L _ ITminus }
PREFIX_TILDE { L _ ITtilde }
PREFIX_BANG { L _ ITbang }
+ PREFIX_MINUS { L _ ITprefixminus }
'*' { L _ (ITstar _) }
'-<' { L _ (ITlarrowtail _) } -- for arrow notation
'>-' { L _ (ITrarrowtail _) } -- for arrow notation
@@ -692,10 +693,21 @@ litpkgname_segment :: { Located FastString }
| CONID { sL1 $1 $ getCONID $1 }
| special_id { $1 }
+-- Parse a minus sign regardless of whether -XLexicalNegation is turned on or off.
+-- See Note [Minus tokens] in GHC.Parser.Lexer
+HYPHEN :: { [AddAnn] }
+ : '-' { [mj AnnMinus $1 ] }
+ | PREFIX_MINUS { [mj AnnMinus $1 ] }
+ | VARSYM {% if (getVARSYM $1 == fsLit "-")
+ then return [mj AnnMinus $1]
+ else do { addError (getLoc $1) $ text "Expected a hyphen"
+ ; return [] } }
+
+
litpkgname :: { Located FastString }
: litpkgname_segment { $1 }
-- a bit of a hack, means p - b is parsed same as p-b, enough for now.
- | litpkgname_segment '-' litpkgname { sLL $1 $> $ appendFS (unLoc $1) (consFS '-' (unLoc $3)) }
+ | litpkgname_segment HYPHEN litpkgname { sLL $1 $> $ appendFS (unLoc $1) (consFS '-' (unLoc $3)) }
mayberns :: { Maybe [LRenaming] }
: {- empty -} { Nothing }
@@ -2727,12 +2739,12 @@ prag_e :: { Located ([AddAnn], HsPragE GhcPs) }
HsPragSCC noExtField
(getSCC_PRAGs $1)
(StringLiteral NoSourceText (getVARID $2))) }
- | '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
+ | '{-# GENERATED' STRING INTEGER ':' INTEGER HYPHEN INTEGER ':' INTEGER '#-}'
{ let getINT = fromInteger . il_value . getINTEGER in
sLL $1 $> $ ([mo $1,mj AnnVal $2
,mj AnnVal $3,mj AnnColon $4
- ,mj AnnVal $5,mj AnnMinus $6
- ,mj AnnVal $7,mj AnnColon $8
+ ,mj AnnVal $5] ++ $6 ++
+ [mj AnnVal $7,mj AnnColon $8
,mj AnnVal $9,mc $10],
HsPragTick noExtField
(getGENERATED_PRAGs $1)
@@ -2778,6 +2790,9 @@ aexp :: { ECP }
| PREFIX_BANG aexp { ECP $
runECP_PV $2 >>= \ $2 ->
amms (mkHsBangPatPV (comb2 $1 $>) $2) [mj AnnBang $1] }
+ | PREFIX_MINUS aexp { ECP $
+ runECP_PV $2 >>= \ $2 ->
+ amms (mkHsNegAppPV (comb2 $1 $>) $2) [mj AnnMinus $1] }
| '\\' apat apats '->' exp
{ ECP $
=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -764,7 +764,8 @@ data Token
| ITrarrow IsUnicodeSyntax
| ITlolly IsUnicodeSyntax
| ITdarrow IsUnicodeSyntax
- | ITminus
+ | ITminus -- See Note [Minus tokens]
+ | ITprefixminus -- See Note [Minus tokens]
| ITbang -- Prefix (!) only, e.g. f !x = rhs
| ITtilde -- Prefix (~) only, e.g. f ~x = rhs
| ITat -- Tight infix (@) only, e.g. f x at pat = rhs
@@ -864,6 +865,38 @@ instance Outputable Token where
ppr x = text (show x)
+{- Note [Minus tokens]
+~~~~~~~~~~~~~~~~~~~~~~
+A minus sign can be used in prefix form (-x) and infix form (a - b).
+
+When LexicalNegation is on:
+ * ITprefixminus represents the prefix form
+ * ITvarsym "-" represents the infix form
+ * ITminus is not used
+
+When LexicalNegation is off:
+ * ITminus represents all forms
+ * ITprefixminus is not used
+ * ITvarsym "-" is not used
+-}
+
+{- Note [Why not LexicalNegationBit]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+One might wonder why we define NoLexicalNegationBit instead of
+LexicalNegationBit. The problem lies in the following line in reservedSymsFM:
+
+ ,("-", ITminus, NormalSyntax, xbit NoLexicalNegationBit)
+
+We want to generate ITminus only when LexicalNegation is off. How would one
+do it if we had LexicalNegationBit? I (int-index) tried to use bitwise
+complement:
+
+ ,("-", ITminus, NormalSyntax, complement (xbit LexicalNegationBit))
+
+This did not work, so I opted for NoLexicalNegationBit instead.
+-}
+
+
-- the bitmap provided as the third component indicates whether the
-- corresponding extension keyword is valid under the extension options
-- provided to the compiler; if the extension corresponding to *any* of the
@@ -967,7 +1000,7 @@ reservedSymsFM = listToUFM $
,("<-", ITlarrow NormalSyntax, NormalSyntax, 0 )
,("->", ITrarrow NormalSyntax, NormalSyntax, 0 )
,("=>", ITdarrow NormalSyntax, NormalSyntax, 0 )
- ,("-", ITminus, NormalSyntax, 0 )
+ ,("-", ITminus, NormalSyntax, xbit NoLexicalNegationBit)
,("*", ITstar NormalSyntax, NormalSyntax, xbit StarIsTypeBit)
@@ -1464,6 +1497,9 @@ varsym_prefix = sym $ \exts s ->
-> return ITdollar
| ThQuotesBit `xtest` exts, s == fsLit "$$"
-> return ITdollardollar
+ | s == fsLit "-" -- Only when LexicalNegation is on, otherwise we get ITminus and
+ -- don't hit this code path. See Note [Minus tokens]
+ -> return ITprefixminus
| s == fsLit "!" -> return ITbang
| s == fsLit "~" -> return ITtilde
| otherwise -> return (ITvarsym s)
@@ -2480,6 +2516,7 @@ data ExtBits
| GadtSyntaxBit
| ImportQualifiedPostBit
| LinearTypesBit
+ | NoLexicalNegationBit -- See Note [Why not LexicalNegationBit]
-- Flags that are updated once parsing starts
| InRulePragBit
@@ -2567,12 +2604,14 @@ mkParserFlags' warningFlags extensionFlags homeUnitId
.|. GadtSyntaxBit `xoptBit` LangExt.GADTSyntax
.|. ImportQualifiedPostBit `xoptBit` LangExt.ImportQualifiedPost
.|. LinearTypesBit `xoptBit` LangExt.LinearTypes
+ .|. NoLexicalNegationBit `xoptNotBit` LangExt.LexicalNegation -- See Note [Why not LexicalNegationBit]
optBits =
HaddockBit `setBitIf` isHaddock
.|. RawTokenStreamBit `setBitIf` rawTokStream
.|. UsePosPragsBit `setBitIf` usePosPrags
xoptBit bit ext = bit `setBitIf` EnumSet.member ext extensionFlags
+ xoptNotBit bit ext = bit `setBitIf` not (EnumSet.member ext extensionFlags)
setBitIf :: ExtBits -> Bool -> ExtsBitmap
b `setBitIf` cond | cond = xbit b
=====================================
docs/users_guide/8.12.1-notes.rst
=====================================
@@ -145,6 +145,16 @@ Language
data U a where
MkU :: (Show a => U a)
+* :extension:`LexicalNegation` is a new extension that detects whether the
+ minus sign stands for negation during lexical analysis by checking for the
+ surrounding whitespace: ::
+
+ a = x - y -- subtraction
+ b = f -x -- negation
+
+ f = (- x) -- operator section
+ c = (-x) -- negation
+
Compiler
~~~~~~~~
=====================================
docs/users_guide/exts/lexical_negation.rst
=====================================
@@ -0,0 +1,50 @@
+.. _lexical-negation:
+
+Lexical negation
+----------------
+
+.. extension:: LexicalNegation
+ :shortdesc: Use whitespace to determine whether the minus sign stands for
+ negation or subtraction.
+
+ :since: 8.12.1
+
+ Detect if the minus sign stands for negation during lexical analysis by
+ checking for the surrounding whitespace.
+
+In Haskell 2010, the minus sign stands for negation when it has no left-hand
+side. Consider ``x = - 5`` and ``y = 2 - 5``. In ``x``, there's no expression
+between the ``=`` and ``-``, so the minus stands for negation, whereas in
+``y``, there's ``2`` to the left of the minus, therefore it stands for
+subtraction.
+
+This leads to certain syntactic anomalies:
+
+* ``(% x)`` is an operator section for any operator ``(%)`` except for ``(-)``.
+ ``(- x)`` is negated ``x`` rather than the right operator section of
+ subtraction. Consequently, it is impossible to write such a section, and
+ users are advised to write ``(subtract x)`` instead.
+
+* Negative numbers must be parenthesized when they appear in function argument
+ position. ``f (-5)`` is correct, whereas ``f -5`` is parsed as ``(-) f 5``.
+
+The latter issue is partly mitigated by :extension:`NegativeLiterals`. When it
+is enabled, ``-5`` is parsed as negative 5 regardless of context, so ``f
+-5`` works as expected. However, it only applies to literals, so ``f -x`` or
+``f -(a*2)`` are still parsed as subtraction.
+
+With :extension:`LexicalNegation`, both anomalies are resolved:
+
+* ``(% x)`` is an operator section for any operator ``(%)``, no exceptions, as
+ long as there's whitespace between ``%`` and ``x``.
+
+* ``-x`` is never subtraction; it's a negation of ``x`` for any syntactically
+ atomic expression ``x`` (variable, literal, or parenthesized expression),
+ therefore ``f -x`` is parsed as ``f (-x)``.
+
+This means that ``(- x)`` is the right operator section of subtraction, whereas
+``(-x)`` is the negation of ``x``.
+
+When both :extension:`NegativeLiterals` and :extension:`LexicalNegation` are
+enabled, :extension:`NegativeLiterals` takes precedence: ``-123`` is desugared
+as ``fromInteger (-123)``, whereas ``-x`` is desugared as ``negate x``.
=====================================
docs/users_guide/exts/syntax.rst
=====================================
@@ -24,3 +24,4 @@ Syntax
block_arguments
typed_holes
arrows
+ lexical_negation
=====================================
libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
=====================================
@@ -145,6 +145,7 @@ data Extension
| ImportQualifiedPost
| CUSKs
| StandaloneKindSignatures
+ | LexicalNegation
deriving (Eq, Enum, Show, Generic, Bounded)
-- 'Ord' and 'Bounded' are provided for GHC API users (see discussions
-- in https://gitlab.haskell.org/ghc/ghc/merge_requests/2707 and
=====================================
testsuite/tests/driver/T4437.hs
=====================================
@@ -41,6 +41,7 @@ expectedGhcOnlyExtensions =
, "AlternativeLayoutRule"
, "AlternativeLayoutRuleTransitional"
, "LinearTypes"
+ , "LexicalNegation"
]
expectedCabalOnlyExtensions :: [String]
=====================================
testsuite/tests/parser/should_compile/LexicalNegation.hs
=====================================
@@ -0,0 +1,15 @@
+{-# LANGUAGE LexicalNegation #-}
+
+module LexicalNegation where
+
+x :: Int
+x = 42
+
+negx :: Int
+negx = f -x where f = (- 5)
+
+subx :: Int -> Int
+subx = (- x)
+
+assertion1 :: Bool
+assertion1 = (- x) -x == x
=====================================
testsuite/tests/parser/should_compile/all.T
=====================================
@@ -152,6 +152,7 @@ test('proposal-229a', normal, compile, [''])
test('proposal-229b', normal, compile, [''])
test('proposal-229d', normal, compile, [''])
test('proposal-229e', normal, compile, [''])
+test('LexicalNegation', normal, compile, [''])
# We omit 'profasm' because it fails with:
# Cannot load -prof objects when GHC is built with -dynamic
=====================================
testsuite/tests/parser/should_run/LexNegVsNegLit.hs
=====================================
@@ -0,0 +1,17 @@
+{-# LANGUAGE LexicalNegation, NegativeLiterals #-}
+
+-- LexicalNegation vs NegativeLiterals
+
+data FreeNum
+ = FromInteger Integer
+ | Negate FreeNum
+ deriving (Show)
+
+instance Num FreeNum where
+ fromInteger = FromInteger
+ negate = Negate
+
+main = do
+ let x = 5
+ print (-123 :: FreeNum)
+ print (-x :: FreeNum)
=====================================
testsuite/tests/parser/should_run/LexNegVsNegLit.stdout
=====================================
@@ -0,0 +1,2 @@
+FromInteger (-123)
+Negate (FromInteger 5)
=====================================
testsuite/tests/parser/should_run/all.T
=====================================
@@ -18,3 +18,4 @@ test('CountParserDeps',
[ only_ways(['normal']), extra_run_opts('"' + config.libdir + '"') ],
compile_and_run,
['-package ghc'])
+test('LexNegVsNegLit', normal, compile_and_run, [''])
=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit 02a1def8d147da88a0433726590f8586f486c760
+Subproject commit 5d726ee45374bdb95ae23e84b9b3b44d83b0dd73
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/98a8a3b41bc4e50293e95b33aaeb9a6a46af78b4
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/98a8a3b41bc4e50293e95b33aaeb9a6a46af78b4
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200619/102f1e78/attachment-0001.html>
More information about the ghc-commits
mailing list