suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

implement scribble/srcdoc' via submodules instead of expand'

Browse Source 
Also add a `for-doc' require form, make `proc-doc' et al. provide
forms, make `provide/doc' an alias for `provide'.

original commit: 964020f288a73340052b471327bfe873d804eea8
This commit is contained in:
Matthew Flatt 2012-05-11 13:12:35 -06:00
parent 757b462154
commit 24acfab0ad
4 changed files with 222 additions and 254 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

206
collects/scribble/extract.rkt
View File

@ -1,187 +1,47 @@
#lang scheme/base #lang racket/base
(require (for-syntax racket/base))
(require scribble/manual
scribble/decode
scribble/srcdoc
(for-syntax scheme/base
scheme/path
scheme/list
syntax/path-spec
syntax/modread
(for-syntax scheme/base)))
(provide include-extracted (provide include-extracted
provide-extracted provide-extracted
include-previously-extracted) include-previously-extracted)
(define-for-syntax (strip-context c) (define-for-syntax (do-include-extracted stx wraps)
(cond (syntax-case stx ()
[(syntax? c) (datum->syntax [(_ module-path)
#f (with-syntax ([get-docs (syntax-local-lift-require
(strip-context (syntax-e c)) #'(only (submod module-path srcdoc) get-docs)
c)] (datum->syntax stx 'get-docs))]
[(pair? c) (cons (strip-context (car c)) [(wrap ...) wraps])
(strip-context (cdr c)))] #'(begin
[else c])) (define-syntax (docs stx)
(define docs (get-docs))
(define-for-syntax (extract orig-path stx) (if (identifier? docs)
(let* ([n-path (resolve-path-spec orig-path orig-path stx)] ;; normal:
[path (if (regexp-match? #rx#"[.]rkt$" (path->bytes n-path)) (with-syntax ([(_ xwrap (... ...)) stx]
(if (file-exists? n-path) [id docs])
n-path #'(xwrap (... ...) id))
(let ([ss (path-replace-suffix n-path #".ss")]) ;; delayed:
(if (file-exists? ss) (with-syntax ([(_ xwrap (... ...)) stx]
ss [(reqs ((id d) (... ...))) (get-docs)])
n-path)))
n-path)])
(let ([s-exp
(parameterize ([current-namespace (make-base-namespace)]
[current-load-relative-directory
(path-only path)])
(expand
(with-module-reading-parameterization
(lambda ()
(with-input-from-file path
(lambda ()
(port-count-lines! (current-input-port))
(read-syntax path)))))))])
(syntax-case s-exp ()
[(mod name lang
(mod-beg
content ...))
(with-syntax ([((content id) ...)
(apply
append
(map (lambda (c)
(syntax-case c (#%plain-app void quote-syntax provide/doc)
[(#%plain-app void (quote-syntax (provide/doc spec ...)))
(syntax->list #'(spec ...))]
[_ null]))
(syntax->list #'(content ...))))]
[(doc-req ...)
(map
strip-context
(append-map (lambda (c)
(syntax-case c (#%plain-app void quote-syntax require/doc)
[(#%plain-app void (quote-syntax (require/doc spec ...)))
(syntax->list #'(spec ...))]
[_ null]))
(syntax->list #'(content ...))))]
[(req ...)
(map
strip-context
(append-map (lambda (c)
(syntax-case c (#%require)
[(#%require spec ...)
(let loop ([specs (syntax->list #'(spec ...))])
(cond
[(null? specs) '()]
[else (let ([spec (car specs)])
(syntax-case spec (for-syntax for-meta)
[(for-syntax . spec) (loop (cdr specs))]
[(for-meta . spec) (loop (cdr specs))]
[(for-template . spec) (loop (cdr specs))]
[(for-label . spec) (loop (cdr specs))]
[(just-meta . spec) (loop (cdr specs))]
[_ (cons #`(for-label #,spec) (loop (cdr specs)))]))]))]
[_ null]))
(syntax->list #'(content ...))))]
[orig-tag (datum->syntax #f 'orig)])
;; This template is matched in `filter-info', below
#`(begin #`(begin
(#%require (for-label #,(strip-context #'lang)) (require . reqs)
(for-label #,(strip-context orig-path)) (xwrap (... ...) (list (cons 'id d) (... ...)))))))
req ...) (docs wrap ...)))]))
(require doc-req ...)
(drop-first (quote-syntax id) (def-it orig-tag content)) ...))]))))
(define-syntax (include-extracted stx) (define-syntax (include-extracted stx)
(syntax-case stx () (do-include-extracted stx #'(map cdr)))
[(_ orig-path)
(extract #'orig-path stx)]))
(define-syntax (provide-extracted stx) (define-syntax (provide-extracted stx)
(syntax-case stx () (syntax-case stx ()
[(_ orig-path) [(_ module-path)
(with-syntax ([(_begin reqs doc-reqs (_drop-first (_quote-syntax id) def) ...)
(extract #'orig-path stx)])
#'(begin
(require (for-label (only-in orig-path))) ;; creates build dependency
(define-syntax (extracted stx)
(syntax-case stx ()
[(_ rx)
(let-syntax ([quote-syntax/loc
(lambda (stx)
(syntax-case stx ()
[(_ s)
(let loop ([stx #'s])
(cond
[(syntax? stx)
(let ([ctx (datum->syntax stx 'ctx #f #f stx)])
(let ([s
#`(datum->syntax (quote-syntax #,ctx)
#,(loop (syntax-e stx))
#,(and (syntax-position stx)
(vector (let ([s (syntax-source stx)])
(if (path-string? s)
s
(format "~s" s)))
(syntax-line stx)
(syntax-column stx)
(syntax-position stx)
(syntax-span stx))))])
(let ([p (syntax-property stx 'paren-shape)])
(if p
#`(syntax-property #,s 'paren-shape '#,p)
s))))]
[(pair? stx) #`(cons #,(loop (car stx)) #,(loop (cdr stx)))]
[(vector? stx) #`(vector #,@(map loop (vector->list stx)))]
[(box? stx) #`(box #,(loop (unbox stx)))]
[else #`(quote #,stx)]))]))])
#`(begin #,(quote-syntax/loc reqs)
#,(quote-syntax/loc doc-reqs)
#,@(filter
values
(map (lambda (i d)
(if (regexp-match (syntax-e #'rx) (symbol->string i))
(d)
#f))
(list 'id ...)
(list (lambda () (quote-syntax/loc def)) ...)))))]))
(provide extracted)))]))
(define-syntax (include-previously-extracted stx)
(syntax-case stx ()
[(_ orig-path regexp-s)
(unless (regexp? (syntax-e #'regexp-s))
(raise-syntax-error #f "expected a literal regular expression as the second argument" stx #'regexp-s))
#`(begin #`(begin
(require (only-in orig-path [#,(datum->syntax #'orig-path 'extracted) extracted])) #,(do-include-extracted stx #'(define exported))
(extracted regexp-s))])) (provide exported))]))
(define-for-syntax (revise-context c orig-tag new-tag tag) (define-syntax-rule (include-previously-extracted module-path regexp)
(cond (let ()
[(syntax? c) (local-require (rename-in module-path [exported exported]))
(datum->syntax (for/list ([p (in-list exported)]
(if (bound-identifier=? tag (datum->syntax c 'tag)) #:when (regexp-match regexp (symbol->string (car p))))
new-tag (cdr p))))
orig-tag)
(revise-context (syntax-e c) orig-tag new-tag tag)
c
c)]
[(pair? c) (cons (revise-context (car c) orig-tag new-tag tag)
(revise-context (cdr c) orig-tag new-tag tag))]
[else c]))
(define-syntax (def-it stx)
(syntax-local-introduce
(syntax-case (syntax-local-introduce stx) ()
[(_ orig-path (reqs doc tag))
(let ([new-tag ((make-syntax-introducer)
(datum->syntax #'orig-path 'new-tag))]
[orig-tag #'orig-path])
#`(begin
(require . #,(revise-context #'reqs orig-tag new-tag #'tag))
#,(revise-context #'doc orig-tag new-tag #'tag)))])))
(define-syntax-rule (drop-first a b) b)

12
collects/scribble/provide-doc-transform.rkt
View File

@ -1,15 +1,7 @@
#lang scheme/base #lang racket/base
(require "srcdoc.rkt")
(require (for-syntax scheme/base))
(provide define-provide/doc-transformer (provide define-provide/doc-transformer
(for-syntax (for-syntax
provide/doc-transformer? provide/doc-transformer?
provide/doc-transformer-proc)) provide/doc-transformer-proc))
(begin-for-syntax
(define-struct provide/doc-transformer (proc) #:omit-define-syntaxes))
(define-syntax-rule (define-provide/doc-transformer id rhs)
(define-syntax id
(make-provide/doc-transformer rhs)))

128
collects/scribble/srcdoc.rkt
View File

@ -1,23 +1,84 @@
#lang scheme/base #lang racket/base
(require racket/contract/base (require racket/contract/base
(for-syntax scheme/base) (for-syntax racket/base
"provide-doc-transform.rkt") racket/require-transform
racket/provide-transform))
(provide require/doc (provide for-doc require/doc
provide/doc provide/doc ; not needed anymore
thing-doc thing-doc
parameter-doc parameter-doc
proc-doc proc-doc
proc-doc/names) proc-doc/names
generate-delayed-documents)
(define-syntax-rule (require/doc spec ...) (begin-for-syntax
(void (quote-syntax (require/doc spec ...)))) (define requires null)
(define doc-body null)
(define generated? #f)
(define delayed? #f)
(define-syntax (provide/doc stx) (define (add-requires!/decl specs)
(unless delayed?
(syntax-local-lift-module-end-declaration
#`(begin-for-syntax (add-requires! (quote-syntax #,specs)))))
(add-requires! (syntax-local-introduce specs)))
(define (add-requires! specs)
(set! requires (cons specs requires)))
(define (generate-doc-submodule!)
(unless generated?
(set! generated? #t)
(syntax-local-lift-module-end-declaration #'(doc-submodule)))))
(define-syntax for-doc
(make-require-transformer
(lambda (stx)
(syntax-case stx () (syntax-case stx ()
[(_ form ...) [(_ spec ...)
(let ([forms (syntax->list #'(form ...))]) (add-requires!/decl #'(spec ...))])
(with-syntax ([((for-provide/contract for-docs id) ...) (values null null))))
(define-syntax (doc-submodule stx)
(with-syntax ([((req ...) ...)
(map syntax-local-introduce (reverse requires))]
[doc-body
(map (lambda (s) (syntax-local-introduce
(syntax-shift-phase-level s #f)))
(reverse doc-body))])
;; This module will be required `for-template':
(if delayed?
;; delayed mode: return syntax objects to drop into context:
#'(begin-for-syntax
(module* srcdoc #f
(require (for-syntax racket/base syntax/quote))
(begin-for-syntax
(provide get-docs)
(define (get-docs)
(list (quote-syntax (req ... ...))
(quote-syntax/keep-srcloc doc-body))))))
;; normal mode: return an identifier that holds the document:
(with-syntax ([((id d) ...) #'doc-body])
#'(begin-for-syntax
(module* srcdoc #f
(require req ... ...)
(define docs (list (cons 'id d) ...))
(require (for-syntax racket/base))
(begin-for-syntax
(provide get-docs)
(define (get-docs)
#'docs))))))))
(define-syntax (require/doc stx)
(syntax-case stx ()
[(_ spec ...)
(add-requires!/decl #'(spec ...))
#'(begin)]))
(define-for-syntax (do-provide/doc stx modes)
(let ([forms (list stx)])
(with-syntax ([((for-provide/contract (req ...) d id) ...)
(map (lambda (form) (map (lambda (form)
(syntax-case form () (syntax-case form ()
[(id . _) [(id . _)
@ -34,7 +95,7 @@
(let-values ([(p/c d req/d id) (let-values ([(p/c d req/d id)
((provide/doc-transformer-proc t) ((provide/doc-transformer-proc t)
(i (syntax-local-introduce form)))]) (i (syntax-local-introduce form)))])
(list (i2 p/c) (list (i2 req/d) (i2 d) (i2 (quote-syntax tag))) (i2 id)))))] (list (i2 p/c) (i req/d) (i d) (i id)))))]
[_ [_
(raise-syntax-error (raise-syntax-error
#f #f
@ -45,12 +106,17 @@
(with-syntax ([(p/c ...) (with-syntax ([(p/c ...)
(map (lambda (form f) (map (lambda (form f)
(quasisyntax/loc form (quasisyntax/loc form
(provide/contract #,f))) (contract-out #,f)))
forms forms
(syntax->list #'(for-provide/contract ...)))]) (syntax->list #'(for-provide/contract ...)))])
#'(begin (generate-doc-submodule!)
p/c ... (set! doc-body (append (reverse (syntax->list #'((id d) ...)))
(void (quote-syntax (provide/doc (for-docs id) ...)))))))])) doc-body))
(set! requires (cons #'(req ... ...) requires))
(pre-expand-export #'(combine-out p/c ...) modes)))))
(define-syntax-rule (provide/doc form ...)
(provide form ...))
(define-for-syntax (remove->i-deps stx) (define-for-syntax (remove->i-deps stx)
(syntax-case stx () (syntax-case stx ()
@ -61,6 +127,24 @@
[else [else
(error 'remove->i-deps "unknown thing ~s" stx)])) (error 'remove->i-deps "unknown thing ~s" stx)]))
(provide define-provide/doc-transformer
(for-syntax
provide/doc-transformer?
provide/doc-transformer-proc))
(begin-for-syntax
(define-struct provide/doc-transformer (proc)
#:property
prop:provide-pre-transformer
(lambda (self)
(lambda (stx mode)
(do-provide/doc stx mode)))))
(define-syntax-rule (define-provide/doc-transformer id rhs)
(define-syntax id
(make-provide/doc-transformer rhs)))
(define-provide/doc-transformer proc-doc (define-provide/doc-transformer proc-doc
(lambda (stx) (lambda (stx)
(syntax-case stx () (syntax-case stx ()
@ -144,7 +228,8 @@
(values (values
#'[id contract] #'[id contract]
#'(defproc header result body-stuff ... . desc) #'(defproc header result body-stuff ... . desc)
#'(scribble/manual) #'(scribble/manual
racket/base) ; for `...'
#'id))]))) #'id))])))
(define-provide/doc-transformer proc-doc/names (define-provide/doc-transformer proc-doc/names
@ -310,3 +395,10 @@
#'(defthing id contract . desc) #'(defthing id contract . desc)
#'((only-in scribble/manual defthing)) #'((only-in scribble/manual defthing))
#'id))]))) #'id))])))
(define-syntax (generate-delayed-documents stx)
(syntax-case stx ()
[(_)
(begin
(set! delayed? #t)
#'(begin))]))

68
collects/scribblings/scribble/srcdoc.scrbl
View File

@ -23,16 +23,17 @@ run-time overhead for the library. Similarly, typesetting the
documentation does not require running the library. The two phases documentation does not require running the library. The two phases
(run time versus documentation time) are kept separate in much the (run time versus documentation time) are kept separate in much the
same way that the module system keeps expansion-time code separate same way that the module system keeps expansion-time code separate
from run-time code. from run-time code, and documentation information is recorded in a
submodule to be separately loadable from the enclosing module.
For an example use, see the @filepath{file} collection's For an example use, see the @filepath{file} collection's
@filepath{gif.rkt} source file and the corresponding extraction in @filepath{gif.rkt} source file and the corresponding extraction in
@filepath{scribblings/gif.scrbl}. As that example illustrates, @filepath{scribblings/gif.scrbl}. As that example illustrates,
prefixing the module declaration with starting the module declaration with
@verbatim[#:indent 2]{ @racketblock[
#reader scribble/reader @#,hash-lang[] @#,racketmodname[at-exp]
} ]
enables the @"@"-reader, which is handy for writing documentation enables the @"@"-reader, which is handy for writing documentation
expressions. expressions.
@ -43,27 +44,21 @@ expressions.
@defmodule[scribble/srcdoc] @defmodule[scribble/srcdoc]
@defform[(provide/doc spec ...)]{ Documentation information generated by @racketmodname[scribble/srcdoc]
forms are accumulated into a @racketidfont{srcdoc} submodule. The
generated submodule is accessed by the bindings of
@racketmodname[scribble/extract].
Like @racket[provide] or @racket[provide/contract], but each @defform[(for-doc require-spec ...)]{
@racket[spec] uses a @deftech{documentation transformer} to describe
the exported identifier and its contract.
The currently supported @tech{documentation transformers} are A @racket[require] sub-form for bindings that are needed at
@racket[proc-doc], @racket[proc-doc/names], @racket[parameter-doc],
and @racket[thing-doc].}
@defform[(require/doc require-spec ...)]{
Like @racket[require], but for bindings that are needed at
documentation time (and documentation-expansion time, etc.) instead of documentation time (and documentation-expansion time, etc.) instead of
run time (and expansion time, etc.). A @racket[require-doc] form has run time (and expansion time, etc.). A @racket[for-doc] import has
no effect on a normal use of the library; it affects only no effect on a normal use of the library; it affects only
documentation extraction. documentation extraction.
Typically, a library that uses @racketmodname[scribble/srcdoc] Typically, a library that uses @racketmodname[scribble/srcdoc]
includes at least @racket[(require/doc scribble/base scribble/manual)] includes at least @racket[(require (for-doc scribble/base scribble/manual))]
to get core Racket forms and basic Scribble functions to use in to get core Racket forms and basic Scribble functions to use in
documentation expressions.} documentation expressions.}
@ -79,9 +74,9 @@ documentation expressions.}
[optional contract-expr [optional contract-expr
(code:line keyword contract-expr)])]{ (code:line keyword contract-expr)])]{
When used in @racket[provide/doc], exports @racket[id] with the A @racket[provide] sub-form that exports @racket[id] with the
contract described by @racket[contract] contract described by @racket[contract]
just like using @racket[provide/contract]. just like using @racket[contract-out].
The @racket[arg-spec] specifies the names of arguments and the The @racket[arg-spec] specifies the names of arguments and the
default values, which are not default values, which are not
@ -124,15 +119,43 @@ Like @racket[proc-doc], but supporting contract forms that embed
argument names. Only a subset of @racket[->i] and @racket[->d] forms are argument names. Only a subset of @racket[->i] and @racket[->d] forms are
currently supported.} currently supported.}
@defform[(thing-doc id contract-expr dec-expr)]{ @defform[(thing-doc id contract-expr dec-expr)]{
Like @racket[proc-doc], but for an export of an arbitrary value.} Like @racket[proc-doc], but for an export of an arbitrary value.}
@defform[#:literals (parameter/c) @defform[#:literals (parameter/c)
(parameter-doc id (parameter/c contract-expr) arg-id desc-expr)]{ (parameter-doc id (parameter/c contract-expr) arg-id desc-expr)]{
Like @racket[proc-doc], but for exporting a parameter.} Like @racket[proc-doc], but for exporting a parameter.}
@defform[(generate-delayed-documents)]{
Causes documentation information to be recorded as a macro that is
expanded (along with any @racket[for-doc] imports) in the
module that uses @racket[include-extracted] or @racket[provide-extracted],
instead of within (a submodule of) the module that declares the information.
Delaying document generation in this way allows @racket[(for-doc
(for-label ....))] imports that would otherwise create cyclic module
dependencies.
To avoid problems with accumulated @racket[for-doc] imports across
modules, @racket[generate-delayed-documents] declaration should appear
before any @racket[for-doc] import.}
@defform[(require/doc require-spec ...)]{
A legacy shorthand for @racket[(require (for-doc require-spec ...))].}
@defform[(provide/doc spec ...)]{
A legacy alternative to @racket[(provide spec ...)]}
@; ---------------------------------------- @; ----------------------------------------
@section{Extracting Documentation from Source} @section{Extracting Documentation from Source}
@ -143,7 +166,8 @@ Like @racket[proc-doc], but for exporting a parameter.}
Expands to a sequence of documentation forms extracted from Expands to a sequence of documentation forms extracted from
@racket[module-path], which is expected to be a module that uses @racket[module-path], which is expected to be a module that uses
@racketmodname[scribble/srcdoc].} @racketmodname[scribble/srcdoc] (so that the module has a
@racketidfont{srcdoc} submodule).}
@defform[(provide-extracted module-path)]{ @defform[(provide-extracted module-path)]{