From 554b440c488a90c8f6bd2d9bf0aee2425dab67ff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9ssica=20Milar=C3=A9?= Date: Sat, 12 Jan 2019 18:15:44 -0200 Subject: [PATCH 08/10] Fix bugs in GENERIC-HASH-TABLES HASH-TABLE-PRUNE! didn't update size after removing keys. HASH-TABLE-DELETE! accessed hash function and associator once per key, instead of accessing only once per procedure call. * module/ice-9/generic-hash-tables.scm (hash-table-prune!): Now updates size after removing keys (bug). * (hash-table-delete!): use WITH-HASHX-VALUES outside of loop, so that hash function and associator are accessed only once. --- module/ice-9/generic-hash-tables.scm | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/module/ice-9/generic-hash-tables.scm b/module/ice-9/generic-hash-tables.scm index 31dead97a..62fd5bb13 100644 --- a/module/ice-9/generic-hash-tables.scm +++ b/module/ice-9/generic-hash-tables.scm @@ -517,19 +517,20 @@ number of keys that had associations." (if (hash-table-delete-single! ht key1) 1 0)) (begin (assert-mutable ht) - (let* ((count 0) - (delete-one! (lambda (key) - (with-hashx-values (h a real-table) ht + (with-hashx-values (h a real-table) ht + (let* ((count 0) + (size (ht-size ht)) + (delete-one! (lambda (key) (when (not (eq? ht-unspecified (hashx-ref h a real-table key ht-unspecified))) (set! count (+ 1 count)) - (hashx-remove! h a real-table key)))))) - (delete-one! key1) - (for-each delete-one! keys) - (unless (or (ht-weakness ht) (zero? count)) - (ht-size! ht (- (ht-size ht) count))) - count)))) + (hashx-remove! h a real-table key))))) + (delete-one! key1) + (for-each delete-one! keys) + (unless (or (ht-weakness ht) (zero? count)) + (ht-size! ht (- size count))) + count))))) (define (hash-table-intern! ht key failure) "Effectively invokes HASH-TABLE-REF with the given arguments and @@ -820,8 +821,10 @@ PROC returns true. Returns an unspecified value." (assert-mutable ht) (with-hashx-values (h a real-table) ht (hash-for-each (lambda (key val) - (if (proc key val) - (hashx-remove! h a real-table key))) + (when (proc key val) + (unless (ht-weakness ht) + (ht-size! ht (- (ht-size ht) 1))) + (hashx-remove! h a real-table key))) real-table))) -- 2.19.1