diff --git a/ghc-parser/generic-src/Language/Haskell/GHC/Parser.hs b/ghc-parser/generic-src/Language/Haskell/GHC/Parser.hs index d58686cf..3a1e660e 100644 --- a/ghc-parser/generic-src/Language/Haskell/GHC/Parser.hs +++ b/ghc-parser/generic-src/Language/Haskell/GHC/Parser.hs @@ -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 diff --git a/ghc-parser/ghc-parser.cabal b/ghc-parser/ghc-parser.cabal index 50f60c85..546b44b5 100644 --- a/ghc-parser/ghc-parser.cabal +++ b/ghc-parser/ghc-parser.cabal @@ -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 diff --git a/ghc-parser/src-9.4/Language/Haskell/GHC/HappyParser.hs b/ghc-parser/src-9.4/Language/Haskell/GHC/HappyParser.hs new file mode 100644 index 00000000..e131e359 --- /dev/null +++ b/ghc-parser/src-9.4/Language/Haskell/GHC/HappyParser.hs @@ -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