Skip to content

Commit

Permalink
9.6 support
Browse files Browse the repository at this point in the history
  • Loading branch information
wz1000 committed Feb 8, 2023
1 parent 2b691b6 commit d11647d
Show file tree
Hide file tree
Showing 19 changed files with 268 additions and 93 deletions.
100 changes: 64 additions & 36 deletions cabal.project
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
packages:
./
-- ./
./hie-compat
./shake-bench
./hls-graph
Expand All @@ -8,49 +8,62 @@ packages:
./ghcide/test
./hls-plugin-api
./hls-test-utils
./plugins/hls-cabal-plugin
./plugins/hls-cabal-fmt-plugin
./plugins/hls-tactics-plugin
./plugins/hls-stylish-haskell-plugin
./plugins/hls-fourmolu-plugin
./plugins/hls-class-plugin
./plugins/hls-eval-plugin
./plugins/hls-explicit-imports-plugin
./plugins/hls-refine-imports-plugin
./plugins/hls-hlint-plugin
./plugins/hls-rename-plugin
./plugins/hls-retrie-plugin
./plugins/hls-haddock-comments-plugin
./plugins/hls-splice-plugin
./plugins/hls-floskell-plugin
./plugins/hls-pragmas-plugin
./plugins/hls-module-name-plugin
./plugins/hls-ormolu-plugin
./plugins/hls-call-hierarchy-plugin
./plugins/hls-alternate-number-format-plugin
./plugins/hls-qualify-imported-names-plugin
./plugins/hls-code-range-plugin
./plugins/hls-change-type-signature-plugin
./plugins/hls-stan-plugin
./plugins/hls-gadt-plugin
./plugins/hls-explicit-fixity-plugin
./plugins/hls-explicit-record-fields-plugin
./plugins/hls-refactor-plugin
/home/zubin/hiedb
/home/zubin/hie-bios
-- ./plugins/hls-cabal-plugin
-- ./plugins/hls-cabal-fmt-plugin
-- ./plugins/hls-tactics-plugin
-- ./plugins/hls-stylish-haskell-plugin
-- ./plugins/hls-fourmolu-plugin
-- ./plugins/hls-class-plugin
-- ./plugins/hls-eval-plugin
-- ./plugins/hls-explicit-imports-plugin
-- ./plugins/hls-refine-imports-plugin
-- ./plugins/hls-hlint-plugin
-- ./plugins/hls-rename-plugin
-- ./plugins/hls-retrie-plugin
-- ./plugins/hls-haddock-comments-plugin
-- ./plugins/hls-splice-plugin
-- ./plugins/hls-floskell-plugin
-- ./plugins/hls-pragmas-plugin
-- ./plugins/hls-module-name-plugin
-- ./plugins/hls-ormolu-plugin
-- ./plugins/hls-call-hierarchy-plugin
-- ./plugins/hls-alternate-number-format-plugin
-- ./plugins/hls-qualify-imported-names-plugin
-- ./plugins/hls-code-range-plugin
-- ./plugins/hls-change-type-signature-plugin
-- ./plugins/hls-stan-plugin
-- ./plugins/hls-gadt-plugin
-- ./plugins/hls-explicit-fixity-plugin
-- ./plugins/hls-explicit-record-fields-plugin
-- ./plugins/hls-refactor-plugin

