racket/gui/init: module caching in the load handler

This commit is contained in:
Matthew Flatt 2012-07-16 15:32:48 -06:00
parent 8358420fcc
commit 5c02b1c95a

View File

@ -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)