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

himportscan upgrade for GHC 9.6 #60

Closed
wants to merge 8 commits into from
Closed
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: 2 additions & 0 deletions .bazelrc
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,8 @@ common:ghc_9_2_5 --repo_env=GHC_VERSION=9.2.5

common:ghc_9_4_5 --repo_env=GHC_VERSION=9.4.5

common:ghc_9_6_2 --repo_env=GHC_VERSION=9.6.2

# Try to load a file that includes the remote cache authentication flag
try-import %workspace%/.bazelrc.auth

Expand Down
2 changes: 1 addition & 1 deletion .github/workflows/workflow.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@ jobs:
fail-fast: false
matrix:
os: [ubuntu-latest]
ghc-version: ["ghc_8_10_7", "ghc_9_0_2", "ghc_9_2_5", "ghc_9_4_5"]
ghc-version: ["ghc_8_10_7", "ghc_9_0_2", "ghc_9_2_5", "ghc_9_4_5", "ghc_9_6_2"]
runs-on: ${{ matrix.os }}
steps:
- uses: actions/checkout@v4
Expand Down
6 changes: 3 additions & 3 deletions WORKSPACE
Original file line number Diff line number Diff line change
Expand Up @@ -8,9 +8,9 @@ load("@bazel_tools//tools/build_defs/repo:http.bzl", "http_archive")

http_archive(
name = "rules_haskell",
sha256 = "298f6f0db23391274b4eca215daa01797d05699469048ef94540d5829b466377",
strip_prefix = "rules_haskell-0.17",
url = "https://github.com/tweag/rules_haskell/archive/refs/tags/v0.17.tar.gz",
sha256 = "fc0c0421051802a8d3cc72dbcfca5e4d4fefcbf0174ed5b444ee4fcae3df4b41",
strip_prefix = "rules_haskell-0.18",
url = "https://github.com/tweag/rules_haskell/archive/refs/tags/v0.18.tar.gz",
)

