improve racket/serialize to handle cycles with mutable prefabs
This commit is contained in:
parent
0a7c65d066
commit
52d04449a1
|
@ -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)
|
||||||
|
|
|
@ -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.}
|
||||||
|
|
||||||
|
|
|
@ -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}
|
||||||
|
|
|
@ -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)))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user