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

Add procedure? as an acceptable type for prop:serialize's deserialize binder. (#2168)

Browse Source 
* Add allow the binder in prop:serialize to be a procedure.

This procedure is evaluated at serialize time, and is useful if
the deserializer is not known during object-type creation time,
but is during serialize time.

* Add docs+tests.

* Add a history note.
This commit is contained in:
Leif Andersen 2018-07-13 13:49:29 -04:00 committed by GitHub
parent cc4daf074f
commit 99fff46726
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 81 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
pkgs/racket-doc/scribblings/reference/serialization.scrbl
View File

@ -556,7 +556,8 @@ serializable. The property value should be constructed with
[deserialize-id (or identifier?
symbol?
(cons/c symbol?
module-path-index?))]
module-path-index?)
(-> any/c))]
[can-cycle? any/c]
[dir path-string?])
any]{
@ -590,6 +591,10 @@ must be one of the following:
a symbol to name an exported identifier, and the @racket[cdr] must be
a module path index to specify the exporting module.}
@item{If @racket[deserialize-id] is a procedure, then it is
applied during serialization and its result is used for
@racket[deserialize-id].}
]
See @racket[make-deserialize-info] and @racket[deserialize] for more
@ -605,7 +610,9 @@ resolve a module reference for the binding of @racket[deserialize-id].
This directory path is used as a last resort when
@racket[deserialize-id] indicates a module that was loaded through a
relative path with respect to the top level. Usually, it should be
@racket[(or (current-load-relative-directory) (current-directory))].}
@racket[(or (current-load-relative-directory) (current-directory))].
@history[#:changed "7.0.0.6" @elem{Allow @racket[deserialize-id] to be a procedure.}]}
@examples[
#:eval ser-eval

32
pkgs/racket-test-core/tests/racket/serialize.rktl
View File

@ -635,4 +635,36 @@
;; ----------------------------------------
(module interchange-deserialize racket/base
(provide (all-defined-out))
(require racket/serialize)
(define current-des #'interchange-des-a)
(define (set-current-des! val)
(set! current-des val))
(struct interchange ()
#:property prop:serializable
(make-serialize-info
(λ (this) (vector))
(λ () current-des)
#t
(or (current-load-relative-directory) (current-directory))))
(define interchange-des-a
(make-deserialize-info
(λ () 42)
(λ ()
(values 42
(λ (other) (void))))))
(define interchange-des-b
(make-deserialize-info
(λ () 43)
(λ ()
(values 43
(λ (other) (void)))))))
(require 'interchange-deserialize)
(test 42 'interchange-default (deserialize (serialize (interchange))))
(set-current-des! #'interchange-des-b)
(test 43 'interchange-alternate (deserialize (serialize (interchange))))
;; ----------------------------------------
(report-errs)

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

@ -118,43 +118,46 @@
(hash-ref
cache deserialize-id
(lambda ()
(let ([id
(let ([path+name
(cond
[(identifier? deserialize-id)
(let ([b (identifier-binding deserialize-id (variable-reference->phase varref))])
(cons
(and (list? b)
(if (symbol? (caddr b))
(caddr b)
(protect-path
(collapse/resolve-module-path-index
(caddr b)
(build-path (serialize-info-dir info)
"here.ss"))
rel-to)))
(syntax-e deserialize-id)))]
[(symbol? deserialize-id)
(cons #f deserialize-id)]
[else
(cons
(if (symbol? (cdr deserialize-id))
(cdr deserialize-id)
(protect-path
(collapse/resolve-module-path-index
(cdr deserialize-id)
(build-path (serialize-info-dir info)
"here.ss"))
rel-to))
(car deserialize-id))])])
(hash-ref
mod-map path+name
(lambda ()
(let ([id (hash-count mod-map)])
(hash-set! mod-map path+name id)
id))))])
(hash-set! cache deserialize-id id)
id)))))
(define id
(let ([path+name
(let loop ([deserialize-id deserialize-id])
(cond
[(procedure? deserialize-id)
(loop (deserialize-id))]
[(identifier? deserialize-id)
(let ([b (identifier-binding deserialize-id (variable-reference->phase varref))])
(cons
(and (list? b)
(if (symbol? (caddr b))
(caddr b)
(protect-path
(collapse/resolve-module-path-index
(caddr b)
(build-path (serialize-info-dir info)
"here.ss"))
rel-to)))
(syntax-e deserialize-id)))]
[(symbol? deserialize-id)
(cons #f deserialize-id)]
[else
(cons
(if (symbol? (cdr deserialize-id))
(cdr deserialize-id)
(protect-path
(collapse/resolve-module-path-index
(cdr deserialize-id)
(build-path (serialize-info-dir info)
"here.ss"))
rel-to))
(car deserialize-id))]))])
(hash-ref
mod-map path+name
(lambda ()
(let ([id (hash-count mod-map)])
(hash-set! mod-map path+name id)
id)))))
(hash-set! cache deserialize-id id)
id))))
(define (is-mutable? o)
(or (and (or (mpair? o)