use new 'serialized=?' to tighten setup scribble fixpoint
svn: r10428
This commit is contained in:
Matthew Flatt
parent
9431017d18
commit
3f60a478ad
|
|
@ -17,6 +17,8 @@
|
|||
serialize
|
||||
deserialize
|
||||
|
||||
serialized=?
|
||||
|
||||
deserialize-module-guard)
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -362,7 +364,7 @@
|
|||
|
||||
(define-struct not-ready (shares fixup))
|
||||
|
||||
(define (lookup-shared! share n mod-map)
|
||||
(define (lookup-shared! share n mod-map module-path-index-join)
|
||||
;; The shared list is not necessarily in order of
|
||||
;; refereds before referees. A `not-ready' object
|
||||
;; indicates a reference before a value is ready,
|
||||
|
|
@ -374,12 +376,12 @@
|
|||
(let* ([v (vector-ref (not-ready-shares sv) n)]
|
||||
[val (if (box? v)
|
||||
(deserial-shell (unbox v) mod-map (not-ready-fixup sv) n)
|
||||
(deserialize-one v share mod-map))])
|
||||
(deserialize-one v share mod-map module-path-index-join))])
|
||||
(vector-set! share n val)
|
||||
val)
|
||||
sv)))
|
||||
|
||||
(define (deserialize-one v share mod-map)
|
||||
(define (deserialize-one v share mod-map module-path-index-join)
|
||||
(let loop ([v v])
|
||||
(cond
|
||||
[(or (boolean? v)
|
||||
|
|
@ -398,7 +400,7 @@
|
|||
(apply (deserialize-info-maker info) (map loop (cdr v))))]
|
||||
[else
|
||||
(case (car v)
|
||||
[(?) (lookup-shared! share (cdr v) mod-map)]
|
||||
[(?) (lookup-shared! share (cdr v) mod-map module-path-index-join)]
|
||||
[(f) (apply make-prefab-struct (cadr v) (map loop (cddr v)))]
|
||||
[(void) (void)]
|
||||
[(u) (let ([x (cdr v)])
|
||||
|
|
@ -488,17 +490,39 @@
|
|||
[(mpi)
|
||||
(error 'deserialize "cannot restore module-path-index in cycle")])]))
|
||||
|
||||
(define (deserialize-with-map mod-map vers l module-path-index-join)
|
||||
(let ([share-n (list-ref l 2)]
|
||||
[shares (list-ref l 3)]
|
||||
[fixups (list-ref l 4)]
|
||||
[result (list-ref l 5)])
|
||||
;; Create vector for sharing:
|
||||
(let* ([fixup (make-vector share-n #f)]
|
||||
[share (make-vector share-n (make-not-ready
|
||||
(list->vector shares)
|
||||
fixup))])
|
||||
;; Deserialize into sharing array:
|
||||
(let loop ([n 0][l shares])
|
||||
(unless (= n share-n)
|
||||
(lookup-shared! share n mod-map module-path-index-join)
|
||||
(loop (add1 n) (cdr l))))
|
||||
;; Fixup shell for graphs
|
||||
(for-each (lambda (n+v)
|
||||
(let ([v (deserialize-one (cdr n+v) share mod-map module-path-index-join)])
|
||||
((vector-ref fixup (car n+v)) v)))
|
||||
fixups)
|
||||
;; Deserialize final result. (If there's no sharing, then
|
||||
;; all the work is actually here.)
|
||||
(deserialize-one result share mod-map module-path-index-join))))
|
||||
|
||||
(define (extract-version l)
|
||||
(if (pair? (car l))
|
||||
(values (caar l) (cdr l))
|
||||
(values 0 l)))
|
||||
|
||||
(define (deserialize l)
|
||||
(let-values ([(vers l)
|
||||
(if (pair? (car l))
|
||||
(values (caar l) (cdr l))
|
||||
(values 0 l))])
|
||||
(let-values ([(vers l) (extract-version l)])
|
||||
(let ([mod-map (make-vector (list-ref l 0))]
|
||||
[mod-map-l (list-ref l 1)]
|
||||
[share-n (list-ref l 2)]
|
||||
[shares (list-ref l 3)]
|
||||
[fixups (list-ref l 4)]
|
||||
[result (list-ref l 5)])
|
||||
[mod-map-l (list-ref l 1)])
|
||||
;; Load constructor mapping
|
||||
(let loop ([n 0][l mod-map-l])
|
||||
(unless (null? l)
|
||||
|
|
@ -512,21 +536,48 @@
|
|||
;; Register maker and struct type:
|
||||
(vector-set! mod-map n des))
|
||||
(loop (add1 n) (cdr l))))
|
||||
;; Create vector for sharing:
|
||||
(let* ([fixup (make-vector share-n #f)]
|
||||
[share (make-vector share-n (make-not-ready
|
||||
(list->vector shares)
|
||||
fixup))])
|
||||
;; Deserialize into sharing array:
|
||||
(let loop ([n 0][l shares])
|
||||
(unless (= n share-n)
|
||||
(lookup-shared! share n mod-map)
|
||||
(loop (add1 n) (cdr l))))
|
||||
;; Fixup shell for graphs
|
||||
(for-each (lambda (n+v)
|
||||
(let ([v (deserialize-one (cdr n+v) share mod-map)])
|
||||
((vector-ref fixup (car n+v)) v)))
|
||||
fixups)
|
||||
;; Deserialize final result. (If there's no sharing, then
|
||||
;; all the work is actually here.)
|
||||
(deserialize-one result share mod-map))))))
|
||||
(deserialize-with-map mod-map vers l module-path-index-join))))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(define (serialized=? l1 l2)
|
||||
(let-values ([(vers1 l1) (extract-version l1)]
|
||||
[(vers2 l2) (extract-version l2)])
|
||||
(let ([mod-map1 (make-vector (list-ref l1 0))]
|
||||
[mod-map1-l (list-ref l1 1)]
|
||||
[mod-map2 (make-vector (list-ref l2 0))]
|
||||
[mod-map2-l (list-ref l2 1)]
|
||||
[make-key (lambda (path+name)
|
||||
(if (car path+name)
|
||||
(let ([p (unprotect-path (car path+name))]
|
||||
[sym (cdr path+name)])
|
||||
(list p sym))
|
||||
(list #f (cdr path+name))))]
|
||||
[mpi-key (gensym)])
|
||||
(let ([keys1 (map make-key mod-map1-l)]
|
||||
[keys2 (map make-key mod-map2-l)]
|
||||
[ht (make-hash)]
|
||||
[mpij (lambda (a b) (vector mpi-key a b))])
|
||||
(for-each (lambda (key)
|
||||
(unless (hash-ref ht key #f)
|
||||
(hash-set! ht key (gensym))))
|
||||
(append keys1 keys2))
|
||||
(for-each (lambda (mod-map keys)
|
||||
(let loop ([n 0][l keys])
|
||||
(unless (null? l)
|
||||
(let ([sym (hash-ref ht (car l))])
|
||||
(vector-set! mod-map n
|
||||
(make-deserialize-info
|
||||
(lambda args
|
||||
(vector sym (list->vector args)))
|
||||
(lambda ()
|
||||
(let ([v (vector sym #f)])
|
||||
(values v
|
||||
(lambda (vec)
|
||||
(vector-set! v 1 (vector-ref vec 1)))))))))
|
||||
(loop (add1 n) (cdr l)))))
|
||||
(list mod-map1 mod-map2)
|
||||
(list keys1 keys2))
|
||||
(let ([v1 (deserialize-with-map mod-map1 vers1 l1 mpij)]
|
||||
[v2 (deserialize-with-map mod-map2 vers2 l2 mpij)])
|
||||
(equal? v1 v2)))))))
|
||||
|
|
|
|||
|
|
@ -58,13 +58,14 @@
|
|||
(let ([seen (make-hasheq)]
|
||||
[search-key #f])
|
||||
(let loop ([queue (list (list (caddr b) (cadddr b) (list-ref b 4) (list-ref b 5) (list-ref b 6)))]
|
||||
[rqueue null])
|
||||
[rqueue null]
|
||||
[need-result? #t])
|
||||
(cond
|
||||
[(null? queue)
|
||||
(if (null? rqueue)
|
||||
;; Not documented
|
||||
#f
|
||||
(loop (reverse rqueue) null))]
|
||||
(loop (reverse rqueue) null need-result?))]
|
||||
[else
|
||||
(let ([mod (list-ref (car queue) 0)]
|
||||
[id (list-ref (car queue) 1)]
|
||||
|
|
@ -80,77 +81,86 @@
|
|||
(not search-key))
|
||||
(set! search-key eb))
|
||||
(let ([v (and eb (resolve-search search-key part ri `(dep ,eb)))])
|
||||
(or (and v
|
||||
(let ([v (resolve-get/tentative part ri `(form ,eb))])
|
||||
(or (and v `(form ,eb))
|
||||
`(def ,eb))))
|
||||
;; Maybe it's re-exported from this module...
|
||||
;; Try a shortcut:
|
||||
(if (eq? rmp (and (car b) (module-path-index-resolve (car b))))
|
||||
;; Not defined through this path, so keep looking
|
||||
(loop queue rqueue)
|
||||
;; Check parents, if we can get the source:
|
||||
(if (and (path? (resolved-module-path-name rmp))
|
||||
(not (hash-ref seen rmp #f)))
|
||||
(let ([exports
|
||||
(hash-ref
|
||||
module-info-cache
|
||||
rmp
|
||||
(lambda ()
|
||||
(let-values ([(valss stxess)
|
||||
(with-handlers ([exn:fail?
|
||||
(lambda (exn)
|
||||
(values null null))])
|
||||
(module-compiled-exports
|
||||
(get-module-code (resolved-module-path-name rmp)
|
||||
#:choose (lambda (src zo so) 'zo))))])
|
||||
(let ([t
|
||||
;; Merge the two association lists:
|
||||
(let loop ([base valss]
|
||||
[stxess stxess])
|
||||
(cond
|
||||
[(null? stxess) base]
|
||||
[(assoc (caar stxess) base)
|
||||
=> (lambda (l)
|
||||
(loop (cons (cons (car l)
|
||||
(append (cdar stxess)
|
||||
(cdr l)))
|
||||
(remq l base))
|
||||
(cdr stxess)))]
|
||||
[else (loop (cons (car stxess)
|
||||
base)
|
||||
(cdr stxess))]))])
|
||||
(hash-set! module-info-cache rmp t)
|
||||
t))))])
|
||||
(hash-set! seen rmp #t)
|
||||
(let ([a (assq id (let ([a (assoc export-phase exports)])
|
||||
(if a
|
||||
(cdr a)
|
||||
null)))])
|
||||
(if a
|
||||
(loop queue
|
||||
(append (map (lambda (m)
|
||||
(if (pair? m)
|
||||
(list (module-path-index-rejoin (car m) mod)
|
||||
(list-ref m 2)
|
||||
defn-phase
|
||||
(list-ref m 1)
|
||||
(list-ref m 3))
|
||||
(list (module-path-index-rejoin m mod)
|
||||
id
|
||||
0
|
||||
0
|
||||
0)))
|
||||
(cadr a))
|
||||
rqueue))
|
||||
(begin
|
||||
;; A dead end may not be our fault: the files could
|
||||
;; have changed in inconsistent ways. So just say #f
|
||||
;; for now.
|
||||
#;
|
||||
(error 'find-scheme-tag
|
||||
"dead end when looking for binding source: ~e"
|
||||
id)
|
||||
#f))))
|
||||
;; Can't get the module source, so continue with queue:
|
||||
(loop queue rqueue)))))))])))))))
|
||||
(let* ([here-result
|
||||
(and need-result?
|
||||
v
|
||||
(let ([v (resolve-get/tentative part ri `(form ,eb))])
|
||||
(or (and v `(form ,eb))
|
||||
`(def ,eb))))]
|
||||
[need-result? (and need-result? (not here-result))])
|
||||
;; Even if we've found `here-result', look deeper so that we have
|
||||
;; consistent `dep' results.
|
||||
(let ([nest-result
|
||||
;; Maybe it's re-exported from this module...
|
||||
;; Try a shortcut:
|
||||
(if (eq? rmp (and (car b) (module-path-index-resolve (car b))))
|
||||
;; Not defined through this path, so keep looking
|
||||
(loop queue rqueue need-result?)
|
||||
;; Check parents, if we can get the source:
|
||||
(if (and (path? (resolved-module-path-name rmp))
|
||||
(not (hash-ref seen rmp #f)))
|
||||
(let ([exports
|
||||
(hash-ref
|
||||
module-info-cache
|
||||
rmp
|
||||
(lambda ()
|
||||
(let-values ([(valss stxess)
|
||||
(with-handlers ([exn:fail?
|
||||
(lambda (exn)
|
||||
(values null null))])
|
||||
(module-compiled-exports
|
||||
(get-module-code (resolved-module-path-name rmp)
|
||||
#:choose (lambda (src zo so) 'zo))))])
|
||||
(let ([t
|
||||
;; Merge the two association lists:
|
||||
(let loop ([base valss]
|
||||
[stxess stxess])
|
||||
(cond
|
||||
[(null? stxess) base]
|
||||
[(assoc (caar stxess) base)
|
||||
=> (lambda (l)
|
||||
(loop (cons (cons (car l)
|
||||
(append (cdar stxess)
|
||||
(cdr l)))
|
||||
(remq l base))
|
||||
(cdr stxess)))]
|
||||
[else (loop (cons (car stxess)
|
||||
base)
|
||||
(cdr stxess))]))])
|
||||
(hash-set! module-info-cache rmp t)
|
||||
t))))])
|
||||
(hash-set! seen rmp #t)
|
||||
(let ([a (assq id (let ([a (assoc export-phase exports)])
|
||||
(if a
|
||||
(cdr a)
|
||||
null)))])
|
||||
(if a
|
||||
(loop queue
|
||||
(append (map (lambda (m)
|
||||
(if (pair? m)
|
||||
(list (module-path-index-rejoin (car m) mod)
|
||||
(list-ref m 2)
|
||||
defn-phase
|
||||
(list-ref m 1)
|
||||
(list-ref m 3))
|
||||
(list (module-path-index-rejoin m mod)
|
||||
id
|
||||
0
|
||||
0
|
||||
0)))
|
||||
(cadr a))
|
||||
rqueue)
|
||||
need-result?)
|
||||
(begin
|
||||
;; A dead end may not be our fault: the files could
|
||||
;; have changed in inconsistent ways. So just say #f
|
||||
;; for now.
|
||||
#;
|
||||
(error 'find-scheme-tag
|
||||
"dead end when looking for binding source: ~e"
|
||||
id)
|
||||
#f))))
|
||||
;; Can't get the module source, so continue with queue:
|
||||
(loop queue rqueue need-result?)))])
|
||||
(or here-result
|
||||
nest-result))))))])))))))
|
||||
|
|
|
|||
|
|
@ -297,6 +297,30 @@ If a value provided to @scheme[serialize] is a simple tree (i.e., no
|
|||
sharing), then the fourth and fifth elements in the serialized
|
||||
representation will be empty.}
|
||||
|
||||
@; ----------------------------------------------------------------------
|
||||
|
||||
@defproc[(serialized=? [v1 any/c] [v2 any/c]) boolean?]{
|
||||
|
||||
Returns @scheme[#t] if @scheme[v1] and @scheme[v2] represent the same
|
||||
serialization information.
|
||||
|
||||
More precisely, it returns the same value that @scheme[(equal?
|
||||
(deserialize v1) (deserialize v2))] would return if
|
||||
|
||||
@itemize[
|
||||
|
||||
@item{all structure types whose deserializers are accessed with
|
||||
distinct module paths are actually distinct types;}
|
||||
|
||||
@item{all structure types are transparent; and}
|
||||
|
||||
@item{all structure instances contain only the constituent values
|
||||
recorded in each of @scheme[v1] and @scheme[v2].}
|
||||
|
||||
]}
|
||||
|
||||
@; ----------------------------------------------------------------------
|
||||
|
||||
@defparam[deserialize-module-guard guard (module-path? symbol? . -> . void?)]{
|
||||
|
||||
A parameter whose value is called by @scheme[deserialize] before
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@
|
|||
(define verbose (make-parameter #t))
|
||||
|
||||
(define-struct doc (src-dir src-spec src-file dest-dir flags under-main? category))
|
||||
(define-struct info (doc sci provides undef searches deps
|
||||
(define-struct info (doc sci provides undef searches deps known-deps
|
||||
build? time out-time need-run?
|
||||
need-in-write? need-out-write?
|
||||
vers rendered? failed?)
|
||||
|
|
@ -138,12 +138,14 @@
|
|||
(let ([one? #f]
|
||||
[added? #f]
|
||||
[deps (make-hasheq)]
|
||||
[known-deps (make-hasheq)]
|
||||
[all-main? (memq 'depends-all-main (doc-flags (info-doc info)))])
|
||||
(set-info-deps!
|
||||
info
|
||||
(map (lambda (d)
|
||||
(if (info? d) d (or (hash-ref src->info d #f) d)))
|
||||
(info-deps info)))
|
||||
;; Propagate existing dependencies as expected dependencies:
|
||||
(for ([d (info-deps info)])
|
||||
(let ([i (if (info? d) d (hash-ref src->info d #f))])
|
||||
(if i
|
||||
|
|
@ -159,7 +161,7 @@
|
|||
(printf " [Removed Dependency: ~a]\n"
|
||||
(doc-src-file (info-doc info))))))))
|
||||
(when (or (memq 'depends-all (doc-flags (info-doc info))) all-main?)
|
||||
;; Add all:
|
||||
;; Add all as expected dependency:
|
||||
(when (verbose)
|
||||
(printf " [Adding all~a as dependencies: ~a]\n"
|
||||
(if all-main? " main" "")
|
||||
|
|
@ -185,10 +187,20 @@
|
|||
(for ([k (info-undef info)])
|
||||
(let ([i (hash-ref ht k #f)])
|
||||
(if i
|
||||
(when (not (hash-ref deps i #f))
|
||||
(set! added? #t)
|
||||
(hash-set! deps i #t))
|
||||
(when first? (unless (eq? (car k) 'dep) (not-found k))))))
|
||||
(begin
|
||||
;; Record a definite dependency:
|
||||
(when (not (hash-ref known-deps i #f))
|
||||
(hash-set! known-deps i #t))
|
||||
;; Record also in the expected-dependency list:
|
||||
(when (not (hash-ref deps i #f))
|
||||
(set! added? #t)
|
||||
(when (verbose)
|
||||
(printf " [Adding... ~a]\n"
|
||||
(doc-src-file (info-doc i))))
|
||||
(hash-set! deps i #t)))
|
||||
(when first?
|
||||
(unless (eq? (car k) 'dep)
|
||||
(not-found k))))))
|
||||
(when first?
|
||||
(for ([(s-key s-ht) (info-searches info)])
|
||||
(unless (ormap (lambda (k) (hash-ref ht k #f))
|
||||
|
|
@ -199,6 +211,7 @@
|
|||
(printf " [Added Dependency: ~a]\n"
|
||||
(doc-src-file (info-doc info))))
|
||||
(set-info-deps! info (hash-map deps (lambda (k v) k)))
|
||||
(set-info-known-deps! info (hash-map known-deps (lambda (k v) k)))
|
||||
(set-info-need-in-write?! info #t)
|
||||
(set-info-need-run?! info #t))))
|
||||
;; If a dependency changed, then we need a re-run:
|
||||
|
|
@ -302,6 +315,10 @@
|
|||
(and (pair? cat)
|
||||
(eq? (car cat) 'omit))))
|
||||
|
||||
(define (any-order keys)
|
||||
(let ([ht (make-hash)])
|
||||
(for-each (lambda (k) (hash-set! ht k #t)) keys)
|
||||
ht))
|
||||
|
||||
(define (read-out-sxref)
|
||||
(fasl->s-exp (current-input-port)))
|
||||
|
|
@ -368,30 +385,21 @@
|
|||
(error "old info has wrong version or flags"))
|
||||
(make-info
|
||||
doc
|
||||
(list-ref v-out 1) ; sci
|
||||
(list-ref v-out 1) ; sci (leave serialized)
|
||||
(let ([v (list-ref v-out 2)]) ; provides
|
||||
(if (not (and (pair? v) ; temporary compatibility; used to be not serialized
|
||||
(pair? (car v))
|
||||
(integer? (caar v))))
|
||||
v
|
||||
(with-my-namespace
|
||||
(lambda ()
|
||||
(deserialize v)))))
|
||||
(with-my-namespace
|
||||
(lambda ()
|
||||
(deserialize v))))
|
||||
(let ([v (list-ref v-in 1)]) ; undef
|
||||
(if (not (and (pair? v) ; temporary compatibility; used to be not serialized
|
||||
(pair? (car v))
|
||||
(integer? (caar v))))
|
||||
v
|
||||
(with-my-namespace
|
||||
(lambda ()
|
||||
(deserialize v)))))
|
||||
(with-my-namespace
|
||||
(lambda ()
|
||||
(deserialize v))))
|
||||
(let ([v (list-ref v-in 3)]) ; searches
|
||||
(if (hash? v) ; temporary compatibility; used to be not serialized
|
||||
v
|
||||
(with-my-namespace
|
||||
(lambda ()
|
||||
(deserialize v)))))
|
||||
(map rel->path (list-ref v-in 2)) ; deps, in case we don't need to build...
|
||||
(with-my-namespace
|
||||
(lambda ()
|
||||
(deserialize v))))
|
||||
(map rel->path (list-ref v-in 2)) ; expected deps, in case we don't need to build...
|
||||
null ; known deps (none at this point)
|
||||
can-run?
|
||||
my-time info-out-time
|
||||
(and can-run? (memq 'always-run (doc-flags doc)))
|
||||
|
|
@ -421,8 +429,11 @@
|
|||
[defs (send renderer get-defined ci)]
|
||||
[searches (resolve-info-searches ri)]
|
||||
[need-out-write?
|
||||
(or (not (equal? (list (list vers (doc-flags doc)) sci defs)
|
||||
out-v))
|
||||
(or (not out-v)
|
||||
(not (equal? (list vers (doc-flags doc))
|
||||
(car out-v)))
|
||||
(not (serialized=? sci (cadr out-v)))
|
||||
(not (equal? (any-order defs) (any-order (deserialize (caddr out-v)))))
|
||||
(info-out-time . > . (current-seconds)))])
|
||||
(when (and (verbose) need-out-write?)
|
||||
(fprintf (current-error-port) " [New out ~a]\n" (doc-src-file doc)))
|
||||
|
|
@ -433,6 +444,7 @@
|
|||
(send renderer get-undefined ri)
|
||||
searches
|
||||
null ; no deps, yet
|
||||
null ; no known deps, yet
|
||||
can-run?
|
||||
-inf.0
|
||||
(if need-out-write?
|
||||
|
|
@ -485,10 +497,11 @@
|
|||
[sci (render-time "serialize" (send renderer serialize-info ri))]
|
||||
[defs (render-time "defined" (send renderer get-defined ci))]
|
||||
[undef (render-time "undefined" (send renderer get-undefined ri))]
|
||||
[in-delta? (not (equal? undef (info-undef info)))]
|
||||
[out-delta? (not (equal? (list sci defs)
|
||||
(list (info-sci info)
|
||||
(info-provides info))))])
|
||||
[in-delta? (not (equal? (any-order undef)
|
||||
(any-order (info-undef info))))]
|
||||
[out-delta? (or (not (serialized=? sci (info-sci info)))
|
||||
(not (equal? (any-order defs)
|
||||
(any-order (info-provides info)))))])
|
||||
(when (verbose)
|
||||
(printf " [~a~afor ~a]\n"
|
||||
(if in-delta? "New in " "")
|
||||
|
|
@ -501,7 +514,9 @@
|
|||
(set-info-sci! info sci)
|
||||
(set-info-provides! info defs)
|
||||
(set-info-undef! info undef)
|
||||
(when in-delta? (set-info-deps! info null)) ; recompute deps outside
|
||||
(when in-delta?
|
||||
;; Reset expected dependencies to known dependencies, and recompute later:
|
||||
(set-info-deps! info (info-known-deps info)))
|
||||
(when (or out-delta? (info-need-out-write? info))
|
||||
(unless latex-dest
|
||||
(render-time "xref-out" (write-out info)))
|
||||
|
|
|
|||
|
|
@ -4,16 +4,16 @@
|
|||
|
||||
(Section 'serialization)
|
||||
|
||||
(require mzlib/serialize)
|
||||
(require scheme/serialize)
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(define insp (current-inspector))
|
||||
|
||||
(define-serializable-struct a () insp)
|
||||
(define-serializable-struct b (x y) insp)
|
||||
(define-serializable-struct (c a) (z) insp)
|
||||
(define-serializable-struct (d b) (w) insp)
|
||||
(define-serializable-struct a () #:inspector insp #:mutable)
|
||||
(define-serializable-struct b (x y) #:inspector insp #:mutable)
|
||||
(define-serializable-struct (c a) (z) #:inspector insp #:mutable)
|
||||
(define-serializable-struct (d b) (w) #:inspector insp #:mutable)
|
||||
|
||||
(define (same? v1 v2)
|
||||
;; This is not quite the same as `equal?', veuase it knows
|
||||
|
|
@ -95,7 +95,9 @@
|
|||
(parameterize ([print-graph #t])
|
||||
(test #t serializable? v)
|
||||
(test #t same? v v)
|
||||
(test #t same? v (deserialize (serialize v)))))
|
||||
(test #t same? v (deserialize (serialize v)))
|
||||
(test #t serialized=? (serialize v) (serialize v))
|
||||
(test #f serialized=? (serialize v) (serialize (not v)))))
|
||||
|
||||
(define (mk-ht mk)
|
||||
(let ([ht (mk)])
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@
|
|||
|
||||
(module test2 mzscheme
|
||||
(require mzlib/unit
|
||||
test)
|
||||
'test)
|
||||
(define-unit u1 (import) (export s)
|
||||
(define a 1))
|
||||
(define-unit u2 (import s) (export)
|
||||
|
|
@ -25,15 +25,15 @@
|
|||
)
|
||||
|
||||
;; 4
|
||||
(require test2)
|
||||
(require 'test2)
|
||||
|
||||
(module test3 mzscheme
|
||||
(require mzlib/unit
|
||||
test)
|
||||
'test)
|
||||
(define-unit u1 (import) (export s)
|
||||
(define a 1))
|
||||
(define-values/invoke-unit u1 (import) (export (rename s)))
|
||||
(printf "~a~n" (+ y (z)))
|
||||
)
|
||||
;;4
|
||||
(require test3)
|
||||
(require 'test3)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user