racket/serialize: simpler handling of quotable values

This commit is contained in:
Matthew Flatt 2012-11-21 06:48:08 -07:00
parent 41e9e3e5ff
commit 20bdbb6d9b
2 changed files with 28 additions and 5 deletions

View File

@ -257,6 +257,17 @@
(hash-remove! tmp-cycle v)
(set! cycle-stack (cdr cycle-stack))]))))
(define (quotable? v)
(if (pair? v)
(eq? (car v) 'q)
(or (boolean? v)
(number? v)
(char? v)
(null? v)
(string? v)
(symbol? v)
(bytes? v))))
(define (serialize-one v share check-share? mod-map mod-map-cache)
(define ((serial check-share?) v)
(cond
@ -297,13 +308,20 @@
[(path-for-some-system? v)
(list* 'p+ (path->bytes v) (path-convention-type v))]
[(vector? v)
(cons (if (immutable? v) 'v 'v!)
(map (serial #t) (vector->list v)))]
(define elems (map (serial #t) (vector->list v)))
(if (and (immutable? v)
(andmap quotable? elems))
(cons 'q v)
(cons (if (immutable? v) 'v 'v!) elems))]
[(pair? v)
(let ([loop (serial #t)])
(cons 'c
(cons (loop (car v))
(loop (cdr v)))))]
(let ([a (loop (car v))]
[d (loop (cdr v))])
(cond
[(and (quotable? a) (quotable? d))
(cons 'q v)]
[else
(cons 'c (cons a d))])))]
[(mpair? v)
(let ([loop (serial #t)])
(cons 'm
@ -460,6 +478,7 @@
[else
(case (car v)
[(?) (lookup-shared! share (cdr v) mod-map module-path-index-join)]
[(q) (cdr v)]
[(f) (apply make-prefab-struct (cadr v) (map loop (cddr v)))]
[(void) (void)]
[(su) (string->unreadable-symbol (cdr v))]

View File

@ -209,6 +209,10 @@ elements:
a list of serials representing arguments to be
provided to the structure type's deserializer.}
@item{a pair whose @racket[car] is @racket['q] and whose
@racket[cdr] is an immutable value; it represents
the quoted value.}
@item{a pair whose @racket[car] is @racket['f]; it
represents an instance of a @tech{prefab} structure
type. The @racket[cadr] of the pair is a @tech{prefab}