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, 26 insertions, 32 deletions
diff --git a/compiler/basicTypes/Lexeme.hs b/compiler/basicTypes/Lexeme.hs
index ef5fa12dbd..7012f5afed 100644
--- a/compiler/basicTypes/Lexeme.hs
+++ b/compiler/basicTypes/Lexeme.hs
@@ -205,25 +205,6 @@ 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"
@@ -232,10 +213,6 @@ 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 677c9a65e6..2ecee61ea6 100644
--- a/libraries/ghc-boot-th/GHC/Lexeme.hs
+++ b/libraries/ghc-boot-th/GHC/Lexeme.hs
@@ -11,14 +11,31 @@
module GHC.Lexeme (
-- * Lexical characteristics of Haskell names
startsVarSym, startsVarId, startsConSym, startsConId,
- startsVarSymASCII, isVarSymChar
+ startsVarSymASCII, isVarSymChar, okSymChar
) 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 = startsVarSymASCII c || (ord c > 0x7f && isSymbol c) -- Infix Ids
-startsConSym c = c == ':' -- Infix data constructors
+startsVarSym c = okSymChar c && 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 bdd4dd388a..0462a8da25 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -10,8 +10,9 @@ import Text.PrettyPrint (render)
import Language.Haskell.TH.PprLib
import Language.Haskell.TH.Syntax
import Data.Word ( Word8 )
-import Data.Char ( toLower, chr, ord, isSymbol )
+import Data.Char ( toLower, chr)
import GHC.Show ( showMultiLineString )
+import GHC.Lexeme( startsVarSym )
import Data.Ratio ( numerator, denominator )
nestDepth :: Int
@@ -114,12 +115,9 @@ isSymOcc :: Name -> Bool
isSymOcc n
= case nameBase n of
[] -> True -- Empty name; weird
- (c:_) -> isSymbolASCII c || (ord c > 0x7f && isSymbol c)
+ (c:_) -> startsVarSym 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 5d4f94f857..02e4128382 100644
--- a/testsuite/tests/rename/should_compile/T4239.hs
+++ b/testsuite/tests/rename/should_compile/T4239.hs
@@ -12,3 +12,4 @@ v2 = X
v3 :: (:+++)
v3 = (:---)
+v4 = (·)
diff --git a/testsuite/tests/rename/should_compile/T4239.stdout b/testsuite/tests/rename/should_compile/T4239.stdout
index 05536b7901..6e55a4ea26 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 ea92d9653b..076f4f2773 100644
--- a/testsuite/tests/rename/should_compile/T4239A.hs
+++ b/testsuite/tests/rename/should_compile/T4239A.hs
@@ -8,3 +8,4 @@ data (:+++) = (:+++)
| X
| Y
+(·) = undefined