commit 113935619f297ee3cd3d88572e7f310bbbe162ac parent 710b66d58c99b5c031d9c9b651cd047c8d504d7b Author: Matthew Flatt <mflatt@racket-lang.org> Date: Sun, 28 Dec 2008 18:57:13 +0000 document compiler/zo-parse and compiler/decompile svn: r12947 original commit: 7aec6b876181bea97b43f16fbe2c237f946d06b3 Diffstat:
| M | collects/scribble/private/manual-proc.ss | | | 30 | +++++++++++++++++++----------- |
1 file changed, 19 insertions(+), 11 deletions(-)
diff --git a/collects/scribble/private/manual-proc.ss b/collects/scribble/private/manual-proc.ss @@ -486,29 +486,33 @@ (define-syntax defstruct (syntax-rules () [(_ name fields #:mutable #:inspector #f desc ...) - (**defstruct name fields #f #t desc ...)] + (**defstruct name fields #f #t #f desc ...)] [(_ name fields #:mutable #:transparent desc ...) - (**defstruct name fields #f #t 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 desc ...)] + (**defstruct name fields #f #f #f desc ...)] [(_ name fields #:inspector #f desc ...) - (**defstruct name fields #t #t desc ...)] + (**defstruct name fields #t #t #f desc ...)] [(_ name fields #:transparent desc ...) - (**defstruct name fields #t #t 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 desc ...)])) + (**defstruct name fields #t #f #f desc ...)])) (define-syntax-rule (**defstruct name ([field field-contract] ...) immutable? - transparent? desc ...) + transparent? prefab? desc ...) (with-togetherable-scheme-variables () () (*defstruct (quote-syntax/loc name) 'name '([field field-contract] ...) (list (lambda () (schemeblock0 field-contract)) ...) - immutable? transparent? (lambda () (list desc ...))))) + immutable? transparent? prefab? (lambda () (list desc ...))))) -(define (*defstruct stx-id name fields field-contracts immutable? transparent? +(define (*defstruct stx-id name fields field-contracts immutable? transparent? prefab? content-thunk) (define (field-name f) ((if (pair? (car f)) caar car) f)) (define (field-view f) @@ -634,7 +638,9 @@ (list flow-spacer flow-spacer (to-flow (make-element #f - (list (to-element '#:transparent) + (list (if prefab? + (to-element '#:prefab) + (to-element '#:transparent)) (schemeparenfont ")")))) 'cont 'cont))] @@ -652,7 +658,9 @@ (list flow-spacer flow-spacer (to-flow (make-element #f - (list (to-element '#:transparent) + (list (if prefab? + (to-element '#:prefab) + (to-element '#:transparent)) (schemeparenfont ")")))) 'cont 'cont))]