commit d49e86f13e843c3979c9e2c1580c8e59021ed073
parent 32fe5545343a5dd8404862661044511e4e897c77
Author: Neil Toronto <neil.toronto@gmail.com>
Date: Sat, 11 Jan 2014 17:40:41 -0700
Added #:value keyword to `defproc', `defparam', `defthing' and related
Also fixed `defproc*' example
original commit: 9ca8c71aadebf741c6ac799b7b78ecf2113d4b16
Diffstat:
5 files changed, 265 insertions(+), 116 deletions(-)
diff --git a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/manual.scrbl b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/manual.scrbl
@@ -766,6 +766,7 @@ Equivalent to @racket[defmodule] variants @racket[#:no-declare].}
@defform/subs[(defproc options prototype
result-contract-expr-datum
+ maybe-value
pre-flow ...)
([prototype (id arg-spec ...)
(prototype arg-spec ...)]
@@ -782,6 +783,8 @@ Equivalent to @racket[defmodule] variants @racket[#:no-declare].}
(code:line #:link-target? link-target?-expr)]
[maybe-id code:blank
(code:line #:id [src-id dest-id-expr])]
+ [maybe-value code:blank
+ (code:line #:value value-expr-datum)]
[ellipses @#,lit-ellipses]
[ellipses+ @#,lit-ellipses+])]{
@@ -895,11 +898,17 @@ If @racket[#:id [src-id dest-id-expr]] is supplied, then
place of @racket[src-id]. This split between @racket[src-id] and
@racket[dest-id-expr] roles is useful for functional abstraction of
@racket[defproc].
+
+If @racket[#:value value-expr-datum] is given, @racket[value-expr-datum]
+is typeset using @racket[racketblock0] and included in the documentation.
+As a service to readers, please use @racket[#:value] to document only
+simple, short functions.
}
@defform[(defproc* options
([prototype
- result-contract-expr-datum] ...)
+ result-contract-expr-datum
+ maybe-value] ...)
pre-flow ...)]{
Like @racket[defproc], but for multiple cases with the same
@@ -916,9 +925,8 @@ should use @racket[#:link-target? #f].
Examples:
@codeblock[#:keep-lang-line? #f]|{
#lang scribble/manual
-@defproc[((make-pb&j)
- (make-pb&j [jelly jelly?]))
- sandwich?]{
+@defproc*[([(make-pb&j) sandwich?]
+ [(make-pb&j [jelly jelly?]) sandwich?])]{
Returns a peanut butter and jelly sandwich. If @racket[jelly]
is provided, then it is used instead of the standard (grape)
jelly.
@@ -926,10 +934,9 @@ Examples:
}|
@doc-render-examples[
- @defproc[#:link-target? #f
- ((make-pb&j)
- (make-pb&j [jelly jelly?]))
- sandwich?]{
+ @defproc*[#:link-target? #f
+ ([(make-pb&j) sandwich?]
+ [(make-pb&j [jelly jelly?]) sandwich?])]{
Returns a peanut butter and jelly sandwich. If @racket[jelly]
is provided, then it is used instead of the standard (grape)
jelly.
@@ -1221,7 +1228,10 @@ Examples:
}
-@defform[(defparam maybe-link id arg-id contract-expr-datum pre-flow ...)]{
+@defform[(defparam maybe-link id arg-id
+ contract-expr-datum
+ maybe-value
+ pre-flow ...)]{
Like @racket[defproc], but for a parameter. The
@racket[contract-expr-datum] serves as both the result contract on the
@@ -1231,22 +1241,24 @@ parameter and the contract on values supplied for the parameter. The
Examples:
@codeblock[#:keep-lang-line? #f]|{
#lang scribble/manual
-@defparam[current-sandwich sandwich sandwich?]{
+@defparam[current-sandwich sandwich sandwich?
+ #:value empty-sandwich]{
A parameter that defines the current sandwich for operations that
- involve eating a sandwich.
+ involve eating a sandwich. Default value is the empty sandwich.
}
}|
@doc-render-examples[
@defparam[#:link-target? #f
- current-sandwich sandwich sandwich?]{
+ current-sandwich sandwich sandwich? #:value empty-sandwich]{
A parameter that defines the current sandwich for operations that
- involve eating a sandwich.
+ involve eating a sandwich. Default value is the empty sandwich.
}]
}
@defform[(defparam* maybe-link id arg-id
in-contract-expr-datum out-contract-expr-datum
+ maybe-value
pre-flow ...)]{
Like @racket[defparam], but with separate contracts for when the parameter is being
@@ -1255,14 +1267,16 @@ coerces values matching a more flexible contract to a more restrictive one;
@racket[current-directory] is an example).}
-@defform[(defboolparam maybe-link id arg-id pre-flow ...)]{
+@defform[(defboolparam maybe-link id arg-id
+ maybe-value
+ pre-flow ...)]{
Like @racket[defparam], but the contract on a parameter argument is
@racket[any/c], and the contract on the parameter result is
@racket[boolean?].}
-@defform/subs[(defthing options id contract-expr-datum
+@defform/subs[(defthing options id contract-expr-datum maybe-value
pre-flow ...)
([options (code:line maybe-kind maybe-link maybe-id)]
[maybe-kind code:blank
@@ -1270,7 +1284,9 @@ Like @racket[defparam], but the contract on a parameter argument is
[maybe-link code:blank
(code:line #:link-target? link-target?-expr)]
[maybe-id code:blank
- (code:line #:id id-expr)])]{
+ (code:line #:id id-expr)]
+ [maybe-value code:blank
+ (code:line #:value value-expr-datum)])]{
Like @racket[defproc], but for a non-procedure binding.
@@ -1281,17 +1297,29 @@ it is used in the same way as for
If @racket[#:id id-expr] is supplied, then the result of
@racket[id-expr] is used in place of @racket[id].
+If @racket[#:value value-expr-datum] is given, @racket[value-expr-datum]
+is typeset using @racket[racketblock0] and included in the documentation.
+Wide values are put on a separate line.
+
Examples:
@codeblock[#:keep-lang-line? #f]|{
#lang scribble/manual
@defthing[moldy-sandwich sandwich?]{
Don't eat this. Provided for backwards compatibility.
}
+
+@defthing[empty-sandwich sandwich? #:value (make-sandwich empty)]{
+ The empty sandwich.
+}
}|
@doc-render-examples[
@defthing[#:link-target? #f
moldy-sandwich sandwich?]{
Don't eat this. Provided for backwards compatibility.
+ }
+ @defthing[#:link-target? #f
+ empty-sandwich sandwich? #:value (make-sandwich empty)]{
+ The empty sandwich.
}]
}
diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-proc.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-proc.rkt
@@ -117,12 +117,25 @@
"expected a result contract, found a string" #'c)
#'(racketblock0 c))]))
+(define no-value #f)
+
+(define-syntax (result-value stx)
+ (syntax-case stx (no-value let)
+ [(_ no-value) #'#f]
+ [(_ (let () e ...)) #'(racketblock0 e ...)]
+ [(_ v) #'(racketblock0 v)]))
+
(begin-for-syntax
(define-splicing-syntax-class kind-kw
#:description "#:kind keyword"
(pattern (~optional (~seq #:kind kind)
#:defaults ([kind #'#f]))))
+ (define-splicing-syntax-class value-kw
+ #:description "#:value keyword"
+ (pattern (~optional (~seq #:value value)
+ #:defaults ([value #'no-value]))))
+
(define-splicing-syntax-class link-target?-kw
#:description "#:link-target? keyword"
(pattern (~seq #:link-target? expr))
@@ -152,13 +165,30 @@
(define-syntax (defproc stx)
(syntax-parse stx
- [(_ kind:kind-kw lt:link-target?-kw i:id-kw (id arg ...) result desc ...)
+ [(_ kind:kind-kw
+ lt:link-target?-kw
+ i:id-kw
+ (id arg ...)
+ result
+ value:value-kw
+ desc ...)
(syntax/loc stx
- (defproc* #:kind kind.kind #:link-target? lt.expr #:id [i.key i.expr] [[(id arg ...) result]] desc ...))]))
+ (defproc*
+ #:kind kind.kind
+ #:link-target? lt.expr
+ #:id [i.key i.expr]
+ [[(id arg ...) result #:value value.value]]
+ desc ...))]))
(define-syntax (defproc* stx)
(syntax-parse stx
- [(_ kind:kind-kw lt:link-target?-kw d:id-kw mode:mode-kw within:within-kw [[proto result] ...] desc ...)
+ [(_ kind:kind-kw
+ lt:link-target?-kw
+ d:id-kw
+ mode:mode-kw
+ within:within-kw
+ [[proto result value:value-kw] ...]
+ desc ...)
(syntax/loc stx
(with-togetherable-racket-variables
()
@@ -173,14 +203,15 @@
(list (arg-contracts proto) ...)
(list (arg-defaults proto) ...)
(list (lambda () (result-contract result)) ...)
- (lambda () (list desc ...))))))]))
+ (lambda () (list desc ...))
+ (list (result-value value.value) ...)))))]))
(define-struct arg
(special? kw id optional? starts-optional? ends-optional? num-closers))
(define (*defproc kind link? mode within-id
- stx-ids sym prototypes arg-contractss arg-valss result-contracts
- content-thunk)
+ stx-ids sym prototypes arg-contractss arg-valss result-contracts content-thunk
+ [result-values (map (lambda (x) #f) result-contracts)])
(define max-proto-width (current-display-width))
(define ((arg->elem show-opt-start?) arg)
(let* ([e (cond [(not (arg-special? arg))
@@ -282,7 +313,7 @@
(syntax-e stx-id)
(car p)))
(loop (car p)))))
- (define (do-one stx-id prototype args arg-contracts arg-vals result-contract
+ (define (do-one stx-id prototype args arg-contracts arg-vals result-contract result-value
first? add-background-label?)
(let ([names (remq* '(... ...+) (map arg-id args))])
(unless (= (length names) (length (remove-duplicates names eq?)))
@@ -550,7 +581,17 @@
[else null]))
args
arg-contracts
- arg-vals)))
+ arg-vals)
+ (if result-value
+ (let ([result-block (if (block? result-value)
+ result-value
+ (make-omitable-paragraph (list result-value)))])
+ (list (list (list (make-table
+ "argcontract"
+ (list (list
+ (to-flow (make-element #f (list spacer "=" spacer)))
+ (make-flow (list result-block)))))))))
+ null)))
(define all-args (map prototype-args prototypes))
(define var-list
(filter-map (lambda (a) (and (not (arg-special? a)) (arg-id a)))
@@ -564,7 +605,7 @@
boxed-style
(append-map
do-one
- stx-ids prototypes all-args arg-contractss arg-valss result-contracts
+ stx-ids prototypes all-args arg-contractss arg-valss result-contracts result-values
(let loop ([ps prototypes] [stx-ids stx-ids] [accum null])
(cond [(null? ps) null]
[(ormap (lambda (a) (eq? (extract-id (car ps) (car stx-ids)) a)) accum)
@@ -579,21 +620,21 @@
(define-syntax (defparam stx)
(syntax-parse stx
- [(_ lt:link-target?-kw id arg contract desc ...)
+ [(_ lt:link-target?-kw id arg contract value:value-kw desc ...)
#'(defproc* #:kind "parameter" #:link-target? lt.expr
- ([(id) contract] [(id [arg contract]) void?])
+ ([(id) contract] [(id [arg contract]) void? #:value value.value])
desc ...)]))
(define-syntax (defparam* stx)
(syntax-parse stx
- [(_ lt:link-target?-kw id arg in-contract out-contract desc ...)
+ [(_ lt:link-target?-kw id arg in-contract out-contract value:value-kw desc ...)
#'(defproc* #:kind "parameter" #:link-target? lt.expr
- ([(id) out-contract] [(id [arg in-contract]) void?])
+ ([(id) out-contract] [(id [arg in-contract]) void? #:value value.value])
desc ...)]))
(define-syntax (defboolparam stx)
(syntax-parse stx
- [(_ lt:link-target?-kw id arg desc ...)
+ [(_ lt:link-target?-kw id arg value:value-kw desc ...)
#'(defproc* #:kind "parameter" #:link-target? lt.expr
- ([(id) boolean?] [(id [arg any/c]) void?])
+ ([(id) boolean?] [(id [arg any/c]) void? #:value value.value])
desc ...)]))
;; ----------------------------------------
@@ -962,6 +1003,7 @@
#:defaults ([id-expr #'#f]))
id
result
+ value:value-kw
desc ...)
#'(with-togetherable-racket-variables
()
@@ -970,11 +1012,12 @@
lt.expr
(list (or id-expr (quote-syntax/loc id))) (list 'id) #f
(list (racketblock0 result))
- (lambda () (list desc ...))))]))
+ (lambda () (list desc ...))
+ (list (result-value value.value))))]))
(define-syntax (defthing* stx)
(syntax-parse stx
- [(_ kind:kind-kw lt:link-target?-kw ([id result] ...) desc ...)
+ [(_ kind:kind-kw lt:link-target?-kw ([id result value:value-kw] ...) desc ...)
#'(with-togetherable-racket-variables
()
()
@@ -982,7 +1025,8 @@
lt.expr
(list (quote-syntax/loc id) ...) (list 'id ...) #f
(list (racketblock0 result) ...)
- (lambda () (list desc ...))))]))
+ (lambda () (list desc ...))
+ (list (result-value value.value) ...)))]))
(define (*defthing kind link? stx-ids names form? result-contracts content-thunk
[result-values (map (lambda (x) #f) result-contracts)])
@@ -993,90 +1037,91 @@
(list
(make-table
boxed-style
- (for/list ([stx-id (in-list stx-ids)]
- [name (in-list names)]
- [result-contract (in-list result-contracts)]
- [result-value (in-list result-values)]
- [i (in-naturals)])
- (list
- ((if (zero? i) (add-background-label (or kind "value")) values)
- (make-flow
- (make-table-if-necessary
- "argcontract"
- (let* ([result-block
- (and result-value
- (if (block? result-value)
- result-value
- (make-omitable-paragraph (list result-value))))]
- [contract-block
- (if (block? result-contract)
- result-contract
- (make-omitable-paragraph (list result-contract)))]
- [total-width (+ (string-length (format "~a" name))
- 3
- (block-width contract-block)
- (if result-block
- (+ (block-width result-block) 3)
- 0))])
- (append
- (list
- (append
- (list
- (make-flow
- (list
- (make-omitable-paragraph
- (list
- (let ([target-maker
- (and link?
- ((if form? id-to-form-target-maker id-to-target-maker)
- stx-id #t))])
- (define-values (content ref-content)
- (if link?
- (definition-site name stx-id form?)
- (let ([s (make-just-context name stx-id)])
- (values (to-element #:defn? #t s)
- (to-element s)))))
- (if target-maker
- (target-maker
- content
- (lambda (tag)
- (make-toc-target2-element
- #f
- (make-index-element
- #f
- content
- tag
- (list (datum-intern-literal (symbol->string name)))
- (list ref-content)
- (with-exporting-libraries
- (lambda (libs) (make-thing-index-desc name libs))))
- tag
- ref-content)))
- content))))))
- (make-flow
- (list
- (make-omitable-paragraph
- (list
- spacer ":" spacer))))
- (make-flow (list contract-block)))
- (if (and result-value
- (total-width . < . 60))
- (list
- (to-flow (make-element #f (list spacer "=" spacer)))
- (make-flow (list result-block)))
- null)))
- (if (and result-value
- (total-width . >= . 60))
- (list
+ (append*
+ (for/list ([stx-id (in-list stx-ids)]
+ [name (in-list names)]
+ [result-contract (in-list result-contracts)]
+ [result-value (in-list result-values)]
+ [i (in-naturals)])
+ (let* ([result-block
+ (and result-value
+ (if (block? result-value)
+ result-value
+ (make-omitable-paragraph (list result-value))))]
+ [contract-block
+ (if (block? result-contract)
+ result-contract
+ (make-omitable-paragraph (list result-contract)))]
+ [total-width (+ (string-length (format "~a" name))
+ 3
+ (block-width contract-block)
+ (if result-block
+ (+ (block-width result-block) 3)
+ 0))])
+ (append
+ (list
+ (list
+ ((if (zero? i) (add-background-label (or kind "value")) values)
+ (make-flow
+ (make-table-if-necessary
+ "argcontract"
+ (append
+ (list
+ (append
(list
- (make-table-if-necessary
- "argcontract"
+ (make-flow
+ (list
+ (make-omitable-paragraph
+ (list
+ (let ([target-maker
+ (and link?
+ ((if form? id-to-form-target-maker id-to-target-maker)
+ stx-id #t))])
+ (define-values (content ref-content)
+ (if link?
+ (definition-site name stx-id form?)
+ (let ([s (make-just-context name stx-id)])
+ (values (to-element #:defn? #t s)
+ (to-element s)))))
+ (if target-maker
+ (target-maker
+ content
+ (lambda (tag)
+ (make-toc-target2-element
+ #f
+ (make-index-element
+ #f
+ content
+ tag
+ (list (datum-intern-literal (symbol->string name)))
+ (list ref-content)
+ (with-exporting-libraries
+ (lambda (libs) (make-thing-index-desc name libs))))
+ tag
+ ref-content)))
+ content))))))
+ (make-flow
(list
- (list flow-spacer
- (to-flow (make-element #f (list spacer "=" spacer)))
- (make-flow (list result-block)))))
- 'cont))
- null)))))))))))
+ (make-omitable-paragraph
+ (list
+ spacer ":" spacer))))
+ (make-flow (list contract-block)))
+ (if (and result-value
+ (and (total-width . < . 60)
+ (not (table? result-value))))
+ (list
+ (to-flow (make-element #f (list spacer "=" spacer)))
+ (make-flow (list result-block)))
+ null)))))))))
+ (if (and result-value
+ (or (total-width . >= . 60)
+ (table? result-value)))
+ (list (list (list (make-table
+ "argcontract"
+ (list (list
+ (to-flow (make-element #f (list spacer "=" spacer)))
+ (make-flow (list result-block))))))))
+ null))))))))
(content-thunk))))
(define (defthing/proc kind id contract descs)
diff --git a/pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/manual-ex.rkt b/pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/manual-ex.rkt
@@ -18,3 +18,5 @@
(define-struct pt (x y))
(struct pn (x y))
+
+(define v 10)
diff --git a/pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/manual.scrbl b/pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/manual.scrbl
@@ -14,6 +14,14 @@
@defproc[#:link-target? #f (f) integer?]{A function, again, not a link target.}
+@defproc[#:link-target? #f (f) integer? #:value 10]{A function, again, not a link target, documented to return @racket[10].}
+
+@defproc[#:link-target? #f (f) integer? #:value (let ()
+ (define x 10)
+ x)]{
+A function, again, not a link target, documented to return @racket[10] using a definition.
+}
+
@defproc[#:kind "function" #:link-target? #f (g [x void?]) integer?]{A ``function,'' again, not a link target.}
@defproc[#:id [i #'j] (i) void?]{Source is @racket[i], documents @racket[j].}
@@ -42,12 +50,27 @@
@defparam[#:link-target? #f p k integer?]{A parameter, again.}
+@defparam[#:link-target? #f p k integer? #:value 10]{A parameter, again, with a documented default value.}
+
@defparam*[#:link-target? #f p k real? integer?]{A parameter, yet again.}
+@defparam*[#:link-target? #f p k real? integer? #:value 10]{A parameter, yet again, with a documented default value.}
+
@defboolparam[q on?]{A boolean parameter.}
@defboolparam[#:link-target? #f q still-on?]{A boolean parameter, again.}
+@defboolparam[#:link-target? #f q still-on? #:value #f]{A boolean parameter, again, with a documented default value.}
+
+
+@defthing[v integer?]{A thing.}
+
+@defthing[#:link-target? #f v integer?]{A thing, again.}
+
+@defthing[#:link-target? #f v integer? #:value 10]{A thing, again, with a documented value.}
+
+@defthing[#:link-target? #f v integer? #:value 12345678901234567890123456789012345678901234567890]{A thing, again, with a documented value that's too wide to fit on one line.}
+
@defstruct[pt ([x real?] [y real?])]{A structure type with extra name.}
diff --git a/pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/manual.txt b/pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/manual.txt
@@ -26,6 +26,18 @@ A function with an optional keyword argument.
A function, again, not a link target.
+(f) -> integer?
+ = 10
+
+A function, again, not a link target, documented to return 10.
+
+(f) -> integer?
+ = (define x 10)
+ x
+
+A function, again, not a link target, documented to return 10 using a
+definition.
+
(g x) -> integer?
x : void?
@@ -88,10 +100,24 @@ A parameter, again.
(p) -> integer?
(p k) -> void?
+ k : integer?
+ = 10
+
+A parameter, again, with a documented default value.
+
+(p) -> integer?
+(p k) -> void?
k : real?
A parameter, yet again.
+(p) -> integer?
+(p k) -> void?
+ k : real?
+ = 10
+
+A parameter, yet again, with a documented default value.
+
(q) -> boolean?
(q on?) -> void?
on? : any/c
@@ -104,6 +130,31 @@ A boolean parameter.
A boolean parameter, again.
+(q) -> boolean?
+(q still-on?) -> void?
+ still-on? : any/c
+ = #f
+
+A boolean parameter, again, with a documented default value.
+
+v : integer?
+
+A thing.
+
+v : integer?
+
+A thing, again.
+
+v : integer? = 10
+
+A thing, again, with a documented value.
+
+v : integer?
+ = 12345678901234567890123456789012345678901234567890
+
+A thing, again, with a documented value that’s too wide to fit on one
+line.
+
(struct pt (x y)
#:extra-constructor-name make-pt)
x : real?
