Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Remove pSupportedExts from ParserOpts #570

Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion CI.hs
Original file line number Diff line number Diff line change
Expand Up @@ -98,7 +98,7 @@ data DaFlavor = DaFlavor

-- Last tested gitlab.haskell.org/ghc/ghc.git at
current :: String
current = "573cad4bd9e7fc146581d9711d36c4e3bacbb6e9" -- 2024-11-03
current = "caaf53881d5cc82ebff617f39ad5363429d2eccf" -- 2024-11-25

ghcFlavorOpt :: GhcFlavor -> String
ghcFlavorOpt = \case
Expand Down
55 changes: 54 additions & 1 deletion examples/ghc-lib-test-mini-compile/src/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -193,6 +193,23 @@ mkDynFlags filename s = do
(dflags, _, _) <- parseDynamicFilePragma dflags0 opts
return dflags

#elif (defined (GHC_9_6) || defined (GHC_9_8) || defined (GHC_9_10) || defined (GHC_9_12))

let baseFlags =
(defaultDynFlags fakeSettings) {
ghcLink = NoLink
, backend = noBackend
, homeUnitId_ = toUnitId (stringToUnit ghclibPrimUnitId)
}
parsePragmasIntoDynFlags filename s baseFlags
where
parsePragmasIntoDynFlags :: String -> String -> DynFlags -> IO DynFlags
parsePragmasIntoDynFlags filepath contents dflags0 = do
let (_, opts) = getOptions (initParserOpts dflags0)
(stringToStringBuffer contents) filepath
(dflags, _, _) <- parseDynamicFilePragma dflags0 opts
return dflags

#else

let baseFlags =
Expand All @@ -206,6 +223,7 @@ mkDynFlags filename s = do
parsePragmasIntoDynFlags :: String -> String -> DynFlags -> IO DynFlags
parsePragmasIntoDynFlags filepath contents dflags0 = do
let (_, opts) = getOptions (initParserOpts dflags0)
(supportedLanguagePragmas dflags0)
(stringToStringBuffer contents) filepath
(dflags, _, _) <- parseDynamicFilePragma dflags0 opts
return dflags
Expand Down Expand Up @@ -394,16 +412,51 @@ fakeSettings = Settings {

platform = genericPlatform

#elif (defined (GHC_9_4) || defined (GHC_9_6) || defined (GHC_9_8) || defined (GHC_9_10) || defined (GHC_9_12))
sGhcNameVersion=ghcNameVersion
, sFileSettings=fileSettings
, sTargetPlatform=platform
, sPlatformMisc=platformMisc
, sToolSettings=toolSettings
}
where
fileSettings = FileSettings {
fileSettings_topDir="."
, fileSettings_toolDir=Nothing
, fileSettings_ghcUsagePath="."
, fileSettings_ghciUsagePath="."
, fileSettings_globalPackageDatabase="."
}

toolSettings = ToolSettings {
toolSettings_opt_P_fingerprint=fingerprint0
}

platformMisc = PlatformMisc {
}

ghcNameVersion = GhcNameVersion{
ghcNameVersion_programName="ghc"
, ghcNameVersion_projectVersion=cProjectVersion
}

platform = genericPlatform

#else
{- defined (GHC_9_4) || defined (GHC_9_6) || defined (GHC_9_8) || defined (GHC_9_10) || defined (GHC_9_12) || defined (GHC_9_14) -}
{- defined (GHC_9_14) -}

sGhcNameVersion=ghcNameVersion
, sFileSettings=fileSettings
, sTargetPlatform=platform
, sPlatformMisc=platformMisc
, sToolSettings=toolSettings
, sUnitSettings=unitSettings
}
where
unitSettings = UnitSettings {
unitSettings_baseUnitId = stringToUnitId "base"
}

fileSettings = FileSettings {
fileSettings_topDir="."
, fileSettings_toolDir=Nothing
Expand Down
53 changes: 51 additions & 2 deletions examples/ghc-lib-test-mini-hlint/src/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -181,11 +181,30 @@ parsePragmasIntoDynFlags flags filepath str =
sDoc : _ -> do putStrLn sDoc; return Nothing
where
sDocs = [ showSDoc flags msg | msg <- pprMsgEnvelopeBagWithLocDefault . getMessages $ srcErrorMessages msgs ]
#elif (defined (GHC_9_8) || defined (GHC_9_10) || defined (GHC_9_12))
catchErrors $ do
let (_, opts) = getOptions (initParserOpts flags)
(stringToStringBuffer str) filepath
(flags, _, _) <- parseDynamicFilePragma flags opts
return $ Just flags
where
catchErrors :: IO (Maybe DynFlags) -> IO (Maybe DynFlags)
catchErrors act = handleGhcException reportGhcException
(handleSourceError reportSourceErr act)

reportGhcException e = do print e; return Nothing

reportSourceErr msgs = case sDocs of
[] -> return Nothing
sDoc : _ -> do putStrLn sDoc; return Nothing
where
sDocs = [ showSDoc flags msg | msg <- pprMsgEnvelopeBagWithLocDefault . getMessages $ srcErrorMessages msgs ]
#else
{- defined (GHC_9_8) || defined (GHC_9_10) || defined (GHC_9_12) || defined (GHC_9_14) -}
{- defined (GHC_9_14) -}

catchErrors $ do
let (_, opts) = getOptions (initParserOpts flags)
(supportedLanguagePragmas flags)
(stringToStringBuffer str) filepath
(flags, _, _) <- parseDynamicFilePragma flags opts
return $ Just flags
Expand Down Expand Up @@ -631,16 +650,46 @@ fakeSettings = Settings {

platform=genericPlatform

#elif (defined (GHC_9_4) || defined (GHC_9_6) || defined (GHC_9_8) || defined (GHC_9_10) || defined (GHC_9_12))

sGhcNameVersion=ghcNameVersion
, sFileSettings=fileSettings
, sTargetPlatform=platform
, sPlatformMisc=platformMisc
, sToolSettings=toolSettings
}
where
fileSettings = FileSettings {
}

toolSettings = ToolSettings {
toolSettings_opt_P_fingerprint=fingerprint0
}

platformMisc = PlatformMisc {
}

ghcNameVersion = GhcNameVersion{
ghcNameVersion_programName="ghc"
, ghcNameVersion_projectVersion=cProjectVersion
}

platform=genericPlatform
#else
{- defined (GHC_9_4) || defined (GHC_9_6) || defined (GHC_9_8) || defined (GHC_9_10) || defined (GHC_9_12) || defined (GHC_9_14) -}
{- defined (GHC_9_14) -}

sGhcNameVersion=ghcNameVersion
, sFileSettings=fileSettings
, sTargetPlatform=platform
, sPlatformMisc=platformMisc
, sToolSettings=toolSettings
, sUnitSettings=unitSettings
}
where
unitSettings = UnitSettings {
unitSettings_baseUnitId = stringToUnitId "base"
}

fileSettings = FileSettings {
}

Expand Down
Loading