minor doc-build space savings
svn: r8600
This commit is contained in:
parent
4f6d727b91
commit
f22f94b345
|
@ -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?]
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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},
|
||||
|
|
|
@ -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",
|
||||
|
|
Loading…
Reference in New Issue
Block a user