Skip to content

Commit 47a6e76

Browse files
committed
GC fixes
1 parent a8b12d9 commit 47a6e76

File tree

1 file changed

+11
-8
lines changed

1 file changed

+11
-8
lines changed

ghcide/src/Development/IDE/Core/Shake.hs

Lines changed: 11 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -743,19 +743,22 @@ getHiddenDiagnostics IdeState{shakeExtras = ShakeExtras{hiddenDiagnostics}} = do
743743
garbageCollectDirtyKeys :: Action ()
744744
garbageCollectDirtyKeys = do
745745
start <- liftIO offsetTime
746-
dirtyKeys <- fromMaybe [] <$> getDirtySet
746+
dirtySet <- fromMaybe [] <$> getDirtySet
747747
extras <- getShakeExtras
748-
n <- liftIO $ modifyVar (state extras) $ \vmap ->
749-
evaluate $ foldl' removeDirtyKey (vmap, 0) dirtyKeys
748+
(n::Int, garbage) <- liftIO $ modifyVar (state extras) $ \vmap ->
749+
evaluate $ foldl' removeDirtyKey (vmap, (0,[])) dirtySet
750+
liftIO $ atomicModifyIORef_ (dirtyKeys extras) $ \x ->
751+
foldl' (flip HSet.insert) x garbage
750752
t <- liftIO start
751-
liftIO $ logDebug (logger extras) $ T.pack $
753+
when (n>0) $ liftIO $ logDebug (logger extras) $ T.pack $
752754
"Garbage collected " <> show n <> " keys (took " <> showDuration t <> ")"
753755
where
754-
removeDirtyKey :: (Values, Int) -> (Key, Int) -> (Values, Int)
755-
removeDirtyKey (vmap,counter) (k, age)
756+
-- removeDirtyKey :: (Values, Int) -> (Key, Int) -> (Values, [Key], Int)
757+
removeDirtyKey (vmap,(counter, keys)) (k, age)
756758
| age > garbageAge
757-
= let !c' = counter +1 in (HMap.delete k vmap, c')
758-
| otherwise = (vmap,counter)
759+
, (True, vmap') <- HMap.alterF (\prev -> (isJust prev, Nothing)) k vmap
760+
= let !c' = counter+1 in (vmap', (c', k:keys))
761+
| otherwise = (vmap, (counter, keys))
759762

760763
-- | Define a new Rule without early cutoff
761764
define

0 commit comments

Comments
 (0)