suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

add #:omit-constructor option to @defstruct[] and @defstruct*[]

Browse Source 
original commit: 4242f62e665949d89c1494e33c67e171d1044437
This commit is contained in:
Robby Findler 2013-09-20 14:24:35 -05:00
parent 82b85a9155
commit 7f75c9a4c6
2 changed files with 17 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/manual.scrbl
View File

@ -1173,7 +1173,8 @@ Examples:
(code:line #:inspector #f)] (code:line #:inspector #f)]
[maybe-constructor code:blank [maybe-constructor code:blank
(code:line #:constructor-name constructor-id) (code:line #:constructor-name constructor-id)
(code:line #:extra-constructor-name constructor-id)])] (code:line #:extra-constructor-name constructor-id)
(code:line #:omit-constructor)])]
)]{ )]{
Similar to @racket[defform] or @racket[defproc], but for a structure Similar to @racket[defform] or @racket[defproc], but for a structure

21
pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-proc.rkt
View File

@ -615,14 +615,22 @@
#:with opacity #''opaque)) #:with opacity #''opaque))
(define-splicing-syntax-class constructor-kw (define-splicing-syntax-class constructor-kw
#:description "#:constructor-name or #:extra-constructor-name keyword" #:description "#:constructor-name, #:extra-constructor-name, or #:omit-constructor keyword"
(pattern (~seq #:constructor-name id) (pattern (~seq #:constructor-name id)
#:with omit? #'#f
#:with given? #'#t #:with given? #'#t
#:with extra? #'#f) #:with extra? #'#f)
(pattern (~seq #:extra-constructor-name id) (pattern (~seq #:extra-constructor-name id)
#:with omit? #'#f
#:with given? #'#t #:with given? #'#t
#:with extra? #'#t) #:with extra? #'#t)
(pattern (~seq #:omit-constructor)
#:with omit? #'#t
#:with id #'#f
#:with given? #'#f
#:with extra? #'#f)
(pattern (~seq) (pattern (~seq)
#:with omit? #'#f
#:with id #'#f #:with id #'#f
#:with given? #'#f #:with given? #'#f
#:with extra? #'#f))) #:with extra? #'#f)))
@ -634,9 +642,9 @@
[(_ lt:link-target?-kw name fields [(_ lt:link-target?-kw name fields
m:mutable-kw o:opacity-kw c:constructor-kw m:mutable-kw o:opacity-kw c:constructor-kw
desc ...) desc ...)
#'(**defstruct lt.expr name fields #`(**defstruct lt.expr name fields
m.immutable? o.opacity m.immutable? o.opacity
c.id c.given? c.extra? default-extra? c.id c.given? c.extra? default-extra? c.omit?
desc ...)])))) desc ...)]))))
(define-defstruct defstruct #t) (define-defstruct defstruct #t)
@ -644,20 +652,20 @@
(define-syntax-rule (**defstruct link? name ([field field-contract] ...) (define-syntax-rule (**defstruct link? name ([field field-contract] ...)
immutable? opacity immutable? opacity
cname cname-given? extra-cname? default-extra? cname cname-given? extra-cname? default-extra? omit-constructor?
desc ...) desc ...)
(with-togetherable-racket-variables (with-togetherable-racket-variables
() ()
() ()
(*defstruct link? (quote-syntax/loc name) 'name (*defstruct link? (quote-syntax/loc name) 'name
(quote-syntax/loc cname) cname-given? extra-cname? default-extra? (quote-syntax/loc cname) cname-given? extra-cname? default-extra? omit-constructor?
'([field field-contract] ...) '([field field-contract] ...)
(list (lambda () (racketblock0 field-contract)) ...) (list (lambda () (racketblock0 field-contract)) ...)
immutable? opacity immutable? opacity
(lambda () (list desc ...))))) (lambda () (list desc ...)))))
(define (*defstruct link? stx-id name (define (*defstruct link? stx-id name
alt-cname-id cname-given? extra-cname? default-extra? alt-cname-id cname-given? extra-cname? default-extra? omit-constructor?
fields field-contracts fields field-contracts
immutable? opacity immutable? opacity
content-thunk) content-thunk)
@ -670,6 +678,7 @@
(if (pair? (car f)) (make-shaped-parens (car f) #\[) (car f))) (if (pair? (car f)) (make-shaped-parens (car f) #\[) (car f)))
(define cname-id (define cname-id
(cond (cond
[omit-constructor? #f]
[(identifier? alt-cname-id) alt-cname-id] [(identifier? alt-cname-id) alt-cname-id]
[(not default-extra?) #f] [(not default-extra?) #f]
[else (let ([name-id (if (identifier? stx-id) [else (let ([name-id (if (identifier? stx-id)