Skip to content

Commit ac14ad2

Browse files
pepeiborrapepeiborra
authored
Review early cutoff fingerprints (#1547)
* Review early cutoff fingerprints Some of these were unnecessary, while others were very inefficient * fix lint * fix one more fingerprint * GHC compat.
1 parent df51305 commit ac14ad2

File tree

6 files changed

+86
-56
lines changed

6 files changed

+86
-56
lines changed

‎ghcide/src/Development/IDE/Core/Compile.hs

Lines changed: 5 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -114,8 +114,6 @@ import Control.Concurrent.Extra
114114
import Control.Concurrent.STM hiding (orElse)
115115
import Data.Aeson (toJSON)
116116
import Data.Binary
117-
import Data.Binary.Put
118-
import qualified Data.ByteString.Lazy as LBS
119117
import Data.Coerce
120118
import Data.Functor
121119
import qualified Data.HashMap.Strict as HashMap
@@ -242,7 +240,7 @@ mkHiFileResultNoCompile session tcm = do
242240
(iface, _) <- mkIfaceTc hsc_env_tmp Nothing sf details tcGblEnv
243241
#endif
244242
let mod_info = HomeModInfo iface details Nothing
245-
pure $! HiFileResult ms mod_info
243+
pure $! mkHiFileResult ms mod_info
246244

247245
mkHiFileResultCompile
248246
:: HscEnv
@@ -277,7 +275,7 @@ mkHiFileResultCompile session' tcm simplified_guts ltype = catchErrs $ do
277275
(final_iface,_) <- mkIface session Nothing details simplified_guts
278276
#endif
279277
let mod_info = HomeModInfo final_iface details linkable
280-
pure (diags, Just $! HiFileResult ms mod_info)
278+
pure (diags, Just $! mkHiFileResult ms mod_info)
281279

282280
where
283281
dflags = hsc_dflags session'
@@ -750,13 +748,12 @@ getModSummaryFromImports env fp modTime contents = do
750748
-- Compute a fingerprint from the contents of `ModSummary`,
751749
-- eliding the timestamps, the preprocessed source and other non relevant fields
752750
computeFingerprint opts ModSummary{..} = do
753-
let moduleUniques = runPut $ do
751+
fingerPrintImports <- fingerprintFromPut $ do
754752
put $ uniq $ moduleNameFS $ moduleName ms_mod
755753
forM_ (ms_srcimps ++ ms_textual_imps) $ \(mb_p, m) -> do
756754
put $ uniq $ moduleNameFS $ unLoc m
757755
whenJust mb_p $ put . uniq
758-
fingerPrintImports <- fingerprintFromByteString $ LBS.toStrict moduleUniques
759-
return $ fingerprintFingerprints $
756+
return $! fingerprintFingerprints $
760757
[ fingerprintString fp
761758
, fingerPrintImports
762759
] ++ map fingerprintString opts
@@ -927,7 +924,7 @@ loadInterface session ms sourceMod linkableNeeded regen = do
927924
if objUpToDate
928925
then do
929926
hmi <- liftIO $ mkDetailsFromIface sessionWithMsDynFlags iface linkable
930-
return ([], Just $ HiFileResult ms hmi)
927+
return ([], Just $ mkHiFileResult ms hmi)
931928
else regen linkableNeeded
932929
(_reason, _) -> regen linkableNeeded
933930

‎ghcide/src/Development/IDE/Core/FileStore.hs

Lines changed: 15 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,7 @@ import Control.Concurrent.STM (atomically)
2727
import Control.Concurrent.STM.TQueue (writeTQueue)
2828
import Control.Exception
2929
import Control.Monad.Extra
30-
import qualified Data.ByteString.Char8 as BS
30+
import qualified Data.ByteString as BS
3131
import Data.Either.Extra
3232
import qualified Data.HashMap.Strict as HM
3333
import Data.Int (Int64)
@@ -46,7 +46,6 @@ import Development.IDE.Types.Diagnostics
4646
import Development.IDE.Types.Location
4747
import Development.IDE.Types.Options
4848
import Development.Shake
49-
import Development.Shake.Classes
5049
import HieDb.Create (deleteMissingRealFiles)
5150
import Ide.Plugin.Config (CheckParents (..))
5251
import System.IO.Error
@@ -66,12 +65,13 @@ import qualified System.Posix.Error as Posix
6665

6766
import qualified Development.IDE.Types.Logger as L
6867

68+
import qualified Data.Binary as B
69+
import qualified Data.ByteString.Lazy as LBS
6970
import Language.LSP.Server hiding
7071
(getVirtualFile)
7172
import qualified Language.LSP.Server as LSP
7273
import Language.LSP.Types (FileChangeType (FcChanged),
7374
FileEvent (FileEvent),
74-
NormalizedFilePath (NormalizedFilePath),
7575
toNormalizedFilePath,
7676
uriToFilePath)
7777
import Language.LSP.VFS
@@ -102,8 +102,16 @@ makeLSPVFSHandle lspEnv = VFSHandle
102102
isFileOfInterestRule :: Rules ()
103103
isFileOfInterestRule = defineEarlyCutoff $ RuleNoDiagnostics $ \IsFileOfInterest f -> do
104104
filesOfInterest <- getFilesOfInterest
105-
let res = maybe NotFOI IsFOI $ f `HM.lookup` filesOfInterest
106-
return (Just $ BS.pack $ show $ hash res, Just res)
105+
let foi = maybe NotFOI IsFOI $ f `HM.lookup` filesOfInterest
106+
fp = summarize foi
107+
res = (Just fp, Just foi)
108+
return res
109+
where
110+
summarize NotFOI = BS.singleton 0
111+
summarize (IsFOI OnDisk) = BS.singleton 1
112+
summarize (IsFOI (Modified False)) = BS.singleton 2
113+
summarize (IsFOI (Modified True)) = BS.singleton 3
114+
107115

108116
getModificationTimeRule :: VFSHandle -> (NormalizedFilePath -> Action Bool) -> Rules ()
109117
getModificationTimeRule vfs isWatched = defineEarlyCutoff $ Rule $ \(GetModificationTime_ missingFileDiags) file ->
@@ -117,15 +125,15 @@ getModificationTimeImpl :: VFSHandle
117125
(Maybe BS.ByteString, ([FileDiagnostic], Maybe FileVersion))
118126
getModificationTimeImpl vfs isWatched missingFileDiags file = do
119127
let file' = fromNormalizedFilePath file
120-
let wrap time@(l,s) = (Just $ BS.pack $ show time, ([], Just $ ModificationTime l s))
128+
let wrap time@(l,s) = (Just $ LBS.toStrict $ B.encode time, ([], Just $ ModificationTime l s))
121129
mbVirtual <- liftIO $ getVirtualFile vfs $ filePathToUri' file
122130
-- we use 'getVirtualFile' to discriminate FOIs so make that
123131
-- dependency explicit by using the IsFileOfInterest rule
124132
_ <- use_ IsFileOfInterest file
125133
case mbVirtual of
126134
Just (virtualFileVersion -> ver) -> do
127135
alwaysRerun
128-
pure (Just $ BS.pack $ show ver, ([], Just $ VFSVersion ver))
136+
pure (Just $ LBS.toStrict $ B.encode ver, ([], Just $ VFSVersion ver))
129137
Nothing -> do
130138
isWF <- isWatched file
131139
unless (isWF || isInterface file) alwaysRerun

‎ghcide/src/Development/IDE/Core/OfInterest.hs

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,6 @@ import Control.DeepSeq
1818
import Control.Exception
1919
import Control.Monad
2020
import Data.Binary
21-
import qualified Data.ByteString.UTF8 as BS
2221
import Data.HashMap.Strict (HashMap)
2322
import qualified Data.HashMap.Strict as HashMap
2423
import Data.Hashable
@@ -30,6 +29,7 @@ import GHC.Generics
3029

3130
import Control.Monad.Trans.Class
3231
import Control.Monad.Trans.Maybe
32+
import qualified Data.ByteString.Lazy as LBS
3333
import Data.List.Extra (nubOrd)
3434
import Data.Maybe (catMaybes)
3535
import Development.IDE.Core.RuleTypes
@@ -59,15 +59,13 @@ ofInterestRules = do
5959
defineEarlyCutoff $ RuleNoDiagnostics $ \GetFilesOfInterest _file -> assert (null $ fromNormalizedFilePath _file) $ do
6060
alwaysRerun
6161
filesOfInterest <- getFilesOfInterestUntracked
62-
pure (Just $ BS.fromString $ show filesOfInterest, Just filesOfInterest)
63-
62+
let !cutoff = LBS.toStrict $ encode $ HashMap.toList filesOfInterest
63+
pure (Just cutoff, Just filesOfInterest)
6464

6565
-- | Get the files that are open in the IDE.
6666
getFilesOfInterest :: Action (HashMap NormalizedFilePath FileOfInterestStatus)
6767
getFilesOfInterest = useNoFile_ GetFilesOfInterest
6868

69-
70-
7169
------------------------------------------------------------
7270
-- Exposed API
7371

‎ghcide/src/Development/IDE/Core/RuleTypes.hs

Lines changed: 15 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -36,10 +36,12 @@ import HscTypes (HomeModInfo,
3636
hm_iface,
3737
hm_linkable)
3838

39+
import qualified Data.Binary as B
3940
import Data.ByteString (ByteString)
40-
import qualified Data.ByteString.Char8 as BS
41+
import qualified Data.ByteString.Lazy as LBS
4142
import Data.Int (Int64)
4243
import Data.Text (Text)
44+
import Data.Time
4345
import Development.IDE.Import.FindImports (ArtifactsLocation)
4446
import Development.IDE.Spans.Common
4547
import Development.IDE.Spans.LocalBindings
@@ -156,15 +158,23 @@ data HiFileResult = HiFileResult
156158
-- a reference to a typechecked module
157159
, hirHomeMod :: !HomeModInfo
158160
-- ^ Includes the Linkable iff we need object files
161+
, hirIfaceFp :: ByteString
162+
-- ^ Fingerprint for the ModIface
163+
, hirLinkableFp :: ByteString
164+
-- ^ Fingerprint for the Linkable
159165
}
160166

161167
hiFileFingerPrint :: HiFileResult -> ByteString
162-
hiFileFingerPrint hfr = ifaceBS <> linkableBS
168+
hiFileFingerPrint HiFileResult{..} = hirIfaceFp <> hirLinkableFp
169+
170+
mkHiFileResult :: ModSummary -> HomeModInfo -> HiFileResult
171+
mkHiFileResult hirModSummary hirHomeMod = HiFileResult{..}
163172
where
164-
ifaceBS = fingerprintToBS . getModuleHash . hirModIface $ hfr -- will always be two bytes
165-
linkableBS = case hm_linkable $ hirHomeMod hfr of
173+
hirIfaceFp = fingerprintToBS . getModuleHash . hm_iface $ hirHomeMod -- will always be two bytes
174+
hirLinkableFp = case hm_linkable hirHomeMod of
166175
Nothing -> ""
167-
Just l -> BS.pack $ show $ linkableTime l
176+
Just (linkableTime -> l) -> LBS.toStrict $
177+
B.encode (fromEnum $ utctDay l, fromEnum $ utctDayTime l)
168178

169179
hirModIface :: HiFileResult -> ModIface
170180
hirModIface = hm_iface . hirHomeMod

0 commit comments

Comments
 (0)