-
-
Notifications
You must be signed in to change notification settings - Fork 91
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Syntax cache: Changes to mitigate issue #512
Although I'm not yet sure these changes /solve/ #512 -- I'd like to confirm with an example problem file -- I think they mitigate it. Certainly they help with e.g. opening a few dozen file in the typed-racket-more collection with racket-xp-mode enabled. With that, I see current-memory-use do the usual "sawtooth wave" -- rising until a GC, then falling. Although Racket seems to delay releasing memory back to the OS, until sufficient major GCs take place, eventually I do see that happen, too. The changes: 1. Eliminate hash-table for online-check-syntax. The hash-table could accumulate online-check-syntax items for sources other than the source being checked. Instead use with-intercepted-logging, a parameter, and put the results in the cache-entry. Something like this is probably what I should have done in the first place when implementing #451. 2. Change the syntax cache to be able to evict items on major GC. This works by wrapping the cache entries in an ephemeron whose value is a namespace. This is fairly chunky. Nothing is evicted until a major GC. And then perhaps more than necessary is evicted. However I spent a fair amount of time trying and rejecting some other ideas.
- Loading branch information
1 parent
d1cbeb7
commit 3e63bdc
Showing
4 changed files
with
239 additions
and
159 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,92 +1,59 @@ | ||
| #lang racket/base | ||
|
|
||
| (require racket/match | ||
| (require racket/logging | ||
| racket/match | ||
| racket/set | ||
| syntax/parse/define | ||
| "util.rkt") | ||
|
|
||
| (provide reset! | ||
| get) | ||
| (provide current-online-check-syntax | ||
| with-online-check-syntax) | ||
|
|
||
| ;;; online-check-syntax logger monitor | ||
|
|
||
| ;; There exists a protocol for macros to communicate tooltips to | ||
| ;; DrRacket via a log-message to the logger 'online-check-syntax. This | ||
| ;; might seem strange, but one motivation for this protocol is that | ||
| ;; e.g. a type-checker might learn things _during_ expansion that it | ||
| ;; e.g. a type-checker might learn things during expansion that it | ||
| ;; would like to show the user -- even if expansion fails. | ||
| ;; | ||
| ;; A consideration, for us, is that we cache fully-expanded syntax. | ||
| ;; Therefore we also need to cache these these logger messages -- they | ||
| ;; might occur long before our `check-syntax` command is called. To do | ||
| ;; so our log receiver monitor runs all the time, storing messages in | ||
| ;; a hash-table where the key is the syntax-source, and the value is | ||
| ;; simply (set (list beg end string-or-thunk))). | ||
| ;; | ||
| ;; Rather than complicate the cache in syntax.rkt, for now I think | ||
| ;; it's less-worse to keep our own hash-table, here, and have | ||
| ;; syntax.rkt call `reset!` whenever it invalidates its cache so we | ||
| ;; know to do same here. | ||
| ;; | ||
| ;; Note: When string-or-thunk is the latter, we record it as such. | ||
| ;; Only force if/when `get` is called, e.g. when our check-syntax is | ||
| ;; run. [Perhaps in DrRacket this could be delayed even further -- | ||
| ;; until a tooltip would actually be _displayed_. Because we must | ||
| ;; marshal data to the Emacs front end, we must force sooner. At least | ||
| ;; delay as long as we can. Not sure if that really helps but it seems | ||
| ;; simple enough to do so here.] | ||
|
|
||
| (define ht (make-hash)) ;(hash/c path? (set/c (list/c nat nat (or/c string? (-> string?)) | ||
|
|
||
| (define sema (make-semaphore 1)) | ||
|
|
||
| (define-simple-macro (with-sema e:expr ...+) | ||
| (call-with-semaphore sema (λ () e ...))) | ||
|
|
||
| (define (reset! src) | ||
| (with-sema (hash-remove! ht src))) | ||
|
|
||
| (define (record! src beg end string-or-thunk) | ||
| (with-sema | ||
| (hash-update! ht | ||
| src | ||
| (λ (v) (set-add v | ||
| (list beg end string-or-thunk))) | ||
| (set)))) | ||
|
|
||
| (define (get src) | ||
| (sleep 0) ;yield to let receiver-thread handle any pending log events | ||
| (with-sema (hash-ref ht src (set)))) | ||
|
|
||
| (define (receiver-thread) | ||
| (define receiver (make-log-receiver (current-logger) | ||
| 'info 'online-check-syntax)) | ||
| (for ([event (in-producer sync 'n/a receiver)]) | ||
| (match-define (vector _level _message stxs _topic) event) | ||
| (for ([stx (in-list stxs)]) | ||
| (let walk ([v (syntax-property stx 'mouse-over-tooltips)]) | ||
| (match v | ||
| ;; "The value of the 'mouse-over-tooltips property is | ||
| ;; expected to be to be a tree of cons pairs (in any | ||
| ;; configuration)..." | ||
| [(cons v more) | ||
| (walk v) | ||
| (walk more)] | ||
| ;; "...whose leaves are either ignored or are vectors of the | ||
| ;; shape:" | ||
| [(vector (? syntax? stx) | ||
| (? exact-positive-integer? beg) | ||
| (? exact-positive-integer? end) | ||
| (or (? string? string-or-thunk) | ||
| (? procedure? string-or-thunk))) | ||
| (record! (syntax-source stx) | ||
| beg | ||
| end | ||
| string-or-thunk)] | ||
| ;; Expected; quietly ignore | ||
| [(or (list) #f) (void)] | ||
| ;; Unexpected; log warning and ignore | ||
| [v (log-racket-mode-warning "unknown online-check-syntax ~v" v) | ||
| (void)]))))) | ||
|
|
||
| (void (thread receiver-thread)) | ||
| (define current-online-check-syntax (make-parameter (mutable-set))) | ||
|
|
||
| (define-simple-macro (with-online-check-syntax source:expr e:expr ...+) | ||
| (call-with-online-check-syntax source (λ () e ...))) | ||
|
|
||
| (define (call-with-online-check-syntax source proc) | ||
| (current-online-check-syntax (mutable-set)) ;reset | ||
| (with-intercepted-logging (make-interceptor source) proc | ||
| 'info 'online-check-syntax)) | ||
|
|
||
| (define ((make-interceptor src) event) | ||
| (match-define (vector _level _message stxs _topic) event) | ||
| (for ([stx (in-list stxs)]) | ||
| (let walk ([v (syntax-property stx 'mouse-over-tooltips)]) | ||
| (match v | ||
| ;; "The value of the 'mouse-over-tooltips property is | ||
| ;; expected to be to be a tree of cons pairs (in any | ||
| ;; configuration)..." | ||
| [(cons v more) | ||
| (walk v) | ||
| (walk more)] | ||
| ;; "...whose leaves are either ignored or are vectors of the | ||
| ;; shape:" | ||
| [(vector (? syntax? stx) | ||
| (? exact-positive-integer? beg) | ||
| (? exact-positive-integer? end) | ||
| (or (? string? string-or-thunk) | ||
| (? procedure? string-or-thunk))) | ||
| (when (equal? src (syntax-source stx)) | ||
| ;; Force now; the resulting string will likely use less | ||
| ;; memory than a thunk closure. | ||
| (define (force v) (if (procedure? v) (v) v)) | ||
| (define str (force string-or-thunk)) | ||
| (set-add! (current-online-check-syntax) | ||
| (list beg end str)))] | ||
| ;; Expected; quietly ignore | ||
| [(or (list) #f) (void)] | ||
| ;; Unexpected; log warning and ignore | ||
| [v (log-racket-mode-warning "unknown online-check-syntax ~v" v) | ||
| (void)])))) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.