improve racket/serialize to handle cycles with mutable prefabs

This commit is contained in:
Matthew Flatt 2010-07-09 14:10:42 -06:00
parent 0a7c65d066
commit 52d04449a1
4 changed files with 57 additions and 7 deletions

View File

@ -130,7 +130,17 @@
(vector? o) (vector? o)
(hash? o)) (hash? o))
(not (immutable? o))) (not (immutable? o)))
(serializable-struct? o))) (serializable-struct? o)
(let ([k (prefab-struct-key o)])
(and k
;; Check whether all fields are mutable:
(pair? k)
(let-values ([(si skipped?) (struct-info o)])
(let loop ([si si])
(let*-values ([(name init auto acc mut imms super skipped?) (struct-type-info si)])
(and (null? imms)
(or (not super)
(loop super))))))))))
;; Finds a mutable object among those that make the ;; Finds a mutable object among those that make the
;; current cycle. ;; current cycle.
@ -152,8 +162,8 @@
(+ (hash-count share) (+ (hash-count share)
(hash-count cycle))) (hash-count cycle)))
;; Traverses v to find cycles and charing. Shared ;; Traverses v to find cycles and sharing. Shared
;; object go in the `shared' table, and cycle-breakers go in ;; objects go in the `shared' table, and cycle-breakers go in
;; `cycle'. In each case, the object is mapped to a number that is ;; `cycle'. In each case, the object is mapped to a number that is
;; incremented as shared/cycle objects are discovered, so ;; incremented as shared/cycle objects are discovered, so
;; when the objects are deserialized, build them in reverse ;; when the objects are deserialized, build them in reverse
@ -332,7 +342,11 @@
[(hash? v) [(hash? v)
(cons 'h (append (cons 'h (append
(if (not (hash-eq? v)) '(equal) null) (if (not (hash-eq? v)) '(equal) null)
(if (hash-weak? v) '(weak) null)))])) (if (hash-weak? v) '(weak) null)))]
[else
;; A mutable prefab
(cons 'pf (cons (prefab-struct-key v)
(sub1 (vector-length (struct->vector v)))))]))
(define (serialize v) (define (serialize v)
(let ([mod-map (make-hasheq)] (let ([mod-map (make-hasheq)]
@ -491,7 +505,22 @@
ht ht
(lambda (k v) (lambda (k v)
(hash-set! ht0 k v))))) (hash-set! ht0 k v)))))
ht0)])] ht0)]
[(pf)
;; Prefab
(let ([s (apply make-prefab-struct
(cadr v)
(vector->list (make-vector (cddr v) #f)))])
(vector-set! fixup n (lambda (v)
(let-values ([(si skipped?) (struct-info s)])
(let loop ([si si])
(let*-values ([(name init auto acc mut imms super skipped?) (struct-type-info si)])
(let ([count (+ init auto)])
(for ([i (in-range 0 count)])
(mut s i (acc v i)))
(when super
(loop super))))))))
s)])]
[else [else
(case v (case v
[(c) [(c)

View File

@ -60,6 +60,15 @@ all content of the value is serializable. If a value given to
@scheme[serialize] is not completely serializable, the @scheme[serialize] is not completely serializable, the
@exnraise[exn:fail:contract]. @exnraise[exn:fail:contract].
If @racket[v] contains a cycle (i.e., a collection of objects that
are all reachable from each other), then @racket[v] can be serialized
only if the cycle includes a mutable value, where a @tech{prefab}
structure counts as mutable only if all of its fields are mutable.
@margin-note{The @racket[serialize] and @racket[deserialize] functions
currently do not handle certain cyclic values that @racket[read] and
@racket[write] can handle, such as @racket['@#,read[(open-input-string "#0=(#0#)")]].}
See @scheme[deserialize] for information on the format of serialized See @scheme[deserialize] for information on the format of serialized
data.} data.}

View File

@ -506,7 +506,7 @@ following items:
any).} any).}
@item{Nothing else, if the structure type has no @item{Nothing else, if the structure type has no
supertype. Otherwise, the rest of the list matches is the key supertype. Otherwise, the rest of the list is the key
for the supertype.} for the supertype.}
] ]
@ -537,7 +537,10 @@ supplied @racket[v]s, the @exnraise[exn:fail:contract].
Returns a @tech{structure type descriptor} for the @tech{prefab} Returns a @tech{structure type descriptor} for the @tech{prefab}
structure type specified by the combination of @racket[key] and structure type specified by the combination of @racket[key] and
@racket[field-count].} @racket[field-count].
If the number of fields indicated by @racket[key] is inconsistent with
@racket[field-count], the @exnraise[exn:fail:contract].}
@;------------------------------------------------------------------------ @;------------------------------------------------------------------------
@section[#:tag "structinfo"]{Structure Type Transformer Binding} @section[#:tag "structinfo"]{Structure Type Transformer Binding}

View File

@ -269,6 +269,15 @@
(test-ser p2) (test-ser p2)
(test-ser (cons p1 p2)) (test-ser (cons p1 p2))
(test-ser (cons p2 p1))) (test-ser (cons p2 p1)))
(let ()
(struct a ([b #:mutable] [c #:mutable]) #:prefab)
(struct z a ([b #:mutable] [c #:mutable]) #:prefab)
(let ([z0 (z 1 2 3 4)])
(test-ser z0)
(set-z-b! z0 z0)
(test-ser z0)))
;; ---------------------------------------- ;; ----------------------------------------