From b17fb3d96bd2e9f3bf96392f3b3b3e0aed7fe276 Mon Sep 17 00:00:00 2001
From: sheaf <sam.derbyshire@gmail.com>
Date: Mon, 6 Feb 2023 11:37:57 +0100
Subject: [PATCH] Don't allow . in overloaded labels

This patch removes . from the list of allowed characters in a non-quoted
overloaded label, as it was realised this steals syntax, e.g. (#.).

Users who want this functionality will have to add quotes around the
label, e.g. `#"17.28"`.

Fixes #22821
---
 compiler/GHC/Parser/Lexer.x                                | 3 +--
 docs/users_guide/9.6.1-notes.rst                           | 2 +-
 testsuite/tests/overloadedrecflds/should_run/T11671_run.hs | 7 ++++---
 testsuite/tests/printer/Test22771.hs                       | 7 ++++---
 4 files changed, 10 insertions(+), 9 deletions(-)

diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x
index a5af14a8bae6..407aa9328023 100644
--- a/compiler/GHC/Parser/Lexer.x
+++ b/compiler/GHC/Parser/Lexer.x
@@ -163,7 +163,6 @@ $small     = [$ascsmall $unismall \_]
 
 $uniidchar = \x07 -- Trick Alex into handling Unicode. See Note [Unicode in Alex].
 $idchar    = [$small $large $digit $uniidchar \']
-$labelchar = [$small $large $digit $uniidchar \' \.]
 
 $unigraphic = \x06 -- Trick Alex into handling Unicode. See Note [Unicode in Alex].
 $graphic   = [$small $large $symbol $digit $idchar $special $unigraphic \"\']
@@ -455,7 +454,7 @@ $unigraphic / { isSmartQuote } { smart_quote_error }
 }
 
 <0> {
-  "#" $labelchar+ / { ifExtension OverloadedLabelsBit } { skip_one_varid_src ITlabelvarid }
+  "#" $idchar+ / { ifExtension OverloadedLabelsBit } { skip_one_varid_src ITlabelvarid }
   "#" \" / { ifExtension OverloadedLabelsBit } { lex_quoted_label }
 }
 
diff --git a/docs/users_guide/9.6.1-notes.rst b/docs/users_guide/9.6.1-notes.rst
index 56e0e42faf32..34e772309254 100644
--- a/docs/users_guide/9.6.1-notes.rst
+++ b/docs/users_guide/9.6.1-notes.rst
@@ -84,7 +84,7 @@ Language
   This extends the variety syntax for constructing labels under :extension:`OverloadedLabels`.
   Examples of newly allowed syntax:
   - Leading capital letters: `#Foo` equivalant to `getLabel @"Foo"`
-  - Numeric characters: `#3.14` equivalent to `getLabel @"3.14"`
+  - Numeric characters: `#1728` equivalent to `getLabel @"1728"`
   - Arbitrary strings: `#"Hello, World!"` equivalent to `getLabel @"Hello, World!"`
 
 Compiler
diff --git a/testsuite/tests/overloadedrecflds/should_run/T11671_run.hs b/testsuite/tests/overloadedrecflds/should_run/T11671_run.hs
index 78ebcdca8ec6..19a051d0cb7d 100644
--- a/testsuite/tests/overloadedrecflds/should_run/T11671_run.hs
+++ b/testsuite/tests/overloadedrecflds/should_run/T11671_run.hs
@@ -12,8 +12,9 @@ import GHC.Prim (Addr#)
 instance KnownSymbol symbol => IsLabel symbol String where
   fromLabel = symbolVal (Proxy :: Proxy symbol)
 
-(#) :: String -> Int -> String
+(#), (#.) :: String -> Int -> String
 (#) _ i = show i
+_ #. i = show i
 
 f :: Addr# -> Int -> String
 f _ i = show i
@@ -26,13 +27,13 @@ main = traverse_ putStrLn
   , #type
   , #Foo
   , #3
-  , #199.4
+  , #"199.4"
   , #17a23b
   , #f'a'
   , #'a'
   , #'
   , #''notTHSplice
-  , #...
+  , #"..."
   , #привет
   , #こんにちは
   , #"3"
diff --git a/testsuite/tests/printer/Test22771.hs b/testsuite/tests/printer/Test22771.hs
index b935a511d0a5..c711471fb61b 100644
--- a/testsuite/tests/printer/Test22771.hs
+++ b/testsuite/tests/printer/Test22771.hs
@@ -14,8 +14,9 @@ import GHC.Prim (Addr#)
 instance KnownSymbol symbol => IsLabel symbol String where
   fromLabel = symbolVal (Proxy :: Proxy symbol)
 
-(#) :: String -> Int -> String
+(#), (#.) :: String -> Int -> String
 (#) _ i = show i
+_ #. i = show i
 
 f :: Addr# -> Int -> String
 f _ i = show i
@@ -28,13 +29,13 @@ main = traverse_ putStrLn
   , #type
   , #Foo
   , #3
-  , #199.4
+  , #"199.4"
   , #17a23b
   , #f'a'
   , #'a'
   , #'
   , #''notTHSplice
-  , #...
+  , #"..."
   , #привет
   , #こんにちは
   , #"3"
-- 
GitLab