diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss index bc001a45..68d9fa09 100644 --- a/collects/scribble/manual.ss +++ b/collects/scribble/manual.ss @@ -446,7 +446,7 @@ (let ([s (to-element/no-color elem)]) (make-delayed-element (lambda (renderer sec ri) - (let* ([tag (find-scheme-tag sec ri sig 'for-label)] + (let* ([tag (find-scheme-tag sec ri sig #f)] [taglet (and tag (append (cadr tag) (list elem)))] [vtag (and tag `(sig-val ,taglet))] [stag (and tag `(sig-form ,taglet))] @@ -490,7 +490,7 @@ (lambda (c mk) (make-delayed-element (lambda (ren p ri) - (let ([tag (find-scheme-tag p ri id/tag 'for-label)]) + (let ([tag (find-scheme-tag p ri id/tag #f)]) (if tag (list (mk tag)) content))) @@ -1851,7 +1851,7 @@ (list (make-link-element #f content - (or (find-scheme-tag p ri stx-id 'for-label) + (or (find-scheme-tag p ri stx-id #f) (format "--UNDEFINED:~a--" (syntax-e stx-id)))))) (lambda () content) (lambda () content)))) @@ -2023,15 +2023,17 @@ (if (path? p) (intern-taglet (path->main-collects-relative p)) p)) - (cadddr b) - (list-ref b 5)) + (list-ref b 3) + (list-ref b 4) + (list-ref b 5) + (list-ref b 6)) (error 'scribble "no class/interface/mixin information for identifier: ~e" id)))) (define-serializable-struct cls/intf (name-element app-mixins super intfs methods)) (define (make-inherited-table r d ri decl) - (let* ([start (let ([key (find-scheme-tag d ri (decl-name decl) 'for-label)]) + (let* ([start (let ([key (find-scheme-tag d ri (decl-name decl) #f)]) (if key (list (cons key (lookup-cls/intf d ri key))) null))] @@ -2047,7 +2049,7 @@ (let ([super (car supers)]) (loop (append (filter values (map (lambda (i) - (let ([key (find-scheme-tag d ri i 'for-label)]) + (let ([key (find-scheme-tag d ri i #f)]) (and key (cons key (lookup-cls/intf d ri key))))) (append @@ -2452,14 +2454,14 @@ null))]) (make-delayed-element (lambda (r d ri) - (let loop ([search (get d ri (find-scheme-tag d ri cname 'for-label))]) + (let loop ([search (get d ri (find-scheme-tag d ri cname #f))]) (cond [(null? search) (list (make-element #f '("")))] [(not (car search)) (loop (cdr search))] [else - (let* ([a-key (find-scheme-tag d ri (car search) 'for-label)] + (let* ([a-key (find-scheme-tag d ri (car search) #f)] [v (and a-key (lookup-cls/intf d ri a-key))]) (if v (if (member name (cls/intf-methods v)) @@ -2468,7 +2470,7 @@ (list (**method name a-key) " in " (cls/intf-name-element v)))) - (loop (append (cdr search) (get d ri (find-scheme-tag d ri (car search) 'for-label))))) + (loop (append (cdr search) (get d ri (find-scheme-tag d ri (car search) #f))))) (loop (cdr search))))]))) (lambda () (format "~a in ~a" (syntax-e cname) name)) (lambda () (format "~a in ~a" (syntax-e cname) name))))) diff --git a/collects/scribble/scheme.ss b/collects/scribble/scheme.ss index 300ecbaf..1be98170 100644 --- a/collects/scribble/scheme.ss +++ b/collects/scribble/scheme.ss @@ -85,7 +85,7 @@ (weak-box-value b)))) (let ([e (make-cached-delayed-element (lambda (renderer sec ri) - (let* ([tag (find-scheme-tag sec ri c 'for-label)]) + (let* ([tag (find-scheme-tag sec ri c #f)]) (if tag (list (case (car tag) diff --git a/collects/scribble/search.ss b/collects/scribble/search.ss index df69f147..ef5408b5 100644 --- a/collects/scribble/search.ss +++ b/collects/scribble/search.ss @@ -36,17 +36,21 @@ v))) - ;; mode is #f, 'for-label, or 'for-run - (define (find-scheme-tag part ri stx/binding mode) + (define (find-scheme-tag part ri stx/binding phase-level) + ;; The phase-level argument is used only when `stx/binding' + ;; is an identifier. + ;; + ;; Note: documentation key currently don't distinguish different + ;; phase definitions of an identifier from a source module. + ;; That is, there's no way to document (define x ....) differently + ;; from (define-for-syntax x ...). This isn't a problem in practice, + ;; because no one uses the same name for different-phase exported + ;; bindings. (let ([b (cond [(identifier? stx/binding) - ((case mode - [(for-label) identifier-label-binding] - [(for-syntax) identifier-transformer-binding] - [else identifier-binding]) - stx/binding)] + (identifier-binding stx/binding phase-level)] [(and (list? stx/binding) - (= 6 (length stx/binding))) + (= 7 (length stx/binding))) stx/binding] [else (and (not (symbol? (car stx/binding))) @@ -57,15 +61,20 @@ (cadr stx/binding) p (cadr stx/binding) - #f (if (= 2 (length stx/binding)) - mode - (caddr stx/binding)))))])]) + 0 + (caddr stx/binding)) + (if (= 2 (length stx/binding)) + 0 + (cadddr stx/binding)) + (if (= 2 (length stx/binding)) + 0 + (cadddr (cdr stx/binding))))))])]) (and (pair? b) (let ([seen (make-hash-table)] [search-key #f]) - (let loop ([queue (list (list (caddr b) (cadddr b) (eq? mode (list-ref b 5))))] + (let loop ([queue (list (list (caddr b) (cadddr b) (list-ref b 4) (list-ref b 5) (list-ref b 6)))] [rqueue null]) (cond [(null? queue) @@ -74,12 +83,14 @@ #f (loop (reverse rqueue) null))] [else - (let ([mod (caar queue)] - [id (cadar queue)] - [here? (caddar queue)] + (let ([mod (list-ref (car queue) 0)] + [id (list-ref (car queue) 1)] + [defn-phase (list-ref (car queue) 2)] + [import-phase (list-ref (car queue) 3)] + [export-phase (list-ref (car queue) 4)] [queue (cdr queue)]) (let* ([rmp (module-path-index-resolve mod)] - [eb (and here? + [eb (and (equal? defn-phase export-phase) (list (let ([p (resolved-module-path-name rmp)]) (if (path? p) (intern-taglet (path->main-collects-relative p)) @@ -106,35 +117,46 @@ module-info-cache rmp (lambda () - (let-values ([(run-vals run-stxes - syntax-vals syntax-stxes - label-vals label-stxes) + (let-values ([(valss stxess) (module-compiled-exports (get-module-code (resolved-module-path-name rmp)))]) - (let ([t (list (append run-vals run-stxes) - (append syntax-vals syntax-stxes) - (append label-vals label-stxes))]) + (let ([t + ;; Merge the two association lists: + (let loop ([base valss] + [stxess stxess]) + (cond + [(null? stxess) base] + [(assoc (caar stxess) base) + => (lambda (l) + (loop (cons (cons (car l) + (append (cdar stxess) + (cdr l))) + (remq l base)) + (cdr stxess)))] + [else (loop (cons (car stxess) + base) + (cdr stxess))]))]) (hash-table-put! module-info-cache rmp t) t))))]) (hash-table-put! seen rmp #t) - (let ([a (assq id (list-ref exports - (if here? - 0 - (case mode - [(for-syntax) 1] - [(for-label) 2] - [else 0]))))]) + (let ([a (assq id (let ([a (assoc export-phase exports)]) + (if a + (cdr a) + null)))]) (if a (loop queue (append (map (lambda (m) (if (pair? m) (list (module-path-index-rejoin (car m) mod) - (caddr m) - (or here? - (eq? mode (cadr m)))) + (list-ref m 2) + defn-phase + (list-ref m 1) + (list-ref m 3)) (list (module-path-index-rejoin m mod) id - here?))) + 0 + 0 + 0))) (cadr a)) rqueue)) (error 'find-scheme-tag diff --git a/collects/scribblings/scribble/xref.scrbl b/collects/scribblings/scribble/xref.scrbl index bd923a2b..b9b68402 100644 --- a/collects/scribblings/scribble/xref.scrbl +++ b/collects/scribblings/scribble/xref.scrbl @@ -49,15 +49,18 @@ get all cross-reference information for installed documentation.} symbol? module-path-index? symbol? - boolean? - (one-of/c #f 'for-syntax 'for-label)) + (one-of/c 0 1) + (or/c exact-integer? false/c) + (or/c exact-integer? false/c)) (list/c (or/c module-path? module-path-index? path? resolved-module-path?) symbol? - (one-of/c #f 'for-syntax 'for-label)))] - [mode (one-of/c #f 'for-syntax 'for-label)]) + (one-of/c 0 1) + (or/c exact-integer? false/c) + (or/c exact-integer? false/c)))] + [mode (or/c exact-integer? false/c)]) (or/c tag? false/c)]{ Locates a tag in @scheme[xref] that documents a module export. The @@ -68,35 +71,27 @@ either for the specified module or, if the exported name is re-exported from other other module, for the other module (transitively). -The @scheme[mode] argument specifies more information about the -binding: whether it refers to a normal binding, a @scheme[for-syntax] -binding, or a @scheme[for-label] binding. - -The @scheme[binding] is specified in one of four ways: +The @scheme[mode] argument specifies the relevant phase level for the +binding. The @scheme[binding] is specified in one of four ways: @itemize{ @item{If @scheme[binding] is an identifier, then - @scheme[identifier-binding], - @scheme[identifier-transformer-binding], or - @scheme[identifier-label-binding] is used to determine the - binding, depending on the value of @scheme[mode].} + @scheme[identifier-binding] is used with @scheme[mode] to + determine the binding.} @item{If @scheme[binding] is a two-element list, then the first element provides the exporting module and the second the exported name. The @scheme[mode] argument is effectively ignored.} - @item{If @scheme[binding] is a six-element list, then it corresponds - to a result from @scheme[identifier-binding], - @scheme[identifier-transformer-binding], or - @scheme[identifier-label-binding], depending on the value of + @item{If @scheme[binding] is a seven-element list, then it corresponds + to a result from @scheme[identifier-binding] using @scheme[mode].} - @item{If @scheme[binding] is a three-element list, then the first - element is as for the 2-element-list case, the second element - is like the fourth element of the six-element case, and the - third element is like the sixth element of the six-element + @item{If @scheme[binding] is a five-element list, then the first + element is as for the two-element-list case, and the remain + elements are as in the last four elements of the seven-element case.} }