Ticket #1718: srfi-69.diff
| File srfi-69.diff, 6.6 KB (added by , 4 years ago) |
|---|
-
trunk/srfi-69.scm
981 981 (if (eq? core-eq? test) 982 982 ; Fast path (eq? is rewritten by the compiler): 983 983 (let loop ([prev #f] [bucket bucket0]) 984 (and (not (null? bucket)) 985 (let ([pare (##sys#slot bucket 0)] 986 [nxt (##sys#slot bucket 1)]) 987 (if (eq? key (##sys#slot pare 0)) 988 (begin 989 (if prev 990 (##sys#setslot prev 1 nxt) 991 (##sys#setslot vec hshidx nxt) ) 992 (##sys#setislot ht 2 newsiz) 993 #t ) 994 (loop bucket nxt) ) ) ) ) 984 (unless (null? bucket) 985 (let ([pare (##sys#slot bucket 0)] 986 [nxt (##sys#slot bucket 1)]) 987 (if (eq? key (##sys#slot pare 0)) 988 (begin 989 (if prev 990 (##sys#setslot prev 1 nxt) 991 (##sys#setslot vec hshidx nxt) ) 992 (##sys#setislot ht 2 newsiz) ) 993 (loop bucket nxt) ) ) ) ) 995 994 ; Slow path 996 995 (let loop ([prev #f] [bucket bucket0]) 997 (and (not (null? bucket)) 998 (let ([pare (##sys#slot bucket 0)] 999 [nxt (##sys#slot bucket 1)]) 1000 (if (test key (##sys#slot pare 0)) 1001 (begin 1002 (if prev 1003 (##sys#setslot prev 1 nxt) 1004 (##sys#setslot vec hshidx nxt) ) 1005 (##sys#setislot ht 2 newsiz) 1006 #t ) 1007 (loop bucket nxt) ) ) ) ) ) ) ) ) ) ) 996 (unless (null? bucket) 997 (let ([pare (##sys#slot bucket 0)] 998 [nxt (##sys#slot bucket 1)]) 999 (if (test key (##sys#slot pare 0)) 1000 (begin 1001 (if prev 1002 (##sys#setslot prev 1 nxt) 1003 (##sys#setslot vec hshidx nxt) ) 1004 (##sys#setislot ht 2 newsiz) ) 1005 (loop bucket nxt) ) ) ) ) ) ) ) ) ) ) 1008 1006 1009 1007 ;; hash-table-remove!: 1010 1008 … … 1017 1015 (do ([i 0 (fx+ i 1)]) 1018 1016 [(fx>= i len) (##sys#setislot ht 2 siz)] 1019 1017 (let loop ([prev #f] [bucket (##sys#slot vec i)]) 1020 (and (not (null? bucket)) 1021 (let ([pare (##sys#slot bucket 0)] 1022 [nxt (##sys#slot bucket 1)]) 1023 (if (func (##sys#slot pare 0) (##sys#slot pare 1)) 1024 (begin 1025 (if prev 1026 (##sys#setslot prev 1 nxt) 1027 (##sys#setslot vec i nxt) ) 1028 (set! siz (fx- siz 1)) 1029 #t ) 1030 (loop bucket nxt ) ) ) ) ) ) ) ) ) 1018 (unless (null? bucket) 1019 (let ([pare (##sys#slot bucket 0)] 1020 [nxt (##sys#slot bucket 1)]) 1021 (if (func (##sys#slot pare 0) (##sys#slot pare 1)) 1022 (begin 1023 (if prev 1024 (##sys#setslot prev 1 nxt) 1025 (##sys#setslot vec i nxt) ) 1026 (set! siz (fx- siz 1)) ) 1027 (loop bucket nxt ) ) ) ) ) ) ) ) ) 1031 1028 1032 1029 ;; hash-table-clear!: 1033 1030 … … 1051 1048 (define (hash-table-merge! ht1 ht2) 1052 1049 (##sys#check-structure ht1 'hash-table 'hash-table-merge!) 1053 1050 (##sys#check-structure ht2 'hash-table 'hash-table-merge!) 1054 (*hash-table-merge! ht1 ht2) ) 1051 (*hash-table-merge! ht1 ht2) 1052 (void) ) 1055 1053 1056 1054 (define (hash-table-merge ht1 ht2) 1057 1055 (##sys#check-structure ht1 'hash-table 'hash-table-merge) -
trunk/srfi-69.types
7 7 (srfi-69#hash-table->alist (#(procedure #:clean #:enforce) srfi-69#hash-table->alist ((struct hash-table)) (list-of pair))) 8 8 (srfi-69#hash-table-clear! (#(procedure #:clean #:enforce) srfi-69#hash-table-clear! ((struct hash-table)) undefined)) 9 9 (srfi-69#hash-table-copy (#(procedure #:clean #:enforce) srfi-69#hash-table-copy ((struct hash-table)) (struct hash-table))) 10 (srfi-69#hash-table-delete! (#(procedure #:clean #:enforce) srfi-69#hash-table-delete! ((struct hash-table) *) boolean))10 (srfi-69#hash-table-delete! (#(procedure #:clean #:enforce) srfi-69#hash-table-delete! ((struct hash-table) *) undefined)) 11 11 (srfi-69#hash-table-equivalence-function (#(procedure #:clean #:enforce) srfi-69#hash-table-equivalence-function ((struct hash-table)) (procedure (* *) *))) 12 12 (srfi-69#hash-table-exists? (#(procedure #:clean #:enforce) srfi-69#hash-table-exists? ((struct hash-table) *) boolean)) 13 13 (srfi-69#hash-table-fold (#(procedure #:enforce) srfi-69#hash-table-fold ((struct hash-table) (procedure (* * *) *) *) *)) -
trunk/tests/hash-table-tests.scm
77 77 (assert (eq? (hash-table-ref ht 23.0) 'foo-bar)) 78 78 79 79 (print "HT - Delete") 80 ( assert (hash-table-delete! ht 23.0))80 (hash-table-delete! ht 23.0) 81 81 (assert (not (hash-table-exists? ht 23.0))) 82 82 (assert (= (hash-table-size ht) 1)) 83 83 84 84 (print "HT - Remove") 85 ( assert (hash-table-remove! ht (lambda (k v) (eq? k 'baz))))85 (hash-table-remove! ht (lambda (k v) (eq? k 'baz))) 86 86 (assert (not (hash-table-exists? ht 'baz))) 87 87 (assert (= (hash-table-size ht) 0)) 88 88 … … 95 95 (let ([ht2 (make-hash-table)]) 96 96 (set! (hash-table-ref ht2 23.0) 'bar) 97 97 (set! (hash-table-ref ht2 'baz) 'foo) 98 (let ([ht3 (hash-table-merge! ht2 ht)]) 99 (assert (eq? ht3 ht2)) 100 (assert (not (eq? ht3 ht))) 101 (let ([alist (hash-table->alist ht3)]) 102 (assert (list? alist)) 103 (assert (= (length alist) 5)) 104 (assert (eq? (alist-ref "abc" alist equal?) #t)) 105 (assert (eq? (alist-ref "cbs" alist equal?) #t)) 106 (assert (eq? (alist-ref "cnn" alist equal?) #f)) 107 (assert (eq? (alist-ref 23.0 alist) 'bar)) 108 (assert (eq? (alist-ref 'baz alist) 'foo)) ) ) ) 98 (hash-table-merge! ht2 ht) 99 (let ([alist (hash-table->alist ht2)]) 100 (assert (list? alist)) 101 (assert (= (length alist) 5)) 102 (assert (eq? (alist-ref "abc" alist equal?) #t)) 103 (assert (eq? (alist-ref "cbs" alist equal?) #t)) 104 (assert (eq? (alist-ref "cnn" alist equal?) #f)) 105 (assert (eq? (alist-ref 23.0 alist) 'bar)) 106 (assert (eq? (alist-ref 'baz alist) 'foo)) ) ) 109 107 110 108 (print "HT - Merge") 111 109 (let ([ht2 (make-hash-table)])
