Rewrite CallerCC parser using ReadP

This allows us to remove the dependency on parsec and hence transitively
on text.

Also added some simple unit tests for the parser and fixed two small
issues in the documentation.

Fixes #21033

1 files changed, 14 insertions, 11 deletions

diff --git a/compiler/GHC/Core/Opt/CallerCC.hs b/compiler/GHC/Core/Opt/CallerCC.hs
index 8808296126..e8ac5a7cff 100644
--- a/compiler/GHC/Core/Opt/CallerCC.hs
+++ b/compiler/GHC/Core/Opt/CallerCC.hs
@@ -10,19 +10,19 @@
 -- flag.
 module GHC.Core.Opt.CallerCC
     ( addCallerCostCentres
-    , CallerCcFilter
+    , CallerCcFilter(..)
+    , NamePattern(..)
     , parseCallerCcFilter
     ) where
 
-import Data.Bifunctor
 import Data.Word (Word8)
 import Data.Maybe
-import qualified Text.Parsec as P
 
 import Control.Applicative
 import GHC.Utils.Monad.State.Strict
 import Data.Either
 import Control.Monad
+import qualified Text.ParserCombinators.ReadP as P
 
 import GHC.Prelude
 import GHC.Utils.Outputable as Outputable
@@ -42,6 +42,7 @@ import GHC.Core
 import GHC.Core.Opt.Monad
 import GHC.Utils.Panic
 import qualified GHC.Utils.Binary as B
+import Data.Char
 
 addCallerCostCentres :: ModGuts -> CoreM ModGuts
 addCallerCostCentres guts = do
@@ -171,17 +172,17 @@ occNameMatches pat = go pat . occNameString
       = go rest s || go (PWildcard rest) (tail s)
     go _ _  = False
 
-type Parser = P.Parsec String ()
+type Parser = P.ReadP
 
 parseNamePattern :: Parser NamePattern
 parseNamePattern = pattern
   where
-    pattern = star <|> wildcard <|> char <|> end
+    pattern = star P.<++ wildcard P.<++ char P.<++ end
     star = PChar '*' <$ P.string "\\*" <*> pattern
     wildcard = do
       void $ P.char '*'
       PWildcard <$> pattern
-    char = PChar <$> P.anyChar <*> pattern
+    char = PChar <$> P.get <*> pattern
     end = PEnd <$ P.eof
 
 data CallerCcFilter
@@ -200,8 +201,10 @@ instance B.Binary CallerCcFilter where
   put_ bh (CallerCcFilter x y) = B.put_ bh x >> B.put_ bh y
 
 parseCallerCcFilter :: String -> Either String CallerCcFilter
-parseCallerCcFilter =
-    first show . P.parse parseCallerCcFilter' "caller-CC filter"
+parseCallerCcFilter inp =
+    case P.readP_to_S parseCallerCcFilter' inp of
+      ((result, ""):_) -> Right result
+      _ -> Left $ "parse error on " ++ inp
 
 parseCallerCcFilter' :: Parser CallerCcFilter
 parseCallerCcFilter' =
@@ -218,8 +221,8 @@ parseCallerCcFilter' =
 
     moduleName :: Parser String
     moduleName = do
-      c <- P.upper
-      cs <- some $ P.upper <|> P.lower <|> P.digit <|> P.oneOf "_"
-      rest <- optional $ P.try $ P.char '.' >> fmap ('.':) moduleName
+      c <- P.satisfy isUpper
+      cs <- P.munch1 (\c -> isUpper c || isLower c || isDigit c || c == '_')
+      rest <- optional $ P.char '.' >> fmap ('.':) moduleName
       return $ c : (cs ++ fromMaybe "" rest)