summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2022-02-02 14:53:34 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-02-03 14:44:53 -0500
commit84ab0153a3527e7bd8b627ca559d782064af3c80 (patch)
treeeb9f6b78e76175ce8d6e5d8c28387b5aa1f00810 /compiler
parentaa5ef3402579da5523ee3d1fef7f26737b8d71fc (diff)
downloadhaskell-84ab0153a3527e7bd8b627ca559d782064af3c80.tar.gz
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
Diffstat (limited to 'compiler')
-rw-r--r--compiler/GHC/Core/Opt/CallerCC.hs25
-rw-r--r--compiler/ghc.cabal.in1
2 files changed, 14 insertions, 12 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)
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index ff90538a0f..0f1abca002 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -74,7 +74,6 @@ Library
hpc == 0.6.*,
transformers == 0.5.*,
exceptions == 0.10.*,
- parsec,
stm,
ghc-boot == @ProjectVersionMunged@,
ghc-heap == @ProjectVersionMunged@,