improve racket/serialize to handle cycles with mutable prefabs
This commit is contained in:
parent
0a7c65d066
commit
52d04449a1
|
@ -130,7 +130,17 @@
|
|||
(vector? o)
|
||||
(hash? 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
|
||||
;; current cycle.
|
||||
|
@ -152,8 +162,8 @@
|
|||
(+ (hash-count share)
|
||||
(hash-count cycle)))
|
||||
|
||||
;; Traverses v to find cycles and charing. Shared
|
||||
;; object go in the `shared' table, and cycle-breakers go in
|
||||
;; Traverses v to find cycles and sharing. Shared
|
||||
;; objects go in the `shared' table, and cycle-breakers go in
|
||||
;; `cycle'. In each case, the object is mapped to a number that is
|
||||
;; incremented as shared/cycle objects are discovered, so
|
||||
;; when the objects are deserialized, build them in reverse
|
||||
|
@ -332,7 +342,11 @@
|
|||
[(hash? v)
|
||||
(cons 'h (append
|
||||
(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)
|
||||
(let ([mod-map (make-hasheq)]
|
||||
|
@ -491,7 +505,22 @@
|
|||
ht
|
||||
(lambda (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
|
||||
(case v
|
||||
[(c)
|
||||
|
|
|
@ -60,6 +60,15 @@ all content of the value is serializable. If a value given to
|
|||
@scheme[serialize] is not completely serializable, the
|
||||
@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
|
||||
data.}
|
||||
|
||||
|
|
|
@ -506,7 +506,7 @@ following items:
|
|||
any).}
|
||||
|
||||
@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.}
|
||||
|
||||
]
|
||||
|
@ -537,7 +537,10 @@ supplied @racket[v]s, the @exnraise[exn:fail:contract].
|
|||
|
||||
Returns a @tech{structure type descriptor} for the @tech{prefab}
|
||||
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}
|
||||
|
|
|
@ -270,6 +270,15 @@
|
|||
(test-ser (cons p1 p2))
|
||||
(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)))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(module ser-mod mzscheme
|
||||
|
|
Loading…
Reference in New Issue
Block a user