-- Copyright (c) 2020-2023, Shayne Fletcher. All rights reserved.
-- SPDX-License-Identifier: BSD-3-Clause.


#include "ghclib_api.h"
module Language.Haskell.GhclibParserEx.GHC.Parser(
    parseFile
  , parseModule
  , parseSignature
  , parseImport
  , parseStatement
  , parseBackpack
  , parseDeclaration
  , parseExpression
  , parsePattern
  , parseTypeSignature
  , parseStmt
  , parseIdentifier
  , parseType
  , parseHeader
  , parse
  )
  where

#if defined (GHC_8_8)
import HsSyn
import DynFlags
import StringBuffer
import Lexer
import qualified Parser
import FastString
import SrcLoc
import BkpSyn
import PackageConfig
import RdrName
#elif defined (GHC_8_10)
import GHC.Hs
import DynFlags
import StringBuffer
import Lexer
import qualified Parser
import FastString
import SrcLoc
import BkpSyn
import PackageConfig
import RdrName
import RdrHsSyn
#elif defined (GHC_9_0)
import GHC.Hs
import GHC.Parser.PostProcess
import GHC.Driver.Session
import GHC.Data.StringBuffer
import GHC.Parser.Lexer
import qualified GHC.Parser.Lexer as Lexer
import qualified GHC.Parser as Parser
import GHC.Data.FastString
import GHC.Types.SrcLoc
import GHC.Driver.Backpack.Syntax
import GHC.Unit.Info
import GHC.Types.Name.Reader
#elif defined (GHC_9_2)
import GHC.Hs
import GHC.Driver.Config
import GHC.Parser.PostProcess
import GHC.Driver.Session
import GHC.Data.StringBuffer
import GHC.Parser.Lexer
import qualified GHC.Parser.Lexer as Lexer
import qualified GHC.Parser as Parser
import GHC.Data.FastString
import GHC.Types.SrcLoc
import GHC.Driver.Backpack.Syntax
import GHC.Unit.Info
import GHC.Types.Name.Reader
#else
import GHC.Hs
import GHC.Driver.Config.Parser
import GHC.Parser.PostProcess
import GHC.Driver.Session
import GHC.Data.StringBuffer
import GHC.Parser.Lexer
import qualified GHC.Parser.Lexer as Lexer
import qualified GHC.Parser as Parser
import GHC.Data.FastString
import GHC.Types.SrcLoc
import GHC.Driver.Backpack.Syntax
import GHC.Unit.Info
import GHC.Types.Name.Reader
#endif

parse :: P a -> String -> DynFlags -> ParseResult a
parse :: forall a. P a -> String -> DynFlags -> ParseResult a
parse P a
p String
str DynFlags
flags =
  P a -> PState -> ParseResult a
forall a. P a -> PState -> ParseResult a
Lexer.unP P a
p PState
parseState
  where
    location :: RealSrcLoc
location = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (String -> FastString
mkFastString String
"<string>") Int
1 Int
1
    buffer :: StringBuffer
buffer = String -> StringBuffer
stringToStringBuffer String
str
    parseState :: PState
parseState =
#if ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )
      ParserOpts -> StringBuffer -> RealSrcLoc -> PState
initParserState (DynFlags -> ParserOpts
initParserOpts DynFlags
flags) StringBuffer
buffer RealSrcLoc
location
#else
      mkPState flags buffer location
#endif
#if defined (GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0)
parseModule :: String -> DynFlags -> ParseResult (Located HsModule)
#else
parseModule :: String -> DynFlags -> ParseResult (Located (HsModule GhcPs))
#endif
parseModule :: String -> DynFlags -> ParseResult (Located (HsModule GhcPs))
parseModule = P (Located (HsModule GhcPs))
-> String -> DynFlags -> ParseResult (Located (HsModule GhcPs))
forall a. P a -> String -> DynFlags -> ParseResult a
parse P (Located (HsModule GhcPs))
Parser.parseModule

