From f22f94b34547d15c4d03cdb8c5684083724966fb Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 9 Feb 2008 14:38:02 +0000 Subject: [PATCH] minor doc-build space savings svn: r8600 --- collects/mzscheme/mzscheme.scrbl | 7 ++- collects/scribble/scheme.ss | 43 ++++++++++++------- collects/scribblings/reference/stx-ops.scrbl | 12 ++++-- .../scribblings/reference/syntax-model.scrbl | 8 ++-- src/mzscheme/src/stxobj.c | 29 ++++++++++--- 5 files changed, 69 insertions(+), 30 deletions(-) diff --git a/collects/mzscheme/mzscheme.scrbl b/collects/mzscheme/mzscheme.scrbl index d36f459bd4..f1be683421 100644 --- a/collects/mzscheme/mzscheme.scrbl +++ b/collects/mzscheme/mzscheme.scrbl @@ -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?] diff --git a/collects/scribble/scheme.ss b/collects/scribble/scheme.ss index 30ceba9778..300ecbaf2e 100644 --- a/collects/scribble/scheme.ss +++ b/collects/scribble/scheme.ss @@ -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) diff --git a/collects/scribblings/reference/stx-ops.scrbl b/collects/scribblings/reference/stx-ops.scrbl index df92e58946..87470dc4df 100644 --- a/collects/scribblings/reference/stx-ops.scrbl +++ b/collects/scribblings/reference/stx-ops.scrbl @@ -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 diff --git a/collects/scribblings/reference/syntax-model.scrbl b/collects/scribblings/reference/syntax-model.scrbl index b2e99f7d2b..7c25d10e7c 100644 --- a/collects/scribblings/reference/syntax-model.scrbl +++ b/collects/scribblings/reference/syntax-model.scrbl @@ -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}, diff --git a/src/mzscheme/src/stxobj.c b/src/mzscheme/src/stxobj.c index c315eea4c5..91652f3abf 100644 --- a/src/mzscheme/src/stxobj.c +++ b/src/mzscheme/src/stxobj.c @@ -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",