Ticket #1718: srfi-69.diff

File srfi-69.diff, 6.6 KB (added by Kon Lovett, 2 months ago)

SVN diff of suggested changes

  • trunk/srfi-69.scm

     
    981981          (if (eq? core-eq? test)
    982982              ; Fast path (eq? is rewritten by the compiler):
    983983              (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) ) ) ) )
    995994              ; Slow path
    996995              (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) ) ) ) ) ) ) ) ) ) )
    10081006
    10091007;; hash-table-remove!:
    10101008
     
    10171015      (do ([i 0 (fx+ i 1)])
    10181016          [(fx>= i len) (##sys#setislot ht 2 siz)]
    10191017        (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 ) ) ) ) ) ) ) ) )
    10311028
    10321029;; hash-table-clear!:
    10331030
     
    10511048(define (hash-table-merge! ht1 ht2)
    10521049  (##sys#check-structure ht1 'hash-table 'hash-table-merge!)
    10531050  (##sys#check-structure ht2 'hash-table 'hash-table-merge!)
    1054   (*hash-table-merge! ht1 ht2) )
     1051  (*hash-table-merge! ht1 ht2)
     1052  (void) )
    10551053
    10561054(define (hash-table-merge ht1 ht2)
    10571055  (##sys#check-structure ht1 'hash-table 'hash-table-merge)
  • trunk/srfi-69.types

     
    77(srfi-69#hash-table->alist (#(procedure #:clean #:enforce) srfi-69#hash-table->alist ((struct hash-table)) (list-of pair)))
    88(srfi-69#hash-table-clear! (#(procedure #:clean #:enforce) srfi-69#hash-table-clear! ((struct hash-table)) undefined))
    99(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))
    1111(srfi-69#hash-table-equivalence-function (#(procedure #:clean #:enforce) srfi-69#hash-table-equivalence-function ((struct hash-table)) (procedure (* *) *)))
    1212(srfi-69#hash-table-exists? (#(procedure #:clean #:enforce) srfi-69#hash-table-exists? ((struct hash-table) *) boolean))
    1313(srfi-69#hash-table-fold (#(procedure #:enforce) srfi-69#hash-table-fold ((struct hash-table) (procedure (* * *) *) *) *))
  • trunk/tests/hash-table-tests.scm

     
    7777(assert (eq? (hash-table-ref ht 23.0) 'foo-bar))
    7878
    7979(print "HT - Delete")
    80 (assert (hash-table-delete! ht 23.0))
     80(hash-table-delete! ht 23.0)
    8181(assert (not (hash-table-exists? ht 23.0)))
    8282(assert (= (hash-table-size ht) 1))
    8383
    8484(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)))
    8686(assert (not (hash-table-exists? ht 'baz)))
    8787(assert (= (hash-table-size ht) 0))
    8888
     
    9595(let ([ht2 (make-hash-table)])
    9696  (set! (hash-table-ref ht2 23.0) 'bar)
    9797  (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)) ) )
    109107
    110108(print "HT - Merge")
    111109(let ([ht2 (make-hash-table)])