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

raco setup and scribble: fix problems tracking document changes

Browse Source 
Some non-transparent but serializable data structures broke
the comparison between previous and new outputs, which caused
too many document rebuilds.

Includes a change to make module path indexes work with `equal?'.
This commit is contained in:
Matthew Flatt 2013-07-11 15:44:22 -06:00
parent 4ee8dc2f5e
commit d5558a4fe0
12 changed files with 112 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
pkgs/racket-pkgs/racket-doc/scribblings/reference/module-reflect.scrbl
View File

@ -230,6 +230,10 @@ and marshaled form of other modules. The transient nature of resolved
names allows the module code to be loaded with a different resolved
name than the name when it was compiled.
Two @tech{module path index} values are @racket[equal?] when they have
@racket[equal?] path and base values (even if they have different
@tech{resolved} values).
@defproc[(module-path-index? [v any/c]) boolean?]{
Returns @racket[#t] if @racket[v] is a @tech{module path index},

53
pkgs/racket-pkgs/racket-index/setup/scribble.rkt
View File

@ -917,9 +917,22 @@
[dest-dir (pick-dest latex-dest doc)]
[fp (send renderer traverse (list v) (list dest-dir))]
[ci (send renderer collect (list v) (list dest-dir) fp)]
[ri (send renderer resolve (list v) (list dest-dir) ci)]
[ri (begin
;; It's ok if cross-reference information isn't available
;; at this point, but we can sometimes save another iteration
;; if the information is available at this pass.
(xref-transfer-info renderer ci (make-collections-xref
#:quiet-fail? #t
#:no-user? (main-doc? doc)
#:doc-db (and latex-dest
(find-doc-db-path latex-dest #t))))
(send renderer resolve (list v) (list dest-dir) ci))]
[out-vs (and info-out-time
(info-out-time . >= . src-time)
;; Don't force a re-write of "out" just because the document
;; is newer:
;; (info-out-time . >= . src-time)
;; We check further belew whether the "out" content actually
;; has changed to decide whether it must be written.
(with-handlers ([exn:fail? (lambda (exn) #f)])
(for/list ([info-out-file info-out-files])
(let ([v (load-sxref info-out-file)])
@ -930,20 +943,22 @@
[defss (send renderer get-defineds ci (add1 (doc-out-count doc)) v)]
[undef (send renderer get-external ri)]
[searches (resolve-info-searches ri)]
[need-out-write?
(or force-out-of-date?
(not out-vs)
(not (for/and ([out-v out-vs])
(equal? (list vers (doc-flags doc))
(car out-v))))
(not (for/and ([sci scis]
[out-v out-vs])
(serialized=? sci (cadr out-v))))
(not provides-time)
(info-out-time . > . provides-time)
(info-out-time . > . (current-seconds)))])
(when (and (verbose) need-out-write?)
(eprintf " [New out ~a]\n" (doc-src-file doc)))
[need-out-write
(or (and force-out-of-date? 'forced)
(and (not out-vs) 'missing)
(and (not (for/and ([out-v out-vs])
(equal? (list vers (doc-flags doc))
(car out-v))))
'version/flags)
(and (not (for/and ([sci scis]
[out-v out-vs])
(serialized=? sci (cadr out-v))))
'content)
(and (not provides-time) 'db-missing)
(and (info-out-time . > . provides-time) 'db-older)
(and (info-out-time . > . (current-seconds)) 'time-inversion))])
(when (and (verbose) need-out-write)
(printf " [New out (~a) ~a]\n" need-out-write (doc-src-file doc)))
(gc-point)
(let ([info
(make-info doc
@ -953,16 +968,16 @@
null ; no known deps, yet
can-run?
-inf.0
(if need-out-write?
(if need-out-write
(/ (current-inexact-milliseconds) 1000)
info-out-time)
#t
can-run?
need-out-write?
(and need-out-write #t)
vers
#f
#f)])
(when need-out-write?
(when need-out-write
(render-time "xref-out" (write-out/info latex-dest info scis defss db-file lock))
(set-info-need-out-write?! info #f))
(when (info-need-in-write? info)

3
pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt
View File

@ -3,6 +3,7 @@
(require "core.rkt"
"private/render-utils.rkt"
"html-properties.rkt"
"private/literal-anchor.rkt"
scheme/class
scheme/path
scheme/file
@ -119,8 +120,6 @@
[v (regexp-replace* #rx#"[^-a-zA-Z0-9_!+*'()/.,]" v encode-bytes)])
(bytes->string/utf-8 v))))
(define-serializable-struct literal-anchor (string))
(define (color->string c)
(if (string? c)
c

7
pkgs/scribble-pkgs/scribble-lib/scribble/private/literal-anchor.rkt Normal file
View File

@ -0,0 +1,7 @@
#lang racket/base
(require racket/serialize)
(provide (all-defined-out))
(define-serializable-struct literal-anchor (string)
#:transparent)

8
pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-class-struct.rkt Normal file
View File

@ -0,0 +1,8 @@
#lang racket/base
(require racket/serialize)
(provide (all-defined-out))
(define-serializable-struct cls/intf
(name-element app-mixins super intfs methods)
#:transparent)

4
pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-class.rkt
View File

@ -15,6 +15,7 @@
"manual-method.rkt"
"manual-proc.rkt"
"manual-vars.rkt"
"manual-class-struct.rkt"
scheme/list
(for-syntax scheme/base)
(for-label scheme/base
@ -56,9 +57,6 @@
(error 'scribble "no class/interface/mixin information for identifier: ~e"
id))))
(define-serializable-struct cls/intf
(name-element app-mixins super intfs methods))
(define (make-inherited-table r d ri decl)
(define start
(let ([key (find-scheme-tag d ri (decl-name decl) #f)])

4
pkgs/scribble-pkgs/scribble-lib/scribble/render-struct.rkt
View File

@ -3,4 +3,6 @@
(require scheme/serialize)
(provide (struct-out mobile-root))
(define-serializable-struct mobile-root (path) #:mutable)
(define-serializable-struct mobile-root (path)
#:mutable
#:transparent)

30
pkgs/scribble-pkgs/scribble-lib/setup/xref.rkt
View File

@ -48,17 +48,18 @@
null))
null)))))
(define ((dest->source done-ht) dest)
(define ((dest->source done-ht quiet-fail?) dest)
(if (hash-ref done-ht dest #f)
(lambda () #f)
(lambda ()
(hash-set! done-ht dest #t)
(with-handlers ([exn:fail? (lambda (exn)
(log-warning
"warning: ~a"
(if (exn? exn)
(exn-message exn)
(format "~e" exn)))
(unless quiet-fail?
(log-warning
"warning: ~a"
(if (exn? exn)
(exn-message exn)
(format "~e" exn))))
#f)])
(make-data+root
;; data to deserialize:
@ -66,7 +67,7 @@
;; provide a root for deserialization:
(path-only dest))))))
(define (make-key->source db-path no-user?)
(define (make-key->source db-path no-user? quiet-fail?)
(define main-db (cons (or db-path
(build-path (find-doc-dir) "docindex.sqlite"))
;; cache for a connection:
@ -79,7 +80,7 @@
(define forced-all? #f)
(define (force-all)
;; force all documents
(define thunks (get-reader-thunks no-user? done-ht))
(define thunks (get-reader-thunks no-user? quiet-fail? done-ht))
(set! forced-all? #t)
(lambda ()
;; return a procedure so we can produce a list of results:
@ -113,13 +114,13 @@
(and dest
(if (eq? dest #t)
(force-all)
((dest->source done-ht) dest)))]
((dest->source done-ht quiet-fail?) dest)))]
[else
(unless forced-all?
(force-all))])))
(define (get-reader-thunks no-user? done-ht)
(map (dest->source done-ht)
(define (get-reader-thunks no-user? quiet-fail? done-ht)
(map (dest->source done-ht quiet-fail?)
(filter values (append (get-dests 'scribblings no-user?)
(get-dests 'rendered-scribblings no-user?)))))
@ -131,8 +132,9 @@
cached-xref)))
(define (make-collections-xref #:no-user? [no-user? #f]
#:doc-db [db-path #f])
#:doc-db [db-path #f]
#:quiet-fail? [quiet-fail? #f])
(if (doc-db-available?)
(load-xref null
#:demand-source (make-key->source db-path no-user?))
(load-xref (get-reader-thunks no-user? (make-hash)))))
#:demand-source (make-key->source db-path no-user? quiet-fail?))
(load-xref (get-reader-thunks no-user? quiet-fail? (make-hash)))))

3
racket/lib/collects/racket/HISTORY.txt
View File

@ -1,3 +1,6 @@
Version 5.3.900.7
Changed equal? to work on module path index values
Version 5.3.900.6
Added identifier-binding-symbol
Changed ".plt" file unpacking to require certain literal S-expression

11
racket/src/racket/src/bool.c
View File

@ -698,6 +698,17 @@ int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql)
obj1 = SCHEME_PTR_VAL(obj1);
obj2 = SCHEME_PTR_VAL(obj2);
goto top;
} else if (t1 == scheme_module_index_type) {
Scheme_Modidx *midx1, *midx2;
# include "mzeqchk.inc"
midx1 = (Scheme_Modidx *)obj1;
midx2 = (Scheme_Modidx *)obj2;
if (is_equal(midx1->path, midx2->path, eql)) {
obj1 = midx1->base;
obj2 = midx2->base;
goto top;
} else
return 0;
} else if (t1 == scheme_place_bi_channel_type) {
Scheme_Place_Bi_Channel *bc1, *bc2;
bc1 = (Scheme_Place_Bi_Channel *)obj1;

22
racket/src/racket/src/hash.c
View File

@ -1487,6 +1487,18 @@ static uintptr_t equal_hash_key(Scheme_Object *o, uintptr_t k, Hash_Info *hi)
o = SCHEME_PTR_VAL(o);
}
break;
case scheme_module_index_type:
{
Scheme_Modidx *midx = (Scheme_Modidx *)o;
# include "mzhashchk.inc"
hi->depth += 2;
k++;
k = (k << 3) + k;
k += equal_hash_key(midx->path, 0, hi);
o = midx->base;
break;
}
break;
case scheme_place_bi_channel_type:
{
k += 7;
@ -1911,6 +1923,16 @@ static uintptr_t equal_hash_key2(Scheme_Object *o, Hash_Info *hi)
/* Needed for interning */
o = SCHEME_PTR_VAL(o);
goto top;
case scheme_module_index_type:
{
Scheme_Modidx *midx = (Scheme_Modidx *)o;
uintptr_t v1, v2;
# include "mzhashchk.inc"
hi->depth += 2;
v1 = equal_hash_key2(midx->path, hi);
v2 = equal_hash_key2(midx->base, hi);
return v1 + v2;
}
case scheme_place_bi_channel_type:
/* a bi channel has sendch and recvch, but
sends are the same iff recvs are the same: */

4
racket/src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "5.3.900.6"
#define MZSCHEME_VERSION "5.3.900.7"
#define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 3
#define MZSCHEME_VERSION_Z 900
#define MZSCHEME_VERSION_W 6
#define MZSCHEME_VERSION_W 7
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)