suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests 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 a7fa9518b6
commit 6b6ae47140
8 changed files with 81 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/mzlib/cm.ss
View File

@ -217,7 +217,7 @@
(define (compile-root mode path up-to-date read-src-syntax)
(let ([path (simplify-path (cleanse-path path))])
(let ((stamp (and up-to-date
(hash-table-get up-to-date path #f))))
(hash-ref up-to-date path #f))))
(cond
(stamp stamp)
(else
@ -272,21 +272,21 @@
(cdr deps)))
(compile-zo mode path read-src-syntax))))))
(let ((stamp (get-compiled-time mode path #t)))
(hash-table-put! up-to-date path stamp)
(hash-set! up-to-date path stamp)
stamp)))))))))
(define (managed-compile-zo zo [read-src-syntax read-syntax])
((make-caching-managed-compile-zo read-src-syntax) zo))
(define (make-caching-managed-compile-zo [read-src-syntax read-syntax])
(let ([cache (make-hash-table 'equal)])
(let ([cache (make-hash)])
(lambda (zo)
(parameterize ([current-load/use-compiled (make-compilation-manager-load/use-compiled-handler/table cache)])
(compile-root (car (use-compiled-file-paths)) (path->complete-path zo) cache read-src-syntax)
(void)))))
(define (make-compilation-manager-load/use-compiled-handler)
(make-compilation-manager-load/use-compiled-handler/table (make-hash-table 'equal)))
(make-compilation-manager-load/use-compiled-handler/table (make-hash)))
(define (make-compilation-manager-load/use-compiled-handler/table cache)
(let ([orig-eval (current-eval)]

8
collects/mzlib/for.ss
View File

@ -18,10 +18,10 @@
in-bytes
in-input-port-bytes
in-input-port-chars
in-hash-table
in-hash-table-keys
in-hash-table-values
in-hash-table-pairs
(rename-out [in-hash in-hash-table]
[in-hash-keys in-hash-table-keys]
[in-hash-values in-hash-table-values]
[in-hash-pairs in-hash-table-pairs])
in-parallel
stop-before

16
collects/mzlib/foreign.ss
View File

@ -200,7 +200,7 @@
(ptr-ref ffi-obj type))
(define (ffi-set! ffi-obj type new)
(let-values ([(new type) (get-lowlevel-object new type)])
(hash-table-put! ffi-objects-ref-table ffi-obj new)
(hash-set! ffi-objects-ref-table ffi-obj new)
(ptr-set! ffi-obj type new)))
;; This is better handled with `make-c-parameter'
@ -282,7 +282,7 @@
;; This table keeps references to values that are set in foreign libraries, to
;; avoid them being GCed. See set-ffi-obj! above.
(define ffi-objects-ref-table (make-hash-table))
(define ffi-objects-ref-table (make-hasheq))
;; ----------------------------------------------------------------------------
;; Compile-time support for fun-expanders
@ -709,14 +709,14 @@
;; `string/eof' type: converts an output #f (NULL) to an eof-object.
(define string-type->string/eof-type
(let ([table (make-hash-table)])
(let ([table (make-hasheq)])
(lambda (string-type)
(hash-table-get table string-type
(hash-ref table string-type
(lambda ()
(let ([new-type (make-ctype string-type
(lambda (x) (and (not (eof-object? x)) x))
(lambda (x) (or x eof)))])
(hash-table-put! table string-type new-type)
(hash-set! table string-type new-type)
new-type))))))
(provide _string/eof _bytes/eof)
(define _bytes/eof
@ -1457,12 +1457,12 @@
;; helper for the above: keep runtime information on structs
(define cstruct-info
(let ([table (make-hash-table 'weak)])
(let ([table (make-weak-hasheq)])
(lambda (cstruct msg/fail-thunk . args)
(cond [(eq? 'set! msg/fail-thunk)
(hash-table-put! table cstruct (make-ephemeron cstruct args))]
(hash-set! table cstruct (make-ephemeron cstruct args))]
[(and cstruct ; might get a #f if there were no slots
(hash-table-get table cstruct (lambda () #f)))
(hash-ref table cstruct (lambda () #f)))
=> (lambda (xs)
(let ([v (ephemeron-value xs)])
(if v

6
collects/mzlib/private/contract-arr-obj-helpers.ss
View File

@ -271,15 +271,15 @@
;; ensure-no-duplicates : syntax (listof syntax[identifier]) -> void
(define (ensure-no-duplicates stx form-name names)
(let ([ht (make-hash-table)])
(let ([ht (make-hasheq)])
(for-each (lambda (name)
(let ([key (syntax-e name)])
(when (hash-table-get ht key (lambda () #f))
(when (hash-ref ht key (lambda () #f))
(raise-syntax-error form-name
"duplicate method name"
stx
name))
(hash-table-put! ht key #t)))
(hash-set! ht key #t)))
names)))
;; method-specifier? : syntax -> boolean

2
collects/mzlib/private/contract-object.ss
View File

@ -367,7 +367,7 @@
[method-ht (extract-method-ht val)])
(make-object cls
val
(method/app-var (vector-ref vtable (hash-table-get method-ht 'method-name))) ...
(method/app-var (vector-ref vtable (hash-ref method-ht 'method-name))) ...
(field/app-var (get-field field-name val)) ...
))))))
#f)))))))]))))

6
collects/net/dns-unit.ss
View File

@ -211,14 +211,14 @@
(values (positive? (bitwise-and #x4 v0))
qds ans nss ars reply)))))))
(define cache (make-hash-table))
(define cache (make-hasheq))
(define (dns-query/cache nameserver addr type class)
(let ([key (string->symbol (format "~a;~a;~a;~a" nameserver addr type class))])
(let ([v (hash-table-get cache key (lambda () #f))])
(let ([v (hash-ref cache key (lambda () #f))])
(if v
(apply values v)
(let-values ([(auth? qds ans nss ars reply) (dns-query nameserver addr type class)])
(hash-table-put! cache key (list auth? qds ans nss ars reply))
(hash-set! cache key (list auth? qds ans nss ars reply))
(values auth? qds ans nss ars reply))))))
(define (ip->string s)

48
collects/scheme/private/old-procs.ss
View File

@ -10,7 +10,10 @@
free-identifier=?*
namespace-transformer-require
transcript-on
transcript-off)
transcript-off
make-hash-table
make-immutable-hash-table
hash-table?)
(define reflect-var #f)
@ -40,4 +43,45 @@
(define (transcript-on filename)
(error 'transcript-on "unsupported"))
(define (transcript-off)
(error 'transcript-off "unsupported")))
(error 'transcript-off "unsupported"))
(define make-hash-table
(case-lambda
[() (make-hasheq)]
[(a) (if (eq? a 'equal)
(make-hash)
(if (eq? a 'weak)
(make-weak-hasheq)
(raise-mismatch-error "make-hash-table: bad argument: " a)))]
[(a b) (if (or (and (eq? a 'equal)
(eq? b 'weak))
(and (eq? a 'weak)
(eq? b 'equal)))
(make-weak-hash)
(raise-mismatch-error "make-hash-table: bad arguments: " (list a b)))]))
(define make-immutable-hash-table
(case-lambda
[(l) (make-immutable-hasheq l)]
[(l a) (if (eq? a 'equal)
(make-immutable-hash l)
(raise-mismatch-error "make-immutable-hash-table: bad argument: " a))]))
(define hash-table?
(case-lambda
[(v) (hash? v)]
[(v a) (if (eq? a 'equal)
(and (hash? v)
(not (hash-eq? v)))
(if (eq? a 'weak)
(and (hash? v)
(hash-weak? v))
(raise-mismatch-error "hash-table?: bad argument: " a)))]
[(v a b) (if (or (and (eq? a 'equal)
(eq? b 'weak))
(and (eq? a 'weak)
(eq? b 'equal)))
(and (hash? v)
(not (hash-eq? v))
(hash-weak? v))
(raise-mismatch-error "hash-table?: bad arguments: " (list a b)))])))

24
collects/tests/mzscheme/pconvert.ss
View File

@ -200,18 +200,18 @@
'(case-lambda [() ...] [args ...]))
(make-same-test (case-lambda [() 'a] [(x y z) 'a] [x 'a])
'(case-lambda [() ...] [(a1 a2 a3) ...] [args ...]))
(make-same-test (make-hash-table)
'(hash-table))
(make-same-test (make-hash-table 'weak)
'(hash-table 'weak))
(make-same-test (make-hash-table 'equal)
'(hash-table 'equal))
(make-same-test (make-hash-table 'equal 'weak)
'(hash-table 'equal 'weak))
(make-same-test (let ([ht (make-hash-table)])
(hash-table-put! ht 'x 1)
(make-same-test (make-hasheq)
'(hasheq))
(make-same-test (make-weak-hasheq)
'(weak-hasheq))
(make-same-test (make-hash)
'(hash))
(make-same-test (make-weak-hash)
'(weak-hash))
(make-same-test (let ([ht (make-hash)])
(hash-set! ht 'x 1)
ht)
'(hash-table ('x 1)))
'(hash ('x 1)))
(make-pctest (list 'a (box (list '())) (cons 1 '()))
'(list (quote a) (box (list empty)) (list 1))
'(list (quote a) (box (list empty)) (list 1))
@ -354,7 +354,7 @@
(test-shared (vector 1 2 3) '(vector 1 2 3))
(let () (define-struct a () #:inspector (make-inspector)) (test-shared (make-a) '(make-a)))
(test-shared (box 1) '(box 1))
(test-shared (make-hash-table) '(hash-table)))
(test-shared (make-hash) '(hash)))
(arity-test print-convert 1 2)
(arity-test build-share 1 1)