ghc-parser: update

This commit is contained in:
Vaibhav Sagar 2022-10-09 13:54:33 +11:00
parent 1238f50da6
commit 7ce0286e81
3 changed files with 66 additions and 6 deletions

View File

@ -28,7 +28,12 @@ module Language.Haskell.GHC.Parser (
import Data.List (intercalate, findIndex, isInfixOf)
import Data.Char (isAlphaNum)
#if MIN_VERSION_ghc(9,2,0)
#if MIN_VERSION_ghc(9,4,0)
import GHC.Driver.Config.Parser (initParserOpts)
import GHC.Types.Error (diagnosticMessage, getMessages, MsgEnvelope(..))
import GHC.Utils.Error (formatBulleted)
import GHC.Utils.Outputable (defaultSDocContext)
#elif MIN_VERSION_ghc(9,2,0)
import GHC.Driver.Config (initParserOpts)
import GHC.Parser.Errors.Ppr (pprError)
#endif
@ -155,10 +160,17 @@ runParser flags (Parser parser) str =
parseState = mkPState flags buffer location in
#endif
-- Convert a GHC parser output into our own.
toParseOut $ unP parser parseState
toParseOut (unP parser parseState)
where
toParseOut :: ParseResult a -> ParseOutput a
#if MIN_VERSION_ghc(9,2,0)
#if MIN_VERSION_ghc(9,4,0)
toParseOut (PFailed pstate) =
let realSpan = SrcLoc.psRealSpan $ last_loc pstate
errMsg = printErrorBag (getMessages $ errors pstate)
ln = srcLocLine $ SrcLoc.realSrcSpanStart realSpan
col = srcLocCol $ SrcLoc.realSrcSpanStart realSpan
in Failure errMsg $ Loc ln col
#elif MIN_VERSION_ghc(9,2,0)
toParseOut (PFailed pstate) =
let realSpan = SrcLoc.psRealSpan $ last_loc pstate
errMsg = printErrorBag (errors pstate)
@ -208,7 +220,9 @@ runParser flags (Parser parser) str =
Parsed result
-- Convert the bag of errors into an error string.
#if MIN_VERSION_ghc(9,2,0)
#if MIN_VERSION_ghc(9,4,0)
printErrorBag bag = joinLines . map (show . formatBulleted defaultSDocContext . diagnosticMessage . errMsgDiagnostic) $ bagToList bag
#elif MIN_VERSION_ghc(9,2,0)
printErrorBag bag = joinLines . map (show . pprError) $ bagToList bag
#else
printErrorBag bag = joinLines . map show $ bagToList bag
@ -218,7 +232,11 @@ runParser flags (Parser parser) str =
parsePragmasIntoDynFlags :: DynFlags -> FilePath -> String -> IO (Maybe DynFlags)
parsePragmasIntoDynFlags flags filepath str =
catchErrors $ do
#if MIN_VERSION_ghc(9,4,0)
let opts = snd $ getOptions (initParserOpts flags) (stringToStringBuffer str) filepath
#else
let opts = getOptions flags (stringToStringBuffer str) filepath
#endif
(flags', _, _) <- parseDynamicFilePragma flags opts
return $ Just flags'
where

View File

@ -23,10 +23,10 @@ library
-- other-modules:
-- other-extensions:
build-depends: base >=4.9 && < 5,
ghc >=8.0 && <9.3
ghc >=8.0 && <9.5
if impl(ghc >= 8.0) && impl(ghc < 8.4)
hs-source-dirs: generic-src src-8.0
hs-source-dirs: generic-src src-8.0
if impl(ghc >= 8.4) && impl(ghc < 8.10)
hs-source-dirs: generic-src src-8.4
if impl(ghc >= 8.10) && impl(ghc < 9.0)
@ -35,6 +35,8 @@ library
hs-source-dirs: generic-src src-9.0
if impl(ghc >= 9.2) && impl(ghc < 9.4)
hs-source-dirs: generic-src src-9.2
if impl(ghc >= 9.4) && impl(ghc < 9.6)
hs-source-dirs: generic-src src-9.4
default-language: Haskell2010

View File

@ -0,0 +1,40 @@
module Language.Haskell.GHC.HappyParser
( fullStatement
, fullImport
, fullDeclaration
, fullExpression
, fullTypeSignature
, fullModule
) where
import GHC.Parser
import GHC.Types.SrcLoc
-- compiler/hsSyn
import GHC.Hs
-- compiler/utils
import GHC.Data.OrdList
-- compiler/parser
import GHC.Parser.Lexer
import GHC.Parser.PostProcess (ECP(..), runPV)
fullStatement :: P (Maybe (LStmt GhcPs (LHsExpr GhcPs)))
fullStatement = parseStmt
fullImport :: P (LImportDecl GhcPs)
fullImport = parseImport
fullDeclaration :: P (OrdList (LHsDecl GhcPs))
fullDeclaration = fmap unitOL parseDeclaration
fullExpression :: P (LHsExpr GhcPs)
fullExpression = parseExpression >>= \p -> runPV $ unECP p
fullTypeSignature :: P (Located (OrdList (LHsDecl GhcPs)))
fullTypeSignature = fmap (noLoc . unitOL) parseTypeSignature
fullModule :: P (Located HsModule)
fullModule = parseModule