[commit: ghc] master: Revert "Fix startsVarSym and refactor operator predicates (fixes #4239)" (b946cf3)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/b946cf3f5d6fd273a79b008472e8cb0ad1432be1/ghc

>---------------------------------------------------------------

commit b946cf3f5d6fd273a79b008472e8cb0ad1432be1
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Thu Sep 1 15:03:46 2016 -0400

    Revert "Fix startsVarSym and refactor operator predicates (fixes #4239)"
    
    This reverts commit 8d35e18d885e60f998a9dddb6db19762fe4c6d92.
    arc butchered the authorship on this.


>---------------------------------------------------------------

b946cf3f5d6fd273a79b008472e8cb0ad1432be1
 compiler/basicTypes/Lexeme.hs                      | 23 ++++++++++++++++++++++
 libraries/ghc-boot-th/GHC/Lexeme.hs                | 23 +++-------------------
 .../template-haskell/Language/Haskell/TH/Ppr.hs    |  8 +++++---
 testsuite/tests/rename/should_compile/T4239.hs     |  1 -
 testsuite/tests/rename/should_compile/T4239.stdout |  2 +-
 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 7012f5a..ef5fa12 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 2ecee61..677c9a6 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 0462a8d..bdd4dd3 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 02e4128..5d4f94f 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 6e55a4e..05536b7 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 076f4f2..ea92d96 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