-- Standard location for temporary packages needed for particular environments
-- For example it is used in the project gitlab mirror to help in the MAcOS M1 build script
-- See https://github.com/haskell/haskell-language-server/blob/master/.gitlab-ci.yml
optional-packages: vendored/*/*.cabal

tests: true
tests: false


source-repository-package
type:git
location: https://github.com/wz1000/HieDb
tag: e9edc2e1e2ffdd73ff33f51fad468df5237ea1b5

source-repository-package
type:git
location: https://github.com/haskell/hie-bios
tag: 8519812ad7501cab31347cd46ad1312b8413b8ad

package *
ghc-options: -haddock
test-show-details: direct

write-ghc-environment-files: never

index-state: 2023-01-10T00:00:00Z
index-state: 2023-01-31T00:00:00Z

constraints:
-- For GHC 9.4, older versions of entropy fail to build on Windows
Expand All @@ -74,14 +87,18 @@ constraints:
-- centos7 has an old version of git which cabal doesn't
-- support. We delete these lines in gitlab ci to workaround
-- this issue, as this is not necessary to build our binaries.
source-repository-package
type:git
location: https://github.com/pepeiborra/ekg-json
tag: 7a0af7a8fd38045fd15fb13445bdcc7085325460
-- https://github.com/tibbe/ekg-json/pull/12
-- END DELETE

allow-newer:
-- ghc-9.6
template-haskell,
base,
ghc-prim,
ghc,
ghc-boot,
mtl,
transformers,
Cabal,
-- ghc-9.4
Chart-diagrams:lens,
Chart:lens,
Expand All @@ -104,3 +121,14 @@ allow-newer:
uuid:time,
vector-space:base,
ekg-wai:time,

repository head.hackage.ghc.haskell.org
url: https://ghc.gitlab.haskell.org/head.hackage/
secure: True
key-threshold: 3
root-keys:
f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89
26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329
7541f32a4ccca4f97aea3b22f5e593ba2c0267546016b992dfadcd2fe944e55d

active-repositories: hackage.haskell.org, head.hackage.ghc.haskell.org:override
69 changes: 45 additions & 24 deletions ghcide/src/Development/IDE/Core/Compile.hs
Original file line number Diff line number Diff line change
Expand Up @@ -36,6 +36,7 @@ module Development.IDE.Core.Compile
, TypecheckHelpers(..)
) where

import Control.Monad.IO.Class
import Control.Concurrent.Extra
import Control.Concurrent.STM.Stats hiding (orElse)
import Control.DeepSeq (NFData (..), force, liftRnf,
Expand Down Expand Up @@ -133,6 +134,13 @@ import GHC.Hs (LEpaComment)
import qualified GHC.Types.Error as Error
#endif

#if MIN_VERSION_ghc(9,5,0)
import GHC.Driver.Config.CoreToStg.Prep
import GHC.Core.Lint.Interactive
import GHC.Driver.Main (mkCgInteractiveGuts)
import GHC.Unit.Home.ModInfo
#endif

-- | Given a string buffer, return the string (after preprocessing) and the 'ParsedModule'.
parseModule
:: IdeOptions
Expand Down Expand Up @@ -467,7 +475,11 @@ mkHiFileResultNoCompile session tcm = do
tcGblEnv = tmrTypechecked tcm
details <- makeSimpleDetails hsc_env_tmp tcGblEnv
sf <- finalSafeMode (ms_hspp_opts ms) tcGblEnv
iface' <- mkIfaceTc hsc_env_tmp sf details ms tcGblEnv
iface' <- mkIfaceTc hsc_env_tmp sf details ms
#if MIN_VERSION_ghc(9,5,0)
Nothing
#endif
tcGblEnv
let iface = iface' { mi_globals = Nothing, mi_usages = filterUsages (mi_usages iface') } -- See Note [Clearing mi_globals after generating an iface]
pure $! mkHiFileResult ms iface details (tmrRuntimeModules tcm) Nothing

Expand All @@ -482,20 +494,19 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do
ms = pm_mod_summary $ tmrParsed tcm
tcGblEnv = tmrTypechecked tcm

(details, mguts) <-
if mg_hsc_src simplified_guts == HsBootFile
then do
details <- mkBootModDetailsTc session tcGblEnv
pure (details, Nothing)
else do
(details, guts) <- do
-- write core file
-- give variables unique OccNames
tidy_opts <- initTidyOpts session
(guts, details) <- tidyProgram tidy_opts simplified_guts
pure (details, Just guts)
pure (details, guts)

#if MIN_VERSION_ghc(9,0,1)
let !partial_iface = force $ mkPartialIface session details
let !partial_iface = force $ mkPartialIface session
#if MIN_VERSION_ghc(9,5,0)
(cg_binds guts)
#endif
details
#if MIN_VERSION_ghc(9,3,0)
ms
#endif
Expand All @@ -513,9 +524,7 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do
let final_iface = final_iface' {mi_globals = Nothing, mi_usages = filterUsages (mi_usages final_iface')} -- See Note [Clearing mi_globals after generating an iface]

-- Write the core file now
core_file <- case mguts of
Nothing -> pure Nothing -- no guts, likely boot file
Just guts -> do
core_file <- do
let core_fp = ml_core_file $ ms_location ms
core_file = codeGutsToCoreFile iface_hash guts
iface_hash = getModuleHash final_iface
Expand All @@ -538,27 +547,37 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do
Just (core, _) | optVerifyCoreFile -> do
let core_fp = ml_core_file $ ms_location ms
traceIO $ "Verifying " ++ core_fp
let CgGuts{cg_binds = unprep_binds, cg_tycons = tycons } = case mguts of
Nothing -> error "invariant optVerifyCoreFile: guts must exist if linkable exists"
Just g -> g
let CgGuts{cg_binds = unprep_binds, cg_tycons = tycons } = guts
mod = ms_mod ms
data_tycons = filter isDataTyCon tycons
CgGuts{cg_binds = unprep_binds'} <- coreFileToCgGuts session final_iface details core

#if MIN_VERSION_ghc(9,5,0)
cp_cfg <- initCorePrepConfig session
#endif

let corePrep = corePrepPgm
#if MIN_VERSION_ghc(9,5,0)
(hsc_logger session) cp_cfg (initCorePrepPgmConfig (hsc_dflags session) (interactiveInScope $ hsc_IC session))
#else
session
#endif
mod (ms_location ms)

-- Run corePrep first as we want to test the final version of the program that will
-- get translated to STG/Bytecode
#if MIN_VERSION_ghc(9,3,0)
prepd_binds
#else
(prepd_binds , _)
#endif
<- corePrepPgm session mod (ms_location ms) unprep_binds data_tycons
<- corePrep unprep_binds data_tycons
#if MIN_VERSION_ghc(9,3,0)
prepd_binds'
#else
(prepd_binds', _)
#endif
<- corePrepPgm session mod (ms_location ms) unprep_binds' data_tycons
<- corePrep unprep_binds' data_tycons
let binds = noUnfoldings $ (map flattenBinds . (:[])) $ prepd_binds
binds' = noUnfoldings $ (map flattenBinds . (:[])) $ prepd_binds'

Expand Down Expand Up @@ -683,7 +702,7 @@ generateByteCode (CoreFileTime time) hscEnv summary guts = do
let session = _tweak (hscSetFlags (ms_hspp_opts summary) hscEnv)
-- TODO: maybe settings ms_hspp_opts is unnecessary?
summary' = summary { ms_hspp_opts = hsc_dflags session }
hscInteractive session guts
hscInteractive session (mkCgInteractiveGuts guts)
(ms_location summary')
let unlinked = BCOs bytecode sptEntries
let linkable = LM time (ms_mod summary) [unlinked]
Expand Down Expand Up @@ -1242,7 +1261,9 @@ parseHeader
=> DynFlags -- ^ flags to use
-> FilePath -- ^ the filename (for source locations)
-> Util.StringBuffer -- ^ Haskell module source text (full Unicode is supported)
#if MIN_VERSION_ghc(9,0,1)
#if MIN_VERSION_ghc(9,5,0)
-> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule GhcPs))
#elif MIN_VERSION_ghc(9,0,1)
-> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule))
#else
-> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule GhcPs))
Expand Down Expand Up @@ -1574,13 +1595,13 @@ showReason (RecompBecause s) = s
mkDetailsFromIface :: HscEnv -> ModIface -> IO ModDetails
mkDetailsFromIface session iface = do
fixIO $ \details -> do
let !hsc' = hscUpdateHPT (\hpt -> addToHpt hpt (moduleName $ mi_module iface) (HomeModInfo iface details Nothing)) session
let !hsc' = hscUpdateHPT (\hpt -> addToHpt hpt (moduleName $ mi_module iface) (HomeModInfo iface details emptyHomeModInfoLinkable)) session
initIfaceLoad hsc' (typecheckIface iface)

coreFileToCgGuts :: HscEnv -> ModIface -> ModDetails -> CoreFile -> IO CgGuts
coreFileToCgGuts session iface details core_file = do
let act hpt = addToHpt hpt (moduleName this_mod)
(HomeModInfo iface details Nothing)
(HomeModInfo iface details emptyHomeModInfoLinkable)
this_mod = mi_module iface
types_var <- newIORef (md_types details)
let hsc_env' = hscUpdateHPT act (session {
Expand All @@ -1604,9 +1625,9 @@ coreFileToLinkable :: LinkableType -> HscEnv -> ModSummary -> ModIface -> ModDet
coreFileToLinkable linkableType session ms iface details core_file t = do
cgi_guts <- coreFileToCgGuts session iface details core_file
(warns, lb) <- case linkableType of
BCOLinkable -> generateByteCode (CoreFileTime t) session ms cgi_guts
ObjectLinkable -> generateObjectCode session ms cgi_guts
pure (warns, HomeModInfo iface details . Just <$> lb)
BCOLinkable -> fmap (maybe emptyHomeModInfoLinkable justBytecode) <$> generateByteCode (CoreFileTime t) session ms cgi_guts
ObjectLinkable -> fmap (maybe emptyHomeModInfoLinkable justObjects) <$> generateObjectCode session ms cgi_guts
pure (warns, Just $ HomeModInfo iface details lb) -- TODO wz1000 handle emptyHomeModInfoLinkable

-- | Non-interactive, batch version of 'InteractiveEval.getDocs'.
-- The interactive paths create problems in ghc-lib builds
Expand Down
10 changes: 7 additions & 3 deletions ghcide/src/Development/IDE/Core/Rules.hs
Original file line number Diff line number Diff line change
Expand Up @@ -62,6 +62,7 @@ module Development.IDE.Core.Rules(
DisplayTHWarning(..),
) where

import Control.Applicative
import Control.Concurrent.Async (concurrently)
import Control.Concurrent.Strict
import Control.DeepSeq
Expand Down Expand Up @@ -160,6 +161,9 @@ import Control.Monad.IO.Unlift
import GHC.Unit.Module.Graph
import GHC.Unit.Env
#endif
#if MIN_VERSION_ghc(9,5,0)
import GHC.Unit.Home.ModInfo
#endif

data Log
= LogShake Shake.Log
Expand Down Expand Up @@ -775,7 +779,7 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do

depSessions <- map hscEnv <$> uses_ (GhcSessionDeps_ fullModSummary) deps
ifaces <- uses_ GetModIface deps
let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails Nothing) ifaces
let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails emptyHomeModInfoLinkable) ifaces
#if MIN_VERSION_ghc(9,3,0)
-- On GHC 9.4+, the module graph contains not only ModSummary's but each `ModuleNode` in the graph
-- also points to all the direct descendants of the current module. To get the keys for the descendants
Expand Down Expand Up @@ -1099,10 +1103,10 @@ getLinkableRule recorder =
else pure Nothing
case mobj_time of
Just obj_t
| obj_t >= core_t -> pure ([], Just $ HomeModInfo hirModIface hirModDetails (Just $ LM (posixSecondsToUTCTime obj_t) (ms_mod ms) [DotO obj_file]))
| obj_t >= core_t -> pure ([], Just $ HomeModInfo hirModIface hirModDetails (justObjects $ LM (posixSecondsToUTCTime obj_t) (ms_mod ms) [DotO obj_file]))
_ -> liftIO $ coreFileToLinkable linkableType (hscEnv session) ms hirModIface hirModDetails bin_core (error "object doesn't have time")
-- Record the linkable so we know not to unload it, and unload old versions
whenJust (hm_linkable =<< hmi) $ \(LM time mod _) -> do
whenJust ((homeModInfoByteCode =<< hmi) <|> (homeModInfoObject =<< hmi)) $ \(LM time mod _) -> do
compiledLinkables <- getCompiledLinkables <$> getIdeGlobalAction
liftIO $ modifyVar compiledLinkables $ \old -> do
let !to_keep = extendModuleEnv old mod time
Expand Down
3 changes: 3 additions & 0 deletions ghcide/src/Development/IDE/GHC/CPP.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,7 @@
module Development.IDE.GHC.CPP(doCpp, addOptP)
where

import Control.Monad
import Development.IDE.GHC.Compat as Compat
import Development.IDE.GHC.Compat.Util
import GHC
Expand Down Expand Up @@ -42,6 +43,8 @@ addOptP f = alterToolSettings $ \s -> s
doCpp :: HscEnv -> Bool -> FilePath -> FilePath -> IO ()
doCpp env raw input_fn output_fn =
#if MIN_VERSION_ghc (9,2,0)
void $ Pipeline.runCppPhase env input_fn output_fn -- TODO wz1000
#elif MIN_VERSION_ghc (9,2,0)
Pipeline.doCpp (hsc_logger env) (hsc_tmpfs env) (hsc_dflags env) (hsc_unit_env env) raw input_fn output_fn
#else
Pipeline.doCpp (hsc_dflags env) raw input_fn output_fn
Expand Down
Loading

0 comments on commit d11647d

Please sign in to comment.