Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add buffer-local caching to friendly-session calculation #3463

Draft
wants to merge 3 commits into
base: master
Choose a base branch
from
Draft

Add buffer-local caching to friendly-session calculation #3463

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
b58f98c
Add buffer-local caching to friendly-session calculation
vemv Sep 13, 2023
9f5902c
Don't use seconds
vemv Sep 13, 2023
e3bef20
Ensure cache hits
vemv Sep 13, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions CHANGELOG.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -48,6 +48,7 @@
- Improve the presentation of `xref` data.
- [#3419](https://github.com/clojure-emacs/cider/issues/3419): Also match friendly sessions based on the buffer's ns form.
- Always match friendly sessions for `cider-ancillary-buffers` (like `*cider-error*`, `*cider-result*`, etc).
- Add buffer-local caching to friendly-session calculation.
- `cider-test`: only show diffs for collections.
- [#3375](https://github.com/clojure-emacs/cider/pull/3375): `cider-test`: don't render a newline between expected and actual, most times.
- Ensure there's a leading `:` when using `cider-clojure-cli-aliases`.
Expand Down
4 changes: 4 additions & 0 deletions cider-common.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -305,6 +305,10 @@ whether DIRECTION is 'from-nrepl or 'to-nrepl."
(seq-filter #'identity (mapcar f cider-path-translations))
(seq-some f cider-path-translations)))))

(defun cider--unix-time ()
"Returns the Unix time."
(float-time))
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ideally I'd get the time in nanoseconds, as integer. floats make me nervous :)

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

What's wrong with using (current-time)? Sure, it uses seconds, but I'm guessing that'd be fine for your use case.

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I found out that seconds are too coarse-grained for timestamp comparisons.

Say that it was all computed in less than second, we'd get the same timestamp so > wouldn't succeed (and >= may not be as optimal to use)


