summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2022-02-02 14:53:34 +0000
committerMatthew Pickering <matthewtpickering@gmail.com>2022-02-03 09:27:04 +0000
commit6477878cedfe9f96b35c81299ffda1d140c025b7 (patch)
treef1832c7ae73fd7e25c90a662cdcf5b48bbde072a /compiler
parent88fba8a4b3c22e953a634b81dd0b67ec66eb5e72 (diff)
downloadhaskell-wip/caller-cc-parser.tar.gz
Rewrite CallerCC parser using ReadPwip/caller-cc-parser
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@,