Skip to content

Commit

Permalink
Skip typechecking when the decls have not changed
Browse files Browse the repository at this point in the history
  • Loading branch information
aabounegm committed Dec 13, 2023
1 parent 0e0f862 commit 9bfb90d
Show file tree
Hide file tree
Showing 2 changed files with 44 additions and 3 deletions.
45 changes: 43 additions & 2 deletions rzk/src/Language/Rzk/VSCode/Lsp.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module Language.Rzk.VSCode.Lsp where

Expand All @@ -17,19 +19,55 @@ import Language.LSP.Protocol.Types
import Language.LSP.Server
import Language.LSP.VFS (virtualFileText)

import Control.Exception (SomeException, evaluate, try)
import Control.Monad.Except (ExceptT (ExceptT),
MonadError (throwError),
modifyError, runExceptT)
import Data.Aeson (Result (Error, Success),
fromJSON)
import Language.Rzk.Syntax (parseModuleSafe)
import Language.Rzk.Syntax (parseModuleFile,
parseModuleSafe)
import Language.Rzk.VSCode.Config (ServerConfig (..))
import Language.Rzk.VSCode.Env
import Language.Rzk.VSCode.Handlers
import Language.Rzk.VSCode.Logging
import Language.Rzk.VSCode.Tokenize (tokenizeModule)
import Rzk.TypeCheck (defaultTypeCheck,
typecheckModulesWithLocationIncremental)

-- | The maximum number of diagnostic messages to send to the client
maxDiagnosticCount :: Int
maxDiagnosticCount = 100

-- | Detects if the given path has changes in its declaration compared to what's in the cache
hasNotChanged :: RzkTypecheckCache -> FilePath -> LSP Bool
hasNotChanged cache path = toBool $ do
cachedDecls <- maybeToEitherLSP $ lookup path cache
module' <- toExceptTLifted $ parseModuleFile path
e <- toExceptTLifted $ try @SomeException $ evaluate $
defaultTypeCheck (typecheckModulesWithLocationIncremental (filter ((/= path) . fst) cache) [(path, module')])
(checkedModules, _errors) <- toExceptT $ return e
decls' <- maybeToEitherLSP $ lookup path checkedModules
return (decls' == cachedDecls)
where
toExceptT = modifyError (const ()) . ExceptT
toExceptTLifted = toExceptT . liftIO
maybeToEitherLSP = \case
Nothing -> throwError ()
Just x -> return x
toBool m = runExceptT m >>= \case
Left _ -> return False
Right x -> return x

-- | Monadic 'dropWhile'
dropWhileM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
dropWhileM _ [] = return []
dropWhileM p (x:xs) = do
q <- p x
if q
then dropWhileM p xs
else return (x:xs)

handlers :: Handlers LSP
handlers =
mconcat
Expand All @@ -46,7 +84,10 @@ handlers =
then do
logDebug "rzk.yaml modified. Clearing module cache"
resetCacheForAllFiles
else resetCacheForFiles modifiedPaths
else do
cache <- getCachedTypecheckedModules
actualModified <- dropWhileM (hasNotChanged cache) modifiedPaths
resetCacheForFiles actualModified
typecheckFromConfigFile
, notificationHandler SMethod_TextDocumentDidSave $ \_msg -> do
-- TODO: check if the file is included in the config's `include` list.
Expand Down
2 changes: 1 addition & 1 deletion rzk/src/Rzk/TypeCheck.hs
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,7 @@ data Decl var = Decl
, declValue :: Maybe (TermT var)
, declIsAssumption :: Bool
, declUsedVars :: [var]
}
} deriving Eq

type Decl' = Decl VarIdent

Expand Down

0 comments on commit 9bfb90d

Please sign in to comment.