diff --git a/scribble-doc/scribblings/scribble/manual.scrbl b/scribble-doc/scribblings/scribble/manual.scrbl index ed9d0a2ecc..90d8ed58ea 100644 --- a/scribble-doc/scribblings/scribble/manual.scrbl +++ b/scribble-doc/scribblings/scribble/manual.scrbl @@ -2,6 +2,7 @@ @(require scribble/manual "utils.rkt" (for-syntax racket/base) (for-label scribble/manual-struct + racket/list version/utils syntax/quote)) @@ -1308,7 +1309,7 @@ Examples: @defform[(defparam maybe-link id arg-id contract-expr-datum - maybe-value + maybe-auto-value pre-flow ...)]{ Like @racket[defproc], but for a parameter. The @@ -1324,19 +1325,30 @@ Examples: A parameter that defines the current sandwich for operations that involve eating a sandwich. Default value is the empty sandwich. } + +@(require (for-label racket/base)) + +@defparam[current-readtable v any/c #:auto-value]{ + A parameter to hold a readtable. +} }| @doc-render-examples[ @defparam[#:link-target? #f current-sandwich sandwich sandwich? #:value empty-sandwich]{ A parameter that defines the current sandwich for operations that involve eating a sandwich. Default value is the empty sandwich. - }] + } + @defparam[#:link-target? #f + current-readtable v any/c #:auto-value]{ + A parameter to hold a readtable. + } +] } @defform[(defparam* maybe-link id arg-id in-contract-expr-datum out-contract-expr-datum - maybe-value + maybe-auto-value pre-flow ...)]{ Like @racket[defparam], but with separate contracts for when the parameter is being @@ -1346,7 +1358,7 @@ coerces values matching a more flexible contract to a more restrictive one; @defform[(defboolparam maybe-link id arg-id - maybe-value + maybe-auto-value pre-flow ...)]{ Like @racket[defparam], but the contract on a parameter argument is @@ -1354,7 +1366,7 @@ Like @racket[defparam], but the contract on a parameter argument is @racket[boolean?].} -@defform/subs[(defthing options id contract-expr-datum maybe-value +@defform/subs[(defthing options id contract-expr-datum maybe-auto-value pre-flow ...) ([options (code:line maybe-kind maybe-link maybe-id)] [maybe-kind code:blank @@ -1363,8 +1375,9 @@ Like @racket[defparam], but the contract on a parameter argument is (code:line #:link-target? link-target?-expr)] [maybe-id code:blank (code:line #:id id-expr)] - [maybe-value code:blank - (code:line #:value value-expr-datum)])]{ + [maybe-auto-value code:blank + (code:line #:value value-expr-datum) + #:auto-value])]{ Like @racket[defproc], but for a non-procedure binding. @@ -1379,6 +1392,11 @@ 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. +@racket[#:auto-value] is similar to @racket[#:value value-expr-datum], +but the value is automatically queried from the for-label binding. +@racket[#:auto-value] can only be used when the value is marshalable +(e.g., if the value is a struct, it must be a prefab struct of marshalable values). + Examples: @codeblock[#:keep-lang-line? #f]|{ #lang scribble/manual @@ -1389,6 +1407,12 @@ Examples: @defthing[empty-sandwich sandwich? #:value (make-sandwich empty)]{ The empty sandwich. } + +@(require (for-label racket/list)) + +@defthing[empty any/c #:auto-value]{ + The empty list. +} }| @doc-render-examples[ @defthing[#:link-target? #f @@ -1398,10 +1422,15 @@ Examples: @defthing[#:link-target? #f empty-sandwich sandwich? #:value (make-sandwich empty)]{ The empty sandwich. - }] + } + @defthing[#:link-target? #f + empty any/c #:auto-value]{ + The empty list. + } +] } -@defform[(defthing* options ([id contract-expr-datum maybe-value] ...+) +@defform[(defthing* options ([id contract-expr-datum maybe-auto-value] ...+) pre-flow ...)]{ Like @racket[defthing], but for multiple non-procedure bindings. diff --git a/scribble-lib/scribble/private/manual-proc.rkt b/scribble-lib/scribble/private/manual-proc.rkt index 77caecd104..41259177fc 100644 --- a/scribble-lib/scribble/private/manual-proc.rkt +++ b/scribble-lib/scribble/private/manual-proc.rkt @@ -21,7 +21,8 @@ racket/list racket/contract (for-syntax racket/base - syntax/parse) + syntax/parse + "marshal.rkt") (for-label racket/base racket/contract racket/class)) @@ -140,6 +141,28 @@ #:description "#:value keyword" (pattern (~optional (~seq #:value value) #:defaults ([value #'no-value])))) + + (define-splicing-syntax-class (autoable-value-kw name proc) + #:description "#:value or #:auto-value keyword" + (pattern (~seq #:value extracted)) + (pattern (~seq #:auto-value) + #:do [(define binding-info (identifier-binding name #f)) + (unless (list? binding-info) + (raise-syntax-error #f "not imported for-label" name)) + ;; the first result is from-mod, which is what we want + (define mod (car binding-info)) + (define val (proc (dynamic-require mod (syntax-e name)))) + (define not-marshalable (check-marshalable val)) + (when not-marshalable + (raise-syntax-error #f "not a marshalable value" name #f '() + (format "\n found: ~s" not-marshalable)))] + ;; avoid quote if the value is self-quoting + #:with extracted (syntax-parse val + [(xs ...) #''(xs ...)] + [x:id #''x] + [x:keyword #''x] + [_ this-syntax])) + (pattern (~seq) #:with extracted #'no-value)) (define-splicing-syntax-class link-target?-kw #:description "#:link-target? keyword" @@ -660,23 +683,32 @@ (= i 0)))))) (content-thunk)))) +(begin-for-syntax + (define ((extract-parameter who id) p) + (unless (parameter? p) + (raise-syntax-error who "not a parameter" id #f '() (format "\n got: ~s" p))) + (p))) + (define-syntax (defparam stx) (syntax-parse stx - [(_ lt:link-target?-kw id arg contract value:value-kw desc:expr ...) + [(_ lt:link-target?-kw id arg contract + {~var value (autoable-value-kw #'id (extract-parameter 'defparam #'id))} desc:expr ...) #'(defproc* #:kind "parameter" #:link-target? lt.expr - ([(id) contract] [(id [arg contract]) void? #:value value.value]) + ([(id) contract] [(id [arg contract]) void? #:value value.extracted]) desc ...)])) (define-syntax (defparam* stx) (syntax-parse stx - [(_ lt:link-target?-kw id arg in-contract out-contract value:value-kw desc:expr ...) + [(_ lt:link-target?-kw id arg in-contract out-contract + {~var value (autoable-value-kw #'id (extract-parameter 'defparam* #'id))} desc:expr ...) #'(defproc* #:kind "parameter" #:link-target? lt.expr - ([(id) out-contract] [(id [arg in-contract]) void? #:value value.value]) + ([(id) out-contract] [(id [arg in-contract]) void? #:value value.extracted]) desc ...)])) (define-syntax (defboolparam stx) (syntax-parse stx - [(_ lt:link-target?-kw id arg value:value-kw desc:expr ...) + [(_ lt:link-target?-kw id arg + {~var value (autoable-value-kw #'id (extract-parameter 'defboolparam #'id))} desc:expr ...) #'(defproc* #:kind "parameter" #:link-target? lt.expr - ([(id) boolean?] [(id [arg any/c]) void? #:value value.value]) + ([(id) boolean?] [(id [arg any/c]) void? #:value value.extracted]) desc ...)])) (define top-align-styles (make-hash)) @@ -1067,7 +1099,7 @@ #:defaults ([id-expr #'#f])) id result - value:value-kw + {~var value (autoable-value-kw #'id values)} desc:expr ...) #'(with-togetherable-racket-variables () @@ -1078,20 +1110,24 @@ (list (or id-val (quote-syntax/loc id))) (list (if (identifier? id-val) (syntax-e id-val) 'id)) #f (list (racketblock0 result)) (lambda () (list desc ...)) - (list (result-value value.value)))))])) + (list (result-value value.extracted)))))])) (define-syntax (defthing* stx) + (define-syntax-class clause + (pattern [id result {~var value (autoable-value-kw #'id values)}] + #:with extracted #'value.extracted)) + (syntax-parse stx - [(_ kind:kind-kw lt:link-target?-kw ([id result value:value-kw] ...+) desc:expr ...) + [(_ kind:kind-kw lt:link-target?-kw (c:clause ...+) desc:expr ...) #'(with-togetherable-racket-variables () () (*defthing kind.kind lt.expr - (list (quote-syntax/loc id) ...) (list 'id ...) #f - (list (racketblock0 result) ...) + (list (quote-syntax/loc c.id) ...) (list 'c.id ...) #f + (list (racketblock0 c.result) ...) (lambda () (list desc ...)) - (list (result-value value.value) ...)))])) + (list (result-value c.extracted) ...)))])) (define (*defthing kind link? stx-ids names form? result-contracts content-thunk [result-values (map (lambda (x) #f) result-contracts)]) diff --git a/scribble-lib/scribble/private/marshal.rkt b/scribble-lib/scribble/private/marshal.rkt new file mode 100644 index 0000000000..8e21273e68 --- /dev/null +++ b/scribble-lib/scribble/private/marshal.rkt @@ -0,0 +1,25 @@ +#lang racket/base + +(provide check-marshalable) + +(require racket/fixnum + racket/flonum + racket/extflonum) + +;; check-marshalable : any/c -> (or/c #f any/c) +(define (check-marshalable v) + (let loop ([v v]) + (cond + [(or (null? v) (symbol? v) (number? v) (char? v) (keyword? v) + (string? v) (bytes? v) + (regexp? v) (byte-regexp? v) + (fxvector? v) (flvector? v) (extflonum? v)) + #f] + [(pair? v) (or (loop (car v)) (loop (cdr v)))] + [(box? v) (loop (unbox v))] + [(vector? v) (for/or ([x (in-vector v)]) + (loop x))] + [(hash? v) (for/or ([(key val) (in-hash v)]) + (or (loop key) (loop val)))] + [(prefab-struct-key v) (loop (struct->vector v))] + [else v]))) diff --git a/scribble-test/tests/scribble/docs/manual-ex.rkt b/scribble-test/tests/scribble/docs/manual-ex.rkt index 2f3a0b28ff..fb199ab756 100644 --- a/scribble-test/tests/scribble/docs/manual-ex.rkt +++ b/scribble-test/tests/scribble/docs/manual-ex.rkt @@ -20,3 +20,14 @@ (struct pn (x y)) (define v 10) + +(require racket/fixnum + racket/flonum) + +(define val:flvector (flvector 1.0 2.0)) +(define val:fxvector (fxvector 1 2)) +(define val:extflonum 1.0t0) +(define val:kw '#:foo) +(define val:list '(1 2 3 4)) +(define val:vector #(1 2 3 4)) +(define val:param (make-parameter 'foo)) diff --git a/scribble-test/tests/scribble/docs/manual.scrbl b/scribble-test/tests/scribble/docs/manual.scrbl index ad80bb3d52..d7cce8ffec 100644 --- a/scribble-test/tests/scribble/docs/manual.scrbl +++ b/scribble-test/tests/scribble/docs/manual.scrbl @@ -52,6 +52,9 @@ A function, again, not a link target, documented to return @racket[10] using a d @defparam[#:link-target? #f p k integer? #:value 10]{A parameter, again, with a documented default value.} +@defparam[#:link-target? #f val:param k any/c #:auto-value]{A parameter with auto-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.} @@ -71,6 +74,12 @@ A function, again, not a link target, documented to return @racket[10] using a d @defthing[#:link-target? #f v integer? #:value 12345678901234567890123456789012345678901234567890]{A thing, again, with a documented value that's too wide to fit on one line.} +@defthing[#:link-target? #f val:flvector any/c #:auto-value]{Test auto-value flvector reading.} +@defthing[#:link-target? #f val:fxvector any/c #:auto-value]{Test auto-value fxvector reading.} +@defthing[#:link-target? #f val:extflonum any/c #:auto-value]{Test auto-value extflonum reading.} +@defthing[#:link-target? #f val:kw any/c #:auto-value]{Test auto-value keyword reading.} +@defthing[#:link-target? #f val:list any/c #:auto-value]{Test auto-value list reading.} +@defthing[#:link-target? #f val:vector any/c #:auto-value]{Test auto-value vector reading.} @defstruct[pt ([x real?] [y real?])]{A structure type with extra name.} diff --git a/scribble-test/tests/scribble/docs/manual.txt b/scribble-test/tests/scribble/docs/manual.txt index a9bb275ee1..4e39fee2d9 100644 --- a/scribble-test/tests/scribble/docs/manual.txt +++ b/scribble-test/tests/scribble/docs/manual.txt @@ -105,6 +105,13 @@ A parameter, again. A parameter, again, with a documented default value. +(val:param) -> any/c +(val:param k) -> void? +  k : any/c + = 'foo + +A parameter with auto-value. + (p) -> integer? (p k) -> void?   k : real? @@ -155,6 +162,30 @@ v : integer? A thing, again, with a documented value that’s too wide to fit on one line. +val:flvector : any/c = #fl(1.0 2.0) + +Test auto-value flvector reading. + +val:fxvector : any/c = #fx(1 2) + +Test auto-value fxvector reading. + +val:extflonum : any/c = 1.0t0 + +Test auto-value extflonum reading. + +val:kw : any/c = '#:foo + +Test auto-value keyword reading. + +val:list : any/c = '(1 2 3 4) + +Test auto-value list reading. + +val:vector : any/c = #(1 2 3 4) + +Test auto-value vector reading. + (struct pt (x y)     #:extra-constructor-name make-pt)   x : real?