suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

minor doc-build space savings

Browse Source 
svn: r8600

original commit: f22f94b34547d15c4d03cdb8c5684083724966fb
This commit is contained in:
Matthew Flatt 2008-02-09 14:38:02 +00:00
parent a05fd5eb87
commit 1d65736113
1 changed files with 27 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
collects/scribble/scheme.ss
View File

@ -62,19 +62,28 @@
(define line-breakable-space (make-element 'tt (list " "))) (define line-breakable-space (make-element 'tt (list " ")))
(define id-element-cache #f #;(make-hash-table 'equal)) ;; These caches intentionally record a key with the value.
(define element-cache #f #;(make-hash-table 'equal)) ;; That way, when the value is no longer used, the key
;; goes away, and the entry is gone.
(define id-element-cache (make-hash-table 'equal 'weak))
(define element-cache (make-hash-table 'equal 'weak))
(define-struct (cached-delayed-element delayed-element) (cache-key))
(define-struct (cached-element element) (cache-key))
(define (make-id-element c s) (define (make-id-element c s)
(let* ([key (and id-element-cache (let* ([key (and id-element-cache
(let ([b (identifier-label-binding c)]) (let ([b (identifier-label-binding c)])
(list (syntax-e c) (vector (syntax-e c)
(module-path-index-resolve (caddr b)) (module-path-index-resolve (caddr b))
(cadddr b) (cadddr b)
(list-ref b 5))))]) (list-ref b 5))))])
(or (and key (or (and key
(hash-table-get id-element-cache key #f)) (let ([b (hash-table-get id-element-cache key #f)])
(let ([e (make-delayed-element (and b
(weak-box-value b))))
(let ([e (make-cached-delayed-element
(lambda (renderer sec ri) (lambda (renderer sec ri)
(let* ([tag (find-scheme-tag sec ri c 'for-label)]) (let* ([tag (find-scheme-tag sec ri c 'for-label)])
(if tag (if tag
@ -88,9 +97,10 @@
(make-element "badlink" (make-element "badlink"
(list (make-element "schemevaluelink" (list s)))))))) (list (make-element "schemevaluelink" (list s))))))))
(lambda () s) (lambda () s)
(lambda () s))]) (lambda () s)
key)])
(when key (when key
(hash-table-put! id-element-cache key e)) (hash-table-put! id-element-cache key (make-weak-box e)))
e)))) e))))
(define (make-element/cache style content) (define (make-element/cache style content)
@ -98,11 +108,12 @@
(pair? content) (pair? content)
(string? (car content)) (string? (car content))
(null? (cdr content))) (null? (cdr content)))
(let ([key (cons style content)]) (let ([key (vector style (car content))])
(or (hash-table-get element-cache key #f) (let ([b (hash-table-get element-cache key #f)])
(let ([e (make-element style content)]) (or (and b (weak-box-value b))
(hash-table-put! element-cache key e) (let ([e (make-cached-element style content key)])
e))) (hash-table-put! element-cache key (make-weak-box e))
e))))
(make-element style content))) (make-element style content)))
(define (typeset-atom c out color? quote-depth) (define (typeset-atom c out color? quote-depth)
@ -549,7 +560,7 @@
,(syntax-case v (uncode) ,(syntax-case v (uncode)
[(uncode e) #'e] [(uncode e) #'e]
[else (stx->loc-s-expr (syntax-e v))]) [else (stx->loc-s-expr (syntax-e v))])
'(code #(code
,(syntax-line v) ,(syntax-line v)
,(syntax-column v) ,(syntax-column v)
,(syntax-position v) ,(syntax-position v)