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

add serializable-struct

Browse Source
This commit is contained in:
Matthew Flatt 2010-04-30 06:21:02 -06:00
parent 5e4386ba13
commit 783e309b4d
2 changed files with 94 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
collects/racket/serialize.rkt
View File

@ -5,13 +5,15 @@
racket/struct-info))
(provide (all-from-out "private/serialize.ss")
serializable-struct
serializable-struct/versions
define-serializable-struct
define-serializable-struct/versions)
(define-syntax (define-serializable-struct/versions/derived stx)
(syntax-case stx ()
;; First check `id/sup':
[(_ orig-stx id/sup . _)
[(_ orig-stx make-prefix? id/sup . _)
(not (or (identifier? #'id/sup)
(syntax-case #'id/sup ()
[(id sup) (and (identifier? #'id)
@ -22,11 +24,11 @@
;; Not valid, so let `define-struct/derived' complain:
#'(define-struct/derived orig-stx id/sup ())]
;; Check version:
[(_ orig-stx id/sup vers . _)
[(_ orig-stx make-prefix? id/sup vers . _)
(not (exact-nonnegative-integer? (syntax-e #'vers)))
(raise-syntax-error #f "expected a nonnegative exact integer for a version" #'orig-stx #'vers)]
;; Main case:
[(_ orig-stx id/sup vers (field ...) ([other-vers make-proc-expr cycle-make-proc-expr] ...)
[(_ orig-stx make-prefix? id/sup vers (field ...) ([other-vers make-proc-expr cycle-make-proc-expr] ...)
prop ...)
(let* ([id (if (identifier? #'id/sup)
#'id/sup
@ -35,10 +37,22 @@
#f
(extract-struct-info (syntax-local-value (cadr (syntax->list #'id/sup)))))]
[fields (syntax->list #'(field ...))]
[maker (datum->syntax id
(string->symbol
(format "make-~a" (syntax-e id)))
id)]
[given-maker (let loop ([props (syntax->list #'(prop ...))])
(cond
[(null? props) #f]
[(null? (cdr props)) #f]
[(or (eq? (syntax-e (car props)) '#:constructor-name)
(eq? (syntax-e (car props)) '#:extra-constructor-name))
(and (identifier? (cadr props))
(cadr props))]
[else (loop (cdr props))]))]
[maker (or given-maker
(if (syntax-e #'make-prefix?)
(datum->syntax id
(string->symbol
(format "make-~a" (syntax-e id)))
id)
id))]
[getters (map (lambda (field)
(datum->syntax
id
@ -103,6 +117,10 @@
id/sup
(field ...)
prop ...
#,@(if (or given-maker
(syntax-e #'make-prefix?))
null
(list #'#:constructor-name id))
#:property prop:serializable
(make-serialize-info
;; The struct-to-vector function: --------------------
@ -203,14 +221,37 @@
(define-syntax (define-serializable-struct/versions stx)
(syntax-case stx ()
[(_ . rest)
#`(define-serializable-struct/versions/derived #,stx . rest)]))
#`(define-serializable-struct/versions/derived #,stx #t . rest)]))
(define-syntax (serializable-struct/versions stx)
(syntax-case stx ()
[(_ id super-id . rest)
(and (identifier? #'id)
(identifier? #'super-id))
#`(define-serializable-struct/versions/derived #,stx #f (id super-id) . rest)]
[(_ id (field ...) . rest)
(identifier? #'id)
#`(define-serializable-struct/versions/derived #,stx #f id (field ...) . rest)]))
(define-syntax (define-serializable-struct stx)
(syntax-case stx ()
[(_ id/sup (field ...) prop ...)
#`(define-serializable-struct/versions/derived #,stx
#`(define-serializable-struct/versions/derived #,stx #t
id/sup 0 (field ...) () prop ...)]
[(_ . rest)
#`(define-struct/derived #,stx . rest)]))
(define-syntax (serializable-struct stx)
(syntax-case stx ()
[(_ id super-id (field ...) prop ...)
(and (identifier? #'id)
(identifier? #'super-id))
#`(define-serializable-struct/versions/derived #,stx #f
(id super-id) 0 (field ...) () prop ...)]
[(_ id (field ...) prop ...)
(and (identifier? #'id)
(identifier? #'super-id))
#`(define-serializable-struct/versions/derived #,stx #f
id 0 (field ...) () prop ...)]))
)

72
collects/scribblings/reference/serialization.scrbl
View File

@ -33,8 +33,8 @@ The following kinds of values are serializable:
@itemize[
@item{structures created through @scheme[define-serializable-struct] or
@scheme[define-serializable-struct/version], or more generally
@item{structures created through @scheme[serializable-struct] or
@scheme[serializable-struct/versions], or more generally
structures with the @scheme[prop:serializable] property (see
@scheme[prop:serializable] for more information);}
@ -338,10 +338,10 @@ exception to disallow the @scheme[dynamic-require].}
@; ----------------------------------------------------------------------
@defform[(define-serializable-struct id-maybe-super (field ...)
struct-option ...)]{
@defform[(serializable-struct id maybe-super (field ...)
struct-option ...)]{
Like @scheme[define-struct], but instances of the structure type are
Like @scheme[struct], but instances of the structure type are
serializable with @scheme[serialize]. This form is allowed only at
the top level or in a module's top level (so that deserialization
information can be found later).
@ -350,17 +350,16 @@ Serialization only supports cycles involving the created structure
type when all fields are mutable (or when the cycle can be broken
through some other mutable value).
In addition to the bindings generated by @scheme[define-struct],
@scheme[define-serializable-struct] binds
In addition to the bindings generated by @scheme[struct],
@scheme[serializable-struct] binds
@schemeidfont{deserialize-info:}@scheme[_id]@schemeidfont{-v0} to
deserialization information. Furthermore, in a module context, it
automatically @scheme[provide]s this binding.
The @scheme[define-serializable-struct] form enables the construction
of structure instances from places where
@schemeidfont{make}@scheme[id] is not accessible, since
deserialization must construct instances. Furthermore,
@scheme[define-serializable-struct] provides limited access to field
The @scheme[serializable-struct] form enables the construction of
structure instances from places where @scheme[id] is not accessible,
since deserialization must construct instances. Furthermore,
@scheme[serializable-struct] provides limited access to field
mutation, but only for instances generated through the deserialization
information bound to
@schemeidfont{deserialize-info:}@scheme[_id]@schemeidfont{-v0}. See
@ -368,9 +367,9 @@ information bound to
The @scheme[-v0] suffix on the deserialization enables future
versioning on the structure type through
@scheme[define-serializable-struct/version].
@scheme[serializable-struct/version].
When a supertype is supplied in @scheme[id-maybe-super] is supplied,
When a supertype is supplied in @scheme[maybe-super] is supplied,
compile-time information bound to the supertype identifier must
include all of the supertype's field accessors. If any field mutator
is missing, the structure type will be treated as immutable for the
@ -379,20 +378,28 @@ structure type cannot be handled by the deserializer).
@examples[
#:eval ser-eval
(define-serializable-struct point (x y))
(point-x (deserialize (serialize (make-point 1 2))))
(serializable-struct point (x y))
(point-x (deserialize (serialize (point 1 2))))
]}
@; ----------------------------------------------------------------------
@defform/subs[(define-serializable-struct/versions id-maybe-super vers (field ...)
(other-version-clause ...)
struct-option ...)
@defform[(define-serializable-struct id-maybe-super (field ...)
struct-option ...)]{
Like @racket[serializable-struct], but with the supertype syntax and
default constructor name of @racket[define-struct].}
@; ----------------------------------------------------------------------
@defform/subs[(serializable-struct/versions id-maybe-super vers (field ...)
(other-version-clause ...)
struct-option ...)
([other-version-clause (other-vers make-proc-expr
cycle-make-proc-expr)])]{
Like @scheme[define-serializable-struct], but the generated
deserializer binding is
Like @scheme[serializable-struct], but the generated deserializer
binding is
@schemeidfont{deserialize-info:}@scheme[_id]@schemeidfont{-v}@scheme[vers]. In
addition,
@schemeidfont{deserialize-info:}@scheme[_id]@schemeidfont{-v}@scheme[other-vers]
@ -410,35 +417,44 @@ instance of @scheme[id] and copies its field values into @scheme[x].
@examples[
#:eval ser-eval
(define-serializable-struct point (x y) #:mutable #:transparent)
(define ps (serialize (make-point 1 2)))
(serializable-struct point (x y) #:mutable #:transparent)
(define ps (serialize (point 1 2)))
(deserialize ps)
(define x (make-point 1 10))
(define x (point 1 10))
(set-point-x! x x)
(define xs (serialize x))
(deserialize xs)
(define-serializable-struct/versions point 1 (x y z)
(serializable-struct/versions point 1 (x y z)
([0
(code:comment @#,t{Constructor for simple v0 instances:})
(lambda (x y) (make-point x y 0))
(lambda (x y) (point x y 0))
(code:comment @#,t{Constructor for v0 instance in a cycle:})
(lambda ()
(let ([p0 (make-point #f #f 0)])
(let ([p0 (point #f #f 0)])
(values
p0
(lambda (p)
(set-point-x! p0 (point-x p))
(set-point-y! p0 (point-y p))))))])
#:mutable #:transparent)
(deserialize (serialize (make-point 4 5 6)))
(deserialize (serialize (point 4 5 6)))
(deserialize ps)
(deserialize xs)
]}
@; ----------------------------------------------------------------------
@defform[(define-serializable-struct/versions id-maybe-super vers (field ...)
(other-version-clause ...)
struct-option ...)]{
Like @racket[serializable-struct/versions], but with the supertype syntax and
default constructor name of @racket[define-struct].}
}
@; ----------------------------------------------------------------------
@defproc[(make-deserialize-info [make procedure?]
[cycle-make (-> (values any/c procedure?))])
any]{