Skip to content

Commit d4fd99e

Browse files
pepeiborrawz1000cocreature
authored
Interface file fixes (#645)
* Add test for inconsistent diagnostics * Refactoring ModIfaceFromDisk This started as a pure refactoring to clarify the responsibilities between ModIface and ModIfaceFromDisk, but ended up having some behaviour changes: 1. Regenerate interface when checkOldIface returns something other than UpToDate. This was a bug. 2. Do not generate a diagnostic when regenerating an interface. 2. Previously we conflated stale interface with other errors, and would regenerate in both cases. Now we only regenerate in the first case. Tentative fix for #597 * Split interface tests * Always recompile modules with TH splices Tentative fix for #614 TODO support stability * Fix expectDiagnostics in MacOs * Avoid File does not exist diagnostics for interface files Fixes #642 * Clarify interface tests * hlints * Performance fixes The previous changes were 10X slower, this is 20X faster than those, so 2X faster than upstream, for some benchmarks * formatting * Fix GetModificationTime identity The answer for a GetModification query is independent of the missingFileDiagnostics field (as the diagnostics are not part of the answer) * remove stale comment * Avoid calling ghcSessionDepsDefinition twice * Apply suggestions from code review Co-authored-by: Moritz Kiefer <[email protected]> * Code review feedback * Address review feedback https://github.com/digital-asset/ghcide/pull/645/files/49b0d9ac65399edf82a7a9cbbb8d8b5420458d8d#r443383239 * Change recomp to direct cradle Co-authored-by: Zubin Duggal <[email protected]> Co-authored-by: Moritz Kiefer <[email protected]>
1 parent ac8d7cd commit d4fd99e

File tree

10 files changed

+245
-116
lines changed

10 files changed

+245
-116
lines changed

src/Development/IDE/Core/Compile.hs

Lines changed: 29 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -38,7 +38,6 @@ import Development.IDE.GHC.Util
3838
import qualified GHC.LanguageExtensions.Type as GHC
3939
import Development.IDE.Types.Options
4040
import Development.IDE.Types.Location
41-
import Outputable
4241

4342
#if MIN_GHC_API_VERSION(8,6,0)
4443
import DynamicLoading (initializePlugins)
@@ -59,8 +58,6 @@ import GhcMonad
5958
import GhcPlugins as GHC hiding (fst3, (<>))
6059
import qualified HeaderInfo as Hdr
6160
import HscMain (hscInteractive, hscSimplify)
62-
import LoadIface (readIface)
63-
import qualified Maybes
6461
import MkIface
6562
import NameCache
6663
import StringBuffer as SB
@@ -81,7 +78,6 @@ import qualified Data.Map.Strict as Map
8178
import System.FilePath
8279
import System.Directory
8380
import System.IO.Extra
84-
import Data.Either.Extra (maybeToEither)
8581
import Control.DeepSeq (rnf)
8682
import Control.Exception (evaluate)
8783
import Exception (ExceptionMonad)
@@ -564,29 +560,36 @@ loadHieFile f = do
564560
let nameCache = initNameCache u []
565561
fmap (GHC.hie_file_result . fst) $ GHC.readHieFile nameCache f
566562

567-
-- | Retuns an up-to-date module interface if available.
563+
-- | Retuns an up-to-date module interface, regenerating if needed.
568564
-- Assumes file exists.
569565
-- Requires the 'HscEnv' to be set up with dependencies
570566
loadInterface
571-
:: HscEnv
567+
:: MonadIO m => HscEnv
572568
-> ModSummary
573-
-> [HiFileResult]
574-
-> IO (Either String ModIface)
575-
loadInterface session ms deps = do
576-
let hiFile = case ms_hsc_src ms of
577-
HsBootFile -> addBootSuffix (ml_hi_file $ ms_location ms)
578-
_ -> ml_hi_file $ ms_location ms
579-
r <- initIfaceLoad session $ readIface (ms_mod ms) hiFile
580-
case r of
581-
Maybes.Succeeded iface -> do
582-
session' <- foldM (\e d -> loadDepModuleIO (hirModIface d) Nothing e) session deps
583-
(reason, iface') <- checkOldIface session' ms SourceUnmodified (Just iface)
584-
return $ maybeToEither (showReason reason) iface'
585-
Maybes.Failed err -> do
586-
let errMsg = showSDoc (hsc_dflags session) err
587-
return $ Left errMsg
588-
589-
showReason :: RecompileRequired -> String
590-
showReason MustCompile = "Stale"
591-
showReason (RecompBecause reason) = "Stale (" ++ reason ++ ")"
592-
showReason UpToDate = "Up to date"
569+
-> SourceModified
570+
-> m ([FileDiagnostic], Maybe HiFileResult) -- ^ Action to regenerate an interface
571+
-> m ([FileDiagnostic], Maybe HiFileResult)
572+
loadInterface session ms sourceMod regen = do
573+
res <- liftIO $ checkOldIface session ms sourceMod Nothing
574+
case res of
575+
(UpToDate, Just x)
576+
-- If the module used TH splices when it was last
577+
-- compiled, then the recompilation check is not
578+
-- accurate enough (https://gitlab.haskell.org/ghc/ghc/-/issues/481)
579+
-- and we must ignore
580+
-- it. However, if the module is stable (none of
581+
-- the modules it depends on, directly or
582+
-- indirectly, changed), then we *can* skip
583+
-- recompilation. This is why the SourceModified
584+
-- type contains SourceUnmodifiedAndStable, and
585+
-- it's pretty important: otherwise ghc --make
586+
-- would always recompile TH modules, even if
587+
-- nothing at all has changed. Stability is just
588+
-- the same check that make is doing for us in
589+
-- one-shot mode.
590+
| not (mi_used_th x) || stable
591+
-> return ([], Just $ HiFileResult ms x)
592+
(_reason, _) -> regen
593+
where
594+
-- TODO support stability
595+
stable = False

src/Development/IDE/Core/FileStore.hs

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -94,7 +94,7 @@ instance Binary GetFileContents
9494

9595
getModificationTimeRule :: VFSHandle -> Rules ()
9696
getModificationTimeRule vfs =
97-
defineEarlyCutoff $ \GetModificationTime file -> do
97+
defineEarlyCutoff $ \(GetModificationTime_ missingFileDiags) file -> do
9898
let file' = fromNormalizedFilePath file
9999
let wrap time@(l,s) = (Just $ BS.pack $ show time, ([], Just $ ModificationTime l s))
100100
alwaysRerun
@@ -106,7 +106,10 @@ getModificationTimeRule vfs =
106106
`catch` \(e :: IOException) -> do
107107
let err | isDoesNotExistError e = "File does not exist: " ++ file'
108108
| otherwise = "IO error while reading " ++ file' ++ ", " ++ displayException e
109-
return (Nothing, ([ideErrorText file $ T.pack err], Nothing))
109+
diag = ideErrorText file (T.pack err)
110+
if isDoesNotExistError e && not missingFileDiags
111+
then return (Nothing, ([], Nothing))
112+
else return (Nothing, ([diag], Nothing))
110113
where
111114
-- Dir.getModificationTime is surprisingly slow since it performs
112115
-- a ton of conversions. Since we do not actually care about

src/Development/IDE/Core/Rules.hs

Lines changed: 56 additions & 77 deletions
Original file line numberDiff line numberDiff line change
@@ -622,37 +622,27 @@ ghcSessionDepsDefinition file = do
622622

623623
getModIfaceFromDiskRule :: Rules ()
624624
getModIfaceFromDiskRule = defineEarlyCutoff $ \GetModIfaceFromDisk f -> do
625-
-- get all dependencies interface files, to check for freshness
626-
(deps,_) <- use_ GetLocatedImports f
627-
depHis <- traverse (use GetModIface) (mapMaybe (fmap artifactFilePath . snd) deps)
628-
629625
ms <- use_ GetModSummary f
630-
let hiFile = toNormalizedFilePath'
631-
$ case ms_hsc_src ms of
632-
HsBootFile -> addBootSuffix (ml_hi_file $ ms_location ms)
633-
_ -> ml_hi_file $ ms_location ms
634-
635-
case sequence depHis of
636-
Nothing -> pure (Nothing, ([], Nothing))
637-
Just deps -> do
638-
mbHiVersion <- use GetModificationTime hiFile
626+
(diags_session, mb_session) <- ghcSessionDepsDefinition f
627+
case mb_session of
628+
Nothing -> return (Nothing, (diags_session, Nothing))
629+
Just session -> do
630+
let hiFile = toNormalizedFilePath'
631+
$ case ms_hsc_src ms of
632+
HsBootFile -> addBootSuffix (ml_hi_file $ ms_location ms)
633+
_ -> ml_hi_file $ ms_location ms
634+
mbHiVersion <- use GetModificationTime_{missingFileDiagnostics=False} hiFile
639635
modVersion <- use_ GetModificationTime f
640-
case (mbHiVersion, modVersion) of
641-
(Just hiVersion, ModificationTime{})
642-
| modificationTime hiVersion >= modificationTime modVersion -> do
643-
session <- hscEnv <$> use_ GhcSession f
644-
r <- liftIO $ loadInterface session ms deps
645-
case r of
646-
Right iface -> do
647-
let result = HiFileResult ms iface
648-
return (Just (fingerprintToBS (getModuleHash iface)), ([], Just result))
649-
Left err -> do
650-
let diag = ideErrorWithSource (Just "interface file loading") (Just DsError) f . T.pack $ err
651-
return (Nothing, (pure diag, Nothing))
652-
(_, VFSVersion{}) ->
653-
error "internal error - GetModIfaceFromDisk of file of interest"
654-
_ ->
655-
pure (Nothing, ([], Nothing))
636+
let sourceModified = case mbHiVersion of
637+
Nothing -> SourceModified
638+
Just x -> if modificationTime x >= modificationTime modVersion
639+
then SourceUnmodified else SourceModified
640+
r <- loadInterface (hscEnv session) ms sourceModified (regenerateHiFile session f)
641+
case r of
642+
(diags, Just x) -> do
643+
let fp = fingerprintToBS (getModuleHash (hirModIface x))
644+
return (Just fp, (diags <> diags_session, Just x))
645+
(diags, Nothing) -> return (Nothing, (diags ++ diags_session, Nothing))
656646

657647
getModSummaryRule :: Rules ()
658648
getModSummaryRule = defineEarlyCutoff $ \GetModSummary f -> do
@@ -687,62 +677,51 @@ getModIfaceRule :: Rules ()
687677
getModIfaceRule = define $ \GetModIface f -> do
688678
#if MIN_GHC_API_VERSION(8,6,0) && !defined(GHC_LIB)
689679
fileOfInterest <- use_ IsFileOfInterest f
690-
let useHiFile =
691-
-- Never load interface files for files of interest
692-
not fileOfInterest
693-
mbHiFile <- if useHiFile then use GetModIfaceFromDisk f else return Nothing
694-
case mbHiFile of
695-
Just x ->
696-
return ([], Just x)
697-
Nothing
698-
| fileOfInterest -> do
699-
-- For files of interest only, create a Shake dependency on typecheck
680+
if fileOfInterest
681+
then do
682+
-- Never load from disk for files of interest
700683
tmr <- use TypeCheck f
701-
return ([], extract tmr)
702-
| otherwise -> do
703-
-- the interface file does not exist or is out of date.
704-
-- Invoke typechecking directly to update it without incurring a dependency
705-
-- on the parsed module and the typecheck rules
706-
sess <- use_ GhcSession f
707-
let hsc = hscEnv sess
708-
-- After parsing the module remove all package imports referring to
709-
-- these packages as we have already dealt with what they map to.
710-
comp_pkgs = mapMaybe (fmap fst . mkImportDirs (hsc_dflags hsc)) (deps sess)
711-
opt <- getIdeOptions
712-
(_, contents) <- getFileContents f
713-
-- Embed --haddocks in the interface file
714-
(_, (diags, mb_pm)) <- liftIO $ getParsedModuleDefinition (withOptHaddock hsc) opt comp_pkgs f contents
715-
(diags, mb_pm) <- case mb_pm of
716-
Just _ -> return (diags, mb_pm)
717-
Nothing -> do
718-
-- if parsing fails, try parsing again with Haddock turned off
719-
(_, (diagsNoHaddock, mb_pm)) <- liftIO $ getParsedModuleDefinition hsc opt comp_pkgs f contents
720-
return (mergeParseErrorsHaddock diagsNoHaddock diags, mb_pm)
721-
case mb_pm of
722-
Nothing -> return (diags, Nothing)
723-
Just pm -> do
724-
-- We want GhcSessionDeps cache objects only for files of interest
725-
-- As that's no the case here, call the implementation directly
726-
(diags, mb_hsc) <- ghcSessionDepsDefinition f
727-
case mb_hsc of
728-
Nothing -> return (diags, Nothing)
729-
Just hsc -> do
730-
(diags', tmr) <- typeCheckRuleDefinition (hscEnv hsc) pm DoGenerateInterfaceFiles
731-
-- Bang pattern is important to avoid leaking 'tmr'
732-
let !res = extract tmr
733-
return (diags <> diags', res)
734-
where
735-
extract Nothing = Nothing
736-
extract (Just tmr) =
737-
-- Bang patterns are important to force the inner fields
738-
Just $! HiFileResult (tmrModSummary tmr) (hm_iface $ tmrModInfo tmr)
684+
return ([], extractHiFileResult tmr)
685+
else
686+
([],) <$> use GetModIfaceFromDisk f
739687
#else
740688
tm <- use TypeCheck f
741689
let modIface = hm_iface . tmrModInfo <$> tm
742690
modSummary = tmrModSummary <$> tm
743691
return ([], HiFileResult <$> modSummary <*> modIface)
744692
#endif
745693

694+
regenerateHiFile :: HscEnvEq -> NormalizedFilePath -> Action ([FileDiagnostic], Maybe HiFileResult)
695+
regenerateHiFile sess f = do
696+
let hsc = hscEnv sess
697+
-- After parsing the module remove all package imports referring to
698+
-- these packages as we have already dealt with what they map to.
699+
comp_pkgs = mapMaybe (fmap fst . mkImportDirs (hsc_dflags hsc)) (deps sess)
700+
opt <- getIdeOptions
701+
(_, contents) <- getFileContents f
702+
-- Embed --haddocks in the interface file
703+
(_, (diags, mb_pm)) <- liftIO $ getParsedModuleDefinition (withOptHaddock hsc) opt comp_pkgs f contents
704+
(diags, mb_pm) <- case mb_pm of
705+
Just _ -> return (diags, mb_pm)
706+
Nothing -> do
707+
-- if parsing fails, try parsing again with Haddock turned off
708+
(_, (diagsNoHaddock, mb_pm)) <- liftIO $ getParsedModuleDefinition hsc opt comp_pkgs f contents
709+
return (mergeParseErrorsHaddock diagsNoHaddock diags, mb_pm)
710+
case mb_pm of
711+
Nothing -> return (diags, Nothing)
712+
Just pm -> do
713+
-- Invoke typechecking directly to update it without incurring a dependency
714+
-- on the parsed module and the typecheck rules
715+
(diags', tmr) <- typeCheckRuleDefinition hsc pm DoGenerateInterfaceFiles
716+
-- Bang pattern is important to avoid leaking 'tmr'
717+
let !res = extractHiFileResult tmr
718+
return (diags <> diags', res)
719+
720+
extractHiFileResult :: Maybe TcModuleResult -> Maybe HiFileResult
721+
extractHiFileResult Nothing = Nothing
722+
extractHiFileResult (Just tmr) =
723+
-- Bang patterns are important to force the inner fields
724+
Just $! HiFileResult (tmrModSummary tmr) (hm_iface $ tmrModInfo tmr)
746725

747726
isFileOfInterestRule :: Rules ()
748727
isFileOfInterestRule = defineEarlyCutoff $ \IsFileOfInterest f -> do

src/Development/IDE/Core/Shake.hs

Lines changed: 24 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,12 @@
1-
{-# LANGUAGE RecursiveDo #-}
21
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
32
-- SPDX-License-Identifier: Apache-2.0
43

54
{-# LANGUAGE ExistentialQuantification #-}
65
{-# LANGUAGE RankNTypes #-}
6+
{-# LANGUAGE RecursiveDo #-}
77
{-# LANGUAGE TypeFamilies #-}
88
{-# LANGUAGE ConstraintKinds #-}
9+
{-# LANGUAGE PatternSynonyms #-}
910

1011
-- | A Shake implementation of the compiler service.
1112
--
@@ -23,7 +24,8 @@
2324
module Development.IDE.Core.Shake(
2425
IdeState, shakeExtras,
2526
ShakeExtras(..), getShakeExtras, getShakeExtrasRules,
26-
IdeRule, IdeResult, GetModificationTime(..),
27+
IdeRule, IdeResult,
28+
GetModificationTime(GetModificationTime, GetModificationTime_, missingFileDiagnostics),
2729
shakeOpen, shakeShut,
2830
shakeRestart,
2931
shakeEnqueue,
@@ -903,12 +905,29 @@ actionLogger = do
903905
return logger
904906

905907

906-
data GetModificationTime = GetModificationTime
907-
deriving (Eq, Show, Generic)
908-
instance Hashable GetModificationTime
908+
-- The Shake key type for getModificationTime queries
909+
data GetModificationTime = GetModificationTime_
910+
{ missingFileDiagnostics :: Bool
911+
-- ^ If false, missing file diagnostics are not reported
912+
}
913+
deriving (Show, Generic)
914+
915+
instance Eq GetModificationTime where
916+
-- Since the diagnostics are not part of the answer, the query identity is
917+
-- independent from the 'missingFileDiagnostics' field
918+
_ == _ = True
919+
920+
instance Hashable GetModificationTime where
921+
-- Since the diagnostics are not part of the answer, the query identity is
922+
-- independent from the 'missingFileDiagnostics' field
923+
hashWithSalt salt _ = salt
924+
909925
instance NFData GetModificationTime
910926
instance Binary GetModificationTime
911927

928+
pattern GetModificationTime :: GetModificationTime
929+
pattern GetModificationTime = GetModificationTime_ {missingFileDiagnostics=True}
930+
912931
-- | Get the modification time of a file.
913932
type instance RuleResult GetModificationTime = FileVersion
914933

test/data/recomp/A.hs

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
module A(x) where
2+
3+
import B
4+
5+
x :: Int
6+
x = y

test/data/recomp/B.hs

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
module B(y) where
2+
3+
y :: Int
4+
y = undefined

test/data/recomp/P.hs

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
module P() where
2+
import A
3+
import B
4+
5+
bar = x :: Int

test/data/recomp/hie.yaml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
cradle: {direct: {arguments: ["-Wmissing-signatures","B", "A", "P"]}}

0 commit comments

Comments
 (0)