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

serializable-struct, etc.: export deserialization info in submodule

Browse Source 
This change is slightly incompatible, because `serializable-struct`,
`define-serializable-struct`, and `define-serializable-class` no
longer `provide` and identifier that they used to. Instead, the identifier
is provided by a `deserialize-info` submodule.

The deserializer looks for a `deserialize-info` submodule, and then
falls back to using a module if the submodule is not available.
This commit is contained in:
Matthew Flatt 2013-11-08 15:44:26 -07:00
parent 0bc89dc641
commit 90142edc5b
12 changed files with 115 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
pkgs/compatibility-pkgs/compatibility-lib/mzlib/serialize.rkt
View File

@ -1,7 +1,8 @@
(module serialize mzscheme
(require-for-syntax syntax/struct)
(require ;; core [de]serializer:
racket/private/serialize)
racket/private/serialize
(only racket/base module+))
(provide define-serializable-struct
define-serializable-struct/versions
@ -361,7 +362,7 @@
#`(begin
(define deserializer-id (make-deserialize-info #,(cadr other-version)
#,(caddr other-version)))
#,@(make-deserialize-provide stx #'deserializer-id))))
#,@(make-deserialize-provide stx #'deserializer-id))))
(define (make-deserialize-name id version-num)
(datum->syntax-object
@ -379,9 +380,10 @@
(list (quasisyntax/loc stx
(namespace-set-variable-value! '#,deserializer-id-stx
#,deserializer-id-stx )))
;; In a module; provide:
;; In a module; provide via submodule:
(list (quasisyntax/loc stx
(provide #,deserializer-id-stx)))))
(module+ deserialize-info
(provide #,deserializer-id-stx))))))
;; ------------------------------
;; The transformers

2
pkgs/racket-pkgs/racket-doc/scribblings/reference/class.scrbl
View File

@ -2249,7 +2249,7 @@ This form can only be used at the top level, either within a module
or outside. The @racket[class-id] identifier is bound to the new
class, and @racketidfont{deserialize-info:}@racket[class-id] is also
defined; if the definition is within a module, then the latter is
provided from the module.
provided from a @racket[deserialize-info] submodule via @racket[module+].
Serialization for the class works in one of two ways:

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

@ -392,7 +392,8 @@ In addition to the bindings generated by @racket[struct],
@racket[serializable-struct] binds
@racketidfont{deserialize-info:}@racket[_id]@racketidfont{-v0} to
deserialization information. Furthermore, in a module context, it
automatically @racket[provide]s this binding.
automatically @racket[provide]s this binding in a @racket[deserialize-info]
submodule using @racket[module+].
The @racket[serializable-struct] form enables the construction of
structure instances from places where @racket[id] is not accessible,
@ -550,7 +551,10 @@ must be one of the following:
@item{If @racket[deserialize-id] is an identifier, and if
@racket[(identifier-binding deserialize-id)] produces a list, then
the third element is used for the exporting module, otherwise the
top-level is assumed. In either case, @racket[syntax-e] is used to
top-level is assumed. Before trying an exporting module directly,
its @racket[deserialize-info] submodule is tried; the module
itself is tried if no @racket[deserialize-info]
submodule is available. In either case, @racket[syntax-e] is used to
obtain the name of an exported identifier or top-level definition.}
@item{If @racket[deserialize-id] is a symbol, it indicates a

41
pkgs/racket-pkgs/racket-test/tests/racket/serialize.rktl
View File

@ -478,6 +478,47 @@
;; ----------------------------------------
;; Custom deserialize:
(module my-own-deserialize racket/base
(require racket/serialize)
(provide a
deserialize-info)
(struct a ()
#:property prop:serializable
(make-serialize-info (lambda (v) #())
#'deserialize-info
#f
(or (current-load-relative-directory)
(current-directory))))
(define deserialize-info
(make-deserialize-info (lambda () 'a)
(lambda () (values 'a void)))))
(require 'my-own-deserialize)
(test 'a deserialize (serialize (a)))
;; Same thing, but with submodule:
(module my-own-deserialize/sub racket/base
(require racket/serialize)
(provide b)
(module+ deserialize-info
(provide deserialize-info))
(struct b ()
#:property prop:serializable
(make-serialize-info (lambda (v) #())
#'deserialize-info
#f
(or (current-load-relative-directory)
(current-directory))))
(define deserialize-info
(make-deserialize-info (lambda () 'b)
(lambda () (values 'b void)))))
(require 'my-own-deserialize/sub)
(test 'b deserialize (serialize (b)))
;; ----------------------------------------
(let ([fn (make-temporary-file)])
(with-output-to-file fn
#:exists 'truncate

1
pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/struct.scrbl
View File

@ -5,7 +5,6 @@
make-page-target-element make-redirect-target-element make-link-element
make-index-element
make-target-url target-url struct:target-url target-url? target-url-addr
deserialize-info:target-url-v0
toc-element-toc-content part-title-content paragraph-content
element? element-content element-style)
(for-label scribble/manual-struct

18
pkgs/scribble-pkgs/scribble-lib/scribble/core.rkt
View File

@ -352,7 +352,8 @@
[sizer (-> any)]
[plain (-> any)])))
(provide deserialize-delayed-element)
(module+ deserialize-info
(provide deserialize-delayed-element))
(define deserialize-delayed-element
(make-deserialize-info values values))
@ -396,7 +397,8 @@
[sizer (-> any)]
[plain (-> any)])))
(provide deserialize-part-relative-element)
(module+ deserialize-info
(provide deserialize-part-relative-element))
(define deserialize-part-relative-element
(make-deserialize-info values values))
@ -437,7 +439,8 @@
(provide/contract
(struct delayed-index-desc ([resolve (any/c part? resolve-info? . -> . any)])))
(provide deserialize-delayed-index-desc)
(module+ deserialize-info
(provide deserialize-delayed-index-desc))
(define deserialize-delayed-index-desc
(make-deserialize-info values values))
@ -457,7 +460,8 @@
(or (current-load-relative-directory) (current-directory)))
#:transparent)
(provide deserialize-collect-element)
(module+ deserialize-info
(provide deserialize-collect-element))
(define deserialize-collect-element
(make-deserialize-info values values))
@ -481,7 +485,8 @@
(or (current-load-relative-directory) (current-directory)))
#:transparent)
(provide deserialize-render-element)
(module+ deserialize-info
(provide deserialize-render-element))
(define deserialize-render-element
(make-deserialize-info values values))
@ -513,7 +518,8 @@
(provide (struct-out generated-tag))
(provide deserialize-generated-tag)
(module+ deserialize-info
(provide deserialize-generated-tag))
(define deserialize-generated-tag
(make-deserialize-info values values))

3
pkgs/scribble-pkgs/scribble-lib/scribble/struct.rkt
View File

@ -1,7 +1,6 @@
#lang scheme/base
(require (rename-in (except-in "core.rkt"
target-url struct:target-url target-url? target-url-addr
deserialize-info:target-url-v0)
target-url struct:target-url target-url? target-url-addr)
[make-target-url core:make-target-url])
"private/provide-structs.rkt"
"html-properties.rkt"

8
pkgs/serialize-cstruct-lib/ffi/serialize-cstruct.rkt
View File

@ -7,6 +7,7 @@
syntax/stx)
racket/promise
racket/serialize
racket/runtime-path
ffi/unsafe
(only-in '#%foreign ctype-c->scheme))
@ -67,7 +68,7 @@
[serialize-inplace (and (attribute serialize-inplace-kw) #t)]
[deserialize-inplace (and (attribute deserialize-inplace-kw) #t)])
(syntax/loc stx
(quasisyntax/loc stx
(begin
;; the wrapped cstruct
(define-cstruct _ID ([field-id type-expr] ...)
@ -99,7 +100,10 @@
(malloc _ID malloc-mode)))
;; deserialization proc
(provide deser-ID)
#,@(if (eq? (syntax-local-context) 'module)
#`((runtime-require (submod "." deserialize-info))
(module+ deserialize-info (provide deser-ID)))
null)
(define deser-ID (id->deserialize-info _ID _ID-pointer deserialize-inplace malloc-ID))
;; mode-aware make-ID

2
racket/collects/racket/HISTORY.txt
View File

@ -1,4 +1,6 @@
Version 5.90.0.10
Changed serializable-struct, etc. to provide deserialized-info:...
through a derialized-info submodule
Added chaperone-channel and impersonate-channel
Change string->path-element and bytes->path-element to raise an
exception for an empty [byte-]string argument

4
racket/collects/racket/private/class-internal.rkt
View File

@ -8,6 +8,7 @@
racket/stxparam
racket/unsafe/ops
"serialize-structs.rkt"
racket/runtime-path
(for-syntax racket/stxparam
syntax/kerncase
syntax/stx
@ -1711,7 +1712,8 @@
#'orig-stx))
(with-syntax ([deserialize-name-info deserialize-name-info]
[(provision ...) (if (eq? (syntax-local-context) 'module)
#`((provide #,deserialize-name-info))
#`((runtime-require (submod "." deserialize-info))
(module+ deserialize-info (provide #,deserialize-name-info)))
#'())])
#'(begin
(define-values (name deserialize-name-info)

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

@ -73,6 +73,16 @@
`(submod ,(unprotect-path (cadr p)) . ,(cddr p))]
[else p]))
;; A deserialization function is provided from a `deserialize-info`
;; module:
(define (add-submodule p)
(module-path-index-join '(submod "." deserialize-info)
(if (resolved-module-path? p)
p
(module-path-index-join
p
#f))))
(define (revive-symbol s)
(if (string? s)
(string->unreadable-symbol s)
@ -648,7 +658,12 @@
(let ([p (unprotect-path (car path+name))]
[sym (revive-symbol (cdr path+name))])
((deserialize-module-guard) p sym)
(dynamic-require p sym))
(let ([sub (add-submodule p)])
(if (module-declared? sub #t)
(dynamic-require sub sym)
;; On failure, for backward compatibility,
;; try module instead of submodule:
(dynamic-require p sym))))
(namespace-variable-value (cdr path+name)))])
;; Register maker and struct type:
(vector-set! mod-map n des))

32
racket/collects/racket/serialize.rkt
View File

@ -2,7 +2,8 @@
(module serialize racket/base
(require "private/serialize.rkt"
(for-syntax racket/base
racket/struct-info))
racket/struct-info)
racket/runtime-path)
(provide (all-from-out "private/serialize.rkt")
serializable-struct
@ -191,16 +192,25 @@
(syntax->list #'(make-proc-expr ...))
(syntax->list #'(cycle-make-proc-expr ...)))
;; =============== provide ===============
#,@(map (lambda (deserialize-id)
(if (eq? 'top-level (syntax-local-context))
;; Top level; in case deserializer-id-stx is macro-introduced,
;; explicitly use namespace-set-variable-value!
#`(namespace-set-variable-value! '#,deserialize-id
#,deserialize-id)
;; In a module; provide:
#`(provide #,deserialize-id)))
(cons deserialize-id
other-deserialize-ids))))]
;; If we're in a module context, then provide through
;; a submodule:
(#,@(if (eq? 'top-level (syntax-local-context))
#'(begin)
#'(module+ deserialize-info))
#,@(map (lambda (deserialize-id)
(if (eq? 'top-level (syntax-local-context))
;; Top level; in case deserializer-id-stx is macro-introduced,
;; explicitly use namespace-set-variable-value!
#`(namespace-set-variable-value! '#,deserialize-id
#,deserialize-id)
;; In a module; provide:
#`(provide #,deserialize-id)))
(cons deserialize-id
other-deserialize-ids)))
;; Make sure submodule is pulled along for run time:
#,@(if (eq? 'top-level (syntax-local-context))
null
#'((runtime-require (submod "." deserialize-info))))))]
;; -- More error cases ---
;; Check fields
[(_ orig-stx id/sup vers fields . _rest)