git.iko.soy/ghcide
on master help sign in
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

commit126e39815b1743acd855530fc7c18fc7cf2c025f authorMatthew Pickering <matthewtpickering@gmail.com> dateFri 22 May 2020, 10:02 (6 years ago) parentb478b82
2 files changed+68−19
compare with master
unifiedsplit
src/Development/IDE/Core/PositionMapping.hs+48−10 src/Development/IDE/Core/Shake.hs+20−9
src/Development/IDE/Core/PositionMapping.hs+48−10
@@ -2,10 +2,15 @@
22-- SPDX-License-Identifier: Apache-2.0
33module 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
1419import Control.Monad
1520import qualified Data.Text as T
1621import 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+
2341toCurrentRange :: PositionMapping -> Range -> Maybe Range
2442toCurrentRange mapping (Range a b) =
2543 Range <$> toCurrentPosition mapping a <*> toCurrentPosition mapping b
@@ -28,13 +46,33 @@ fromCurrentRange :: PositionMapping -> Range -> Maybe Range
2846fromCurrentRange 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 }
3977applyChange posMapping _ = posMapping
4078
src/Development/IDE/Core/Shake.hs+20−9
@@ -53,7 +53,7 @@ import qualified Data.ByteString.Char8 as BS
5353import Data.Dynamic
5454import Data.Maybe
5555import Data.Map.Strict (Map)
56−import Data.List.Extra (foldl', partition, takeEnd)
56+import Data.List.Extra (partition, takeEnd)
5757import qualified Data.Set as Set
5858import qualified Data.Text as T
5959import 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
203205mappingForVersion
204− :: HMap.HashMap NormalizedUri (Map TextDocumentVersion PositionMapping)
206+ :: HMap.HashMap NormalizedUri (Map TextDocumentVersion (a, PositionMapping))
205207 -> NormalizedFilePath
206208 -> TextDocumentVersion
207209 -> PositionMapping
208210mappingForVersion 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
537539withProgress :: (Eq a, Hashable a) => Var (HMap.HashMap a Int) -> a -> Action b -> Action b
538540withProgress 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
542547defineEarlyCutoff
@@ -828,11 +833,17 @@ filterVersionMap =
828833 HMap.intersectionWith $ \versionsToKeep versionMap -> Map.restrictKeys versionMap versionsToKeep
829834
830835updatePositionMapping :: 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