diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/reference/module-reflect.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/reference/module-reflect.scrbl index 9935869bd0..9c9e4051ff 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/reference/module-reflect.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/reference/module-reflect.scrbl @@ -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}, diff --git a/pkgs/racket-pkgs/racket-index/setup/scribble.rkt b/pkgs/racket-pkgs/racket-index/setup/scribble.rkt index 75ec5f9d5c..97c868d6df 100644 --- a/pkgs/racket-pkgs/racket-index/setup/scribble.rkt +++ b/pkgs/racket-pkgs/racket-index/setup/scribble.rkt @@ -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) diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt index 21a9884a22..3d2dd7cc66 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt @@ -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 diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/private/literal-anchor.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/private/literal-anchor.rkt new file mode 100644 index 0000000000..e7b445642b --- /dev/null +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/private/literal-anchor.rkt @@ -0,0 +1,7 @@ +#lang racket/base +(require racket/serialize) + +(provide (all-defined-out)) + +(define-serializable-struct literal-anchor (string) + #:transparent) diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-class-struct.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-class-struct.rkt new file mode 100644 index 0000000000..40c41dbf92 --- /dev/null +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-class-struct.rkt @@ -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) diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-class.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-class.rkt index b2edd921cd..5e09fba65d 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-class.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-class.rkt @@ -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)]) diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/render-struct.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/render-struct.rkt index 7ad90ec2eb..24b27b5404 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/render-struct.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/render-struct.rkt @@ -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) diff --git a/pkgs/scribble-pkgs/scribble-lib/setup/xref.rkt b/pkgs/scribble-pkgs/scribble-lib/setup/xref.rkt index 506f8e160b..5f4c396346 100644 --- a/pkgs/scribble-pkgs/scribble-lib/setup/xref.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/setup/xref.rkt @@ -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))))) diff --git a/racket/lib/collects/racket/HISTORY.txt b/racket/lib/collects/racket/HISTORY.txt index b48254d097..08e3385291 100644 --- a/racket/lib/collects/racket/HISTORY.txt +++ b/racket/lib/collects/racket/HISTORY.txt @@ -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 diff --git a/racket/src/racket/src/bool.c b/racket/src/racket/src/bool.c index 02163713da..ebb3751b4b 100644 --- a/racket/src/racket/src/bool.c +++ b/racket/src/racket/src/bool.c @@ -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; diff --git a/racket/src/racket/src/hash.c b/racket/src/racket/src/hash.c index 394e3bb13f..5bc04bc9f0 100644 --- a/racket/src/racket/src/hash.c +++ b/racket/src/racket/src/hash.c @@ -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: */ diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index 073628ef25..e5d1c77bcb 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -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)