@@ -174,6 +174,7 @@ import System.Info.Extra (isWindows)
174
174
import qualified Data.IntMap as IM
175
175
import GHC.Fingerprint
176
176
177
+ import GHC.Driver.Env (hsc_all_home_unit_ids )
177
178
178
179
data Log
179
180
= LogShake Shake. Log
@@ -519,7 +520,12 @@ persistentHieFileRule recorder = addPersistentRule GetHieAst $ \file -> runMaybe
519
520
520
521
getHieAstRuleDefinition :: NormalizedFilePath -> HscEnv -> TcModuleResult -> Action (IdeResult HieAstResult )
521
522
getHieAstRuleDefinition f hsc tmr = do
522
- (diags, masts) <- liftIO $ generateHieAsts hsc tmr
523
+ (diags, masts') <- liftIO $ generateHieAsts hsc tmr
524
+ #if MIN_VERSION_ghc(9,11,0)
525
+ let masts = fst <$> masts'
526
+ #else
527
+ let masts = masts'
528
+ #endif
523
529
se <- getShakeExtras
524
530
525
531
isFoi <- use_ IsFileOfInterest f
@@ -529,7 +535,7 @@ getHieAstRuleDefinition f hsc tmr = do
529
535
LSP. sendNotification (SMethod_CustomMethod (Proxy @ " ghcide/reference/ready" )) $
530
536
toJSON $ fromNormalizedFilePath f
531
537
pure []
532
- _ | Just asts <- masts -> do
538
+ _ | Just asts <- masts' -> do
533
539
source <- getSourceFileSource f
534
540
let exports = tcg_exports $ tmrTypechecked tmr
535
541
modSummary = tmrModSummary tmr
@@ -610,6 +616,13 @@ knownFilesRule recorder = defineEarlyCutOffNoFile (cmapWithPrio LogShake recorde
610
616
fs <- knownTargets
611
617
pure (LBS. toStrict $ B. encode $ hash fs, unhashed fs)
612
618
619
+ getFileHashRule :: Recorder (WithPriority Log ) -> Rules ()
620
+ getFileHashRule recorder =
621
+ defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \ GetFileHash file -> do
622
+ void $ use_ GetModificationTime file
623
+ fileHash <- liftIO $ Util. getFileHash (fromNormalizedFilePath file)
624
+ return (Just (fingerprintToBS fileHash), ([] , Just fileHash))
625
+
613
626
getModuleGraphRule :: Recorder (WithPriority Log ) -> Rules ()
614
627
getModuleGraphRule recorder = defineEarlyCutOffNoFile (cmapWithPrio LogShake recorder) $ \ GetModuleGraph -> do
615
628
fs <- toKnownFiles <$> useNoFile_ GetKnownTargets
@@ -646,6 +659,7 @@ typeCheckRuleDefinition hsc pm = do
646
659
unlift <- askUnliftIO
647
660
let dets = TypecheckHelpers
648
661
{ getLinkables = unliftIO unlift . uses_ GetLinkable
662
+ , getModuleGraph = unliftIO unlift $ useNoFile_ GetModuleGraph
649
663
}
650
664
addUsageDependencies $ liftIO $
651
665
typecheckModule defer hsc dets pm
@@ -757,7 +771,8 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do
757
771
nubOrdOn mkNodeKey (ModuleNode final_deps ms : concatMap mgModSummaries' mgs)
758
772
liftIO $ evaluate $ liftRnf rwhnf module_graph_nodes
759
773
return $ mkModuleGraph module_graph_nodes
760
- session' <- liftIO $ mergeEnvs hsc mg ms inLoadOrder depSessions
774
+ de <- useNoFile_ GetModuleGraph
775
+ session' <- liftIO $ mergeEnvs hsc mg de ms inLoadOrder depSessions
761
776
762
777
-- Here we avoid a call to to `newHscEnvEqWithImportPaths`, which creates a new
763
778
-- ExportsMap when it is called. We only need to create the ExportsMap once per
@@ -786,9 +801,11 @@ getModIfaceFromDiskRule recorder = defineEarlyCutoff (cmapWithPrio LogShake reco
786
801
, old_value = m_old
787
802
, get_file_version = use GetModificationTime_ {missingFileDiagnostics = False }
788
803
, get_linkable_hashes = \ fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs
804
+ , get_module_graph = useNoFile_ GetModuleGraph
789
805
, regenerate = regenerateHiFile session f ms
790
806
}
791
- r <- loadInterface (hscEnv session) ms linkableType recompInfo
807
+ hsc_env' <- setFileCacheHook (hscEnv session)
808
+ r <- loadInterface hsc_env' ms linkableType recompInfo
792
809
case r of
793
810
(diags, Nothing ) -> return (Nothing , (diags, Nothing ))
794
811
(diags, Just x) -> do
@@ -856,7 +873,7 @@ getModSummaryRule displayTHWarning recorder = do
856
873
defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \ GetModSummary f -> do
857
874
session' <- hscEnv <$> use_ GhcSession f
858
875
modify_dflags <- getModifyDynFlags dynFlagsModifyGlobal
859
- let session = hscSetFlags (modify_dflags $ hsc_dflags session') session'
876
+ let session = setNonHomeFCHook $ hscSetFlags (modify_dflags $ hsc_dflags session') session' -- TODO wz1000
860
877
(modTime, mFileContent) <- getFileModTimeContents f
861
878
let fp = fromNormalizedFilePath f
862
879
modS <- liftIO $ runExceptT $
@@ -887,8 +904,9 @@ getModSummaryRule displayTHWarning recorder = do
887
904
generateCore :: RunSimplifier -> NormalizedFilePath -> Action (IdeResult ModGuts )
888
905
generateCore runSimplifier file = do
889
906
packageState <- hscEnv <$> use_ GhcSessionDeps file
907
+ hsc' <- setFileCacheHook packageState
890
908
tm <- use_ TypeCheck file
891
- liftIO $ compileModule runSimplifier packageState (tmrModSummary tm) (tmrTypechecked tm)
909
+ liftIO $ compileModule runSimplifier hsc' (tmrModSummary tm) (tmrTypechecked tm)
892
910
893
911
generateCoreRule :: Recorder (WithPriority Log ) -> Rules ()
894
912
generateCoreRule recorder =
@@ -903,14 +921,15 @@ getModIfaceRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $
903
921
tmr <- use_ TypeCheck f
904
922
linkableType <- getLinkableType f
905
923
hsc <- hscEnv <$> use_ GhcSessionDeps f
924
+ hsc' <- setFileCacheHook hsc
906
925
let compile = fmap ([] ,) $ use GenerateCore f
907
926
se <- getShakeExtras
908
- (diags, ! mbHiFile) <- writeCoreFileIfNeeded se hsc linkableType compile tmr
927
+ (diags, ! mbHiFile) <- writeCoreFileIfNeeded se hsc' linkableType compile tmr
909
928
let fp = hiFileFingerPrint <$> mbHiFile
910
929
hiDiags <- case mbHiFile of
911
930
Just hiFile
912
931
| OnDisk <- status
913
- , not (tmrDeferredError tmr) -> liftIO $ writeHiFile se hsc hiFile
932
+ , not (tmrDeferredError tmr) -> liftIO $ writeHiFile se hsc' hiFile
914
933
_ -> pure []
915
934
return (fp, (diags++ hiDiags, mbHiFile))
916
935
NotFOI -> do
@@ -934,12 +953,21 @@ incrementRebuildCount = do
934
953
count <- getRebuildCountVar <$> getIdeGlobalAction
935
954
liftIO $ atomically $ modifyTVar' count (+ 1 )
936
955
956
+ setFileCacheHook :: HscEnv -> Action HscEnv
957
+ setFileCacheHook old_hsc_env = do
958
+ #if MIN_VERSION_ghc(9,11,0)
959
+ unlift <- askUnliftIO
960
+ return $ old_hsc_env { hsc_FC = (hsc_FC old_hsc_env) { lookupFileCache = unliftIO unlift . use_ GetFileHash . toNormalizedFilePath' } }
961
+ #else
962
+ return old_hsc_env
963
+ #endif
964
+
937
965
-- | Also generates and indexes the `.hie` file, along with the `.o` file if needed
938
966
-- Invariant maintained is that if the `.hi` file was successfully written, then the
939
967
-- `.hie` and `.o` file (if needed) were also successfully written
940
968
regenerateHiFile :: HscEnvEq -> NormalizedFilePath -> ModSummary -> Maybe LinkableType -> Action ([FileDiagnostic ], Maybe HiFileResult )
941
969
regenerateHiFile sess f ms compNeeded = do
942
- let hsc = hscEnv sess
970
+ hsc <- setFileCacheHook ( hscEnv sess)
943
971
opt <- getIdeOptions
944
972
945
973
-- Embed haddocks in the interface file
@@ -1038,6 +1066,13 @@ getLinkableRule recorder =
1038
1066
HiFileResult {hirModSummary, hirModIface, hirModDetails, hirCoreFp} <- use_ GetModIface f
1039
1067
let obj_file = ml_obj_file (ms_location hirModSummary)
1040
1068
core_file = ml_core_file (ms_location hirModSummary)
1069
+ #if MIN_VERSION_ghc(9,11,0)
1070
+ mkLinkable t mod l = Linkable t mod (pure l)
1071
+ dotO o = DotO o ModuleObject
1072
+ #else
1073
+ mkLinkable t mod l = LM t mod [l]
1074
+ dotO = DotO
1075
+ #endif
1041
1076
case hirCoreFp of
1042
1077
Nothing -> error $ " called GetLinkable for a file without a linkable: " ++ show f
1043
1078
Just (bin_core, fileHash) -> do
@@ -1063,10 +1098,15 @@ getLinkableRule recorder =
1063
1098
else pure Nothing
1064
1099
case mobj_time of
1065
1100
Just obj_t
1066
- | obj_t >= core_t -> pure ([] , Just $ HomeModInfo hirModIface hirModDetails (justObjects $ LM (posixSecondsToUTCTime obj_t) (ms_mod hirModSummary) [ DotO obj_file] ))
1101
+ | obj_t >= core_t -> pure ([] , Just $ HomeModInfo hirModIface hirModDetails (justObjects $ mkLinkable (posixSecondsToUTCTime obj_t) (ms_mod hirModSummary) (dotO obj_file) ))
1067
1102
_ -> liftIO $ coreFileToLinkable linkableType (hscEnv session) hirModSummary hirModIface hirModDetails bin_core (error " object doesn't have time" )
1068
1103
-- Record the linkable so we know not to unload it, and unload old versions
1069
- whenJust ((homeModInfoByteCode =<< hmi) <|> (homeModInfoObject =<< hmi)) $ \ (LM time mod _) -> do
1104
+ whenJust ((homeModInfoByteCode =<< hmi) <|> (homeModInfoObject =<< hmi))
1105
+ #if MIN_VERSION_ghc(9,11,0)
1106
+ $ \ (Linkable time mod _) -> do
1107
+ #else
1108
+ $ \ (LM time mod _) -> do
1109
+ #endif
1070
1110
compiledLinkables <- getCompiledLinkables <$> getIdeGlobalAction
1071
1111
liftIO $ modifyVar compiledLinkables $ \ old -> do
1072
1112
let ! to_keep = extendModuleEnv old mod time
@@ -1080,7 +1120,9 @@ getLinkableRule recorder =
1080
1120
-- just before returning it to be loaded. This has a substantial effect on recompile
1081
1121
-- times as the number of loaded modules and splices increases.
1082
1122
--
1083
- unload (hscEnv session) (map (\ (mod', time') -> LM time' mod' [] ) $ moduleEnvToList to_keep)
1123
+ -- We use a dummy DotA linkable part to fake a NativeCode linkable.
1124
+ -- The unload function doesn't care about the exact linkable parts.
1125
+ unload (hscEnv session) (map (\ (mod', time') -> mkLinkable time' mod' (DotA " dummy" )) $ moduleEnvToList to_keep)
1084
1126
return (to_keep, () )
1085
1127
return (fileHash <$ hmi, (warns, LinkableResult <$> hmi <*> pure fileHash))
1086
1128
@@ -1178,12 +1220,13 @@ mainRule recorder RulesConfig{..} = do
1178
1220
reportImportCyclesRule recorder
1179
1221
typeCheckRule recorder
1180
1222
getDocMapRule recorder
1181
- loadGhcSession recorder GhcSessionDepsConfig {fullModuleGraph}
1223
+ loadGhcSession recorder def {fullModuleGraph}
1182
1224
getModIfaceFromDiskRule recorder
1183
1225
getModIfaceFromDiskAndIndexRule recorder
1184
1226
getModIfaceRule recorder
1185
1227
getModSummaryRule templateHaskellWarning recorder
1186
1228
getModuleGraphRule recorder
1229
+ getFileHashRule recorder
1187
1230
knownFilesRule recorder
1188
1231
getClientSettingsRule recorder
1189
1232
getHieAstsRule recorder
0 commit comments