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)) racket/struct-info))
(provide (all-from-out "private/serialize.ss") (provide (all-from-out "private/serialize.ss")
serializable-struct
serializable-struct/versions
define-serializable-struct define-serializable-struct
define-serializable-struct/versions) define-serializable-struct/versions)
(define-syntax (define-serializable-struct/versions/derived stx) (define-syntax (define-serializable-struct/versions/derived stx)
(syntax-case stx () (syntax-case stx ()
;; First check `id/sup': ;; First check `id/sup':
[(_ orig-stx id/sup . _) [(_ orig-stx make-prefix? id/sup . _)
(not (or (identifier? #'id/sup) (not (or (identifier? #'id/sup)
(syntax-case #'id/sup () (syntax-case #'id/sup ()
[(id sup) (and (identifier? #'id) [(id sup) (and (identifier? #'id)
@ -22,11 +24,11 @@
;; Not valid, so let `define-struct/derived' complain: ;; Not valid, so let `define-struct/derived' complain:
#'(define-struct/derived orig-stx id/sup ())] #'(define-struct/derived orig-stx id/sup ())]
;; Check version: ;; Check version:
[(_ orig-stx id/sup vers . _) [(_ orig-stx make-prefix? id/sup vers . _)
(not (exact-nonnegative-integer? (syntax-e #'vers))) (not (exact-nonnegative-integer? (syntax-e #'vers)))
(raise-syntax-error #f "expected a nonnegative exact integer for a version" #'orig-stx #'vers)] (raise-syntax-error #f "expected a nonnegative exact integer for a version" #'orig-stx #'vers)]
;; Main case: ;; 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 ...) prop ...)
(let* ([id (if (identifier? #'id/sup) (let* ([id (if (identifier? #'id/sup)
#'id/sup #'id/sup
@ -35,10 +37,22 @@
#f #f
(extract-struct-info (syntax-local-value (cadr (syntax->list #'id/sup)))))] (extract-struct-info (syntax-local-value (cadr (syntax->list #'id/sup)))))]
[fields (syntax->list #'(field ...))] [fields (syntax->list #'(field ...))]
[maker (datum->syntax id [given-maker (let loop ([props (syntax->list #'(prop ...))])
(string->symbol (cond
(format "make-~a" (syntax-e id))) [(null? props) #f]
id)] [(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) [getters (map (lambda (field)
(datum->syntax (datum->syntax
id id
@ -103,6 +117,10 @@
id/sup id/sup
(field ...) (field ...)
prop ... prop ...
#,@(if (or given-maker
(syntax-e #'make-prefix?))
null
(list #'#:constructor-name id))
#:property prop:serializable #:property prop:serializable
(make-serialize-info (make-serialize-info
;; The struct-to-vector function: -------------------- ;; The struct-to-vector function: --------------------
@ -203,14 +221,37 @@
(define-syntax (define-serializable-struct/versions stx) (define-syntax (define-serializable-struct/versions stx)
(syntax-case stx () (syntax-case stx ()
[(_ . rest) [(_ . 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) (define-syntax (define-serializable-struct stx)
(syntax-case stx () (syntax-case stx ()
[(_ id/sup (field ...) prop ...) [(_ id/sup (field ...) prop ...)
#`(define-serializable-struct/versions/derived #,stx #`(define-serializable-struct/versions/derived #,stx #t
id/sup 0 (field ...) () prop ...)] id/sup 0 (field ...) () prop ...)]
[(_ . rest) [(_ . rest)
#`(define-struct/derived #,stx . 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[ @itemize[
@item{structures created through @scheme[define-serializable-struct] or @item{structures created through @scheme[serializable-struct] or
@scheme[define-serializable-struct/version], or more generally @scheme[serializable-struct/versions], or more generally
structures with the @scheme[prop:serializable] property (see structures with the @scheme[prop:serializable] property (see
@scheme[prop:serializable] for more information);} @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 ...) @defform[(serializable-struct id maybe-super (field ...)
struct-option ...)]{ 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 serializable with @scheme[serialize]. This form is allowed only at
the top level or in a module's top level (so that deserialization the top level or in a module's top level (so that deserialization
information can be found later). 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 type when all fields are mutable (or when the cycle can be broken
through some other mutable value). through some other mutable value).
In addition to the bindings generated by @scheme[define-struct], In addition to the bindings generated by @scheme[struct],
@scheme[define-serializable-struct] binds @scheme[serializable-struct] binds
@schemeidfont{deserialize-info:}@scheme[_id]@schemeidfont{-v0} to @schemeidfont{deserialize-info:}@scheme[_id]@schemeidfont{-v0} to
deserialization information. Furthermore, in a module context, it deserialization information. Furthermore, in a module context, it
automatically @scheme[provide]s this binding. automatically @scheme[provide]s this binding.
The @scheme[define-serializable-struct] form enables the construction The @scheme[serializable-struct] form enables the construction of
of structure instances from places where structure instances from places where @scheme[id] is not accessible,
@schemeidfont{make}@scheme[id] is not accessible, since since deserialization must construct instances. Furthermore,
deserialization must construct instances. Furthermore, @scheme[serializable-struct] provides limited access to field
@scheme[define-serializable-struct] provides limited access to field
mutation, but only for instances generated through the deserialization mutation, but only for instances generated through the deserialization
information bound to information bound to
@schemeidfont{deserialize-info:}@scheme[_id]@schemeidfont{-v0}. See @schemeidfont{deserialize-info:}@scheme[_id]@schemeidfont{-v0}. See
@ -368,9 +367,9 @@ information bound to
The @scheme[-v0] suffix on the deserialization enables future The @scheme[-v0] suffix on the deserialization enables future
versioning on the structure type through 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 compile-time information bound to the supertype identifier must
include all of the supertype's field accessors. If any field mutator include all of the supertype's field accessors. If any field mutator
is missing, the structure type will be treated as immutable for the 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[ @examples[
#:eval ser-eval #:eval ser-eval
(define-serializable-struct point (x y)) (serializable-struct point (x y))
(point-x (deserialize (serialize (make-point 1 2)))) (point-x (deserialize (serialize (point 1 2))))
]} ]}
@; ---------------------------------------------------------------------- @; ----------------------------------------------------------------------
@defform/subs[(define-serializable-struct/versions id-maybe-super vers (field ...) @defform[(define-serializable-struct id-maybe-super (field ...)
(other-version-clause ...) struct-option ...)]{
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 ([other-version-clause (other-vers make-proc-expr
cycle-make-proc-expr)])]{ cycle-make-proc-expr)])]{
Like @scheme[define-serializable-struct], but the generated Like @scheme[serializable-struct], but the generated deserializer
deserializer binding is binding is
@schemeidfont{deserialize-info:}@scheme[_id]@schemeidfont{-v}@scheme[vers]. In @schemeidfont{deserialize-info:}@scheme[_id]@schemeidfont{-v}@scheme[vers]. In
addition, addition,
@schemeidfont{deserialize-info:}@scheme[_id]@schemeidfont{-v}@scheme[other-vers] @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[ @examples[
#:eval ser-eval #:eval ser-eval
(define-serializable-struct point (x y) #:mutable #:transparent) (serializable-struct point (x y) #:mutable #:transparent)
(define ps (serialize (make-point 1 2))) (define ps (serialize (point 1 2)))
(deserialize ps) (deserialize ps)
(define x (make-point 1 10)) (define x (point 1 10))
(set-point-x! x x) (set-point-x! x x)
(define xs (serialize x)) (define xs (serialize x))
(deserialize xs) (deserialize xs)
(define-serializable-struct/versions point 1 (x y z) (serializable-struct/versions point 1 (x y z)
([0 ([0
(code:comment @#,t{Constructor for simple v0 instances:}) (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:}) (code:comment @#,t{Constructor for v0 instance in a cycle:})
(lambda () (lambda ()
(let ([p0 (make-point #f #f 0)]) (let ([p0 (point #f #f 0)])
(values (values
p0 p0
(lambda (p) (lambda (p)
(set-point-x! p0 (point-x p)) (set-point-x! p0 (point-x p))
(set-point-y! p0 (point-y p))))))]) (set-point-y! p0 (point-y p))))))])
#:mutable #:transparent) #:mutable #:transparent)
(deserialize (serialize (make-point 4 5 6))) (deserialize (serialize (point 4 5 6)))
(deserialize ps) (deserialize ps)
(deserialize xs) (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?] @defproc[(make-deserialize-info [make procedure?]
[cycle-make (-> (values any/c procedure?))]) [cycle-make (-> (values any/c procedure?))])
any]{ any]{