{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wno-missing-fields -Wno-name-shadowing -Wno-unused-imports #-}
{-# LANGUAGE CPP #-}
module PyF.Internal.ParserEx (fakeSettings, fakeLlvmConfig, parseExpression)
where
#if MIN_VERSION_ghc(9,0,0)
import GHC.Settings.Config
import GHC.Driver.Session
import GHC.Utils.Fingerprint
import GHC.Platform
import GHC.Settings
#elif MIN_VERSION_ghc(8, 10, 0)
import Config
import DynFlags
import Fingerprint
import GHC.Platform
import ToolSettings
#else
import Config
import DynFlags
import Fingerprint
import Platform
#endif

#if MIN_VERSION_ghc(8,10,0)
import GHC.Hs
#else
import HsSyn
#endif

#if MIN_VERSION_ghc(9, 2, 0)
import GHC.Driver.Config
#endif

#if MIN_VERSION_ghc(9,0,0)
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 StringBuffer
import Lexer
import qualified Parser
import FastString
import SrcLoc
import RdrName
#endif

#if MIN_VERSION_ghc(9, 0, 0)
#else
import RdrHsSyn
#endif

import Data.Data hiding (Fixity)

#if MIN_VERSION_ghc(9,0,0)
import GHC.Hs

#if MIN_VERSION_ghc(9, 2, 0)
import GHC.Types.Fixity
import GHC.Types.SourceText
#else
import GHC.Types.Basic
#endif

import GHC.Types.Name.Reader
import GHC.Types.Name
import GHC.Types.SrcLoc
#elif MIN_VERSION_ghc(8, 10, 0)
import BasicTypes
import OccName
#else
import BasicTypes
import OccName
#endif

import Data.Maybe

fakeSettings :: Settings
fakeSettings :: Settings
fakeSettings = Settings :: GhcNameVersion
-> FileSettings
-> Platform
-> ToolSettings
-> PlatformMisc
-> PlatformConstants
-> [(String, String)]
-> Settings
Settings
#if MIN_VERSION_ghc(9, 2, 0)
  { sGhcNameVersion=ghcNameVersion
  , sFileSettings=fileSettings
  , sTargetPlatform=platform
  , sPlatformMisc=platformMisc
  , sToolSettings=toolSettings
  }
#elif MIN_VERSION_ghc(8, 10, 0)
  { sGhcNameVersion :: GhcNameVersion
sGhcNameVersion=GhcNameVersion
ghcNameVersion
  , sFileSettings :: FileSettings
sFileSettings=FileSettings
fileSettings
  , sTargetPlatform :: Platform
sTargetPlatform=Platform
platform
  , sPlatformMisc :: PlatformMisc
sPlatformMisc=PlatformMisc
platformMisc
  , sPlatformConstants :: PlatformConstants
sPlatformConstants=PlatformConstants
platformConstants
  , sToolSettings :: ToolSettings
sToolSettings=ToolSettings
toolSettings
  }
#else
  { sTargetPlatform=platform
  , sPlatformConstants=platformConstants
  , sProjectVersion=cProjectVersion
  , sProgramName="ghc"
  , sOpt_P_fingerprint=fingerprint0
  }
#endif
  where
#if MIN_VERSION_ghc(8, 10, 0)
    toolSettings :: ToolSettings
toolSettings = ToolSettings :: Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> String
-> (String, [Option])
-> String
-> String
-> (String, [Option])
-> (String, [Option])
-> (String, [Option])
-> (String, [Option])
-> String
-> String
-> String
-> String
-> String
-> (String, [Option])
-> (String, [Option])
-> (String, [Option])
-> String
-> [String]
-> [String]
-> Fingerprint
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> ToolSettings
ToolSettings {
      toolSettings_opt_P_fingerprint :: Fingerprint
toolSettings_opt_P_fingerprint=Fingerprint
fingerprint0
      }
    fileSettings :: FileSettings
fileSettings = FileSettings :: String
-> String
-> Maybe String
-> String
-> String
-> String
-> FileSettings
FileSettings {}
    platformMisc :: PlatformMisc
platformMisc = PlatformMisc :: String
-> String
-> IntegerLibrary
-> Bool
-> Bool
-> Bool
-> String
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> String
-> PlatformMisc
PlatformMisc {}
    ghcNameVersion :: GhcNameVersion
ghcNameVersion =
      GhcNameVersion :: String -> String -> GhcNameVersion
GhcNameVersion{ghcNameVersion_programName :: String
ghcNameVersion_programName=String
"ghc"
                    ,ghcNameVersion_projectVersion :: String
ghcNameVersion_projectVersion=String
cProjectVersion
                    }
#endif
    platform :: Platform
platform =
      Platform :: PlatformMini
-> PlatformWordSize
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Platform
Platform{
#if MIN_VERSION_ghc(9, 0, 0)
    -- It doesn't matter what values we write here as these fields are
    -- not referenced for our purposes. However the fields are strict
    -- so we must say something.
        platformByteOrder=LittleEndian
      , platformHasGnuNonexecStack=True
      , platformHasIdentDirective=False
      , platformHasSubsectionsViaSymbols=False
      , platformIsCrossCompiling=False
      , platformLeadingUnderscore=False
      , platformTablesNextToCode=False
#if MIN_VERSION_ghc(9, 2, 0)
      , platform_constants=platformConstants
#endif
      ,
#endif

#if MIN_VERSION_ghc(9, 2, 0)
        platformWordSize=PW8
      , platformArchOS=ArchOS {archOS_arch=ArchUnknown, archOS_OS=OSUnknown}
#elif MIN_VERSION_ghc(8, 10, 0)
        platformWordSize :: PlatformWordSize
platformWordSize=PlatformWordSize
PW8
      , platformMini :: PlatformMini
platformMini=PlatformMini :: Arch -> OS -> PlatformMini
PlatformMini {platformMini_arch :: Arch
platformMini_arch=Arch
ArchUnknown, platformMini_os :: OS
platformMini_os=OS
OSUnknown}
#else
        platformWordSize=8
      , platformOS=OSUnknown
#endif
      , platformUnregisterised :: Bool
platformUnregisterised=Bool
True
      }
#if MIN_VERSION_ghc(9, 2, 0)
    platformConstants = Nothing
#else
    platformConstants :: PlatformConstants
platformConstants =
      PlatformConstants :: Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Bool
-> Bool
-> Int
-> Integer
-> Integer
-> Integer
-> PlatformConstants
PlatformConstants{pc_DYNAMIC_BY_DEFAULT :: Bool
pc_DYNAMIC_BY_DEFAULT=Bool
False,pc_WORD_SIZE :: Int
pc_WORD_SIZE=Int
8}
#endif

#if MIN_VERSION_ghc(8, 10, 0)
fakeLlvmConfig :: LlvmConfig
fakeLlvmConfig :: LlvmConfig
fakeLlvmConfig = [(String, LlvmTarget)] -> [(Int, String)] -> LlvmConfig
LlvmConfig [] []
#else
fakeLlvmConfig :: (LlvmTargets, LlvmPasses)
fakeLlvmConfig = ([], [])
#endif

-- From Language.Haskell.GhclibParserEx.GHC.Parser

parse :: P a -> String -> DynFlags -> ParseResult a
parse :: 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 MIN_VERSION_ghc(9, 2, 0)
      initParserState (initParserOpts flags) buffer location
#else
      DynFlags -> StringBuffer -> RealSrcLoc -> PState
mkPState DynFlags
flags StringBuffer
buffer RealSrcLoc
location
#endif


#if MIN_VERSION_ghc(9, 2, 0)
parseExpression :: String -> DynFlags -> ParseResult (LocatedA (HsExpr GhcPs))
parseExpression s flags =
  case parse Parser.parseExpression s flags of
    POk s e -> unP (runPV (unECP e)) s
    PFailed ps -> PFailed ps
#elif MIN_VERSION_ghc(8, 10, 0)
parseExpression :: String -> DynFlags -> ParseResult (Located (HsExpr GhcPs))
parseExpression :: String -> DynFlags -> ParseResult (Located (HsExpr 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
s ECP
e -> P (Located (HsExpr GhcPs))
-> PState -> ParseResult (Located (HsExpr GhcPs))
forall a. P a -> PState -> ParseResult a
unP (ECP -> P (Located (HsExpr GhcPs))
forall b. DisambECP b => ECP -> P (Located b)
runECP_P ECP
e) PState
s
    PFailed PState
ps -> PState -> ParseResult (Located (HsExpr GhcPs))
forall a. PState -> ParseResult a
PFailed PState
ps
#else
parseExpression = parse Parser.parseExpression
#endif