diff options
| -rw-r--r-- | compiler/basicTypes/Lexeme.hs | 23 | ||||
| -rw-r--r-- | libraries/ghc-boot-th/GHC/Lexeme.hs | 23 | ||||
| -rw-r--r-- | libraries/template-haskell/Language/Haskell/TH/Ppr.hs | 8 | ||||
| -rw-r--r-- | testsuite/tests/rename/should_compile/T4239.hs | 1 | ||||
| -rw-r--r-- | testsuite/tests/rename/should_compile/T4239.stdout | 2 | ||||
| -rw-r--r-- | testsuite/tests/rename/should_compile/T4239A.hs | 1 |
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 |