minor doc-build space savings

svn: r8600
This commit is contained in:
Matthew Flatt 2008-02-09 14:38:02 +00:00
parent 4f6d727b91
commit f22f94b345
5 changed files with 69 additions and 30 deletions

View File

@ -242,7 +242,12 @@ they are accepted in either order.}
(or/c exact-positive-integer? false/c)
(or/c exact-nonnegative-integer? false/c)
(or/c exact-nonnegative-integer? false/c)
(or/c exact-positive-integer? false/c)))]
(or/c exact-positive-integer? false/c))
(vector/c any/c
(or/c exact-positive-integer? false/c)
(or/c exact-nonnegative-integer? false/c)
(or/c exact-nonnegative-integer? false/c)
(or/c exact-positive-integer? false/c)))]
[prop (or/c syntax? false/c) #f]
[cert (or/c syntax? false/c) #f])
syntax?]

View File

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

View File

@ -144,7 +144,12 @@ source-location information recursively.}
(or/c exact-positive-integer? false/c)
(or/c exact-nonnegative-integer? false/c)
(or/c exact-nonnegative-integer? false/c)
(or/c exact-positive-integer? false/c)))]
(or/c exact-positive-integer? false/c))
(vector/c any/c
(or/c exact-positive-integer? false/c)
(or/c exact-nonnegative-integer? false/c)
(or/c exact-nonnegative-integer? false/c)
(or/c exact-positive-integer? false/c)))]
[prop (or/c syntax? false/c) #f]
[cert (or/c syntax? false/c) #f])
syntax?]{
@ -171,11 +176,12 @@ Any of @scheme[ctxt], @scheme[srcloc], @scheme[prop], or @scheme[cert]
can be @scheme[#f], in which case the resulting syntax has no lexical
context, source information, new properties, and/or certificates.
If @scheme[srcloc] is not @scheme[#f]
or a @tech{syntax object}, it must be a list of five elements:
If @scheme[srcloc] is not @scheme[#f] or a @tech{syntax object}, it
must be a list or vector of five elements:
@schemeblock[
(list source-name line column position span)
#, @elem{or} (vector source-name line column position span)
]
where @scheme[source-name-v] is an arbitrary value for the source

View File

@ -174,6 +174,10 @@ expression.
A complete expansion produces a @tech{syntax object} matching the
following grammar:
@margin-note{Beware that the symbolic names of identifiers in a fully
expanded program may not match the symbolic names in the grammar. Only
the binding (according to @scheme[free-identifier=?]) matters.}
@schemegrammar*[
#:literals (#%expression module #%plain-module-begin begin #%provide
define-values define-syntaxes define-values-for-syntax
@ -221,10 +225,6 @@ of a program (i.e., a @deftech{parsed} program), and @tech{lexical
information} on its @tech{identifiers} indicates the
@tech{parse}.
@margin-note{Beware that the symbolic names of identifiers in a fully
expanded program may not match the symbolic names in the grammar. Only
the binding (according to @scheme[free-identifier=?]) matters.}
More specifically, the typesetting of identifiers in the above grammar
is significant. For example, the second case for @scheme[_expr] is a
@tech{syntax-object} list whose first element is an @tech{identifier},

View File

@ -5696,12 +5696,21 @@ static Scheme_Object *datum_to_syntax(int argc, Scheme_Object **argv)
if (!SCHEME_FALSEP(src)
&& !SCHEME_STXP(src)
&& !(SCHEME_VECTORP(src)
&& (SCHEME_VEC_SIZE(src) == 5)
&& pos_exact_or_false_p(SCHEME_VEC_ELS(src)[1])
&& nonneg_exact_or_false_p(SCHEME_VEC_ELS(src)[2])
&& pos_exact_or_false_p(SCHEME_VEC_ELS(src)[3])
&& nonneg_exact_or_false_p(SCHEME_VEC_ELS(src)[4]))
&& !((ll == 5)
&& pos_exact_or_false_p(SCHEME_CADR(src))
&& nonneg_exact_or_false_p(SCHEME_CADR(SCHEME_CDR(src)))
&& pos_exact_or_false_p(SCHEME_CADR(SCHEME_CDR(SCHEME_CDR(src))))
&& nonneg_exact_or_false_p(SCHEME_CADR(SCHEME_CDR(SCHEME_CDR(SCHEME_CDR(src)))))))
scheme_wrong_type("datum->syntax", "syntax, source location list, or #f", 2, argc, argv);
scheme_wrong_type("datum->syntax", "syntax, source location vector or list, or #f", 2, argc, argv);
if (SCHEME_VECTORP(src))
ll = 5;
if (argc > 3) {
if (!SCHEME_FALSEP(argv[3])) {
@ -5722,11 +5731,19 @@ static Scheme_Object *datum_to_syntax(int argc, Scheme_Object **argv)
if (ll == 5) {
/* line--column--pos--span format */
Scheme_Object *line, *col, *pos, *span;
line = SCHEME_CADR(src);
col = SCHEME_CADR(SCHEME_CDR(src));
pos = SCHEME_CADR(SCHEME_CDR(SCHEME_CDR(src)));
span = SCHEME_CADR(SCHEME_CDR(SCHEME_CDR(SCHEME_CDR(src))));
src = SCHEME_CAR(src);
if (SCHEME_VECTORP(src)) {
line = SCHEME_VEC_ELS(src)[1];
col = SCHEME_VEC_ELS(src)[2];
pos = SCHEME_VEC_ELS(src)[3];
span = SCHEME_VEC_ELS(src)[4];
src = SCHEME_VEC_ELS(src)[0];
} else {
line = SCHEME_CADR(src);
col = SCHEME_CADR(SCHEME_CDR(src));
pos = SCHEME_CADR(SCHEME_CDR(SCHEME_CDR(src)));
span = SCHEME_CADR(SCHEME_CDR(SCHEME_CDR(SCHEME_CDR(src))));
src = SCHEME_CAR(src);
}
if (SCHEME_FALSEP(line) != SCHEME_FALSEP(col))
scheme_arg_mismatch("datum->syntax",