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*
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:))

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

@ -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?]{