suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

another fix to serializer for cycles containing immutable

Browse Source 
When walking up the cycle chain to find the mutable item,
intermediate items need to be marked as potentially
shared, and a mutable item should not be added more
than once.
This commit is contained in:
Matthew Flatt 2016-05-16 19:07:25 -06:00
parent 6ba3461738
commit f1bba3c2d0
1 changed files with 20 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
racket/collects/racket/private/serialize.rkt
View File

@ -171,18 +171,24 @@
;; Finds a mutable object among those that make the ;; Finds a mutable object among those that make the
;; current cycle. ;; current cycle.
(define (find-mutable v cycle-stack) (define (find-mutable v cycle-stack share cycle)
;; Walk back through cycle-stack to find something ;; Walk back through cycle-stack to find something
;; mutable. If we get to v without anything being ;; mutable. If we get to v without anything being
;; mutable, then we're stuck. ;; mutable, then we're stuck.
(let ([o (car cycle-stack)]) (define (potentially-shared! v)
(unless (hash-ref share v #f)
(hash-set! share v (share-id share cycle))))
(potentially-shared! v)
(let loop ([cycle-stack cycle-stack])
(define o (car cycle-stack))
(cond (cond
[(eq? o v) [(eq? o v)
(error 'serialize "cannot serialize cycle of immutable values: ~e" v)] (error 'serialize "cannot serialize cycle of immutable values: ~e" v)]
[(is-mutable? o) [(is-mutable? o)
o] o]
[else [else
(find-mutable v (cdr cycle-stack))]))) (potentially-shared! o)
(loop (cdr cycle-stack))])))
(define (share-id share cycle) (define (share-id share cycle)
@ -219,11 +225,9 @@
;; part of a cycle. ;; part of a cycle.
(let ([mut-v (if (is-mutable? v) (let ([mut-v (if (is-mutable? v)
v v
(find-mutable v cycle-stack))]) (find-mutable v cycle-stack share cycle))])
(hash-set! cycle mut-v (share-id share cycle)) (unless (hash-ref cycle mut-v #f)
(unless (eq? mut-v v) (hash-set! cycle mut-v (share-id share cycle))))]
;; This value is potentially shared
(hash-set! share v (share-id share cycle))))]
[(hash-ref share v #f) [(hash-ref share v #f)
;; We already know that this value is shared ;; We already know that this value is shared
(void)] (void)]
@ -266,9 +270,9 @@
[(date? v) [(date? v)
(for-each loop (take (struct->list v) 10))] (for-each loop (take (struct->list v) 10))]
[(hash? v) [(hash? v)
(hash-for-each v (lambda (k v) (for ([(k v) (in-hash v)])
(loop k) (loop k)
(loop v)))] (loop v))]
[(arity-at-least? v) [(arity-at-least? v)
(loop (arity-at-least-value v))] (loop (arity-at-least-value v))]
[(module-path-index? v) [(module-path-index? v)
@ -376,9 +380,9 @@
(if (hash-eqv? v) '(eqv) null) (if (hash-eqv? v) '(eqv) null)
(if (hash-weak? v) '(weak) null)) (if (hash-weak? v) '(weak) null))
(let ([loop (serial #t)]) (let ([loop (serial #t)])
(hash-map v (lambda (k v) (for/list ([(k v) (in-hash v)])
(cons (loop k) (cons (loop k)
(loop v))))))] (loop v)))))]
[(date*? v) [(date*? v)
(cons 'date* (cons 'date*
(map (serial #t) (take (struct->list v) 12)))] (map (serial #t) (take (struct->list v) 12)))]
@ -589,10 +593,8 @@
;; Hash table ;; Hash table
(let ([ht0 (make-hash/flags (cdr v))]) (let ([ht0 (make-hash/flags (cdr v))])
(vector-set! fixup n (lambda (ht) (vector-set! fixup n (lambda (ht)
(hash-for-each (for ([(k v) (in-hash ht)])
ht (hash-set! ht0 k v))))
(lambda (k v)
(hash-set! ht0 k v)))))
ht0)] ht0)]
[(pf) [(pf)
;; Prefab ;; Prefab