From 2e6c5d9374cc195833dc566d0c7a740366f9cd6b Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Thu, 12 Aug 2010 22:29:28 +0000 Subject: [PATCH] Fix SRFI 69 HASH-TABLE-FOLD. The specification makes no mention of any constraint that the combine procedure not update the hash table, so we must be prepared for that case. The old definition for HASH-TABLE-FOLD now has the new name %HASH-TABLE-FOLD, used internally by the procedures that need to fold but need not update the hash table while doing so. --- src/runtime/hashtb.scm | 41 +++++++++++++++++++++++++---------------- 1 file changed, 25 insertions(+), 16 deletions(-) diff --git a/src/runtime/hashtb.scm b/src/runtime/hashtb.scm index 391ff7465..bbf4a96b6 100644 --- a/src/runtime/hashtb.scm +++ b/src/runtime/hashtb.scm @@ -167,23 +167,30 @@ USA. (hash-table->alist table))) (define (hash-table-fold table procedure initial-value) - (guarantee-hash-table table 'HASH-TABLE-FOLD) - ((table-type-method:fold (table-type table)) table procedure initial-value)) + (fold (lambda (p v) (procedure (car p) (cdr p) v)) + initial-value + (hash-table->alist table))) (define (hash-table->alist table) - (hash-table-fold table - (lambda (key datum alist) (cons (cons key datum) alist)) - '())) + (guarantee-hash-table table 'HASH-TABLE->ALIST) + (%hash-table-fold table + (lambda (key datum alist) (cons (cons key datum) alist)) + '())) (define (hash-table/key-list table) - (hash-table-fold table - (lambda (key datum alist) datum (cons key alist)) - '())) + (guarantee-hash-table table 'HASH-TABLE/KEY-LIST) + (%hash-table-fold table + (lambda (key datum alist) datum (cons key alist)) + '())) (define (hash-table/datum-list table) - (hash-table-fold table - (lambda (key datum alist) key (cons datum alist)) - '())) + (guarantee-hash-table table 'HASH-TABLE/DATUM-LIST) + (%hash-table-fold table + (lambda (key datum alist) key (cons datum alist)) + '())) + +(define (%hash-table-fold table procedure initial-value) + ((table-type-method:fold (table-type table)) table procedure initial-value)) (define (hash-table/rehash-threshold table) (guarantee-hash-table table 'HASH-TABLE/REHASH-THRESHOLD) @@ -865,12 +872,14 @@ USA. table*)))) (define (hash-table-merge! table1 table2) + (guarantee-hash-table table1 'HASH-TABLE-MERGE!) + (guarantee-hash-table table2 'HASH-TABLE-MERGE!) (if (not (eq? table2 table1)) - (hash-table-fold table2 - (lambda (key datum ignore) - ignore - (hash-table/put! table1 key datum)) - unspecific)) + (%hash-table-fold table2 + (lambda (key datum ignore) + ignore + (hash-table/put! table1 key datum)) + unspecific)) table1) ;;;; Miscellany -- 2.25.1