3.99.0.13: generalize require and provide to work with arbitrary phases
svn: r8742 original commit: ba63bd6f954b4b1ce09225f4b55dbe7c3a93a46b
This commit is contained in:
Matthew Flatt
parent
d9a438219a
commit
1cc6ff191b
|
|
@ -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 '("<method not found>")))]
|
||||
[(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)))))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.}
|
||||
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user