(defun cider--all-path-translations ()
"Returns `cider-path-translations' if non-empty, else seeks a present value."
(or cider-path-translations
Expand Down
113 changes: 83 additions & 30 deletions cider-repl.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -229,6 +229,9 @@ Currently its only purpose is to facilitate `cider-repl-clear-buffer'.")
"A dict holding information about all currently loaded namespaces.
This cache is stored in the connection buffer.")

(defvar-local cider-repl-ns-cached-at nil
"As Unix time.")

(defvar cider-mode)
(declare-function cider-refresh-dynamic-font-lock "cider-mode")

Expand All @@ -246,6 +249,7 @@ This cache is stored in the connection buffer.")
(setq cider-repl-cljs-upgrade-pending nil))
(unless (nrepl-dict-empty-p changed-namespaces)
(setq cider-repl-ns-cache (nrepl-dict-merge cider-repl-ns-cache changed-namespaces))
(setq cider-repl-ns-cached-at (cider--unix-time))
(dolist (b (buffer-list))
(with-current-buffer b
;; Metadata changed, so signatures may have changed too.
Expand Down Expand Up @@ -1750,6 +1754,19 @@ constructs."
(mapconcat #'identity (cider-repl--available-shortcuts) ", "))))
(error "No command selected")))))

(defvar-local cider--sesman-friendly-session-result
nil
"A <repl buffer> -> <is friendly> hashmap.")

(defvar-local cider--sesman-friendly-session-calculated-at
nil
"A <repl buffer> -> <latest 'friendly' calculation unix time> hashmap.")

(defvar-local cider--sesman-friendly-session-last-path-translations
nil
"The latest perceived value of (cider--all-path-translations)
in this buffer.")

(defun cider--sesman-friendly-session-p (session &optional debug)
"Check if SESSION is a friendly session, DEBUG optionally.

Expand Down Expand Up @@ -1777,11 +1794,13 @@ The checking is done as follows:
(let ((cp (with-current-buffer repl
(cider-classpath-entries))))
(process-put proc :cached-classpath cp)
(process-put proc :cached-classpath-at (cider--unix-time))
cp)))
(ns-list (or (process-get proc :all-namespaces)
(ns-list (or (process-get proc :cached-all-namespaces)
(let ((ns-list (with-current-buffer repl
(cider-sync-request:ns-list))))
(process-put proc :all-namespaces ns-list)
(process-put proc :cached-all-namespaces ns-list)
(process-put proc :cached-all-namespaces-at (cider--unix-time))
ns-list)))
(classpath-roots (or (process-get proc :cached-classpath-roots)
(let ((cp (thread-last classpath
Expand All @@ -1790,35 +1809,69 @@ The checking is done as follows:
(seq-remove #'null)
(seq-uniq))))
(process-put proc :cached-classpath-roots cp)
(process-put proc :cached-classpath-roots-at (cider--unix-time))
cp))))
(or (seq-find (lambda (path) (string-prefix-p path file))
classpath)
(seq-find (lambda (path) (string-prefix-p path file))
classpath-roots)
(when-let* ((cider-path-translations (cider--all-path-translations))
(translated (cider--translate-path file 'to-nrepl :return-all)))
(seq-find (lambda (translated-path)
(or (seq-find (lambda (path)
(string-prefix-p path translated-path))
classpath)
(seq-find (lambda (path)
(string-prefix-p path translated-path))
classpath-roots)))
translated))
(when-let ((ns (condition-case nil
(substring-no-properties (cider-current-ns :no-default
;; important - don't query the repl,
;; avoiding a recursive invocation of `cider--sesman-friendly-session-p`:
:no-repl-check))
(error nil))))
;; if the ns form matches with a ns of all runtime namespaces, we can consider the buffer to match
;; (this is a bit lax, but also quite useful)
(with-current-buffer repl
(or (when cider-repl-ns-cache ;; may be nil on repl startup
(member ns (nrepl-dict-keys cider-repl-ns-cache)))
(member ns ns-list))))
(when debug
(list file "was not determined to belong to classpath:" classpath "or classpath-roots:" classpath-roots))))))))

;; Initialize this buffer-local variable:
(unless cider--sesman-friendly-session-calculated-at
(setq cider--sesman-friendly-session-calculated-at (nrepl-dict)))

;; Initialize this buffer-local variable:
(unless cider--sesman-friendly-session-result
(setq cider--sesman-friendly-session-result (nrepl-dict)))

(let ((calculated-at (nrepl-dict-get cider--sesman-friendly-session-calculated-at repl))
(cider-path-translations (cider--all-path-translations))
(cider-repl-ns-cached-at (buffer-local-value 'cider-repl-ns-cached-at repl)))
(if (and calculated-at
(equal cider--sesman-friendly-session-last-path-translations
cider-path-translations)
(or (not cider-repl-ns-cached-at)
(> calculated-at
cider-repl-ns-cached-at))
(> calculated-at
(process-get proc :cached-classpath-at))
(> calculated-at
(process-get proc :cached-all-namespaces-at))
(> calculated-at
(process-get proc :cached-classpath-roots-at)))
(nrepl-dict-get cider--sesman-friendly-session-result repl)
(let ((v (or (seq-find (lambda (path) (string-prefix-p path file))
classpath)
(seq-find (lambda (path) (string-prefix-p path file))
classpath-roots)
(when-let* ((translated (and cider-path-translations
(cider--translate-path file 'to-nrepl :return-all))))
(seq-find (lambda (translated-path)
(or (seq-find (lambda (path)
(string-prefix-p path translated-path))
classpath)
(seq-find (lambda (path)
(string-prefix-p path translated-path))
classpath-roots)))
translated))
(when-let ((ns (condition-case nil
(substring-no-properties (cider-current-ns :no-default
;; important - don't query the repl,
;; avoiding a recursive invocation of `cider--sesman-friendly-session-p`:
:no-repl-check))
(error nil))))
;; if the ns form matches with a ns of all runtime namespaces, we can consider the buffer to match
;; (this is a bit lax, but also quite useful)
(with-current-buffer repl
(or (when cider-repl-ns-cache ;; may be nil on repl startup
(member ns (nrepl-dict-keys cider-repl-ns-cache)))
(member ns ns-list))))
(when debug
(list file "was not determined to belong to classpath:" classpath "or classpath-roots:" classpath-roots)))))

(setq cider--sesman-friendly-session-last-path-translations cider-path-translations)

(nrepl-dict-put cider--sesman-friendly-session-calculated-at repl (cider--unix-time))

(nrepl-dict-put cider--sesman-friendly-session-result repl v)

v))))))))

(defun cider-debug-sesman-friendly-session-p ()
"`message's debugging information relative to friendly sessions.
Expand Down
Loading