load("@rules_haskell//haskell:repositories.bzl", "rules_haskell_dependencies")
Expand Down
2 changes: 1 addition & 1 deletion himportscan/src/HImportScan/GHC/FakeSettings9_4.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@
-- SPDX-License-Identifier: BSD-3-Clause.
{-#LANGUAGE CPP #-}

#if __GLASGOW_HASKELL__ >= 904
#if __GLASGOW_HASKELL__ == 904

{-# OPTIONS_GHC -Wno-missing-fields #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
Expand Down
67 changes: 67 additions & 0 deletions himportscan/src/HImportScan/GHC/FakeSettings9_6.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,67 @@
-- Copyright (c) 2020, Shayne Fletcher. All rights reserved.
-- SPDX-License-Identifier: BSD-3-Clause.
{-#LANGUAGE CPP #-}

#if __GLASGOW_HASKELL__ >= 906

{-# OPTIONS_GHC -Wno-missing-fields #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}

-- This file is a single code path copied over from https://hackage.haskell.org/package/ghc-lib-parser-ex-8.10.0.24/docs/src/Language.Haskell.GhclibParserEx.GHC.Settings.Config.html
-- TODO[GL]: We can get rid of this file once we only support >=9.2, as ParserOpts are much smaller there.
module HImportScan.GHC.FakeSettings9_6(
fakeSettings
, fakeLlvmConfig
)
where

import GHC.CmmToLlvm.Config (LlvmConfig (..))
import GHC.Settings.Config
import GHC.Driver.Session
import GHC.Utils.Fingerprint
import GHC.Platform
import GHC.Settings

fakeSettings :: Settings
fakeSettings = Settings
{ sGhcNameVersion=ghcNameVersion
, sFileSettings=fileSettings
, sTargetPlatform=platform
, sPlatformMisc=platformMisc
, sToolSettings=toolSettings
, sRawSettings=[]
}
where
toolSettings = ToolSettings {
toolSettings_opt_P_fingerprint=fingerprint0
}
fileSettings = FileSettings {}
platformMisc = PlatformMisc {}
ghcNameVersion =
GhcNameVersion{ghcNameVersion_programName="ghc"
,ghcNameVersion_projectVersion=cProjectVersion
}
platform =
Platform{
platformWordSize=PW8
, platformArchOS=ArchOS {archOS_arch=ArchUnknown, archOS_OS=OSUnknown}
, platformByteOrder = LittleEndian
, platformUnregisterised=True
, platformHasGnuNonexecStack = False
, platformHasIdentDirective = False
, platformHasSubsectionsViaSymbols = False
, platformIsCrossCompiling = False
, platformLeadingUnderscore = False
, platformTablesNextToCode = False
, platform_constants = Nothing
, platformHasLibm = True
}

fakeLlvmConfig :: LlvmConfig
fakeLlvmConfig = LlvmConfig [] []

#else

module HImportScan.GHC.FakeSettings9_6 where

#endif
2 changes: 1 addition & 1 deletion himportscan/src/HImportScan/GHC9_4.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
{-#LANGUAGE CPP #-}

#if __GLASGOW_HASKELL__ >= 904
#if __GLASGOW_HASKELL__ == 904

-- | A module abstracting the provenance of GHC API names
module HImportScan.GHC9_4 (module X, imports, handleParseError, getOptions) where
Expand Down
103 changes: 103 additions & 0 deletions himportscan/src/HImportScan/GHC9_6.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,103 @@
{-#LANGUAGE CPP #-}

#if __GLASGOW_HASKELL__ >= 906

-- | A module abstracting the provenance of GHC API names
module HImportScan.GHC9_6 (module X, imports, handleParseError, getOptions) where

import HImportScan.GHC.FakeSettings9_6 as X

import GHC.Driver.Session as X (DynFlags, defaultDynFlags, xopt_set, xopt_unset)
import GHC.Data.EnumSet as X (empty, fromList)
import GHC.Driver.Errors as X (printMessages)
import GHC.Data.FastString as X (FastString, mkFastString, unpackFS)
import GHC as X (runGhc, getSessionDynFlags)
import GHC.LanguageExtensions as X
(Extension
( ImportQualifiedPost
, PackageImports
, TemplateHaskell
, ImplicitPrelude
, PatternSynonyms
, ExplicitNamespaces
, MagicHash
)
)
import GHC.Parser.Header as X (getImports)
import GHC.Types.Error (NoDiagnosticOpts (..))
import GHC.Types.SourceError (mkSrcErr)
import GHC.Parser.Lexer as X
( ParseResult(..)
, ParserOpts
, Token(..)
, lexer
, loc
, unP
)
import GHC.Unit.Module as X (ModuleName, moduleNameString)
import GHC.Types.SrcLoc as X
( Located
, RealSrcLoc
, SrcLoc(RealSrcLoc)
, getLoc
, mkRealSrcLoc
, srcLocLine
, srcLocCol
, srcSpanStart
, unLoc
)
import GHC.Data.StringBuffer as X (StringBuffer(StringBuffer), stringToStringBuffer)
import GHC.Driver.Config.Parser
import GHC.Utils.Logger as X
import Control.Exception (throwIO)
import GHC.Parser.Errors.Types (PsMessage)
import GHC.Driver.Errors.Types (GhcMessage(GhcPsMessage))
import GHC.Driver.Config.Diagnostic (initDiagOpts)
import GHC.Types.Error (Messages)
import GHC.Types.PkgQual (RawPkgQual (RawPkgQual, NoRawPkgQual))
import qualified GHC.Types.SourceText as StringLiteral (sl_fs)
import qualified GHC.Parser.Header as PH (getOptions)

initOpts :: DynFlags -> ParserOpts
initOpts = initParserOpts

getOptions :: DynFlags -> StringBuffer -> FilePath -> [Located String]
getOptions dynFlags sb filePath =
snd $ PH.getOptions (initOpts dynFlags) sb filePath

imports ::
DynFlags ->
StringBuffer ->
FilePath ->
IO
( Either
-- (Bag PsError)
(Messages PsMessage)
( [(Maybe FastString, Located ModuleName)],
[(Maybe FastString, Located ModuleName)], Located ModuleName
)
)
imports dynFlagsWithExtensions sb filePath = do
-- [GG] We should never care about the Prelude import,
-- since it is always a module from an external library.
-- Hence the `False`.
imports' <- getImports (initOpts dynFlagsWithExtensions) False sb filePath filePath

return $ (\ (m1, m2, _, mname) -> (toFastMessage <$> m1, toFastMessage <$> m2, mname)) `fmap` imports'
where
toFastMessage (NoRawPkgQual, b) = (Nothing, b)
toFastMessage (RawPkgQual stringLit, b) = (Just $ StringLiteral.sl_fs stringLit, b)

handleParseError :: DynFlags -> Messages PsMessage -> IO a
handleParseError dynFlagsWithExtensions err = do
logger <- initLogger
let diagOpts = initDiagOpts dynFlagsWithExtensions
ghcErrors = GhcPsMessage <$> err
printMessages logger NoDiagnosticOpts diagOpts err
throwIO (mkSrcErr ghcErrors)

#else

module HImportScan.GHC9_6 where

#endif
12 changes: 9 additions & 3 deletions himportscan/src/HImportScan/ImportScanner.hs
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,9 @@ import Data.Set (Set)
import qualified Data.Set as Set
import System.Directory (doesFileExist)

#if __GLASGOW_HASKELL__ >= 904
#if __GLASGOW_HASKELL__ >= 906
import HImportScan.GHC9_6 as GHC
#elif __GLASGOW_HASKELL__ == 904
import HImportScan.GHC9_4 as GHC
#elif __GLASGOW_HASKELL__ >= 902
import HImportScan.GHC9_2 as GHC
Expand Down Expand Up @@ -112,8 +114,12 @@ scanImports filePath contents = do

-- TODO[GL]: Once we're on ghc 9.2 we can get rid of all the things relating to dynFlags, and use the much smaller
-- ParserOpts, as getImports no longer depends on DynFlags then.
let dynFlagsWithExtensions = toggleDynFlags $ GHC.defaultDynFlags GHC.fakeSettings GHC.fakeLlvmConfig

let dynFlagsWithExtensions = toggleDynFlags $
#if __GLASGOW_HASKELL__ >= 906
GHC.defaultDynFlags GHC.fakeSettings
#else
GHC.defaultDynFlags GHC.fakeSettings GHC.fakeLlvmConfig
#endif
let
-- [GL] The fact that the resulting strings here contain the "-X"s makes me a bit doubtful that this is the right approach,
-- but this is what I found for now.
Expand Down
Loading
Loading