Skip to content

Commit 126e398

Browse files
mpickeringmpickering
authored
Fix 3 space leaks and refactoring of PositionMapping (#557)
* Rats: Fix space leak in withProgress Eta-expanding the function means GHC no longer allocates a function closure every time `withProgress` is called (which is a lot). See: https://www.joachim-breitner.de/blog/763-Faster_Winter_5__Eta-Expanding_ReaderT * Rats: Share computation of position mapping Ensure that PositionMappings are shared between versions There was a quadratic space leak as the tails of the position maps were not shared with each other. Now the space usage is linear which is produces more acceptable levels of residency after 3000 modifications. * Rats: Eta-expand modification function See: https://www.joachim-breitner.de/blog/763-Faster_Winter_5__Eta-Expanding_ReaderT * Add a comment warning about eta-reducing * Distinguish between a Delta and a Mapping in PositionMapping A Delta is a change between two versions A Mapping is a change from the current version to a specific older version. Fix hlint Fix hlint
1 parent b478b82 commit 126e398

File tree

2 files changed

+68
-19
lines changed

2 files changed

+68
-19
lines changed

‎src/Development/IDE/Core/PositionMapping.hs

Lines changed: 48 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -2,10 +2,15 @@
22
-- SPDX-License-Identifier: Apache-2.0
33
module Development.IDE.Core.PositionMapping
44
( PositionMapping(..)
5+
, fromCurrentPosition
6+
, toCurrentPosition
7+
, PositionDelta(..)
8+
, addDelta
9+
, mkDelta
510
, toCurrentRange
611
, fromCurrentRange
712
, applyChange
8-
, idMapping
13+
, zeroMapping
914
-- toCurrent and fromCurrent are mainly exposed for testing
1015
, toCurrent
1116
, fromCurrent
@@ -14,12 +19,25 @@ module Development.IDE.Core.PositionMapping
1419
import Control.Monad
1520
import qualified Data.Text as T
1621
import Language.Haskell.LSP.Types
22+
import Data.List
1723

18-
data PositionMapping = PositionMapping
19-
{ toCurrentPosition :: !(Position -> Maybe Position)
20-
, fromCurrentPosition :: !(Position -> Maybe Position)
24+
-- The position delta is the difference between two versions
25+
data PositionDelta = PositionDelta
26+
{ toDelta :: !(Position -> Maybe Position)
27+
, fromDelta :: !(Position -> Maybe Position)
2128
}
2229

30+
fromCurrentPosition :: PositionMapping -> Position -> Maybe Position
31+
fromCurrentPosition (PositionMapping pm) = fromDelta pm
32+
33+
toCurrentPosition :: PositionMapping -> Position -> Maybe Position
34+
toCurrentPosition (PositionMapping pm) = toDelta pm
35+
36+
-- A position mapping is the difference from the current version to
37+
-- a specific version
38+
newtype PositionMapping = PositionMapping PositionDelta
39+
40+
2341
toCurrentRange :: PositionMapping -> Range -> Maybe Range
2442
toCurrentRange mapping (Range a b) =
2543
Range <$> toCurrentPosition mapping a <*> toCurrentPosition mapping b
@@ -28,13 +46,33 @@ fromCurrentRange :: PositionMapping -> Range -> Maybe Range
2846
fromCurrentRange mapping (Range a b) =
2947
Range <$> fromCurrentPosition mapping a <*> fromCurrentPosition mapping b
3048

31-
idMapping :: PositionMapping
32-
idMapping = PositionMapping Just Just
49+
zeroMapping :: PositionMapping
50+
zeroMapping = PositionMapping idDelta
51+
52+
-- | Compose two position mappings. Composes in the same way as function
53+
-- composition (ie the second argument is applyed to the position first).
54+
composeDelta :: PositionDelta
55+
-> PositionDelta
56+
-> PositionDelta
57+
composeDelta (PositionDelta to1 from1) (PositionDelta to2 from2) =
58+
PositionDelta (to1 <=< to2)
59+
(from1 >=> from2)
60+
61+
idDelta :: PositionDelta
62+
idDelta = PositionDelta Just Just
63+
64+
-- | Convert a set of changes into a delta from k to k + 1
65+
mkDelta :: [TextDocumentContentChangeEvent] -> PositionDelta
66+
mkDelta cs = foldl' applyChange idDelta cs
67+
68+
-- | Add a new delta onto a Mapping k n to make a Mapping (k - 1) n
69+
addDelta :: PositionDelta -> PositionMapping -> PositionMapping
70+
addDelta delta (PositionMapping pm) = PositionMapping (composeDelta delta pm)
3371

34-
applyChange :: PositionMapping -> TextDocumentContentChangeEvent -> PositionMapping
35-
applyChange posMapping (TextDocumentContentChangeEvent (Just r) _ t) = PositionMapping
36-
{ toCurrentPosition = toCurrent r t <=< toCurrentPosition posMapping
37-
, fromCurrentPosition = fromCurrentPosition posMapping <=< fromCurrent r t
72+
applyChange :: PositionDelta -> TextDocumentContentChangeEvent -> PositionDelta
73+
applyChange PositionDelta{..} (TextDocumentContentChangeEvent (Just r) _ t) = PositionDelta
74+
{ toDelta = toCurrent r t <=< toDelta
75+
, fromDelta = fromDelta <=< fromCurrent r t
3876
}
3977
applyChange posMapping _ = posMapping
4078

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

Lines changed: 20 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -53,7 +53,7 @@ import qualified Data.ByteString.Char8 as BS
5353
import Data.Dynamic
5454
import Data.Maybe
5555
import Data.Map.Strict (Map)
56-
import Data.List.Extra (foldl', partition, takeEnd)
56+
import Data.List.Extra (partition, takeEnd)
5757
import qualified Data.Set as Set
5858
import qualified Data.Text as T
5959
import Data.Traversable (for)
@@ -97,9 +97,11 @@ data ShakeExtras = ShakeExtras
9797
,publishedDiagnostics :: Var (HMap.HashMap NormalizedUri [Diagnostic])
9898
-- ^ This represents the set of diagnostics that we have published.
9999
-- Due to debouncing not every change might get published.
100-
,positionMapping :: Var (HMap.HashMap NormalizedUri (Map TextDocumentVersion PositionMapping))
100+
,positionMapping :: Var (HMap.HashMap NormalizedUri (Map TextDocumentVersion (PositionDelta, PositionMapping)))
101101
-- ^ Map from a text document version to a PositionMapping that describes how to map
102102
-- positions in a version of that document to positions in the latest version
103+
-- First mapping is delta from previous version and second one is an
104+
-- accumlation of all previous mappings.
103105
,inProgress :: Var (HMap.HashMap NormalizedFilePath Int)
104106
-- ^ How many rules are running for each file
105107
}
@@ -201,12 +203,12 @@ valueVersion = \case
201203
Failed -> Nothing
202204

203205
mappingForVersion
204-
:: HMap.HashMap NormalizedUri (Map TextDocumentVersion PositionMapping)
206+
:: HMap.HashMap NormalizedUri (Map TextDocumentVersion (a, PositionMapping))
205207
-> NormalizedFilePath
206208
-> TextDocumentVersion
207209
-> PositionMapping
208210
mappingForVersion allMappings file ver =
209-
fromMaybe idMapping $
211+
maybe zeroMapping snd $
210212
Map.lookup ver =<<
211213
HMap.lookup (filePathToUri' file) allMappings
212214

@@ -536,7 +538,10 @@ usesWithStale key files = do
536538

537539
withProgress :: (Eq a, Hashable a) => Var (HMap.HashMap a Int) -> a -> Action b -> Action b
538540
withProgress var file = actionBracket (f succ) (const $ f pred) . const
539-
where f shift = modifyVar_ var $ return . HMap.alter (Just . shift . fromMaybe 0) file
541+
-- This functions are deliberately eta-expanded to avoid space leaks.
542+
-- Do not remove the eta-expansion without profiling a session with at
543+
-- least 1000 modifications.
544+
where f shift = modifyVar_ var $ \x -> return (HMap.alter (\x -> Just (shift (fromMaybe 0 x))) file x)
540545

541546

542547
defineEarlyCutoff
@@ -828,11 +833,17 @@ filterVersionMap =
828833
HMap.intersectionWith $ \versionsToKeep versionMap -> Map.restrictKeys versionMap versionsToKeep
829834

830835
updatePositionMapping :: IdeState -> VersionedTextDocumentIdentifier -> List TextDocumentContentChangeEvent -> IO ()
831-
updatePositionMapping IdeState{shakeExtras = ShakeExtras{positionMapping}} VersionedTextDocumentIdentifier{..} changes = do
836+
updatePositionMapping IdeState{shakeExtras = ShakeExtras{positionMapping}} VersionedTextDocumentIdentifier{..} (List changes) = do
832837
modifyVar_ positionMapping $ \allMappings -> do
833838
let uri = toNormalizedUri _uri
834839
let mappingForUri = HMap.lookupDefault Map.empty uri allMappings
835-
let updatedMapping =
836-
Map.insert _version idMapping $
837-
Map.map (\oldMapping -> foldl' applyChange oldMapping changes) mappingForUri
840+
let (_, updatedMapping) =
841+
-- Very important to use mapAccum here so that the tails of
842+
-- each mapping can be shared, otherwise quadratic space is
843+
-- used which is evident in long running sessions.
844+
Map.mapAccumRWithKey (\acc _k (delta, _) -> let new = addDelta delta acc in (new, (delta, acc)))
845+
zeroMapping
846+
(Map.insert _version (shared_change, zeroMapping) mappingForUri)
838847
pure $! HMap.insert uri updatedMapping allMappings
848+
where
849+
shared_change = mkDelta changes

0 commit comments

Comments
 (0)