Cache package metadata across sessions and fix Polars member completion

NEWS.md

@@ -1,5 +1,38 @@
 # languageserver 0.3.20
 
+- Preserve member completion for Polars conversions such as
+  `dt <- as_polars_df(iris)` and for `pl$` after calls using the converted frame.
+  Prepare bounded S3 method return summaries with their owning namespace.
+  Retain namespace ownership through chained methods and nested argument
+  expressions. Extend cold member analysis in place from 250 ms up to two
+  seconds of CPU time, allowing up to five seconds elapsed on busy hosts.
+  Retain node and depth bounds and cache completed uncertain receivers for
+  repeated completion, signature help and hover requests. Offer
+  common known method members as possible-receiver suggestions when a
+  conversion's input class is unresolved, without claiming a definite type.
+  Share these possible receivers with signature help and hover when the member
+  implementation is unambiguous, and display an uncertainty note. Preserve
+  possible results through member calls and subsequent assignments and aliases.
+  Reuse completed binding summaries across member-name and argument edits,
+  following-code changes and different cursor positions. Validate unchanged
+  preceding source and package attachment context without retaining source
+  closures or mutable object identities across edits.
+
+- Share bounded semantic analysis caches across member and S3 inference,
+  source signature/documentation providers and package NAMESPACE parsing.
+  Reuse completed S3 binding summaries across edits and cursor positions while
+  validating peer-source contents, metadata and registration context. Exclude
+  exhausted and scratch-state results from reuse. Retain exact-text signature
+  and documentation facts across reparses, including unchanged comment blocks
+  in persistent parse workers.
+
+- Persist package member models, startup datasets, S3 catalogs, documentation
+  summaries and rendered help in a shared bounded cache. Reuse unchanged models
+  across saves and server sessions; invalidate changes to package files,
+  loaded namespace values, dependencies, registered methods, cache format or
+  server implementation. Verify serialized payload checksums before restoring
+  cached values.
+
 - Avoid a server crash when completion, hover or signature help is requested
   inside `function()`, `if`, `for` or `while` while package metadata is loading.
   Report errors from queued request readiness checks without stopping the server.

R/analysis-cache.R

