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

add eqv hash tables; add hash-update

Browse Source 
svn: r12018

original commit: ec68bafa9c7114785dc9e02781eeaa33cfcbec4f
This commit is contained in:
Matthew Flatt 2008-10-13 16:21:18 +00:00
parent ae40ef8c69
commit 395eab1669
2 changed files with 29 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/mzlib/pretty.ss
View File

@ -736,7 +736,9 @@
(lambda ()
(out (if (hash-table? obj 'equal)
"#hash"
"#hasheq"))
(if (hash-table? obj 'eqv)
"#hasheqv"
"#hasheq")))
(wr-lst (hash-table-map obj (lambda (k v)
(cons k (make-hide v))))
#f depth
@ -855,7 +857,9 @@
[(hash-table? obj)
(out (if (hash-table? obj 'equal)
"#hash"
"#hasheq"))
(if (hash-table? obj 'eqv)
"#hasheqv"
"#hasheq")))
(pp-list (hash-table-map obj cons) extra pp-expr #f depth
pair? car cdr pair-open pair-close)]
[(and (box? obj) print-box?)

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

@ -54,12 +54,18 @@
(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)
(if (eq? a 'eqv)
(make-hasheqv)
(raise-mismatch-error 'make-hash-table "bad argument: " a))))]
[(a b) (if (or (and (or (eq? a 'equal)
(eq? a 'eqv))
(eq? b 'weak))
(and (eq? a 'weak)
(eq? b 'equal)))
(make-weak-hash)
(or (eq? b 'equal)
(eq? b 'eqv))))
(if (or (eq? a 'eqv) (eq? b 'eqv))
(make-weak-hasheqv)
(make-weak-hash))
(raise-mismatch-error 'make-hash-table "bad arguments: " (list a b)))]))
(define make-immutable-hash-table
@ -67,23 +73,30 @@
[(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))]))
(if (eq? a 'eqv)
(make-immutable-hasheqv 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)))
(not (hash-eq? v))
(not (hash-eqv? 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)
(if (eq? a 'eqv)
(hash-eqv? v)
(raise-mismatch-error 'hash-table? "bad argument: " a))))]
[(v a b) (if (or (and (or (eq? a 'equal) (eq? a 'eqv))
(eq? b 'weak))
(and (eq? a 'weak)
(eq? b 'equal)))
(or (eq? b 'equal) (eq? b 'eqv))))
(and (hash? v)
(not (hash-eq? v))
(if (or (eq? a 'eqv) (eq? b 'eqv))
(hash-eqv? v)
(not (or (hash-eq? v) (hash-eqv? v))))
(hash-weak? v))
(raise-mismatch-error 'hash-table? "bad arguments: " (list a b)))])))