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

fix *SL `define-struct' expand-time info: omit non-existent struct type

Browse Source
This commit is contained in:
Matthew Flatt 2010-08-30 16:11:08 -06:00
parent 76c3c76214
commit 036ed57000
4 changed files with 33 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/lang/private/teach.rkt
View File

@ -63,6 +63,7 @@
scheme/list
(rename racket/base racket:define-struct define-struct)
(only racket/base syntax->datum datum->syntax)
(rename racket/base kw-app #%app)
racket/struct-info
stepper/private/shared)
@ -777,12 +778,13 @@
(string->symbol
(string-append (symbol->string (syntax->datum name))
"-of")))])
(let* ([to-define-names (list* struct: constructor-name predicate-name
(let* ([to-define-names (list* constructor-name predicate-name
(if setters?
(append getter-names setter-names)
getter-names))]
[proc-names (cdr to-define-names)])
(with-syntax ([compile-info (build-struct-expand-info name fields #f (not setters?) #t null null)]
[proc-names to-define-names])
(with-syntax ([compile-info (kw-app build-struct-expand-info name fields #f (not setters?) #t null null
#:omit-struct-type? #t)]
[(field_/no-loc ...) (map (λ (x) (datum->syntax x (syntax->datum x) #f)) (syntax->list #'(field_ ...)))])
(let-values ([(defn0 bind-names)
(wrap-func-definitions

4
collects/racket/private/reqprov.rkt
View File

@ -868,8 +868,8 @@
(raise-syntax-error
#f
(if (null? ids)
"no import for structure-type identifier"
(format "multiple imports (~a~a~a~a) for structure-type identifier"
"no binding for structure-type identifier"
(format "multiple bindings (~a~a~a~a) for structure-type identifier"
(syntax-e (car ids))
(if (null? (cddr ids))
" and "

27
collects/syntax/scribblings/struct.scrbl
View File

@ -22,6 +22,7 @@ expression.}
@defproc[(build-struct-names [name-id identifier?]
[field-ids (listof identifier?)]
[#:constructor-name ctr-name (or/c identifier? #f) #f]
[omit-sel? boolean?]
[omit-set? boolean?]
[src-stx (or/c syntax? false/c) #f])
@ -33,7 +34,7 @@ field names. The result is a list of identifiers:
@itemize[
@item{@schemeidfont{struct:}@scheme[name-id]}
@item{@schemeidfont{make-}@scheme[name-id]}
@item{@scheme[ctr-name], or @schemeidfont{make-}@scheme[name-id] if @racket[ctr-name] is @racket[#f]}
@item{@scheme[name-id]@schemeidfont{?}}
@item{@scheme[name-id]@schemeidfont{-}@scheme[_field], for each
@scheme[_field] in @scheme[field-ids].}
@ -50,6 +51,8 @@ source location to the generated identifiers.}
@defproc[(build-struct-generation [name-id identifier?]
[field-ids (listof identifier?)]
[#:constructor-name ctr-name (or/c identifier? #f) #f]
[omit-sel? boolean?]
[omit-set? boolean?]
@ -66,9 +69,11 @@ the structure type and return values for the identifiers created by
S-expression values that are used as the corresponding arguments to
@scheme[make-struct-type].}
@defproc[(build-struct-generation* [all-name-ids (listof identifier?)]
[name-id identifier?]
[field-ids (listof identifier?)]
[#:constructor-name ctr-name (or/c identifier? #f) #f]
[omit-sel? boolean?]
[omit-set? boolean?]
[super-type any/c #f]
@ -81,6 +86,9 @@ Like @scheme[build-struct-generation], but given the names produced by
@defproc[(build-struct-expand-info [name-id identifier?]
[field-ids (listof identifier?)]
[#:omit-constructor? no-ctr? any/c #f]
[#:constructor-name ctr-name (or/c identifier? #f) #f]
[#:omit-struct-type? no-type? any/c #f]
[omit-sel? boolean?]
[omit-set? boolean?]
[base-name (or/c identifier? boolean?)]
@ -88,14 +96,20 @@ Like @scheme[build-struct-generation], but given the names produced by
[base-setters (listof (or/c identifier? false/c))])
any]{
Takes the same arguments as @scheme[build-struct-names], plus a parent
Takes mostly the same arguments as @scheme[build-struct-names], plus a parent
identifier/@scheme[#t]/@scheme[#f] and a list of accessor and mutator
identifiers (possibly ending in @scheme[#f]) for a parent type, and
generates an S-expression for expansion-time code to be used in the
binding for the structure name. A @scheme[#t] for the
@scheme[base-name] means no super-type, @scheme[#f] means that the
super-type (if any) is unknown, and an identifier indicates the
super-type identifier.}
binding for the structure name.
If @racket[no-ctr?] is true, then the constructor name is omitted from
the expansion-time information. Similarly, if @racket[no-type?] is
true, then the structure-type name is omitted.
A @scheme[#t] for the @scheme[base-name] means no super-type,
@scheme[#f] means that the super-type (if any) is unknown, and an
identifier indicates the super-type identifier.}
@defproc[(struct-declaration-info? [v any/c]) boolean?]{
@ -103,6 +117,7 @@ Returns @scheme[#t] if @scheme[x] has the shape of expansion-time
information for structure type declarations, @scheme[#f] otherwise.
See @secref[#:doc refman]{structinfo}.}
@defproc[(generate-struct-declaration [orig-stx syntax?]
[name-id identifier?]
[super-id-or-false (or/c identifier? false/c)]

6
collects/syntax/struct.rkt
View File

@ -166,13 +166,17 @@
(define build-struct-expand-info
(lambda (name-stx fields omit-sel? omit-set? base-name base-getters base-setters
#:omit-constructor? [no-ctr? #f]
#:constructor-name [ctr-name #f])
#:constructor-name [ctr-name #f]
#:omit-struct-type? [no-type? #f])
(let* ([names (build-struct-names name-stx fields omit-sel? omit-set?
#:constructor-name ctr-name)]
[names (if no-ctr?
(list* (car names)
#f
(cddr names))
names)]
[names (if no-type?
(cons #f (cdr names))
names)])
(build-struct-expand-info* names name-stx fields omit-sel? omit-set? base-name base-getters base-setters))))