diff --git a/pkgs/racket-doc/scribblings/foreign/serialize-cstruct.scrbl b/pkgs/racket-doc/scribblings/foreign/serialize-cstruct.scrbl index 416b4206fe..a837fae1b6 100644 --- a/pkgs/racket-doc/scribblings/foreign/serialize-cstruct.scrbl +++ b/pkgs/racket-doc/scribblings/foreign/serialize-cstruct.scrbl @@ -1,8 +1,15 @@ #lang scribble/doc @(require "utils.rkt" (for-label racket/serialize - ffi/serialize-cstruct) - scribble/racket) + ffi/serialize-cstruct + (except-in ffi/unsafe ->)) + scribble/racket + scribble/example) + +@(define serialize-eval (make-base-eval)) +@examples[#:eval serialize-eval #:hidden (require ffi/serialize-cstruct + ffi/unsafe + racket/serialize)] @title[#:tag "serialize-struct"]{Serializable C Struct Types} @@ -14,13 +21,49 @@ (code:line #:malloc-mode malloc-mode-expr) (code:line #:serialize-inplace) (code:line #:deserialize-inplace) + (code:line #:version vers) + (code:line #:other-versions ([other-vers deserialize-chain-expr + convert-proc-expr + unconvert-proc-expr + cycle-convert-proc-expr] + ...)) (code:line #:property prop-expr val-expr))]]{ -Like @racket[define-cstruct], but defines a serializable type. -In addition to the bindings created by @racket[define-cstruct], -@racketidfont{make-@racketvarfont{id}/mode} is bound to a function that behaves -like @racketidfont{make-@racketvarfont{id}} but uses the mode or allocator -specified via @racket[malloc-mode-expr]. +Like @racket[define-cstruct], but defines a serializable type, with +several changed additional bindings: + +@itemize[ + + @item{@racketidfont{make-@racketvarfont{id}} --- always uses + @racket['atomic] allocation, even if @racket[#:malloc-mode] is + specified (for historical reasons).} + + @item{@racketidfont{make-@racketvarfont{id}/mode} --- like behaves + like @racketidfont{make-@racketvarfont{id}} but uses the mode + or allocator specified via @racket[malloc-mode-expr] (for + historical reasons).} + + @item{@racketidfont{deserialize:cstruct:@racketvarfont{id}} (for a + @racket[vers] of @racket[0]) or + @racketidfont{deserialize:cstruct:@racketvarfont{id}-v@racketvarfont{vers}} + (for a @racket[vers] of @racket[1] or more) --- deserialization information that is + automatically exported from a @racket[deserialize-info] submodule.} + + @item{@racketidfont{deserialize-chain:cstruct:@racketvarfont{id}} + (for a @racket[vers] of @racket[0]) or + @racketidfont{deserialize-chain:cstruct:@racketvarfont{id}-v@racketvarfont{vers}} + (for a @racket[vers] of @racket[1] or more) --- deserialization + information for use via @racket[#:other-versions] in other + @racket[define-serializable-cstruct] forms.} + + @item{@racketidfont{deserialize:cstruct:@racketvarfont{id}} (for an + @racket[other-vers] of @racket[0]) or + @racketidfont{deserialize:cstruct:@racketvarfont{id}-v@racketvarfont{other-vers}} + (for an @racket[other-vers] of @racket[1] or more) --- + deserialization information that is automatically exported from + a @racket[deserialize-info] submodule.} + +] Instances of the new type fulfill the @racket[serializable?] predicate and can be used with @racket[serialize] and @racket[deserialize]. Serialization may @@ -28,6 +71,28 @@ fail if one of the fields contains an arbitrary pointer, an embedded non-serializable C struct, or a pointer to a non-serializable C struct. Array-types are supported as long as they don't contain one of these types. +The default @racket[vers] is @racket[0], and @racket[vers] must be a +literal, exact, non-negative integer. An @racket[#:other-versions] +clause provides deserializers for previous versions of the structure +with the name @racketvarfont{id}, so that previously serialized data can be +deserialized after a change to the declaration of @racketvarfont{id}. For +each @racket[other-vers], @racket[deserialize-chain-expr] should be +the value of a +@racketidfont{deserialize:cstruct:@racketvarfont{other-id}} binding +for some other @racket{other-id} declared with +@racket[define-serializable-cstruct] that has the same shape that the +previous version of @racketvarfont{id}; the function produced by +@racket[convert-proc-expr] should convert an instance of +@racket[_other-id] to an instance of @racketvarfont{id}. The functions +produced by @racket[unconvert-proc-expr] and +@racket[cycle-convert-proc-expr] are used if a record is involved in a +cycle; the function from @racket[unconvert-proc-expr] takes an +@racketvarfont{id} instance produced by @racket[convert-proc-expr]'s function +back to a @racket[_other-id], while @racket[cycle-convert-proc-expr] +returns two values: a shell instance of @racketidfont{id} and function to +accept a filled @racket[_other-id] whose content should be moved to +the shell instance of @racketidfont{id}. + The @racket[malloc-mode-expr] arguments control the memory allocation for this type during deserialization and @racketidfont{make-@racketvarfont{id}/mode}. It can be one of the mode @@ -55,6 +120,66 @@ When the C struct contains pointers, it is advisable to use a custom allocator. It should be based on a non-moving-memory allocation like @racket['raw], potentially with manual freeing to avoid memory leaks after garbage collection. -} +@history[#:changed "1.1" @elem{Added @racket[#:version] and @racket[#:other-versions].}] + +@examples[ +#:eval serialize-eval +(define-serializable-cstruct _fish ([color _int])) +(define f0/s (serialize (make-fish 1))) +(fish-color (deserialize f0/s)) + +(define-serializable-cstruct _aq ([a _fish-pointer] + [d _aq-pointer/null]) + #:malloc-mode 'nonatomic) +(define aq1 (make-aq/mode (make-fish 6) #f)) +(code:line (set-aq-d! aq1 aq1) (code:comment "create a cycle")) +(define aq0/s (serialize aq1)) +(aq-a (aq-d (aq-d (deserialize aq0/s)))) +(code:comment @#,elem{Same shape as original @racket[aq]:}) +(define-serializable-cstruct _old-aq ([a _fish-pointer] + [d _pointer]) + #:malloc-mode 'nonatomic) +(code:comment @#,elem{Replace the original @racket[aq]:}) +(define-serializable-cstruct _aq ([a _fish-pointer] + [b _fish-pointer] + [d _aq-pointer/null]) + #:malloc-mode 'nonatomic + #:version 1 + #:other-versions ([0 deserialize-chain:cstruct:old-aq + (lambda (oa) + (make-aq/mode (old-aq-a oa) + (old-aq-a oa) + (cast (old-aq-d oa) _pointer _aq-pointer))) + (lambda (a) + (make-old-aq/mode (aq-a a) + (aq-d a))) + (lambda () + (define tmp-fish (make-fish 0)) + (define a (make-aq/mode tmp-fish tmp-fish #f)) + (values a + (lambda (oa) + (set-aq-a! a (old-aq-a oa)) + (set-aq-b! a (old-aq-a oa)) + (set-aq-d! a (cast (old-aq-d oa) _pointer _aq-pointer)))))])) +(code:comment "Deserialize old instance to new cstruct:") +(fish-color (aq-a (aq-d (aq-d (deserialize aq0/s))))) + +(define aq1/s (serialize (make-aq (make-fish 1) (make-fish 2) #f))) +(code:comment @#,elem{New version of @racket[fish]:}) +(define-serializable-cstruct _old-fish ([color _int])) +(define-serializable-cstruct _fish ([weight _float] + [color _int]) + #:version 1 + #:other-versions ([0 deserialize-chain:cstruct:old-fish + (lambda (of) + (make-fish 10.0 (old-fish-color of))) + (lambda (a) (error "cycles not possible!")) + (lambda () (error "cycles not possible!"))])) +(code:comment @#,elem{Deserialized content upgraded to new @racket[fish]:}) +(fish-color (aq-b (deserialize aq1/s))) +(fish-weight (aq-b (deserialize aq1/s))) +]} + +@close-eval[serialize-eval] diff --git a/pkgs/racket-test-extra/info.rkt b/pkgs/racket-test-extra/info.rkt index 963e7a3832..0449833d41 100644 --- a/pkgs/racket-test-extra/info.rkt +++ b/pkgs/racket-test-extra/info.rkt @@ -7,4 +7,6 @@ (define pkg-authors '(eli jay matthias mflatt robby ryanc samth)) (define build-deps '("base" "redex-lib" - "scheme-lib")) + "scheme-lib" + "rackunit-lib" + "serialize-cstruct-lib")) diff --git a/pkgs/racket-test-extra/tests/ffi/serialize-cstruct.rkt b/pkgs/racket-test-extra/tests/ffi/serialize-cstruct.rkt new file mode 100644 index 0000000000..7cd1881dad --- /dev/null +++ b/pkgs/racket-test-extra/tests/ffi/serialize-cstruct.rkt @@ -0,0 +1,122 @@ +#lang racket/base +(require rackunit + racket/serialize + ffi/unsafe + ffi/serialize-cstruct) + +(define-serializable-cstruct _point ([x _double] + [y _int])) + +(check-equal? (point-x (deserialize (serialize (make-point 1.0 2)))) + 1.0) +(check-equal? (point-y (deserialize (serialize (make-point 1.1 3)))) + 3) + + +(define-serializable-cstruct _fish ([color _int]) + #:version 1) + +(check-equal? (fish-color (deserialize (serialize (make-fish 4)))) + 4) + +(define-serializable-cstruct _aq ([a _fish-pointer] + [d _aq-pointer/null]) + #:malloc-mode 'nonatomic) + +(define aq1 (make-aq/mode (make-fish 6) #f)) +(set-aq-d! aq1 aq1) +(check-equal? (let ([a (deserialize (serialize aq1))]) + (list (ptr-equal? a (aq-d a)) + (fish-color (aq-a (aq-d a))))) + (list #t 6)) + +(define old-pond + (parameterize ([current-namespace (make-base-namespace)]) + (eval + '(module pond racket/base + (require ffi/unsafe + ffi/serialize-cstruct) + (provide make-pond) + (define-serializable-cstruct _pond ([depth _float])))) + (eval '(require 'pond racket/serialize)) + (eval '(serialize (make-pond 8.0))))) + +(check-equal? + (parameterize ([current-namespace (make-base-namespace)]) + (eval + '(module pond racket/base + (require ffi/unsafe + ffi/serialize-cstruct) + (provide pond-depth) + (define-serializable-cstruct _old-pond ([depth _float])) + (define-serializable-cstruct _pond ([num-fish _int] + [depth _float]) + #:version 1 + #:other-versions ([0 deserialize-chain:cstruct:old-pond + (lambda (op) + (make-pond 0 (old-pond-depth op))) + (lambda (p) + (make-old-pond (pond-depth p))) + (lambda () + (define p (make-pond 0 0)) + (values p + (lambda (op) + (set-pond-depth! p (old-pond-depth op)))))])))) + (eval '(require 'pond racket/serialize)) + (eval `(pond-depth (deserialize ',old-pond)))) + 8.0) + + +(define old-aq + (parameterize ([current-namespace (make-base-namespace)]) + (eval + '(module aq racket/base + (require ffi/unsafe + ffi/serialize-cstruct) + (provide make-aq/mode make-fish set-aq-d!) + (define-serializable-cstruct _fish ([color _int])) + (define-serializable-cstruct _aq ([a _fish-pointer] + [d _aq-pointer/null]) + #:malloc-mode 'nonatomic))) + (eval '(require 'aq racket/serialize)) + (eval '(serialize + (let ([aq1 (make-aq/mode (make-fish 7) #f)]) + (set-aq-d! aq1 aq1) + aq1))))) + +(check-equal? + (parameterize ([current-namespace (make-base-namespace)]) + (eval + '(module aq racket/base + (require ffi/unsafe + ffi/serialize-cstruct) + (provide aq-a aq-b aq-d + fish-color) + (define-serializable-cstruct _fish ([color _int])) + (define-serializable-cstruct _old-aq ([a _fish-pointer] + [d _pointer]) + #:malloc-mode 'nonatomic) + (define-serializable-cstruct _aq ([a _fish-pointer] + [b _fish-pointer] + [d _aq-pointer/null]) + #:malloc-mode 'nonatomic + #:version 1 + #:other-versions ([0 deserialize-chain:cstruct:old-aq + (lambda (oa) + (make-aq/mode (old-aq-a oa) + (old-aq-a oa) + (cast (old-aq-d oa) _pointer _aq-pointer))) + (lambda (a) + (make-old-aq/mode (aq-a a) + (aq-d a))) + (lambda () + (define tmp-fish (make-fish 0)) + (define a (make-aq/mode tmp-fish tmp-fish #f)) + (values a + (lambda (oa) + (set-aq-a! a (old-aq-a oa)) + (set-aq-b! a (old-aq-a oa)) + (set-aq-d! a (cast (old-aq-d oa) _pointer _aq-pointer)))))])))) + (eval '(require 'aq racket/serialize)) + (eval `(fish-color (aq-b (aq-d (deserialize ',old-aq)))))) + 7)