suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues4 Pull Requests1 Actions Packages Projects Releases Wiki Activity

document compiler/zo-parse and compiler/decompile

Browse Source 
svn: r12947

original commit: 7aec6b876181bea97b43f16fbe2c237f946d06b3
This commit is contained in:
Matthew Flatt 2008-12-28 18:57:13 +00:00
parent 710b66d58c
commit 113935619f
1 changed files with 19 additions and 11 deletions

30
collects/scribble/private/manual-proc.ss
View File

@ -486,29 +486,33 @@
(define-syntax defstruct (define-syntax defstruct
(syntax-rules () (syntax-rules ()
[(_ name fields #:mutable #:inspector #f desc ...) [(_ name fields #:mutable #:inspector #f desc ...)
(**defstruct name fields #f #t desc ...)] (**defstruct name fields #f #t #f desc ...)]
[(_ name fields #:mutable #:transparent 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 ...) [(_ name fields #:mutable desc ...)
(**defstruct name fields #f #f desc ...)] (**defstruct name fields #f #f #f desc ...)]
[(_ name fields #:inspector #f desc ...) [(_ name fields #:inspector #f desc ...)
(**defstruct name fields #t #t desc ...)] (**defstruct name fields #t #t #f desc ...)]
[(_ name fields #:transparent 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 ...) [(_ 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? (define-syntax-rule (**defstruct name ([field field-contract] ...) immutable?
transparent? desc ...) transparent? prefab? desc ...)
(with-togetherable-scheme-variables (with-togetherable-scheme-variables
() ()
() ()
(*defstruct (quote-syntax/loc name) 'name (*defstruct (quote-syntax/loc name) 'name
'([field field-contract] ...) '([field field-contract] ...)
(list (lambda () (schemeblock0 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) content-thunk)
(define (field-name f) ((if (pair? (car f)) caar car) f)) (define (field-name f) ((if (pair? (car f)) caar car) f))
(define (field-view f) (define (field-view f)
@ -634,7 +638,9 @@
(list flow-spacer flow-spacer (list flow-spacer flow-spacer
(to-flow (make-element (to-flow (make-element
#f #f
(list (to-element '#:transparent) (list (if prefab?
(to-element '#:prefab)
(to-element '#:transparent))
(schemeparenfont ")")))) (schemeparenfont ")"))))
'cont 'cont
'cont))] 'cont))]
@ -652,7 +658,9 @@
(list flow-spacer flow-spacer (list flow-spacer flow-spacer
(to-flow (make-element (to-flow (make-element
#f #f
(list (to-element '#:transparent) (list (if prefab?
(to-element '#:prefab)
(to-element '#:transparent))
(schemeparenfont ")")))) (schemeparenfont ")"))))
'cont 'cont
'cont))] 'cont))]