Add checked-struct-info.
svn: r9227
This commit is contained in:
parent
5ec2b40957
commit
13b7f8c506
|
@ -11,7 +11,32 @@
|
|||
|
||||
(#%provide define-struct*
|
||||
define-struct/derived
|
||||
struct-field-index)
|
||||
struct-field-index
|
||||
(for-syntax
|
||||
(rename checked-struct-info-rec? checked-struct-info?)))
|
||||
|
||||
(define-values-for-syntax
|
||||
(struct:checked-struct-info
|
||||
make-checked-struct-info
|
||||
checked-struct-info-rec?
|
||||
checked-struct-info-ref
|
||||
checked-struct-info-set!)
|
||||
(make-struct-type 'struct-info struct:struct-info
|
||||
0 0 #f
|
||||
null (current-inspector)
|
||||
(lambda (v stx)
|
||||
(raise-syntax-error
|
||||
#f
|
||||
"identifier for static struct-type information cannot be used as an expression"
|
||||
stx))
|
||||
null
|
||||
(lambda (proc info)
|
||||
(if (and (procedure? proc)
|
||||
(procedure-arity-includes? proc 0))
|
||||
proc
|
||||
(raise-type-error 'make-struct-info
|
||||
"procedure (arity 0)"
|
||||
proc)))))
|
||||
|
||||
(define-syntax-parameter struct-field-index
|
||||
(lambda (stx)
|
||||
|
@ -249,20 +274,22 @@
|
|||
"bad syntax; expected <id> for structure-type name or (<id> <id>) for name and supertype name"
|
||||
stx
|
||||
#'id)]))])
|
||||
(let ([super-info
|
||||
(and super-id
|
||||
(let ([v (syntax-local-value super-id (lambda () #f))])
|
||||
(if (struct-info? v)
|
||||
(extract-struct-info v)
|
||||
(raise-syntax-error
|
||||
#f
|
||||
(format "parent struct type not defined~a"
|
||||
(if v
|
||||
(format " (~a does not name struct type information)"
|
||||
(syntax-e super-id))
|
||||
""))
|
||||
stx
|
||||
super-id))))])
|
||||
(let-values ([(super-info super-info-checked?)
|
||||
(if super-id
|
||||
(let ([v (syntax-local-value super-id (lambda () #f))])
|
||||
(if (struct-info? v)
|
||||
(values (extract-struct-info v) (checked-struct-info-rec? v))
|
||||
(raise-syntax-error
|
||||
#f
|
||||
(format "parent struct type not defined~a"
|
||||
(if v
|
||||
(format " (~a does not name struct type information)"
|
||||
(syntax-e super-id))
|
||||
""))
|
||||
stx
|
||||
super-id)))
|
||||
;; if there's no super type, it's like it was checked
|
||||
(values #f #t))])
|
||||
(when (and super-info
|
||||
(not (car super-info)))
|
||||
(raise-syntax-error
|
||||
|
@ -397,11 +424,14 @@
|
|||
(and sel
|
||||
(if (syntax-e sel)
|
||||
#`(c (quote-syntax #,sel))
|
||||
sel)))])
|
||||
sel)))]
|
||||
[mk-info (if super-info-checked?
|
||||
#'make-checked-struct-info
|
||||
#'make-struct-info)])
|
||||
(quasisyntax/loc stx
|
||||
(define-syntaxes (#,id)
|
||||
(let ([c (syntax-local-certifier)])
|
||||
(make-struct-info
|
||||
(#,mk-info
|
||||
(lambda ()
|
||||
(list
|
||||
(c (quote-syntax #,struct:))
|
||||
|
|
|
@ -534,10 +534,17 @@ type.
|
|||
|
||||
@defproc[(struct-info? [v any/c]) boolean?]{
|
||||
|
||||
Returns @scheme[#f] if @scheme[v] is either a six-element list with
|
||||
Returns @scheme[#t] if @scheme[v] is either a six-element list with
|
||||
the correct shape for representing structure-type information, or a
|
||||
procedure encapsulated by @scheme[make-struct-info].}
|
||||
|
||||
@defproc[(checked-struct-info? [v any/c]) boolean?]{
|
||||
|
||||
Returns @scheme[#t] if @scheme[v] is a structure encapsulated by
|
||||
@scheme[make-struct-info] and produced by @scheme[define-struct]. Such
|
||||
values may be relied upon to accurately represent a structure and have
|
||||
correct super-type information.}
|
||||
|
||||
@defproc[(make-struct-info [thunk (-> (and/c struct-info? list?))])
|
||||
struct-info?]{
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user