summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/basicTypes/Lexeme.hs23
-rw-r--r--libraries/ghc-boot-th/GHC/Lexeme.hs23
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Ppr.hs8
-rw-r--r--testsuite/tests/rename/should_compile/T4239.hs1
-rw-r--r--testsuite/tests/rename/should_compile/T4239.stdout2
-rw-r--r--testsuite/tests/rename/should_compile/T4239A.hs1
6 files changed, 32 insertions, 26 deletions
diff --git a/compiler/basicTypes/Lexeme.hs b/compiler/basicTypes/Lexeme.hs
index 7012f5afed..ef5fa12dbd 100644
--- a/compiler/basicTypes/Lexeme.hs
+++ b/compiler/basicTypes/Lexeme.hs
@@ -205,6 +205,25 @@ okIdChar c = case generalCategory c of
OtherNumber -> True -- See #4373
_ -> c == '\'' || c == '_'
+-- | Is this character acceptable in a symbol (after the first char)?
+-- See alexGetByte in Lexer.x
+okSymChar :: Char -> Bool
+okSymChar c
+ | c `elem` specialSymbols
+ = False
+ | c `elem` "_\"'"
+ = False
+ | otherwise
+ = case generalCategory c of
+ ConnectorPunctuation -> True
+ DashPunctuation -> True
+ OtherPunctuation -> True
+ MathSymbol -> True
+ CurrencySymbol -> True
+ ModifierSymbol -> True
+ OtherSymbol -> True
+ _ -> False
+
-- | All reserved identifiers. Taken from section 2.4 of the 2010 Report.
reservedIds :: Set.Set String
reservedIds = Set.fromList [ "case", "class", "data", "default", "deriving"
@@ -213,6 +232,10 @@ reservedIds = Set.fromList [ "case", "class", "data", "default", "deriving"
, "module", "newtype", "of", "then", "type", "where"
, "_" ]
+-- | All punctuation that cannot appear in symbols. See $special in Lexer.x.
+specialSymbols :: [Char]
+specialSymbols = "(),;[]`{}"
+
-- | All reserved operators. Taken from section 2.4 of the 2010 Report.
reservedOps :: Set.Set String
reservedOps = Set.fromList [ "..", ":", "::", "=", "\\", "|", "<-", "->"
diff --git a/libraries/ghc-boot-th/GHC/Lexeme.hs b/libraries/ghc-boot-th/GHC/Lexeme.hs
index 2ecee61ea6..677c9a65e6 100644
--- a/libraries/ghc-boot-th/GHC/Lexeme.hs
+++ b/libraries/ghc-boot-th/GHC/Lexeme.hs
@@ -11,31 +11,14 @@
module GHC.Lexeme (
-- * Lexical characteristics of Haskell names
startsVarSym, startsVarId, startsConSym, startsConId,
- startsVarSymASCII, isVarSymChar, okSymChar
+ startsVarSymASCII, isVarSymChar
) where
import Data.Char
--- | Is this character acceptable in a symbol (after the first char)?
--- See alexGetByte in Lexer.x
-okSymChar :: Char -> Bool
-okSymChar c
- | c `elem` "(),;[]`{}_\"'"
- = False
- | otherwise
- = case generalCategory c of
- ConnectorPunctuation -> True
- DashPunctuation -> True
- OtherPunctuation -> True
- MathSymbol -> True
- CurrencySymbol -> True
- ModifierSymbol -> True
- OtherSymbol -> True
- _ -> False
-
startsVarSym, startsVarId, startsConSym, startsConId :: Char -> Bool
-startsVarSym c = okSymChar c && c /= ':' -- Infix Ids
-startsConSym c = c == ':' -- Infix data constructors
+startsVarSym c = startsVarSymASCII c || (ord c > 0x7f && isSymbol c) -- Infix Ids
+startsConSym c = c == ':' -- Infix data constructors
startsVarId c = c == '_' || case generalCategory c of -- Ordinary Ids
LowercaseLetter -> True
OtherLetter -> True -- See #1103
diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index 0462a8da25..bdd4dd388a 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -10,9 +10,8 @@ import Text.PrettyPrint (render)
import Language.Haskell.TH.PprLib
import Language.Haskell.TH.Syntax
import Data.Word ( Word8 )
-import Data.Char ( toLower, chr)
+import Data.Char ( toLower, chr, ord, isSymbol )
import GHC.Show ( showMultiLineString )
-import GHC.Lexeme( startsVarSym )
import Data.Ratio ( numerator, denominator )
nestDepth :: Int
@@ -115,9 +114,12 @@ isSymOcc :: Name -> Bool
isSymOcc n
= case nameBase n of
[] -> True -- Empty name; weird
- (c:_) -> startsVarSym c
+ (c:_) -> isSymbolASCII c || (ord c > 0x7f && isSymbol c)
-- c.f. OccName.startsVarSym in GHC itself
+isSymbolASCII :: Char -> Bool
+isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
+
pprInfixExp :: Exp -> Doc
pprInfixExp (VarE v) = pprName' Infix v
pprInfixExp (ConE v) = pprName' Infix v
diff --git a/testsuite/tests/rename/should_compile/T4239.hs b/testsuite/tests/rename/should_compile/T4239.hs
index 02e4128382..5d4f94f857 100644
--- a/testsuite/tests/rename/should_compile/T4239.hs
+++ b/testsuite/tests/rename/should_compile/T4239.hs
@@ -12,4 +12,3 @@ v2 = X
v3 :: (:+++)
v3 = (:---)
-v4 = (·)
diff --git a/testsuite/tests/rename/should_compile/T4239.stdout b/testsuite/tests/rename/should_compile/T4239.stdout
index 6e55a4ea26..05536b7901 100644
--- a/testsuite/tests/rename/should_compile/T4239.stdout
+++ b/testsuite/tests/rename/should_compile/T4239.stdout
@@ -1 +1 @@
-import T4239A ( type (:+++)((:---), X, (:+++)), (·) )
+import T4239A ( type (:+++)((:---), X, (:+++)) )
diff --git a/testsuite/tests/rename/should_compile/T4239A.hs b/testsuite/tests/rename/should_compile/T4239A.hs
index 076f4f2773..ea92d9653b 100644
--- a/testsuite/tests/rename/should_compile/T4239A.hs
+++ b/testsuite/tests/rename/should_compile/T4239A.hs
@@ -8,4 +8,3 @@ data (:+++) = (:+++)
| X
| Y
-(·) = undefined