@@ -0,0 +1,75 @@
+# Analysis adapters supply the semantic context and key that make a result
+# reusable. Stores are allocated on demand, bounded independently by domain,
+# and retain serialized values so mutable request state is never shared.
+analysis_cache_format <- 2L
+
+analysis_cache <- function(owner, domain, context = NULL, max_bytes = 2 * 1024^2, max_entries = 128L) {
+    if (is.null(owner$analysis_caches)) owner$analysis_caches <- new.env(parent = emptyenv())
+    entry <- owner$analysis_caches[[domain]]
+    limits <- list(bytes = max(as.numeric(max_bytes), 0), entries = max(as.integer(max_entries), 1L))
+    runtime <- list(namespace = asNamespace("languageserver"), format = analysis_cache_format)
+    if (is.null(entry) || !identical(entry$context, context) || !identical(entry$limits, limits) ||
+            !identical(entry$runtime, runtime)) {
+        # Keep old handles isolated: an in-flight computation may still write
+        # its result after a newer context has been installed.
+        entry <- list(context = context, limits = limits, runtime = runtime,
+            values = ByteLruCache$new(limits$bytes, limits$entries))
+    }
+    owner$analysis_caches[[domain]] <- entry
+    entry$values
+}
+
+analysis_cache_get <- function(cache, key) {
+    if (is.null(cache) || is.null(key) || !cache$has(key)) return(list(hit = FALSE))
+    tryCatch({
+        record <- cache$get(key)
+        if (!is.list(record) || is.object(record) || !identical(record$format, analysis_cache_format) || !is.raw(record$payload) ||
+                !identical(record$checksum, digest::digest(record$payload, algo = "xxhash64", serialize = FALSE))) {
+            cache$remove(key)
+            return(list(hit = FALSE))
+        }
+        list(hit = TRUE, value = unserialize(record$payload))
+    }, error = function(e) {
+        cache$remove(key)
+        list(hit = FALSE)
+    })
+}
+
+analysis_cache_set <- function(cache, key, value) {
+    if (!is.null(cache) && !is.null(key) && cache$capacity()$bytes > 0 &&
+            as.numeric(utils::object.size(value)) <= cache$capacity()$bytes) {
+        payload <- serialize(value, NULL)
+        if (length(payload) <= cache$capacity()$bytes) {
+            cache$set(key, list(format = analysis_cache_format, payload = payload,
+                    checksum = digest::digest(payload, algo = "xxhash64", serialize = FALSE)))
+        }
+    }
+    invisible(value)
+}
+
+# Exact syntax is a context-independent input. Only formals are parsed; neither
+# function bodies nor defaults are evaluated. Both syntax and XML providers use
+# these facts across reparses, independently of declaration position.
+analysis_function_header <- function(document, text, symbol) {
+    context <- list(format = lapply(c("width", "digits", "scipen", "deparse.cutoff"), getOption),
+        formatter = get_signature)
+    cache <- analysis_cache(document, "function-headers", context)
+    key <- digest::digest(list(symbol, text), algo = "xxhash64")
+    found <- analysis_cache_get(cache, key)
+    if (found$hit) return(found$value)
+    fn <- str2expression(c(text, "NULL"))[[1L]]
+    value <- list(signature = get_signature(symbol, fn), formals = fn[[2L]])
+    analysis_cache_set(cache, key, value)
+}
+
+analysis_documentation_owner <- new.env(parent = emptyenv())
+
+analysis_documentation <- function(document, comments) {
+    owner <- if (is.null(document)) analysis_documentation_owner else document
+    cache <- analysis_cache(owner, "source-documentation", context = asNamespace("roxygen2"))
+    key <- digest::digest(comments, algo = "xxhash64")
+    found <- analysis_cache_get(cache, key)
+    if (found$hit) return(found$value)
+    value <- if (length(comments)) convert_comment_to_documentation(comments)
+    analysis_cache_set(cache, key, value)
+}

R/document.R

@@ -22,6 +22,8 @@
         requested_packages = NULL,
         member_refresh = FALSE,
         member_receivers = NULL,
+        member_binding_cache = NULL,
+        analysis_caches = NULL,
         s3_calls = NULL,
         s3_identity = NULL,
         member_revision = NULL,
@@ -170,7 +172,7 @@
             # row and col are 0-indexed
             text <- self$line0(row)
             matches <- scan_token(text, col, forward)
             return(list(
                 full_token = matches$full_token,
                 right_token = matches$right_token,
                 package = empty_string_to_null(matches$package),
@@ -547,7 +549,7 @@
                         }
                         assign(
                             symbol,
-                            convert_comment_to_documentation(comment),
+                            analysis_documentation(NULL, comment),
                             envir = env$documentation_store
                         )
                     }