#if defined (GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0)
parseSignature :: String -> DynFlags -> ParseResult (Located HsModule)
#else
parseSignature :: String -> DynFlags -> ParseResult (Located (HsModule GhcPs))
#endif
parseSignature :: String -> DynFlags -> ParseResult (Located (HsModule GhcPs))
parseSignature = P (Located (HsModule GhcPs))
-> String -> DynFlags -> ParseResult (Located (HsModule GhcPs))
forall a. P a -> String -> DynFlags -> ParseResult a
parse P (Located (HsModule GhcPs))
Parser.parseSignature

parseImport :: String -> DynFlags -> ParseResult (LImportDecl GhcPs)
parseImport :: String -> DynFlags -> ParseResult (LImportDecl GhcPs)
parseImport = P (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> String
-> DynFlags
-> ParseResult (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a. P a -> String -> DynFlags -> ParseResult a
parse P (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
Parser.parseImport

parseStatement :: String -> DynFlags -> ParseResult (LStmt GhcPs (LHsExpr GhcPs))
parseStatement :: String -> DynFlags -> ParseResult (LStmt GhcPs (LHsExpr GhcPs))
parseStatement = P (GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> String
-> DynFlags
-> ParseResult
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. P a -> String -> DynFlags -> ParseResult a
parse P (GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
Parser.parseStatement

parseBackpack :: String -> DynFlags -> ParseResult [LHsUnit PackageName]
parseBackpack :: String -> DynFlags -> ParseResult [LHsUnit PackageName]
parseBackpack = P [LHsUnit PackageName]
-> String -> DynFlags -> ParseResult [LHsUnit PackageName]
forall a. P a -> String -> DynFlags -> ParseResult a
parse P [LHsUnit PackageName]
Parser.parseBackpack

parseDeclaration :: String -> DynFlags -> ParseResult (LHsDecl GhcPs)
parseDeclaration :: String -> DynFlags -> ParseResult (LHsDecl GhcPs)
parseDeclaration = P (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> String
-> DynFlags
-> ParseResult (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. P a -> String -> DynFlags -> ParseResult a
parse P (GenLocated SrcSpanAnnA (HsDecl GhcPs))
Parser.parseDeclaration

parseExpression :: String -> DynFlags -> ParseResult (LHsExpr GhcPs)
#if ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )
parseExpression :: String -> DynFlags -> ParseResult (LHsExpr GhcPs)
parseExpression String
s DynFlags
flags =
  case P ECP -> String -> DynFlags -> ParseResult ECP
forall a. P a -> String -> DynFlags -> ParseResult a
parse P ECP
Parser.parseExpression String
s DynFlags
flags of
    POk PState
state ECP
e ->
      let e' :: ECP
e' = ECP
e :: ECP
          parser_validator :: PV (LHsExpr GhcPs)
parser_validator = ECP -> forall b. DisambECP b => PV (LocatedA b)
unECP ECP
e' :: PV (LHsExpr GhcPs)
          parser :: P (LHsExpr GhcPs)
parser = PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> P (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. PV a -> P a
runPV PV (GenLocated SrcSpanAnnA (HsExpr GhcPs))
parser_validator :: P (LHsExpr GhcPs)
      in P (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> PState -> ParseResult (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. P a -> PState -> ParseResult a
unP P (GenLocated SrcSpanAnnA (HsExpr GhcPs))
parser PState
state :: ParseResult (LHsExpr GhcPs)
    PFailed PState
ps -> PState -> ParseResult (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. PState -> ParseResult a
PFailed PState
ps
#elif defined (GHC_8_10) || defined (GHC_9_0)
parseExpression s flags =
  case parse Parser.parseExpression s flags of
    POk s e -> unP (runECP_P e) s
    PFailed ps -> PFailed ps
#else
parseExpression = parse Parser.parseExpression
#endif

parsePattern :: String -> DynFlags -> ParseResult (LPat GhcPs)
parsePattern :: String -> DynFlags -> ParseResult (LPat GhcPs)
parsePattern = P (GenLocated SrcSpanAnnA (Pat GhcPs))
-> String
-> DynFlags
-> ParseResult (GenLocated SrcSpanAnnA (Pat GhcPs))
forall a. P a -> String -> DynFlags -> ParseResult a
parse P (GenLocated SrcSpanAnnA (Pat GhcPs))
Parser.parsePattern

parseTypeSignature :: String -> DynFlags -> ParseResult (LHsDecl GhcPs)
parseTypeSignature :: String -> DynFlags -> ParseResult (LHsDecl GhcPs)
parseTypeSignature = P (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> String
-> DynFlags
-> ParseResult (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall a. P a -> String -> DynFlags -> ParseResult a
parse P (GenLocated SrcSpanAnnA (HsDecl GhcPs))
Parser.parseTypeSignature

parseStmt :: String -> DynFlags -> ParseResult (Maybe (LStmt GhcPs (LHsExpr GhcPs)))
parseStmt :: String
-> DynFlags -> ParseResult (Maybe (LStmt GhcPs (LHsExpr GhcPs)))
parseStmt = P (Maybe
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> String
-> DynFlags
-> ParseResult
     (Maybe
        (GenLocated
           SrcSpanAnnA
           (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
forall a. P a -> String -> DynFlags -> ParseResult a
parse P (Maybe
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
Parser.parseStmt

#if ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )
parseIdentifier :: String -> DynFlags -> ParseResult (LocatedN RdrName)
#else
parseIdentifier :: String -> DynFlags -> ParseResult (Located RdrName)
#endif
parseIdentifier :: String -> DynFlags -> ParseResult (LocatedN RdrName)
parseIdentifier = P (LocatedN RdrName)
-> String -> DynFlags -> ParseResult (LocatedN RdrName)
forall a. P a -> String -> DynFlags -> ParseResult a
parse P (LocatedN RdrName)
Parser.parseIdentifier

parseType :: String -> DynFlags -> ParseResult (LHsType GhcPs)
parseType :: String -> DynFlags -> ParseResult (LHsType GhcPs)
parseType = P (GenLocated SrcSpanAnnA (HsType GhcPs))
-> String
-> DynFlags
-> ParseResult (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. P a -> String -> DynFlags -> ParseResult a
parse P (GenLocated SrcSpanAnnA (HsType GhcPs))
Parser.parseType

#if defined (GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0)
parseHeader :: String -> DynFlags -> ParseResult (Located HsModule)
#else
parseHeader :: String -> DynFlags -> ParseResult (Located (HsModule GhcPs))
#endif
parseHeader :: String -> DynFlags -> ParseResult (Located (HsModule GhcPs))
parseHeader = P (Located (HsModule GhcPs))
-> String -> DynFlags -> ParseResult (Located (HsModule GhcPs))
forall a. P a -> String -> DynFlags -> ParseResult a
parse P (Located (HsModule GhcPs))
Parser.parseHeader

#if defined (GHC_9_4) || defined(GHC_9_2) || defined (GHC_9_0)
parseFile :: String
          -> DynFlags
          -> String
          -> ParseResult (Located HsModule)
#else
parseFile :: String
          -> DynFlags
          -> String
          -> ParseResult (Located (HsModule GhcPs))
#endif
parseFile :: String
-> DynFlags -> String -> ParseResult (Located (HsModule GhcPs))
parseFile String
filename DynFlags
flags String
str =
  P (Located (HsModule GhcPs))
-> PState -> ParseResult (Located (HsModule GhcPs))
forall a. P a -> PState -> ParseResult a
unP P (Located (HsModule GhcPs))
Parser.parseModule PState
parseState
  where
    location :: RealSrcLoc
location = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (String -> FastString
mkFastString String
filename) Int
1 Int
1
    buffer :: StringBuffer
buffer = String -> StringBuffer
stringToStringBuffer String
str
    parseState :: PState
parseState =
#if ! (defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )
      ParserOpts -> StringBuffer -> RealSrcLoc -> PState
initParserState (DynFlags -> ParserOpts
initParserOpts DynFlags
flags) StringBuffer
buffer RealSrcLoc
location
#else
      mkPState flags buffer location
#endif