From d86c257426e16368e6442f9215bd576a25563523 Mon Sep 17 00:00:00 2001 From: Steve Dunham Date: Mon, 16 Feb 2026 09:22:49 -0800 Subject: [PATCH] Show user info messages in LSP, invalidate modules transitively on change --- src/LSP.newt | 29 ++++++++++++++++++++++++++++- src/Lib/ProcessModule.newt | 24 ++++++++++++++++++++++-- 2 files changed, 50 insertions(+), 3 deletions(-) diff --git a/src/LSP.newt b/src/LSP.newt index cda9355..f206628 100644 --- a/src/LSP.newt +++ b/src/LSP.newt @@ -3,6 +3,7 @@ module LSP import Prelude -- TODO pull this into its own file import Lib.Common +import Lib.Eval import Lib.Types import Lib.TopContext import Lib.Tokenizer @@ -14,6 +15,8 @@ import Data.IORef import Node import Commands import Data.List1 +import Lib.Prettier +import Lib.ProcessDecl pfunc js_castArray : Array JSObject → JSObject := `x => x` pfunc js_castInt : Int → JSObject := `x => x` @@ -115,6 +118,28 @@ errorToDiag (E fc msg) = errorToDiag (Postpone fc qn msg) = errorToDiag $ E fc "Postpone \{show qn} \{msg}" +getInfos : M (List Json) +getInfos = do + top <- getTop + go Nil $ listValues $ top.metaCtx.metas + where + go : List Json → List MetaEntry → M (List Json) + go acc Nil = pure acc + go acc (Unsolved fc k ctx ty User cons :: rest) = do + ty' <- quote ctx.lvl ty + let names = map fst ctx.types + let dispType = render 90 $ pprint names ty' + dispEnv <- dumpEnv ctx + let msg = "\{dispEnv}\n--------\n\{dispType}" + let diag = JsonObj + $ ("severity", JsonInt 3) + :: ("range", fcToRange fc) + :: ("message", JsonStr msg) + :: ("source", JsonStr "newt") -- what is this key for? + :: Nil + go (diag :: acc) rest + go acc (_ :: es) = go acc es + checkFile : String → JSObject checkFile fn = unsafePerformIO $ do let (base,modName) = decomposeName fn @@ -131,7 +156,9 @@ checkFile fn = unsafePerformIO $ do pure MkUnit -- pull out errors and infos top <- getTop - pure $ map (errorToDiag) top.errors + let errors = map (errorToDiag) top.errors + infos <- getInfos + pure $ infos ++ errors ).runM st.topContext | Left err => do putStrLn $ showError "" err diff --git a/src/Lib/ProcessModule.newt b/src/Lib/ProcessModule.newt index 57965b9..be32dc5 100644 --- a/src/Lib/ProcessModule.newt +++ b/src/Lib/ProcessModule.newt @@ -138,6 +138,26 @@ processModule importFC repo stk modns = do (Left err) <- tryError $ processDecl ns decl | _ => pure MkUnit addError err --- NOW TODO clear dependents too. +-- invalidate Module and anyone who depends on it invalidateModule : String -> M Unit -invalidateModule modname = modifyTop [modules $= deleteMap modname] +invalidateModule modname = do + top <- getTop + let modules = join $ map getDeps $ toList top.modules + let revMap = map swap modules + let deps = foldl accumulate emptyMap revMap + go deps $ modname :: Nil + where + accumulate : SortedMap String (List String) → String × String → SortedMap String (List String) + accumulate deps (k,v) = let prev = fromMaybe Nil $ lookupMap' k deps + in updateMap k (v :: prev) deps + + getDeps : String × ModContext → List (String × String) + getDeps (nm, mod) = map (nm , ) mod.modDeps + + go : SortedMap String (List String) → List String → M Unit + go deps Nil = pure MkUnit + go deps (name :: names) = do + modifyTop [modules $= deleteMap name] + let ds = fromMaybe Nil $ lookupMap' name deps + putStrLn "Chase \{name} → \{show ds}" + go deps $ ds ++ names