suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

new hash function names and ops (3.99.0.23)

Browse Source 
svn: r9209

original commit: 021d4d7527f39cc01b6b8952f4a90e61e55e8956
This commit is contained in:
Matthew Flatt 2008-04-08 21:42:38 +00:00
parent ce62ef8ae0
commit 733521109c
9 changed files with 145 additions and 144 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
collects/scribble/base-render.ss
View File

@ -53,28 +53,28 @@
(let ([ht (deserialize v)] (let ([ht (deserialize v)]
[in-ht (collect-info-ext-ht ci)]) [in-ht (collect-info-ext-ht ci)])
(for ([(k v) ht]) (for ([(k v) ht])
(hash-table-put! in-ht k v)))) (hash-set! in-ht k v))))
(define/public (get-defined ci) (define/public (get-defined ci)
(hash-table-map (collect-info-ht ci) (lambda (k v) k))) (hash-map (collect-info-ht ci) (lambda (k v) k)))
(define/public (get-undefined ri) (define/public (get-undefined ri)
(hash-table-map (resolve-info-undef ri) (lambda (k v) k))) (hash-map (resolve-info-undef ri) (lambda (k v) k)))
(define/public (transfer-info ci src-ci) (define/public (transfer-info ci src-ci)
(let ([in-ht (collect-info-ext-ht ci)]) (let ([in-ht (collect-info-ext-ht ci)])
(for ([(k v) (collect-info-ext-ht src-ci)]) (for ([(k v) (collect-info-ext-ht src-ci)])
(hash-table-put! in-ht k v)))) (hash-set! in-ht k v))))
;; ---------------------------------------- ;; ----------------------------------------
;; global-info collection ;; global-info collection
(define/public (collect ds fns) (define/public (collect ds fns)
(let ([ci (make-collect-info (make-hash-table 'equal) (let ([ci (make-collect-info (make-hash)
(make-hash-table 'equal) (make-hash)
(make-hash-table) (make-hasheq)
(make-hash-table) (make-hasheq)
null null
(make-hash-table) (make-hasheq)
null)]) null)])
(start-collect ds fns ci) (start-collect ds fns ci)
ci)) ci))
@ -85,7 +85,7 @@
(define/public (collect-part d parent ci number) (define/public (collect-part d parent ci number)
(let ([p-ci (make-collect-info (let ([p-ci (make-collect-info
(make-hash-table 'equal) (make-hash)
(collect-info-ext-ht ci) (collect-info-ext-ht ci)
(collect-info-parts ci) (collect-info-parts ci)
(collect-info-tags ci) (collect-info-tags ci)
@ -95,11 +95,11 @@
(collect-info-gen-prefix ci)) (collect-info-gen-prefix ci))
(collect-info-relatives ci) (collect-info-relatives ci)
(cons d (collect-info-parents ci)))]) (cons d (collect-info-parents ci)))])
(hash-table-put! (collect-info-parts ci) (hash-set! (collect-info-parts ci)
d d
(make-collected-info number (make-collected-info number
parent parent
(collect-info-ht p-ci))) (collect-info-ht p-ci)))
(when (part-title-content d) (when (part-title-content d)
(collect-content (part-title-content d) p-ci)) (collect-content (part-title-content d) p-ci))
(collect-part-tags d p-ci number) (collect-part-tags d p-ci number)
@ -138,7 +138,7 @@
(define/public (collect-part-tags d ci number) (define/public (collect-part-tags d ci number)
(for ([t (part-tags d)]) (for ([t (part-tags d)])
(hash-table-put! (collect-info-ht ci) (hash-set! (collect-info-ht ci)
(generate-tag t ci) (generate-tag t ci)
(list (or (part-title-content d) '("???")) number)))) (list (or (part-title-content d) '("???")) number))))
@ -175,9 +175,9 @@
(define/public (collect-element i ci) (define/public (collect-element i ci)
(if (part-relative-element? i) (if (part-relative-element? i)
(let ([content (let ([content
(or (hash-table-get (collect-info-relatives ci) i #f) (or (hash-ref (collect-info-relatives ci) i #f)
(let ([v ((part-relative-element-collect i) ci)]) (let ([v ((part-relative-element-collect i) ci)])
(hash-table-put! (collect-info-relatives ci) i v) (hash-set! (collect-info-relatives ci) i v)
v))]) v))])
(collect-content content ci)) (collect-content content ci))
(begin (begin
@ -205,9 +205,9 @@
(define/public (resolve ds fns ci) (define/public (resolve ds fns ci)
(let ([ri (make-resolve-info ci (let ([ri (make-resolve-info ci
(make-hash-table) (make-hasheq)
(make-hash-table 'equal) (make-hash)
(make-hash-table 'equal))]) (make-hash))])
(start-resolve ds fns ri) (start-resolve ds fns ri)
ri)) ri))
@ -239,7 +239,7 @@
[(blockquote? p) (resolve-blockquote p d ri)] [(blockquote? p) (resolve-blockquote p d ri)]
[(delayed-block? p) [(delayed-block? p)
(let ([v ((delayed-block-resolve p) this d ri)]) (let ([v ((delayed-block-resolve p) this d ri)])
(hash-table-put! (resolve-info-delays ri) p v) (hash-set! (resolve-info-delays ri) p v)
(resolve-block v d ri))] (resolve-block v d ri))]
[else (resolve-paragraph p d ri)])) [else (resolve-paragraph p d ri)]))
@ -260,9 +260,9 @@
[(part-relative-element? i) [(part-relative-element? i)
(resolve-content (part-relative-element-content i ri) d ri)] (resolve-content (part-relative-element-content i ri) d ri)]
[(delayed-element? i) [(delayed-element? i)
(resolve-content (or (hash-table-get (resolve-info-delays ri) i #f) (resolve-content (or (hash-ref (resolve-info-delays ri) i #f)
(let ([v ((delayed-element-resolve i) this d ri)]) (let ([v ((delayed-element-resolve i) this d ri)])
(hash-table-put! (resolve-info-delays ri) i v) (hash-set! (resolve-info-delays ri) i v)
v)) v))
d ri)] d ri)]
[(element? i) [(element? i)
@ -271,7 +271,7 @@
(let ([e (index-element-desc i)]) (let ([e (index-element-desc i)])
(when (delayed-index-desc? e) (when (delayed-index-desc? e)
(let ([v ((delayed-index-desc-resolve e) this d ri)]) (let ([v ((delayed-index-desc-resolve e) this d ri)])
(hash-table-put! (resolve-info-delays ri) e v))))] (hash-set! (resolve-info-delays ri) e v))))]
[(link-element? i) [(link-element? i)
(resolve-get d ri (link-element-tag i))]) (resolve-get d ri (link-element-tag i))])
(for ([e (element-content i)]) (for ([e (element-content i)])

8
collects/scribble/basic.ss
View File

@ -227,8 +227,8 @@
(define line-break (if (send renderer index-manual-newlines?) (define line-break (if (send renderer index-manual-newlines?)
(make-element 'newline '("\n")) (make-element 'newline '("\n"))
"")) ""))
(define alpha-starts (make-hash-table)) (define alpha-starts (make-hasheq))
(hash-table-for-each (hash-for-each
(let ([parent (collected-info-parent (part-collected-info sec ri))]) (let ([parent (collected-info-parent (part-collected-info sec ri))])
(if parent (if parent
(collected-info-info (part-collected-info parent ri)) (collected-info-info (part-collected-info parent ri))
@ -253,7 +253,7 @@
[(char-ci>? letter (car alpha)) [(char-ci>? letter (car alpha))
(add-letter (car alpha) (loop i (cdr alpha)))] (add-letter (car alpha) (loop i (cdr alpha)))]
[(char-ci=? letter (car alpha)) [(char-ci=? letter (car alpha))
(hash-table-put! alpha-starts (car i) letter) (hash-set! alpha-starts (car i) letter)
(list* (make-element (list* (make-element
(make-target-url (format "#alpha:~a" letter) #f) (make-target-url (format "#alpha:~a" letter) #f)
(list (string (car alpha)))) (list (string (car alpha))))
@ -270,7 +270,7 @@
(make-link-element "indexlink" (make-link-element "indexlink"
`(,@(commas (caddr i)) ,line-break) `(,@(commas (caddr i)) ,line-break)
(car i))) (car i)))
(cond [(hash-table-get alpha-starts i #f) (cond [(hash-ref alpha-starts i #f)
=> (lambda (let) => (lambda (let)
(make-element (make-url-anchor (make-element (make-url-anchor
(format "alpha:~a" (char-upcase let))) (format "alpha:~a" (char-upcase let)))

14
collects/scribble/eval.ss
View File

@ -149,7 +149,7 @@
(get-output ev) (get-output ev)
(get-error-output ev)))]) (get-error-output ev)))])
(list (let ([v (do-plain-eval ev s #t)]) (list (let ([v (do-plain-eval ev s #t)])
(make-reader-graph (copy-value v (make-hash-table)))) (make-reader-graph (copy-value v (make-hasheq))))
(get-output ev) (get-output ev)
(get-error-output ev)))]) (get-error-output ev)))])
(when expect (when expect
@ -160,31 +160,31 @@
(define (install ht v v2) (define (install ht v v2)
(hash-table-put! ht v v2) (hash-set! ht v v2)
v2) v2)
;; Since we evaluate everything in an interaction before we typeset, ;; Since we evaluate everything in an interaction before we typeset,
;; copy each value to avoid side-effects. ;; copy each value to avoid side-effects.
(define (copy-value v ht) (define (copy-value v ht)
(cond (cond
[(and v (hash-table-get ht v #f)) [(and v (hash-ref ht v #f))
=> (lambda (v) v)] => (lambda (v) v)]
[(string? v) (install ht v (string-copy v))] [(string? v) (install ht v (string-copy v))]
[(bytes? v) (install ht v (bytes-copy v))] [(bytes? v) (install ht v (bytes-copy v))]
[(pair? v) [(pair? v)
(let ([ph (make-placeholder #f)]) (let ([ph (make-placeholder #f)])
(hash-table-put! ht v ph) (hash-set! ht v ph)
(placeholder-set! ph (placeholder-set! ph
(cons (copy-value (car v) ht) (cons (copy-value (car v) ht)
(copy-value (cdr v) ht))) (copy-value (cdr v) ht)))
ph)] ph)]
[(mpair? v) (let ([p (mcons #f #f)]) [(mpair? v) (let ([p (mcons #f #f)])
(hash-table-put! ht v p) (hash-set! ht v p)
(set-mcar! p (copy-value (mcar v) ht)) (set-mcar! p (copy-value (mcar v) ht))
(set-mcdr! p (copy-value (mcdr v) ht)) (set-mcdr! p (copy-value (mcdr v) ht))
p)] p)]
[(vector? v) (let ([v2 (make-vector (vector-length v))]) [(vector? v) (let ([v2 (make-vector (vector-length v))])
(hash-table-put! ht v v2) (hash-set! ht v v2)
(let loop ([i (vector-length v2)]) (let loop ([i (vector-length v2)])
(unless (zero? i) (unless (zero? i)
(let ([i (sub1 i)]) (let ([i (sub1 i)])
@ -192,7 +192,7 @@
(loop i)))) (loop i))))
v2)] v2)]
[(box? v) (let ([v2 (box #f)]) [(box? v) (let ([v2 (box #f)])
(hash-table-put! ht v v2) (hash-set! ht v v2)
(set-box! v2 (copy-value (unbox v) ht)) (set-box! v2 (copy-value (unbox v) ht))
v2)] v2)]
[else v])) [else v]))

40
collects/scribble/manual.ss
View File

@ -353,26 +353,26 @@
(annote-exporting-library (annote-exporting-library
(to-element (make-just-context name stx-id)))))) (to-element (make-just-context name stx-id))))))
(define checkers (make-hash-table 'equal)) (define checkers (make-hash))
(define (libs->taglet id libs source-libs) (define (libs->taglet id libs source-libs)
(let ([lib (let ([lib
(or (ormap (lambda (lib) (or (ormap (lambda (lib)
(let ([checker (hash-table-get checkers lib (let ([checker (hash-ref checkers lib
(lambda () (lambda ()
(let ([ns (make-base-empty-namespace)]) (let ([ns (make-base-empty-namespace)])
(parameterize ([current-namespace ns]) (parameterize ([current-namespace ns])
(namespace-require `(for-label ,lib))) (namespace-require `(for-label ,lib)))
(let ([checker (let ([checker
(lambda (id) (lambda (id)
(parameterize ([current-namespace ns]) (parameterize ([current-namespace ns])
(let ([new-id (namespace-syntax-introduce (let ([new-id (namespace-syntax-introduce
(datum->syntax (datum->syntax
#f #f
(syntax-e id)))]) (syntax-e id)))])
(free-label-identifier=? new-id id))))]) (free-label-identifier=? new-id id))))])
(hash-table-put! checkers lib checker) (hash-set! checkers lib checker)
checker))))]) checker))))])
(and (checker id) (and (checker id)
lib))) lib)))
(or source-libs (or source-libs
@ -2100,10 +2100,10 @@
(reverse (cls/intf-app-mixins (cdr super)))))) (reverse (cls/intf-app-mixins (cdr super))))))
(cdr supers)) (cdr supers))
(cons super accum)))]))))] (cons super accum)))]))))]
[ht (let ([ht (make-hash-table)]) [ht (let ([ht (make-hasheq)])
(for-each (lambda (i) (for-each (lambda (i)
(when (meth? i) (when (meth? i)
(hash-table-put! ht (meth-name i) #t))) (hash-set! ht (meth-name i) #t)))
(decl-body decl)) (decl-body decl))
ht)] ht)]
[inh (apply [inh (apply
@ -2113,10 +2113,10 @@
values values
(map (map
(lambda (k) (lambda (k)
(if (hash-table-get ht k #f) (if (hash-ref ht k #f)
#f #f
(begin (begin
(hash-table-put! ht k #t) (hash-set! ht k #t)
(cons (symbol->string k) (cons (symbol->string k)
(**method k (car super)))))) (**method k (car super))))))
(cls/intf-methods (cdr super))))]) (cls/intf-methods (cdr super))))])

72
collects/scribble/scheme.ss
View File

@ -41,7 +41,7 @@
(define current-meta-list (define current-meta-list
(make-parameter null)) (make-parameter null))
(define defined-names (make-hash-table)) (define defined-names (make-hasheq))
(define-struct (sized-element element) (length)) (define-struct (sized-element element) (length))
@ -66,8 +66,8 @@
;; That way, when the value is no longer used, the key ;; That way, when the value is no longer used, the key
;; goes away, and the entry is gone. ;; goes away, and the entry is gone.
(define id-element-cache (make-hash-table 'equal 'weak)) (define id-element-cache (make-weak-hash))
(define element-cache (make-hash-table 'equal 'weak)) (define element-cache (make-weak-hash))
(define-struct (cached-delayed-element delayed-element) (cache-key)) (define-struct (cached-delayed-element delayed-element) (cache-key))
(define-struct (cached-element element) (cache-key)) (define-struct (cached-element element) (cache-key))
@ -80,7 +80,7 @@
(cadddr b) (cadddr b)
(list-ref b 5))))]) (list-ref b 5))))])
(or (and key (or (and key
(let ([b (hash-table-get id-element-cache key #f)]) (let ([b (hash-ref id-element-cache key #f)])
(and b (and b
(weak-box-value b)))) (weak-box-value b))))
(let ([e (make-cached-delayed-element (let ([e (make-cached-delayed-element
@ -100,7 +100,7 @@
(lambda () s) (lambda () s)
key)]) key)])
(when key (when key
(hash-table-put! id-element-cache key (make-weak-box e))) (hash-set! id-element-cache key (make-weak-box e)))
e)))) e))))
(define (make-element/cache style content) (define (make-element/cache style content)
@ -109,10 +109,10 @@
(string? (car content)) (string? (car content))
(null? (cdr content))) (null? (cdr content)))
(let ([key (vector style (car content))]) (let ([key (vector style (car content))])
(let ([b (hash-table-get element-cache key #f)]) (let ([b (hash-ref element-cache key #f)])
(or (and b (weak-box-value b)) (or (and b (weak-box-value b))
(let ([e (make-cached-element style content key)]) (let ([e (make-cached-element style content key)])
(hash-table-put! element-cache key (make-weak-box e)) (hash-set! element-cache key (make-weak-box e))
e)))) e))))
(make-element style content))) (make-element style content)))
@ -178,8 +178,8 @@
[src-col init-col] [src-col init-col]
[dest-col 0] [dest-col 0]
[highlight? #f] [highlight? #f]
[col-map (make-hash-table 'equal)] [col-map (make-hash)]
[next-col-map (make-hash-table 'equal)] [next-col-map (make-hash)]
[line (or (syntax-line first) 0)]) [line (or (syntax-line first) 0)])
(define (finish-line!) (define (finish-line!)
(when multi-line? (when multi-line?
@ -241,11 +241,11 @@
(out "\n" no-color)) (out "\n" no-color))
(set! line l) (set! line l)
(set! col-map next-col-map) (set! col-map next-col-map)
(set! next-col-map (make-hash-table 'equal)) (set! next-col-map (make-hash))
(init-line!)) (init-line!))
(let ([d-col (let ([def-val (+ dest-col (- c src-col))]) (let ([d-col (let ([def-val (+ dest-col (- c src-col))])
(if new-line? (if new-line?
(hash-table-get col-map c def-val) (hash-ref col-map c def-val)
def-val))]) def-val))])
(let ([amt (- d-col dest-col)]) (let ([amt (- d-col dest-col)])
(when (positive? amt) (when (positive? amt)
@ -256,7 +256,7 @@
#f) #f)
(set! dest-col (+ old-dest-col amt)))))) (set! dest-col (+ old-dest-col amt))))))
(set! src-col c) (set! src-col c)
(hash-table-put! next-col-map src-col dest-col)))] (hash-set! next-col-map src-col dest-col)))]
[(c init-line!) (advance c init-line! 0)])) [(c init-line!) (advance c init-line! 0)]))
(define (convert-infix c quote-depth) (define (convert-infix c quote-depth)
(let ([l (syntax->list c)]) (let ([l (syntax->list c)])
@ -346,7 +346,7 @@
(error "bad code:redex: ~e" (syntax->datum c))) (error "bad code:redex: ~e" (syntax->datum c)))
(advance c init-line!) (advance c init-line!)
(set! src-col (syntax-column (cadr l))) (set! src-col (syntax-column (cadr l)))
(hash-table-put! next-col-map src-col dest-col) (hash-set! next-col-map src-col dest-col)
(set! highlight? #t) (set! highlight? #t)
((loop init-line! quote-depth) (cadr l)) ((loop init-line! quote-depth) (cadr l))
(set! highlight? h?) (set! highlight? h?)
@ -356,7 +356,7 @@
(advance c init-line!) (advance c init-line!)
(out "(" (if (positive? quote-depth) value-color paren-color)) (out "(" (if (positive? quote-depth) value-color paren-color))
(set! src-col (+ src-col 1)) (set! src-col (+ src-col 1))
(hash-table-put! next-col-map src-col dest-col) (hash-set! next-col-map src-col dest-col)
((loop init-line! quote-depth) ((loop init-line! quote-depth)
(datum->syntax #'here 'quote (car (syntax-e c)))) (datum->syntax #'here 'quote (car (syntax-e c))))
(for-each (loop init-line! (add1 quote-depth)) (for-each (loop init-line! (add1 quote-depth))
@ -364,7 +364,7 @@
(out ")" (if (positive? quote-depth) value-color paren-color)) (out ")" (if (positive? quote-depth) value-color paren-color))
(set! src-col (+ src-col 1)) (set! src-col (+ src-col 1))
#; #;
(hash-table-put! next-col-map src-col dest-col)] (hash-set! next-col-map src-col dest-col)]
[(and (pair? (syntax-e c)) [(and (pair? (syntax-e c))
(memq (syntax-e (car (syntax-e c))) (memq (syntax-e (car (syntax-e c)))
'(quote quasiquote unquote unquote-splicing '(quote quasiquote unquote unquote-splicing
@ -385,7 +385,7 @@
reader-color)) reader-color))
(let ([i (cadr (syntax->list c))]) (let ([i (cadr (syntax->list c))])
(set! src-col (or (syntax-column i) src-col)) (set! src-col (or (syntax-column i) src-col))
(hash-table-put! next-col-map src-col dest-col) (hash-set! next-col-map src-col dest-col)
((loop init-line! (+ quote-depth quote-delta)) i)))] ((loop init-line! (+ quote-depth quote-delta)) i)))]
[(and (pair? (syntax-e c)) [(and (pair? (syntax-e c))
(convert-infix c quote-depth)) (convert-infix c quote-depth))
@ -426,7 +426,7 @@
[else "("]) [else "("])
p-color) p-color)
(set! src-col (+ src-col 1)) (set! src-col (+ src-col 1))
(hash-table-put! next-col-map src-col dest-col) (hash-set! next-col-map src-col dest-col)
(let lloop ([l (cond (let lloop ([l (cond
[(vector? (syntax-e c)) [(vector? (syntax-e c))
(vector->short-list (syntax-e c) syntax-e)] (vector->short-list (syntax-e c) syntax-e)]
@ -469,7 +469,7 @@
(advance l init-line! -2) (advance l init-line! -2)
(out ". " (if (positive? quote-depth) value-color paren-color)) (out ". " (if (positive? quote-depth) value-color paren-color))
(set! src-col (+ src-col 3)) (set! src-col (+ src-col 3))
(hash-table-put! next-col-map src-col dest-col) (hash-set! next-col-map src-col dest-col)
((loop init-line! quote-depth) l)])) ((loop init-line! quote-depth) l)]))
(out (case sh (out (case sh
[(#\[ #\?) "]"] [(#\[ #\?) "]"]
@ -478,16 +478,16 @@
p-color) p-color)
(set! src-col (+ src-col 1)) (set! src-col (+ src-col 1))
#; #;
(hash-table-put! next-col-map src-col dest-col))] (hash-set! next-col-map src-col dest-col))]
[(box? (syntax-e c)) [(box? (syntax-e c))
(advance c init-line!) (advance c init-line!)
(out "#&" value-color) (out "#&" value-color)
(set! src-col (+ src-col 2)) (set! src-col (+ src-col 2))
(hash-table-put! next-col-map src-col dest-col) (hash-set! next-col-map src-col dest-col)
((loop init-line! +inf.0) (unbox (syntax-e c)))] ((loop init-line! +inf.0) (unbox (syntax-e c)))]
[(hash-table? (syntax-e c)) [(hash? (syntax-e c))
(advance c init-line!) (advance c init-line!)
(let ([equal-table? (hash-table? (syntax-e c) 'equal)]) (let ([equal-table? (not (hash-eq? (syntax-e c)))])
(out (if equal-table? (out (if equal-table?
"#hash" "#hash"
"#hasheq") "#hasheq")
@ -495,9 +495,9 @@
(let ([delta (+ 5 (if equal-table? 2 0))] (let ([delta (+ 5 (if equal-table? 2 0))]
[orig-col src-col]) [orig-col src-col])
(set! src-col (+ src-col delta)) (set! src-col (+ src-col delta))
(hash-table-put! next-col-map src-col dest-col) (hash-set! next-col-map src-col dest-col)
((loop init-line! +inf.0) ((loop init-line! +inf.0)
(syntax-ize (hash-table-map (syntax-e c) cons) (syntax-ize (hash-map (syntax-e c) cons)
(+ (syntax-column c) delta))) (+ (syntax-column c) delta)))
(set! src-col (+ orig-col (syntax-span c)))))] (set! src-col (+ orig-col (syntax-span c)))))]
[(graph-reference? (syntax-e c)) [(graph-reference? (syntax-e c))
@ -519,10 +519,10 @@
(typeset-atom c out color? quote-depth) (typeset-atom c out color? quote-depth)
(set! src-col (+ src-col (or (syntax-span c) 1))) (set! src-col (+ src-col (or (syntax-span c) 1)))
#; #;
(hash-table-put! next-col-map src-col dest-col)]))) (hash-set! next-col-map src-col dest-col)])))
(out prefix1 #f) (out prefix1 #f)
(set! dest-col 0) (set! dest-col 0)
(hash-table-put! next-col-map init-col dest-col) (hash-set! next-col-map init-col dest-col)
((loop (lambda () (set! src-col init-col) (set! dest-col 0)) 0) c) ((loop (lambda () (set! src-col init-col) (set! dest-col 0)) 0) c)
(if (list? suffix) (if (list? suffix)
(map (lambda (sfx) (map (lambda (sfx)
@ -548,7 +548,7 @@
(struct? s) (struct? s)
(box? s) (box? s)
(null? s) (null? s)
(hash-table? s) (hash? s)
(graph-defn? s) (graph-defn? s)
(graph-reference? s)) (graph-reference? s))
(gen-typeset c multi-line? prefix1 prefix suffix color?) (gen-typeset c multi-line? prefix1 prefix suffix color?)
@ -659,12 +659,12 @@
(define-struct graph-defn (r bx)) (define-struct graph-defn (r bx))
(define (syntax-ize v col [line 1]) (define (syntax-ize v col [line 1])
(do-syntax-ize v col line (make-hash-table) #f)) (do-syntax-ize v col line (make-hasheq) #f))
(define (graph-count ht graph?) (define (graph-count ht graph?)
(and graph? (and graph?
(let ([n (hash-table-get ht '#%graph-count 0)]) (let ([n (hash-ref ht '#%graph-count 0)])
(hash-table-put! ht '#%graph-count (add1 n)) (hash-set! ht '#%graph-count (add1 n))
n))) n)))
(define (do-syntax-ize v col line ht graph?) (define (do-syntax-ize v col line ht graph?)
@ -682,7 +682,7 @@
s s
s s
(just-context-ctx v)))] (just-context-ctx v)))]
[(hash-table-get ht v #f) [(hash-ref ht v #f)
=> (lambda (m) => (lambda (m)
(unless (unbox m) (unless (unbox m)
(set-box! m #t)) (set-box! m #t))
@ -707,7 +707,7 @@
(and (struct? v) (and (struct? v)
(prefab-struct-key v))) (prefab-struct-key v)))
(let ([graph-box (box (graph-count ht graph?))]) (let ([graph-box (box (graph-count ht graph?))])
(hash-table-put! ht v graph-box) (hash-set! ht v graph-box)
(let ([r (let* ([vec-sz (+ (if graph? (let ([r (let* ([vec-sz (+ (if graph?
(+ 2 (string-length (format "~a" (unbox graph-box)))) (+ 2 (string-length (format "~a" (unbox graph-box))))
0) 0)
@ -743,7 +743,7 @@
(sub1 (length l))) (sub1 (length l)))
(apply + (map syntax-span l)))))))]) (apply + (map syntax-span l)))))))])
(unless graph? (unless graph?
(hash-table-put! ht v #f)) (hash-set! ht v #f))
(cond (cond
[graph? (datum->syntax #f [graph? (datum->syntax #f
(make-graph-defn r graph-box) (make-graph-defn r graph-box)
@ -754,14 +754,14 @@
[else r])))] [else r])))]
[(pair? v) [(pair? v)
(let ([graph-box (box (graph-count ht graph?))]) (let ([graph-box (box (graph-count ht graph?))])
(hash-table-put! ht v graph-box) (hash-set! ht v graph-box)
(let* ([inc (if graph? (let* ([inc (if graph?
(+ 2 (string-length (format "~a" (unbox graph-box)))) (+ 2 (string-length (format "~a" (unbox graph-box))))
0)] 0)]
[a (do-syntax-ize (car v) (+ col 1 inc) line ht #f)] [a (do-syntax-ize (car v) (+ col 1 inc) line ht #f)]
[sep (if (and (pair? (cdr v)) [sep (if (and (pair? (cdr v))
;; FIXME: what if it turns out to be a graph reference? ;; FIXME: what if it turns out to be a graph reference?
(not (hash-table-get ht (cdr v) #f))) (not (hash-ref ht (cdr v) #f)))
0 0
3)] 3)]
[b (do-syntax-ize (cdr v) (+ col 1 inc (syntax-span a) sep) line ht #f)]) [b (do-syntax-ize (cdr v) (+ col 1 inc (syntax-span a) sep) line ht #f)])
@ -770,7 +770,7 @@
(vector #f line (+ col inc) (+ 1 col inc) (vector #f line (+ col inc) (+ 1 col inc)
(+ 2 sep (syntax-span a) (syntax-span b))))]) (+ 2 sep (syntax-span a) (syntax-span b))))])
(unless graph? (unless graph?
(hash-table-put! ht v #f)) (hash-set! ht v #f))
(cond (cond
[graph? (datum->syntax #f [graph? (datum->syntax #f
(make-graph-defn r graph-box) (make-graph-defn r graph-box)

18
collects/scribble/search.ss
View File

@ -7,7 +7,7 @@
(provide find-scheme-tag (provide find-scheme-tag
intern-taglet) intern-taglet)
(define module-info-cache (make-hash-table)) (define module-info-cache (make-hasheq))
(define (module-path-index-rejoin mpi rel-to) (define (module-path-index-rejoin mpi rel-to)
(let-values ([(name base) (module-path-index-split mpi)]) (let-values ([(name base) (module-path-index-split mpi)])
@ -18,7 +18,7 @@
(module-path-index-join name (module-path-index-join name
(module-path-index-rejoin base rel-to))]))) (module-path-index-rejoin base rel-to))])))
(define interned (make-hash-table 'equal 'weak)) (define interned (make-weak-hash))
(define (intern-taglet v) (define (intern-taglet v)
(let ([v (if (list? v) (let ([v (if (list? v)
@ -27,11 +27,11 @@
(if (or (string? v) (if (or (string? v)
(bytes? v) (bytes? v)
(list? v)) (list? v))
(let ([b (hash-table-get interned v #f)]) (let ([b (hash-ref interned v #f)])
(if b (if b
(weak-box-value b) (weak-box-value b)
(begin (begin
(hash-table-put! interned v (make-weak-box v)) (hash-set! interned v (make-weak-box v))
v))) v)))
v))) v)))
@ -72,7 +72,7 @@
(cadddr (cdr stx/binding))))))])]) (cadddr (cdr stx/binding))))))])])
(and (and
(pair? b) (pair? b)
(let ([seen (make-hash-table)] (let ([seen (make-hasheq)]
[search-key #f]) [search-key #f])
(let loop ([queue (list (list (caddr b) (cadddr b) (list-ref b 4) (list-ref b 5) (list-ref b 6)))] (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])
@ -111,9 +111,9 @@
(loop queue rqueue) (loop queue rqueue)
;; Check parents, if we can get the source: ;; Check parents, if we can get the source:
(if (and (path? (resolved-module-path-name rmp)) (if (and (path? (resolved-module-path-name rmp))
(not (hash-table-get seen rmp #f))) (not (hash-ref seen rmp #f)))
(let ([exports (let ([exports
(hash-table-get (hash-ref
module-info-cache module-info-cache
rmp rmp
(lambda () (lambda ()
@ -136,9 +136,9 @@
[else (loop (cons (car stxess) [else (loop (cons (car stxess)
base) base)
(cdr stxess))]))]) (cdr stxess))]))])
(hash-table-put! module-info-cache rmp t) (hash-set! module-info-cache rmp t)
t))))]) t))))])
(hash-table-put! seen rmp #t) (hash-set! seen rmp #t)
(let ([a (assq id (let ([a (assoc export-phase exports)]) (let ([a (assq id (let ([a (assoc export-phase exports)])
(if a (if a
(cdr a) (cdr a)

82
collects/scribble/struct.ss
View File

@ -10,25 +10,25 @@
(define-struct resolve-info (ci delays undef searches)) (define-struct resolve-info (ci delays undef searches))
(define (part-collected-info part ri) (define (part-collected-info part ri)
(hash-table-get (collect-info-parts (resolve-info-ci ri)) (hash-ref (collect-info-parts (resolve-info-ci ri))
part)) part))
(define (collect-put! ci key val) (define (collect-put! ci key val)
(let ([ht (collect-info-ht ci)]) (let ([ht (collect-info-ht ci)])
(when (hash-table-get ht key #f) (when (hash-ref ht key #f)
(fprintf (current-error-port) (fprintf (current-error-port)
"WARNING: collected information for key multiple times: ~e\n" "WARNING: collected information for key multiple times: ~e\n"
key)) key))
(hash-table-put! ht key val))) (hash-set! ht key val)))
(define (resolve-get/where part ri key) (define (resolve-get/where part ri key)
(let ([key (tag-key key ri)]) (let ([key (tag-key key ri)])
(let ([v (hash-table-get (if part (let ([v (hash-ref (if part
(collected-info-info (part-collected-info part ri)) (collected-info-info (part-collected-info part ri))
(collect-info-ht (resolve-info-ci ri))) (collect-info-ht (resolve-info-ci ri)))
key key
#f)]) #f)])
(cond (cond
[v (values v #f)] [v (values v #f)]
[part (resolve-get/where (collected-info-parent [part (resolve-get/where (collected-info-parent
@ -36,29 +36,29 @@
ri ri
key)] key)]
[else [else
(let ([v (hash-table-get (collect-info-ext-ht (resolve-info-ci ri)) (let ([v (hash-ref (collect-info-ext-ht (resolve-info-ci ri))
key key
#f)]) #f)])
(values v #t))])))) (values v #t))]))))
(define (resolve-get part ri key) (define (resolve-get part ri key)
(let-values ([(v ext?) (resolve-get/where part ri key)]) (let-values ([(v ext?) (resolve-get/where part ri key)])
(when ext? (when ext?
(hash-table-put! (resolve-info-undef ri) (hash-set! (resolve-info-undef ri)
(tag-key key ri) (tag-key key ri)
#t)) #t))
v)) v))
(define (resolve-search search-key part ri key) (define (resolve-search search-key part ri key)
(let ([s-ht (hash-table-get (resolve-info-searches ri) (let ([s-ht (hash-ref (resolve-info-searches ri)
search-key search-key
(lambda () (lambda ()
(let ([s-ht (make-hash-table 'equal)]) (let ([s-ht (make-hash)])
(hash-table-put! (resolve-info-searches ri) (hash-set! (resolve-info-searches ri)
search-key search-key
s-ht) s-ht)
s-ht)))]) s-ht)))])
(hash-table-put! s-ht key #t)) (hash-set! s-ht key #t))
(resolve-get part ri key)) (resolve-get part ri key))
(define (resolve-get/tentative part ri key) (define (resolve-get/tentative part ri key)
@ -67,7 +67,7 @@
(define (resolve-get-keys part ri key-pred) (define (resolve-get-keys part ri key-pred)
(let ([l null]) (let ([l null])
(hash-table-for-each (hash-for-each
(collected-info-info (collected-info-info
(part-collected-info part ri)) (part-collected-info part ri))
(lambda (k v) (lambda (k v)
@ -211,11 +211,11 @@
(provide delayed-element-content) (provide delayed-element-content)
(define (delayed-element-content e ri) (define (delayed-element-content e ri)
(hash-table-get (resolve-info-delays ri) e)) (hash-ref (resolve-info-delays ri) e))
(provide delayed-block-blocks) (provide delayed-block-blocks)
(define (delayed-block-blocks p ri) (define (delayed-block-blocks p ri)
(hash-table-get (resolve-info-delays ri) p)) (hash-ref (resolve-info-delays ri) p))
(provide current-serialize-resolve-info) (provide current-serialize-resolve-info)
(define current-serialize-resolve-info (make-parameter #f)) (define current-serialize-resolve-info (make-parameter #f))
@ -254,10 +254,10 @@
(provide part-relative-element-content) (provide part-relative-element-content)
(define (part-relative-element-content e ci/ri) (define (part-relative-element-content e ci/ri)
(hash-table-get (collect-info-relatives (if (resolve-info? ci/ri) (hash-ref (collect-info-relatives (if (resolve-info? ci/ri)
(resolve-info-ci ci/ri) (resolve-info-ci ci/ri)
ci/ri)) ci/ri))
e)) e))
(provide collect-info-parents) (provide collect-info-parents)
@ -326,10 +326,10 @@
(unless ri (unless ri
(error 'serialize-generated-tag (error 'serialize-generated-tag
"current-serialize-resolve-info not set")) "current-serialize-resolve-info not set"))
(let ([t (hash-table-get (collect-info-tags (let ([t (hash-ref (collect-info-tags
(resolve-info-ci ri)) (resolve-info-ci ri))
g g
#f)]) #f)])
(if t (if t
(vector t) (vector t)
(error 'serialize-generated-tag (error 'serialize-generated-tag
@ -352,20 +352,20 @@
(let ([t (cadr tg)]) (let ([t (cadr tg)])
(list (car tg) (list (car tg)
(let ([tags (collect-info-tags ci)]) (let ([tags (collect-info-tags ci)])
(or (hash-table-get tags t #f) (or (hash-ref tags t #f)
(let ([key (list* 'gentag (let ([key (list* 'gentag
(hash-table-count tags) (hash-count tags)
(collect-info-gen-prefix ci))]) (collect-info-gen-prefix ci))])
(hash-table-put! tags t key) (hash-set! tags t key)
key))))) key)))))
tg)) tg))
(define (tag-key tg ri) (define (tag-key tg ri)
(if (generated-tag? (cadr tg)) (if (generated-tag? (cadr tg))
(list (car tg) (list (car tg)
(hash-table-get (collect-info-tags (hash-ref (collect-info-tags
(resolve-info-ci ri)) (resolve-info-ci ri))
(cadr tg))) (cadr tg)))
tg)) tg))
;; ---------------------------------------- ;; ----------------------------------------

1
collects/scribble/text-render.ss
View File

@ -89,6 +89,7 @@
[(ndash) "\U2013"] [(ndash) "\U2013"]
[(ldquo) "\U201C"] [(ldquo) "\U201C"]
[(rdquo) "\U201D"] [(rdquo) "\U201D"]
[(rsquo) "\U2019"]
[(lang) ">"] [(lang) ">"]
[(rang) "<"] [(rang) "<"]
[(rarr) "->"] [(rarr) "->"]

4
collects/scribble/xref.ss
View File

@ -53,7 +53,7 @@
(define (xref-index xrefs) (define (xref-index xrefs)
(filter (filter
values values
(hash-table-map (hash-map
(collect-info-ext-ht (resolve-info-ci (xrefs-ri xrefs))) (collect-info-ext-ht (resolve-info-ci (xrefs-ri xrefs)))
(lambda (k v) (lambda (k v)
(and (pair? k) (and (pair? k)
@ -128,7 +128,7 @@
tag->path+anchor (xrefs-ri xrefs) tag)) tag->path+anchor (xrefs-ri xrefs) tag))
(define (xref-tag->index-entry xrefs tag) (define (xref-tag->index-entry xrefs tag)
(let ([v (hash-table-get (let ([v (hash-ref
(collect-info-ext-ht (resolve-info-ci (xrefs-ri xrefs))) (collect-info-ext-ht (resolve-info-ci (xrefs-ri xrefs)))
`(index-entry ,tag) `(index-entry ,tag)
#f)]) #f)])