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

Add checked-struct-info.

Browse Source 
svn: r9227
This commit is contained in:
Sam Tobin-Hochstadt 2008-04-09 23:25:30 +00:00
parent 5ec2b40957
commit 13b7f8c506
2 changed files with 55 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
collects/scheme/private/define-struct.ss
View File

@ -11,7 +11,32 @@
(#%provide define-struct* (#%provide define-struct*
define-struct/derived 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 (define-syntax-parameter struct-field-index
(lambda (stx) (lambda (stx)
@ -249,20 +274,22 @@
"bad syntax; expected <id> for structure-type name or (<id> <id>) for name and supertype name" "bad syntax; expected <id> for structure-type name or (<id> <id>) for name and supertype name"
stx stx
#'id)]))]) #'id)]))])
(let ([super-info (let-values ([(super-info super-info-checked?)
(and super-id (if super-id
(let ([v (syntax-local-value super-id (lambda () #f))]) (let ([v (syntax-local-value super-id (lambda () #f))])
(if (struct-info? v) (if (struct-info? v)
(extract-struct-info v) (values (extract-struct-info v) (checked-struct-info-rec? v))
(raise-syntax-error (raise-syntax-error
#f #f
(format "parent struct type not defined~a" (format "parent struct type not defined~a"
(if v (if v
(format " (~a does not name struct type information)" (format " (~a does not name struct type information)"
(syntax-e super-id)) (syntax-e super-id))
"")) ""))
stx stx
super-id))))]) super-id)))
;; if there's no super type, it's like it was checked
(values #f #t))])
(when (and super-info (when (and super-info
(not (car super-info))) (not (car super-info)))
(raise-syntax-error (raise-syntax-error
@ -397,11 +424,14 @@
(and sel (and sel
(if (syntax-e sel) (if (syntax-e sel)
#`(c (quote-syntax #,sel)) #`(c (quote-syntax #,sel))
sel)))]) sel)))]
[mk-info (if super-info-checked?
#'make-checked-struct-info
#'make-struct-info)])
(quasisyntax/loc stx (quasisyntax/loc stx
(define-syntaxes (#,id) (define-syntaxes (#,id)
(let ([c (syntax-local-certifier)]) (let ([c (syntax-local-certifier)])
(make-struct-info (#,mk-info
(lambda () (lambda ()
(list (list
(c (quote-syntax #,struct:)) (c (quote-syntax #,struct:))

9
collects/scribblings/reference/struct.scrbl
View File

@ -534,10 +534,17 @@ type.
@defproc[(struct-info? [v any/c]) boolean?]{ @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 the correct shape for representing structure-type information, or a
procedure encapsulated by @scheme[make-struct-info].} 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?))]) @defproc[(make-struct-info [thunk (-> (and/c struct-info? list?))])
struct-info?]{ struct-info?]{