@@ -1099,6 +1101,16 @@
 
 resolve_member_task <- function(self, uri, document, packages, namespace_packages) {
     workspace <- self$get_workspace(uri)
+    metadata <- workspace$member_metadata
+    known <- list()
+    if (!is.null(metadata)) {
+        for (package in metadata$keys()) {
+            catalog <- if (is.function(metadata$catalog)) metadata$catalog(package) else metadata$get(package)
+            if (!isTRUE(catalog$dataset_only) && is.null(catalog$error) && !is.null(catalog$identity)) {
+                known[package] <- list(catalog$identity)
+            }
+        }
+    }
     requested <- document$requested_packages
     version <- document$version
     current <- function() {
@@ -1109,7 +1121,7 @@
     create_task(
         target = package_call(member_resolve_packages),
         args = list(pkgs = packages, lib_paths = .libPaths(), namespace_packages = namespace_packages,
-            prepare = TRUE, prepare_s3 = FALSE),
+            prepare = TRUE, prepare_s3 = FALSE, known_members = known, cache_dir = package_metadata_cache_root()),
         callback = function(result) {
             if (current()) resolve_callback(self, uri, version, result)
         },
@@ -1139,7 +1151,7 @@
         target = package_call(member_resolve_packages),
         args = list(pkgs = packages, lib_paths = .libPaths(), namespace_packages = namespace_packages,
             prepare = prepare_members && !split_members,
-            prepare_s3 = isTRUE(lsp_settings$get("s3_dispatch"))),
+            prepare_s3 = isTRUE(lsp_settings$get("s3_dispatch")), cache_dir = package_metadata_cache_root()),
         callback = function(result) resolve_callback(self, uri, version, result),
         error = function(e) {
             on.exit(s3_queue_ready(self, uri), add = TRUE)

R/hover.R

@@ -132,7 +132,7 @@ hover_reply <- function(id, uri, workspace, document, point) {
                         doc_line1 <- detect_comments(document$content, def_line1 - 1) + 1
                         if (doc_line1 < def_line1) {
                             comment <- document$content[doc_line1:(def_line1 - 1)]
-                            doc <- convert_comment_to_documentation(comment)
+                            doc <- analysis_documentation(document, comment)
                             if (is.character(doc)) {
                                 doc_string <- doc
                             } else if (is.list(doc)) {
@@ -168,7 +168,7 @@ hover_reply <- function(id, uri, workspace, document, point) {
                             doc_line1 <- detect_comments(document$content, func_line1 - 1) + 1
                             if (doc_line1 < func_line1) {
                                 comment <- document$content[doc_line1:(func_line1 - 1)]
-                                doc <- convert_comment_to_documentation(comment)
+                                doc <- analysis_documentation(document, comment)
                                 if (is.list(doc)) {
                                     doc_string <- doc$arguments[[token_text]]
                                     if (!is.null(doc_string)) {
@@ -197,7 +197,7 @@ hover_reply <- function(id, uri, workspace, document, point) {
 
                 if (doc_line1 < func_line1) {
                     comment <- document$content[doc_line1:(func_line1 - 1)]
-                    doc <- convert_comment_to_documentation(comment)
+                    doc <- analysis_documentation(document, comment)
                     if (is.list(doc)) {
                         doc_string <- doc$arguments[[token_text]]
                         if (!is.null(doc_string)) {

R/member-analysis.R

@@ -45,6 +45,49 @@ member_history_position <- function(history, at) {
     hi
 }
 
+# Incremental source fingerprints are prepared with the parse, not rebuilt by
+# providers. Each source segment is hashed once. Invalid virtual source ranges
+# disable reuse rather than making recovery fail.
+member_source_prefix <- function(content, start, end, prefix) {
+    if (is.null(prefix) || length(end) != 2L || anyNA(end) || !member_before(start, end) ||
+            end[[1L]] < 0L || end[[1L]] >= length(content) || end[[2L]] < 0L ||
+            is.na(content[[end[[1L]] + 1L]]) ||
+            end[[2L]] > nchar(content[[end[[1L]] + 1L]])) return(NULL)
+    lines <- content[seq.int(start[[1L]] + 1L, end[[1L]] + 1L)]
+    if (anyNA(lines)) return(NULL)
+    lines[[length(lines)]] <- substr(lines[[length(lines)]], 1L, end[[2L]])
+    lines[[1L]] <- substring(lines[[1L]], start[[2L]] + 1L)
+    digest::digest(list(prefix, start, end, lines), algo = "xxhash64")
+}
+
+member_document_cache_revision <- function(document, metadata) {
+    revision <- if (is.null(metadata)) 0L else if (is.function(metadata$revision)) metadata$revision() else NULL
+    identity <- list(metadata = if (is.function(metadata$identity)) metadata$identity() else metadata,
+        revision = revision)
+    document$member_binding_cache <- analysis_cache(document, "member-bindings", identity, max_bytes = 4 * 1024^2)
+    if (!identical(document$member_revision, identity)) {
+        document$member_receivers$clear()
+        document$member_revision <- identity
+    }
+    revision
+}
+
+# Cross-edit summaries must not capture lexical positions, source closures or
+# mutable object identities. Package function keys are tied to the metadata
+# revision; uncertain candidates have the exact same source/context key.
+member_binding_cacheable <- function(value, depth = 0L) {
+    if (is.null(value)) return(TRUE)
+    if (depth > 8L || !is.null(value$function_expr) || !is.null(value$closure) ||
+            !is.null(value$binding_expr) || !is.null(value$binding_env) ||
+            !is.null(value$r6_class) || !is.null(value$r6_identity) || !is.null(value$r6_role) ||
+            !is.null(value$s7_descriptor) || !is.null(value$s7_generator) || !is.null(value$s4_generator) ||
+            (!is.null(value$function_key) && is.null(value$metadata)) ||
+            (isTRUE(value$known_literal) && (!is.atomic(value$literal) || is.object(value$literal)))) return(FALSE)
+    children <- c(value$fields, value$slots, value$elements, value$possible_returns,
+        value[c("receiver_value", "element_shape", "result_shape", "r6_private", "r6_super", "r6_self")])
+    all(vapply(children, member_binding_cacheable, logical(1L), depth + 1L))
+}
+
 # Lazy local values keep the lexical state from before the assignment. The
 # memo belongs to this recovered scope, never to a package-wide summary.
 member_local_binding <- function(expr, bindings, referenced = member_syntax_names(expr), lookup = NULL) {
@@ -94,18 +137,42 @@ member_completion_value <- function(value, index, budget) {
 }
 
 member_receiver_cacheable <- function(value, index, budget) {
-    if (isTRUE(budget$exhausted) || !length(value$type)) return(FALSE)
+    if (isTRUE(budget$exhausted) || (!length(value$type) && !length(value$possible_returns))) return(FALSE)
     if (!isTRUE(budget$transient)) return(TRUE)
+    if (!length(value$type)) {
+        return(all(vapply(value$possible_returns, member_receiver_cacheable, logical(1L), index, budget)))
+    }
+    # Alias histories can start in a generic document context. The declared
+    # native surface belongs to the receiver's namespace, regardless of which
+    # package was selected while recovering the cursor.
+    owner <- member_package_context(index, value$member_package)
+    if (is.null(owner)) return(FALSE)
     # Recursive argument analysis must not preserve partial instance fields.
     # A native-backed class-only result has a complete declared member surface
     # independent of argument values; retain just that proven surface.
     length(value$type) == 1L && is.null(value$reason) && is.null(value$fields) &&
         is.null(value$slots) && is.null(value$function_expr) && is.null(value$closure) &&
         is.null(value$binding_expr) && is.null(value$elements) && is.null(value$element_shape) &&
         is.null(value$result_shape) && is.null(value$r6_class) && !isTRUE(value$open) &&
-        (any(index$members[[value$type]] %in% index$native_factories, na.rm = TRUE) ||
-            any(vapply(index$properties[[value$type]], function(property) {
+        (any(owner$members[[value$type]] %in% owner$native_factories, na.rm = TRUE) ||
+            any(vapply(owner$properties[[value$type]], function(property) {
                 length(property$type) == 1L &&
-                    any(index$members[[property$type]] %in% index$native_factories, na.rm = TRUE)
+                    any(owner$members[[property$type]] %in% owner$native_factories, na.rm = TRUE)
             }, logical(1L))))
 }
+
+member_receiver_cache_value <- function(value, index, budget) {
+    if (member_receiver_cacheable(value, index, budget)) return(value)
+    if (isTRUE(budget$exhausted) || !isTRUE(budget$transient) ||
+            length(value$type) || !length(value$possible_returns)) return(NULL)
+    # A possible native result may carry argument-dependent instance fields.
+    # Its declared surface is still useful, but those partial fields cannot be
+    # retained. The existing native-surface check verifies every projection.
+    candidates <- lapply(value$possible_returns, function(candidate) {
+        candidate$fields <- NULL
+        if (member_receiver_cacheable(candidate, index, budget)) candidate else NULL
+    })
+    if (any(vapply(candidates, is.null, logical(1L)))) return(NULL)
+    value$possible_returns <- candidates
+    value
+}