[Performance] Run refresh work in the existing force runner

hls-graph/src/Development/IDE/Graph/Internal/Database.hs

@@ -55,8 +55,46 @@ newDatabase databaseExtra databaseRules = do
     databaseValues <- atomically SMap.new
     pure Database{..}
 
+{- Note [Invalidation, Step Counter, and Stale Running States]
+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+hls-graph implements an in-memory, lock-less build graph designed for reactive
+builds and rapid cancellation/restart (e.g. when new LSP edits arrive).
+
+Invalidation Architecture:
+-----------------------------
+Invalidation operates through two complementary mechanisms:
+
+  a) Eager Invalidation ('incDatabase'):
+     When starting a build step, 'incDatabase' increments 'databaseStep' by 1.
+     If a subset of modified keys is supplied, 'transitiveDirtySet'
+     traverses the reverse dependency graph ('keyReverseDeps') and sets every
+     downstream key's status to 'Dirty' via 'updateDirty'.
+
+  b) Lazy Invalidation ('viewDirty' and 'databaseStep'):
+     When a build session is interrupted, in-flight worker threads are aborted.
+     Interrupted keys are simply left in the 'Running' state.
+     When the next session starts, 'incDatabase' incre 'databaseStep'.
+     Any subsequent access to the key via 'builder' goes through 'viewDirty',
+     'viewDirty' automatically treats the stale 'Running' with old step as Dirty.
+
+Invariants:
+--------------
+  * [Running Step Match]:
+    A key is actively running in the current build if and only if its status is
+    'Running' and 'runningStep == databaseStep'. Any 'Running' node with
+    'runningStep /= databaseStep' represents an aborted/stale run and is
+    semantically 'Dirty'.
+  * [Single Active Spawner]:
+    Within any single build step s, at most one thread creates a 'Spawn' for a
+    given key. Any subsequent requests in the same step register a 'Wait'.
+  * [Safe Interruption / Zero-Cost Cancellation]:
+    Cancelling a build session requires no rollback or cleanup in 'databaseValues'.
+    Stale 'Running' states are lazily and safely neutralized by the step increment.
+-}
+
 -- | Increment the step and mark dirty.
 --   Assumes that the database is not running a build
+--   See Note [Invalidation, Step Counter, and Stale Running States]
 incDatabase :: Database -> Maybe [Key] -> IO ()
 -- only some keys are dirty
 incDatabase db (Just kk) = do
@@ -102,6 +140,7 @@ build db stack keys = do
 -- | Build a list of keys and return their results.
 --  If none of the keys are dirty, we can return the results immediately.
 --  Otherwise, a blocking computation is returned *which must be evaluated asynchronously* to avoid deadlock.
+--  See Note [Invalidation, Step Counter, and Stale Running States]
 builder
     :: Traversable f => Database -> Stack -> f Key -> AIO (Either (f (Key, Result)) (IO (f (Key, Result))))
 -- builder _ st kk | traceShow ("builder", st,kk) False = undefined
@@ -124,7 +163,7 @@ builder db@Database{..} stack keys = withRunInIO $ \(RunInIO run) -> do
                     pure val
                 Dirty s -> do
                     let act = run (refresh db stack id s)
-                        (force, val) = splitIO (join act)
+                        (force, val) = splitIO act
                     SMap.focus (updateStatus $ Running current force val s) id databaseValues
                     modifyTVar' toForce (Spawn force:)
                     pure val
@@ -151,7 +190,8 @@ isDirty me = any (\(_,dep) -> resultBuilt me < resultChanged dep)
 -- and shortcut the refreshing of the rest of the deps.
 -- * If no dirty dependencies and we have evaluated the key previously, then we refresh it in the current thread.
 --   This assumes that the implementation will be a lookup
--- * Otherwise, we spawn a new thread to refresh the dirty deps (if any) and the key itself
+-- * Otherwise, new threads would be created to refresh the dirty deps (if any) and
+--   then compute the key itself in current thread
 refreshDeps :: KeySet -> Database -> Stack -> Key -> Result -> [KeySet] -> AIO Result
 refreshDeps visited db stack key result = \case
     -- no more deps to refresh
@@ -171,14 +211,14 @@ refreshDeps visited db stack key result = \case
                     then liftIO $ compute db stack key RunDependenciesChanged (Just result)
                     else refreshDeps newVisited db stack key result deps
 
--- | Refresh a key:
-refresh :: Database -> Stack -> Key -> Maybe Result -> AIO (IO Result)
+-- | Refresh a key in the existing force runner, which already owns its lifetime.
+refresh :: Database -> Stack -> Key -> Maybe Result -> AIO Result
 -- refresh _ st k _ | traceShow ("refresh", st, k) False = undefined
 refresh db stack key result = case (addStack key stack, result) of
     (Left e, _) -> throw e
-    (Right stack, Just me@Result{resultDeps = ResultDeps deps}) -> asyncWithCleanUp $ refreshDeps mempty db stack key me (reverse deps)
+    (Right stack, Just me@Result{resultDeps = ResultDeps deps}) -> refreshDeps mempty db stack key me (reverse deps)
     (Right stack, _) ->
-        asyncWithCleanUp $ liftIO $ compute db stack key RunDependenciesChanged result
+        liftIO $ compute db stack key RunDependenciesChanged result
 
 -- | Compute a key.
 compute :: Database -> Stack -> Key -> RunMode -> Maybe Result -> IO Result
@@ -310,23 +350,6 @@ runAIO (AIO act) = do
     asyncs <- newIORef []
     runReaderT act asyncs `onException` cleanupAsync asyncs
 
--- | Like 'async' but with built-in cancellation.
---   Returns an IO action to wait on the result.
-asyncWithCleanUp :: AIO a -> AIO (IO a)
-asyncWithCleanUp act = do
-    st <- AIO ask
-    io <- unliftAIO act
-    -- mask to make sure we keep track of the spawned async
-    liftIO $ uninterruptibleMask $ \restore -> do
-        a <- async $ restore io
-        atomicModifyIORef'_ st (void a :)
-        return $ wait a
-
-unliftAIO :: AIO a -> AIO (IO a)
-unliftAIO act = do
-    st <- AIO ask
-    return $ runReaderT (unAIO act) st
-
 newtype RunInIO = RunInIO (forall a. AIO a -> IO a)
 
 withRunInIO :: (RunInIO -> AIO b) -> AIO b

hls-graph/src/Development/IDE/Graph/Internal/Types.hs

@@ -135,6 +135,9 @@ data Status
         runningPrev   :: !(Maybe Result)
         }
 
+-- | Map running states from previous steps to 'Dirty'.
+-- See Note [Invalidation, Step Counter, and Stale Running States]
+-- in Development.IDE.Graph.Internal.Database.
 viewDirty :: Step -> Status -> Status
 viewDirty currentStep (Running s _ _ re) | currentStep /= s = Dirty re
 viewDirty _ other = other