racket/gui/init: module caching in the load handler
This commit is contained in:
parent
8358420fcc
commit
5c02b1c95a
|
@ -241,6 +241,29 @@
|
||||||
;; don't load the file from source or reload useless bytecode:
|
;; don't load the file from source or reload useless bytecode:
|
||||||
(void)])))
|
(void)])))
|
||||||
|
|
||||||
|
;; cache modules that have hash codes:
|
||||||
|
(define module-cache (make-hash))
|
||||||
|
|
||||||
|
(define (check-module-cache in-port check-second? normal-k)
|
||||||
|
(let ([header (bytes-append #"^#~"
|
||||||
|
(bytes (string-length (version)))
|
||||||
|
(regexp-quote (string->bytes/utf-8 (version)))
|
||||||
|
#"T")])
|
||||||
|
(cond
|
||||||
|
[(regexp-match-peek header in-port)
|
||||||
|
(define hash-code (peek-bytes 20 (+ 2 1 (string-length (version)) 1) in-port))
|
||||||
|
(cond
|
||||||
|
[(bytes=? hash-code (make-bytes 20 0))
|
||||||
|
(values (normal-k) #f check-second?)]
|
||||||
|
[else
|
||||||
|
(define key (cons hash-code (current-load-relative-directory)))
|
||||||
|
(define m (hash-ref module-cache key #f))
|
||||||
|
(if m
|
||||||
|
(values m #f #f)
|
||||||
|
(values (normal-k) key check-second?))])]
|
||||||
|
[else
|
||||||
|
(values (normal-k) #f check-second?)])))
|
||||||
|
|
||||||
(define (text-editor-load-handler filename expected-module)
|
(define (text-editor-load-handler filename expected-module)
|
||||||
(unless (path? filename)
|
(unless (path? filename)
|
||||||
(raise-type-error 'text-editor-load-handler "path" filename))
|
(raise-type-error 'text-editor-load-handler "path" filename))
|
||||||
|
@ -259,21 +282,27 @@
|
||||||
(jump-to-submodule
|
(jump-to-submodule
|
||||||
in-port
|
in-port
|
||||||
expected-module
|
expected-module
|
||||||
(lambda (check-second?)
|
(lambda (orig-check-second?)
|
||||||
(with-module-reading-parameterization
|
(with-module-reading-parameterization
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(let* ([first (read-syntax src in-port)]
|
(define-values (first cache-key check-second?)
|
||||||
[module-ized-exp (check-module-form first expected-module filename)]
|
(check-module-cache in-port
|
||||||
[second (if check-second?
|
orig-check-second?
|
||||||
|
(lambda () (read-syntax src in-port))))
|
||||||
|
(define module-ized-exp
|
||||||
|
(check-module-form first expected-module filename))
|
||||||
|
(define second (if check-second?
|
||||||
(read in-port)
|
(read in-port)
|
||||||
eof)])
|
eof))
|
||||||
(unless (eof-object? second)
|
(unless (eof-object? second)
|
||||||
(raise-syntax-error
|
(raise-syntax-error
|
||||||
'text-editor-load-handler
|
'text-editor-load-handler
|
||||||
(format "expected only a `module' declaration for `~s', but found an extra expression"
|
(format "expected only a `module' declaration for `~s', but found an extra expression"
|
||||||
expected-module)
|
expected-module)
|
||||||
second))
|
second))
|
||||||
(eval module-ized-exp))))))))
|
(when cache-key
|
||||||
|
(hash-set! module-cache cache-key module-ized-exp))
|
||||||
|
(eval module-ized-exp)))))))
|
||||||
(let loop ([last-time-values (list (void))])
|
(let loop ([last-time-values (list (void))])
|
||||||
(let ([exp (read-syntax src in-port)])
|
(let ([exp (read-syntax src in-port)])
|
||||||
(if (eof-object? exp)
|
(if (eof-object? exp)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user