change 'define-struct' to bind the type name as a constructor, add an #:extra-constructor-name option, etc.
original commit: 616080c7c4bc10f3f758a198c6e94c394e051038
This commit is contained in:
Matthew Flatt
parent
4a93eb50b6
commit
37fe4645d5
|
|
@ -23,8 +23,9 @@
|
|||
"private/manual-bib.ss"
|
||||
"private/manual-form.ss"
|
||||
"private/manual-class.ss"
|
||||
"private/manual-unit.ss"
|
||||
"private/manual-vars.ss")
|
||||
"private/manual-unit.ss")
|
||||
(except-out (all-from-out "private/manual-vars.ss")
|
||||
*deftogether)
|
||||
(except-out (all-from-out "private/manual-proc.ss")
|
||||
*defthing))
|
||||
|
||||
|
|
|
|||
|
|
@ -25,7 +25,9 @@
|
|||
specsubform specsubform/subs specspecsubform specspecsubform/subs
|
||||
specsubform/inline
|
||||
defsubform defsubform*
|
||||
schemegrammar schemegrammar*
|
||||
racketgrammar racketgrammar*
|
||||
(rename-out [racketgrammar schemegrammar]
|
||||
[racketgrammar* schemegrammar*])
|
||||
var svar)
|
||||
|
||||
(define-syntax (defform*/subs stx)
|
||||
|
|
@ -269,32 +271,32 @@
|
|||
([form/maybe (#f spec)])
|
||||
(*specsubform 'spec null #f null null null (lambda () (list desc ...)))))
|
||||
|
||||
(define-syntax schemegrammar
|
||||
(define-syntax racketgrammar
|
||||
(syntax-rules ()
|
||||
[(_ #:literals (lit ...) id clause ...)
|
||||
(with-scheme-variables
|
||||
(lit ...)
|
||||
([non-term (id clause ...)])
|
||||
(*schemegrammar '(lit ...)
|
||||
(*racketgrammar '(lit ...)
|
||||
'(id clause ...)
|
||||
(lambda ()
|
||||
(list (list (scheme id)
|
||||
(schemeblock0/form clause) ...)))))]
|
||||
[(_ id clause ...) (schemegrammar #:literals () id clause ...)]))
|
||||
[(_ id clause ...) (racketgrammar #:literals () id clause ...)]))
|
||||
|
||||
(define-syntax schemegrammar*
|
||||
(define-syntax racketgrammar*
|
||||
(syntax-rules ()
|
||||
[(_ #:literals (lit ...) [id clause ...] ...)
|
||||
(with-scheme-variables
|
||||
(lit ...)
|
||||
([non-term (id clause ...)] ...)
|
||||
(*schemegrammar '(lit ...)
|
||||
(*racketgrammar '(lit ...)
|
||||
'(id ... clause ... ...)
|
||||
(lambda ()
|
||||
(list (list (scheme id) (schemeblock0/form clause) ...)
|
||||
...))))]
|
||||
[(_ [id clause ...] ...)
|
||||
(schemegrammar* #:literals () [id clause ...] ...)]))
|
||||
(racketgrammar* #:literals () [id clause ...] ...)]))
|
||||
|
||||
(define-syntax-rule (var id)
|
||||
(*var 'id))
|
||||
|
|
@ -409,7 +411,7 @@
|
|||
(define (*schemerawgrammar style nonterm clause1 . clauses)
|
||||
(*schemerawgrammars style (list nonterm) (list (cons clause1 clauses))))
|
||||
|
||||
(define (*schemegrammar lits s-expr clauseses-thunk)
|
||||
(define (*racketgrammar lits s-expr clauseses-thunk)
|
||||
(let ([l (clauseses-thunk)])
|
||||
(*schemerawgrammars #f
|
||||
(map (lambda (x)
|
||||
|
|
|
|||
|
|
@ -20,7 +20,7 @@
|
|||
(for-label racket/base
|
||||
racket/class))
|
||||
|
||||
(provide defproc defproc* defstruct
|
||||
(provide defproc defproc* defstruct defstruct*
|
||||
defparam defparam* defboolparam
|
||||
defthing defthing*
|
||||
defthing/proc ; XXX unknown contract
|
||||
|
|
@ -485,42 +485,90 @@
|
|||
|
||||
;; ----------------------------------------
|
||||
|
||||
(define-syntax defstruct
|
||||
(syntax-rules ()
|
||||
[(_ name fields #:mutable #:inspector #f desc ...)
|
||||
(**defstruct name fields #f #t #f desc ...)]
|
||||
[(_ name fields #:mutable #:transparent desc ...)
|
||||
(**defstruct name fields #f #t #f desc ...)]
|
||||
[(_ name fields #:mutable #:prefab desc ...)
|
||||
(**defstruct name fields #f #t #t desc ...)]
|
||||
[(_ name fields #:mutable desc ...)
|
||||
(**defstruct name fields #f #f #f desc ...)]
|
||||
[(_ name fields #:inspector #f desc ...)
|
||||
(**defstruct name fields #t #t #f desc ...)]
|
||||
[(_ name fields #:transparent desc ...)
|
||||
(**defstruct name fields #t #t #f desc ...)]
|
||||
[(_ name fields #:prefab desc ...)
|
||||
(**defstruct name fields #t #t #t desc ...)]
|
||||
[(_ name fields desc ...)
|
||||
(**defstruct name fields #t #f #f desc ...)]))
|
||||
(define-syntax-rule (define-defstruct defstruct default-cname)
|
||||
(...
|
||||
(define-syntax defstruct
|
||||
(syntax-rules ()
|
||||
[(_ name fields #:constructor-name cname #:mutable #:inspector #f desc ...)
|
||||
(**defstruct name fields #f #t #f cname #f desc ...)]
|
||||
[(_ name fields #:extra-constructor-name cname #:mutable #:inspector #f desc ...)
|
||||
(**defstruct name fields #f #t #f cname #t desc ...)]
|
||||
[(_ name fields #:mutable #:inspector #f desc ...)
|
||||
(**defstruct name fields #f #t #f default-cname #t desc ...)]
|
||||
[(_ name fields #:constructor-name cname #:mutable #:transparent desc ...)
|
||||
(**defstruct name fields #f #t #f cname #f desc ...)]
|
||||
[(_ name fields #:extra-constructor-name cname #:mutable #:transparent desc ...)
|
||||
(**defstruct name fields #f #t #f cname #t desc ...)]
|
||||
[(_ name fields #:mutable #:transparent desc ...)
|
||||
(**defstruct name fields #f #t #f default-cname #t desc ...)]
|
||||
[(_ name fields #:constructor-name cname #:mutable #:prefab desc ...)
|
||||
(**defstruct name fields #f #t #t cname #f desc ...)]
|
||||
[(_ name fields #:extra-constructor-name cname #:mutable #:prefab desc ...)
|
||||
(**defstruct name fields #f #t #t cname #t desc ...)]
|
||||
[(_ name fields #:mutable #:prefab desc ...)
|
||||
(**defstruct name fields #f #t #t default-cname #t desc ...)]
|
||||
[(_ name fields #:constructor-name cname #:mutable desc ...)
|
||||
(**defstruct name fields #f #f #f cname #f desc ...)]
|
||||
[(_ name fields #:extra-constructor-name cname #:mutable desc ...)
|
||||
(**defstruct name fields #f #f #f cname #t desc ...)]
|
||||
[(_ name fields #:mutable desc ...)
|
||||
(**defstruct name fields #f #f #f default-cname #f desc ...)]
|
||||
[(_ name fields #:constructor-name cname #:inspector #f desc ...)
|
||||
(**defstruct name fields #t #t #f cname #f desc ...)]
|
||||
[(_ name fields #:extra-constructor-name cname #:inspector #f desc ...)
|
||||
(**defstruct name fields #t #t #f cname #t desc ...)]
|
||||
[(_ name fields #:inspector #f desc ...)
|
||||
(**defstruct name fields #t #t #f default-cname #t desc ...)]
|
||||
[(_ name fields #:constructor-name cname #:transparent desc ...)
|
||||
(**defstruct name fields #t #t #f cname #f desc ...)]
|
||||
[(_ name fields #:extra-constructor-name cname #:transparent desc ...)
|
||||
(**defstruct name fields #t #t #f cname #t desc ...)]
|
||||
[(_ name fields #:transparent desc ...)
|
||||
(**defstruct name fields #t #t #f default-cname #t desc ...)]
|
||||
[(_ name fields #:constructor-name cname #:prefab desc ...)
|
||||
(**defstruct name fields #t #t #t cname #f desc ...)]
|
||||
[(_ name fields #:extra-constructor-name cname #:prefab desc ...)
|
||||
(**defstruct name fields #t #t #t cname #t desc ...)]
|
||||
[(_ name fields #:prefab desc ...)
|
||||
(**defstruct name fields #t #t #t default-cname #t desc ...)]
|
||||
[(_ name fields #:constructor-name cname desc ...)
|
||||
(**defstruct name fields #t #f #f cname #f desc ...)]
|
||||
[(_ name fields #:extra-constructor-name cname desc ...)
|
||||
(**defstruct name fields #t #f #f cname #t desc ...)]
|
||||
[(_ name fields desc ...)
|
||||
(**defstruct name fields #t #f #f default-cname #t desc ...)]))))
|
||||
|
||||
(define-defstruct defstruct #t)
|
||||
(define-defstruct defstruct* #f)
|
||||
|
||||
(define-syntax-rule (**defstruct name ([field field-contract] ...) immutable?
|
||||
transparent? prefab? desc ...)
|
||||
transparent? prefab? cname extra-cname? desc ...)
|
||||
(with-togetherable-scheme-variables
|
||||
()
|
||||
()
|
||||
(*defstruct (quote-syntax/loc name) 'name
|
||||
(*defstruct (quote-syntax/loc name) 'name (quote-syntax/loc cname) extra-cname?
|
||||
'([field field-contract] ...)
|
||||
(list (lambda () (schemeblock0 field-contract)) ...)
|
||||
immutable? transparent? prefab? (lambda () (list desc ...)))))
|
||||
|
||||
(define (*defstruct stx-id name fields field-contracts immutable? transparent? prefab?
|
||||
(define (*defstruct stx-id name alt-cname-id extra-cname?
|
||||
fields field-contracts immutable? transparent? prefab?
|
||||
content-thunk)
|
||||
(define (field-name f) ((if (pair? (car f)) caar car) f))
|
||||
(define (field-view f)
|
||||
(if (pair? (car f)) (make-shaped-parens (car f) #\[) (car f)))
|
||||
(make-box-splice
|
||||
(cons
|
||||
(define cname-id
|
||||
(cond
|
||||
[(identifier? alt-cname-id) alt-cname-id]
|
||||
[(not (syntax-e alt-cname-id)) #f]
|
||||
[else (let ([name-id (if (identifier? stx-id)
|
||||
stx-id
|
||||
(car (syntax-e stx-id)))])
|
||||
(datum->syntax name-id
|
||||
(string->symbol (format "make-~a" (syntax-e name-id)))
|
||||
name-id
|
||||
name-id))]))
|
||||
(define main-table
|
||||
(make-table
|
||||
'boxed
|
||||
(cons
|
||||
|
|
@ -543,8 +591,10 @@
|
|||
(list* (list 'info name)
|
||||
(list 'type 'struct: name)
|
||||
(list 'predicate name '?)
|
||||
(list 'constructor 'make- name)
|
||||
(append
|
||||
(if cname-id
|
||||
(list (list 'constructor (syntax-e cname-id)))
|
||||
null)
|
||||
(map (lambda (f)
|
||||
(list 'accessor name '-
|
||||
(field-name f)))
|
||||
|
|
@ -584,96 +634,111 @@
|
|||
fields)))])
|
||||
(if (and (short-width . < . max-proto-width)
|
||||
immutable?
|
||||
(not transparent?))
|
||||
(not transparent?)
|
||||
(not cname-id))
|
||||
(make-omitable-paragraph
|
||||
(list
|
||||
(to-element
|
||||
`(,(scheme struct)
|
||||
,the-name
|
||||
,(map field-view fields)))))
|
||||
(make-table
|
||||
#f
|
||||
(append
|
||||
(list
|
||||
(list (to-flow (make-element #f
|
||||
(list
|
||||
(schemeparenfont "(")
|
||||
(scheme struct))))
|
||||
flow-spacer
|
||||
(to-flow the-name)
|
||||
(if (or (null? fields)
|
||||
(short-width . < . max-proto-width))
|
||||
flow-spacer
|
||||
(to-flow (make-element
|
||||
#f (list spacer (schemeparenfont "(")))))
|
||||
(to-flow (if (or (null? fields)
|
||||
(short-width . < . max-proto-width))
|
||||
(make-element
|
||||
#f (cons (to-element (map field-view
|
||||
fields))
|
||||
(if (and immutable?
|
||||
(not transparent?))
|
||||
(list (schemeparenfont ")"))
|
||||
null)))
|
||||
(to-element (field-view (car fields)))))))
|
||||
(if (short-width . < . max-proto-width)
|
||||
null
|
||||
(let loop ([fields (if (null? fields)
|
||||
fields (cdr fields))])
|
||||
(if (null? fields)
|
||||
(let* ([one-right-column?
|
||||
(or (null? fields)
|
||||
(short-width . < . max-proto-width))]
|
||||
[a-right-column
|
||||
(lambda (c)
|
||||
(if one-right-column?
|
||||
(list flow-spacer flow-spacer c)
|
||||
(list flow-spacer flow-spacer c 'cont 'cont)))])
|
||||
(make-table
|
||||
#f
|
||||
(append
|
||||
(list
|
||||
(append
|
||||
(list (to-flow (make-element #f
|
||||
(list
|
||||
(schemeparenfont "(")
|
||||
(scheme struct))))
|
||||
flow-spacer)
|
||||
(if one-right-column?
|
||||
(list (to-flow (make-element
|
||||
#f
|
||||
(list* the-name
|
||||
spacer
|
||||
(to-element (map field-view
|
||||
fields))
|
||||
(if (and immutable?
|
||||
(not transparent?)
|
||||
(not cname-id))
|
||||
(list (schemeparenfont ")"))
|
||||
null)))))
|
||||
(list (to-flow the-name)
|
||||
(to-flow (make-element
|
||||
#f (list spacer (schemeparenfont "("))))
|
||||
(to-flow (to-element (field-view (car fields))))))))
|
||||
(if (short-width . < . max-proto-width)
|
||||
null
|
||||
(cons
|
||||
(let ([fld (car fields)])
|
||||
(list flow-spacer flow-spacer
|
||||
flow-spacer flow-spacer
|
||||
(to-flow
|
||||
(let ([e (to-element (field-view fld))])
|
||||
(if (null? (cdr fields))
|
||||
(make-element
|
||||
#f
|
||||
(list e (schemeparenfont
|
||||
(if (and immutable?
|
||||
(not transparent?))
|
||||
"))" ")"))))
|
||||
e)))))
|
||||
(loop (cdr fields))))))
|
||||
(cond
|
||||
[(and (not immutable?) transparent?)
|
||||
(list
|
||||
(list flow-spacer flow-spacer
|
||||
(to-flow (to-element '#:mutable))
|
||||
'cont
|
||||
'cont)
|
||||
(list flow-spacer flow-spacer
|
||||
(to-flow (make-element
|
||||
#f
|
||||
(list (if prefab?
|
||||
(to-element '#:prefab)
|
||||
(to-element '#:transparent))
|
||||
(schemeparenfont ")"))))
|
||||
'cont
|
||||
'cont))]
|
||||
[(not immutable?)
|
||||
(list
|
||||
(list flow-spacer flow-spacer
|
||||
(to-flow (make-element
|
||||
#f
|
||||
(list (to-element '#:mutable)
|
||||
(schemeparenfont ")"))))
|
||||
'cont
|
||||
'cont))]
|
||||
[transparent?
|
||||
(list
|
||||
(list flow-spacer flow-spacer
|
||||
(to-flow (make-element
|
||||
#f
|
||||
(list (if prefab?
|
||||
(to-element '#:prefab)
|
||||
(to-element '#:transparent))
|
||||
(schemeparenfont ")"))))
|
||||
'cont
|
||||
'cont))]
|
||||
[else null]))))))))
|
||||
(let loop ([fields (if (null? fields)
|
||||
fields (cdr fields))])
|
||||
(if (null? fields)
|
||||
null
|
||||
(cons
|
||||
(let ([fld (car fields)])
|
||||
(list flow-spacer flow-spacer
|
||||
flow-spacer flow-spacer
|
||||
(to-flow
|
||||
(let ([e (to-element (field-view fld))])
|
||||
(if (null? (cdr fields))
|
||||
(make-element
|
||||
#f
|
||||
(list e (schemeparenfont
|
||||
(if (and immutable?
|
||||
(not transparent?)
|
||||
(not cname-id))
|
||||
"))"
|
||||
")"))))
|
||||
e)))))
|
||||
(loop (cdr fields))))))
|
||||
(if cname-id
|
||||
(list (a-right-column
|
||||
(to-flow (make-element
|
||||
#f
|
||||
(append
|
||||
(list (to-element (if extra-cname?
|
||||
'#:extra-constructor-name
|
||||
'#:constructor-name))
|
||||
(hspace 1)
|
||||
(to-element cname-id))
|
||||
(if (and immutable?
|
||||
(not transparent?))
|
||||
(list (schemeparenfont ")"))
|
||||
null))))))
|
||||
null)
|
||||
(cond
|
||||
[(and (not immutable?) transparent?)
|
||||
(list
|
||||
(a-right-column (to-flow (to-element '#:mutable)))
|
||||
(a-right-column (to-flow (make-element
|
||||
#f
|
||||
(list (if prefab?
|
||||
(to-element '#:prefab)
|
||||
(to-element '#:transparent))
|
||||
(schemeparenfont ")"))))))]
|
||||
[(not immutable?)
|
||||
(list
|
||||
(a-right-column (to-flow (make-element
|
||||
#f
|
||||
(list (to-element '#:mutable)
|
||||
(schemeparenfont ")"))))))]
|
||||
[transparent?
|
||||
(list
|
||||
(a-right-column (to-flow (make-element
|
||||
#f
|
||||
(list (if prefab?
|
||||
(to-element '#:prefab)
|
||||
(to-element '#:transparent))
|
||||
(schemeparenfont ")"))))))]
|
||||
[else null])))))))))
|
||||
(map (lambda (v field-contract)
|
||||
(cond
|
||||
[(pair? v)
|
||||
|
|
@ -688,7 +753,10 @@
|
|||
flow-spacer
|
||||
(make-flow (list (field-contract))))))))]
|
||||
[else null]))
|
||||
fields field-contracts)))
|
||||
fields field-contracts))))
|
||||
(make-box-splice
|
||||
(cons
|
||||
main-table
|
||||
(content-thunk))))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
|
@ -709,49 +777,87 @@
|
|||
(list (schemeblock0 result) ...)
|
||||
(lambda () (list desc ...)))))
|
||||
|
||||
(define (*defthing stx-ids names form? result-contracts content-thunk)
|
||||
(define (*defthing stx-ids names form? result-contracts content-thunk
|
||||
[result-values (map (lambda (x) #f) result-contracts)])
|
||||
(make-box-splice
|
||||
(cons
|
||||
(make-table
|
||||
'boxed
|
||||
(map
|
||||
(lambda (stx-id name result-contract)
|
||||
(lambda (stx-id name result-contract result-value)
|
||||
(list
|
||||
(make-flow
|
||||
(make-table-if-necessary
|
||||
"argcontract"
|
||||
(list
|
||||
(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
|
||||
(make-flow
|
||||
(append
|
||||
(list
|
||||
(make-omitable-paragraph
|
||||
(make-flow
|
||||
(list
|
||||
(let ([target-maker
|
||||
((if form? id-to-form-target-maker id-to-target-maker)
|
||||
stx-id #t)]
|
||||
[content (list (definition-site name stx-id form?))])
|
||||
(if target-maker
|
||||
(target-maker
|
||||
content
|
||||
(lambda (tag)
|
||||
(make-toc-target-element
|
||||
#f
|
||||
(list
|
||||
(make-index-element
|
||||
#f
|
||||
content
|
||||
tag
|
||||
(list (symbol->string name))
|
||||
content
|
||||
(with-exporting-libraries
|
||||
(lambda (libs) (make-thing-index-desc name libs)))))
|
||||
tag)))
|
||||
(car content)))
|
||||
spacer ":" spacer))))
|
||||
(make-flow (list (if (block? result-contract)
|
||||
result-contract
|
||||
(make-omitable-paragraph (list result-contract)))))))))))
|
||||
stx-ids names result-contracts))
|
||||
(make-omitable-paragraph
|
||||
(list
|
||||
(let ([target-maker
|
||||
((if form? id-to-form-target-maker id-to-target-maker)
|
||||
stx-id #t)]
|
||||
[content (list (definition-site name stx-id form?))])
|
||||
(if target-maker
|
||||
(target-maker
|
||||
content
|
||||
(lambda (tag)
|
||||
(make-toc-target-element
|
||||
#f
|
||||
(list
|
||||
(make-index-element
|
||||
#f
|
||||
content
|
||||
tag
|
||||
(list (symbol->string name))
|
||||
content
|
||||
(with-exporting-libraries
|
||||
(lambda (libs) (make-thing-index-desc name libs)))))
|
||||
tag)))
|
||||
(car 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
|
||||
(list
|
||||
(make-table-if-necessary
|
||||
"argcontract"
|
||||
(list
|
||||
(list flow-spacer
|
||||
(to-flow (make-element #f (list spacer "=" spacer)))
|
||||
(make-flow (list result-block)))))
|
||||
'cont))
|
||||
null)))))))
|
||||
stx-ids names result-contracts result-values))
|
||||
(content-thunk))))
|
||||
|
||||
(define (defthing/proc id contract descs)
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@
|
|||
|
||||
(provide/contract
|
||||
[struct (box-splice splice) ([run list?])]) ; XXX ugly copying
|
||||
(provide deftogether
|
||||
(provide deftogether *deftogether
|
||||
with-scheme-variables
|
||||
with-togetherable-scheme-variables)
|
||||
|
||||
|
|
@ -109,7 +109,7 @@
|
|||
|
||||
|
||||
(define (*deftogether boxes body-thunk)
|
||||
(make-splice
|
||||
(make-box-splice
|
||||
(cons
|
||||
(make-table
|
||||
'boxed
|
||||
|
|
|
|||
|
|
@ -34,12 +34,14 @@
|
|||
(let ([v (read i)])
|
||||
(and (eof-object? (read i)) v)))))
|
||||
|
||||
(current-render-mixin html:render-mixin)
|
||||
|
||||
(define (run)
|
||||
(command-line
|
||||
#:program (short-program+command-name)
|
||||
#:once-any
|
||||
[("--text") "generate text-format output (the default)"
|
||||
(void)]
|
||||
(current-render-mixin text:render-mixin)]
|
||||
[("--html") "generate HTML-format output file"
|
||||
(current-render-mixin html:render-mixin)]
|
||||
[("--htmls") "generate HTML-format output directory"
|
||||
|
|
|
|||
|
|
@ -617,19 +617,28 @@ Like @scheme[defparam], but the contract on a parameter argument is
|
|||
|
||||
Like @scheme[defproc], but for a non-procedure binding.}
|
||||
|
||||
|
||||
@defform/subs[(defstruct struct-name ([field-name contract-expr-datum] ...)
|
||||
flag-keywords
|
||||
pre-flow ...)
|
||||
([struct-name id
|
||||
(id super-id)]
|
||||
[flag-keywords code:blank
|
||||
#:mutable
|
||||
(code:line #:inspector #f)
|
||||
(code:line #:mutable #:inspector #f)])]{
|
||||
@deftogether[(
|
||||
@defform[ (defstruct* struct-name ([field-name contract-expr-datum] ...)
|
||||
maybe-mutable maybe-non-opaque maybe-constructor
|
||||
pre-flow ...)]
|
||||
@defform/subs[ (defstruct struct-name ([field-name contract-expr-datum] ...)
|
||||
maybe-mutable maybe-non-opaque maybe-constructor
|
||||
pre-flow ...)
|
||||
([struct-name id
|
||||
(id super-id)]
|
||||
[maybe-mutable code:blank
|
||||
#:mutable]
|
||||
[maybe-non-opaque code:blank
|
||||
#:prefab
|
||||
#:transparent]
|
||||
[maybe-constructor code:blank
|
||||
(code:line #:constructor-name constructor-id)
|
||||
(code:line #:extra-constructor-name constructor-id)])]
|
||||
)]{
|
||||
|
||||
Similar to @scheme[defform] or @scheme[defproc], but for a structure
|
||||
definition.}
|
||||
definition. The @scheme[defstruct*] form corresponds to @scheme[struct],
|
||||
while @scheme[defstruct] corresponds to @scheme[define-struct].}
|
||||
|
||||
|
||||
@defform[(deftogether [def-expr ...] pre-flow ...)]{
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(require scribble/core
|
||||
scribble/html-properties
|
||||
scribble/manual
|
||||
(prefix-in scheme: scribble/scheme)
|
||||
(prefix-in racket: scribble/racket)
|
||||
(prefix-in scribble: scribble/reader))
|
||||
|
||||
(define-syntax bounce-for-label
|
||||
|
|
@ -15,12 +15,12 @@
|
|||
(provide (for-label (all-from-out mod))))]
|
||||
[(_ mod ...) (begin (bounce-for-label mod) ...)]))
|
||||
|
||||
(bounce-for-label (all-except scheme (link) ())
|
||||
(bounce-for-label (all-except racket (link) ())
|
||||
scribble/core
|
||||
scribble/base-render
|
||||
scribble/decode
|
||||
scribble/manual
|
||||
scribble/scheme
|
||||
scribble/racket
|
||||
scribble/html-properties
|
||||
scribble/latex-properties
|
||||
scribble/eval
|
||||
|
|
@ -94,7 +94,7 @@
|
|||
(map (lambda (x)
|
||||
(let ([@expr (if x (litchar/lines (car x)) "")]
|
||||
[sexpr (if x
|
||||
(scheme:to-paragraph
|
||||
(racket:to-paragraph
|
||||
((norm-spacing 0) (cadr x)))
|
||||
"")]
|
||||
[reads-as (if x reads-as "")])
|
||||
|
|
@ -103,7 +103,7 @@
|
|||
|
||||
;; stuff for the preprocessor examples
|
||||
|
||||
(require scheme/list (for-syntax scheme/base scheme/list))
|
||||
(require racket/list (for-syntax racket/base racket/list))
|
||||
|
||||
(define max-textsample-width 45)
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user