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

cs: fix compile for non-serializable literals

Browse Source 
Lift and delay serialization for non-serializable literals when
using `compile`. Just `compile`ing such an expression is ok, but
it reports an error if there's an attempt to serialize (by printing)
the compiled value.

This improvment also brings Racket CS much more in line with
traditional Racket on the kinds of values that it is willing to
serialize. For example, non-prefab structures no longer serialize
(where deserializing in a new Racket run would produce an instance of
a distinct structure type). The exception type and error message also
now matches traditional Racket.

The improvement relies on a new argument to `s-exp->fasl` for handling
errors.
This commit is contained in:
Matthew Flatt 2019-10-18 14:04:30 -06:00
parent 014f3ab800
commit 588778d14c
8 changed files with 83 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
pkgs/racket-doc/scribblings/reference/fasl.scrbl
View File

@ -11,7 +11,8 @@
@deftogether[(
@defproc[(s-exp->fasl [v any/c]
[out (or/c output-port? #f) #f]
[#:keep-mutable? keep-mutable? any/c #f])
[#:keep-mutable? keep-mutable? any/c #f]
[#:handle-fail handle-fail (or/c #f (any/c . -> . any/c)) #f])
(or/c (void) bytes?)]
@defproc[(fasl->s-exp [in (or/c input-port? bytes?)]
[#:datum-intern? datum-intern? any/c #t])
@ -33,6 +34,15 @@ objects} mixed with those values. The byte string produced by
@racket[s-exp->fasl] does not use the same format as compiled code,
however.
If a value within @racket[v] is not valid as a @racket[quote]d
literal, and if @racket[handle-fail] is not @racket[#f], then
@racket[handle-fail] is called on the nested value, and the result of
@racket[handle-fail] is written in that value's place. The
@racket[handle-fail] procedure might raise an exception instead of
returning a replacement value. If @racket[handle-fail] is @racket[#f],
then the @exnraise[exn:fail:contract] when an invalid value is
encountered.
Like @racket[(compile `(quote ,v))], @racket[s-exp->fasl] does not
preserve graph structure, support cycles, or handle non-@tech{prefab}
structures. Compose @racket[s-exp->fasl] with @racket[serialize] to
@ -69,7 +79,8 @@ fasl
@history[#:changed "6.90.0.21" @elem{Made @racket[s-exp->fasl] format version-independent
and added the @racket[#:keep-mutable?]
and @racket[#:datum-intern?] arguments.}
#:changed "7.3.0.7" @elem{Added support for @tech{correlated objects}.}]}
#:changed "7.3.0.7" @elem{Added support for @tech{correlated objects}.}
#:changed "7.5.0.3" @elem{Added the @racket[#:handle-fail] argument.}]}
@; ----------------------------------------------------------------------

11
pkgs/racket-test-core/tests/racket/syntax.rktl
View File

@ -2244,6 +2244,17 @@
(f #f)))
(λ args (void))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check that `compile` works on non-serializable
(let ([c (compile (let ([c #f])
(lambda (v)
(begin0 c (set! c v)))))])
(test #t values (compiled-expression? c))
(test #t procedure? (eval c))
(err/rt-test (write c (open-output-bytes))
exn:fail?))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

14
racket/collects/racket/fasl.rkt
View File

@ -119,10 +119,14 @@
(define (s-exp->fasl v
[orig-o #f]
#:keep-mutable? [keep-mutable? #f])
#:keep-mutable? [keep-mutable? #f]
#:handle-fail [handle-fail #f])
(when orig-o
(unless (output-port? orig-o)
(raise-argument-error 'fasl->s-exp "(or/c output-port? #f)" orig-o)))
(when handle-fail
(unless (and (procedure? handle-fail) (procedure-arity-includes? handle-fail 1))
(raise-argument-error 'fasl->s-exp "(or/c (procedure-arity-includes/c 1) #f)" handle-fail)))
(define o (or orig-o (open-output-bytes)))
(define shared (make-hasheq))
(define shared-counter 0)
@ -353,9 +357,11 @@
[(eq? v unsafe-undefined)
(write-byte fasl-undefined-type o)]
[else
(raise-arguments-error 's-exp->fasl
"cannot write value"
"value" v)]))
(if handle-fail
(loop (handle-fail v))
(raise-arguments-error 's-exp->fasl
"cannot write value"
"value" v))]))
(get-output-bytes o #t)))
;; Record the number of entries in the shared-value table that is
;; used by `fasl-graph-ref-type` and `fasl-graph-ref-type`:

2
racket/src/cs/linklet.sls
View File

@ -448,7 +448,7 @@
(define-record-type linklet
(fields (mutable code) ; the procedure or interpretable form
paths ; list of paths; if non-empty, `code` expects them as arguments
paths ; list of paths and other fasled; if non-empty, `code` expects them as arguments
format ; 'compile or 'interpret (where the latter may have compiled internal parts)
(mutable preparation) ; 'faslable, 'faslable-strict, 'faslable-unsafe, 'callable, 'lazy, or (cons 'cross <machine>)
importss-abi ; ABI for each import, in parallel to `importss`

14
racket/src/schemify/path.rkt
View File

@ -15,6 +15,13 @@
;; return the list of path values. If `convert?`, then
;; change the schemified linklet to expect the paths
;; as arguments.
;;
;; In addition to paths, this extraction deals with values
;; that have been packages as `to-fasl`, either because they
;; are large values that are best handled in fasl form or
;; because they are not serializable (and we want to delay
;; complaining in case no serialization is needed).
(define (extract-paths-from-schemified-linklet linklet-e convert?)
(match linklet-e
[`(lambda . ,_)
@ -53,7 +60,7 @@
(lambda (orig-p)
(cond
[(to-fasl? orig-p)
(box (s-exp->fasl (force-unfasl orig-p)))]
(box (s-exp->fasl (force-unfasl orig-p) #:handle-fail cannot-fasl))]
[else
(define p (if (path-for-srcloc? orig-p)
(path-for-srcloc-path orig-p)
@ -97,3 +104,8 @@
[else
;; already forced (or never fasled)
v]))
(define (cannot-fasl v)
(error 'write
"cannot marshal value that is embedded in compiled code\n value: ~v"
v))

14
racket/src/schemify/quoted.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require racket/extflonum
racket/fixnum)
racket/fixnum
racket/unsafe/undefined)
(provide lift-quoted?
large-quoted?)
@ -32,7 +33,16 @@
[(box? q) (lift-quoted? (unbox q))]
[(prefab-struct-key q) #t]
[(extflonum? q) #t]
[else #f])))
[(or (null? q)
(number? q)
(char? q)
(boolean? q)
(symbol? q)
(eof-object? q)
(void? q)
(eq? q unsafe-undefined))
#f]
[else #t])))
;; Check whether a quoted value is large enough to be worth representing
;; in fasl format:

23
racket/src/schemify/serialize.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require racket/extflonum
racket/prefab
racket/unsafe/undefined
"match.rkt"
"wrap.rkt"
"path-for-srcloc.rkt"
@ -18,6 +19,11 @@
;; out and replace the use of a quoted value with a variable
;; reference. This lifting can interefere with optimizations, so only
;; lift as a last resort.
;;
;; Also lift out paths so they can be made relative, convert large
;; constants to fasl form, and lift out other non-serializable values
;; (so that `compile` will be ok, even though `write` cannot write out
;; those values).
(define (convert-for-serialize bodys for-cify? datum-intern?)
(define lifted-eq-constants (make-hasheq))
@ -244,7 +250,22 @@
new-q)]
[(extflonum? q)
`(string->number ,(format "~a" q) 10 'read)]
[else `(quote ,q)]))
[(or for-cify?
(null? q)
(number? q)
(char? q)
(boolean? q)
(symbol? q)
(eof-object? q)
(void? q)
(eq? q unsafe-undefined))
;; Serializable in-place:
`(quote ,q)]
[else
;; Lift out anything non-serializable, so we can deal with those
;; values like we deal with paths:
(define id (add-lifted (to-fasl (box q) #f)))
`(force-unfasl ,id)]))
(cond
[(and (quote? rhs)
(or (not for-cify?)

2
racket/src/schemify/to-fasl.rkt
View File

@ -2,6 +2,6 @@
(provide (struct-out to-fasl))
(struct to-fasl (vb ; box containing byte string as marhsaled or other as unmarshaled
(struct to-fasl (vb ; box containing byte string as marshaled or other as unmarshaled
wrt) ; directory for unmarshaling
#:mutable)