diff options
author | Andy Wingo <wingo@pobox.com> | 2009-03-20 13:20:28 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-03-20 16:20:00 +0100 |
commit | 80540f391498ebb0f955db2fafb6a36ed03b7886 (patch) | |
tree | fea641155639a7e553ab06fbd67bb8914f865558 | |
parent | 32e49fa35528692a8ac0ddf583655646dd09f36e (diff) | |
download | guile-80540f391498ebb0f955db2fafb6a36ed03b7886.tar.gz |
speed up goops rehashing
* module/oop/goops/dispatch.scm (cache-try-hash!): Speed up goops
rehashing, in theory. I haven't measured, though.
-rw-r--r-- | module/oop/goops/dispatch.scm | 34 |
1 files changed, 15 insertions, 19 deletions
diff --git a/module/oop/goops/dispatch.scm b/module/oop/goops/dispatch.scm index 93fdf98af..a54044729 100644 --- a/module/oop/goops/dispatch.scm +++ b/module/oop/goops/dispatch.scm @@ -185,28 +185,24 @@ sum) (set! sum (+ sum (struct-ref (car classes) hashset-index)))))) -;;; FIXME: the throw probably is expensive, given that this function -;;; might be called an average of 3 or 4 times per rehash... (define (cache-try-hash! min-misses hashset cache entries) (let ((max-misses 0) (mask (- (vector-length cache) 1))) - (catch 'misses - (lambda () - (do ((ls entries (cdr ls)) - (misses 0 0)) - ((null? ls) max-misses) - (do ((i (logand mask (cache-hashval hashset (car ls))) - (logand mask (+ i 1)))) - ((and (pair? (vector-ref cache i)) - (eq? (car (vector-ref cache i)) 'no-method)) - (vector-set! cache i (car ls))) - (set! misses (+ 1 misses)) - (if (>= misses min-misses) - (throw 'misses misses))) - (if (> misses max-misses) - (set! max-misses misses)))) - (lambda (key misses) - misses)))) + (let outer ((in entries) (max-misses 0)) + (if (null? in) + max-misses + (let inner ((i (logand mask (cache-hashval hashset (car in)))) + (misses 0)) + (cond + ((and (pair? (vector-ref cache i)) + (eq? (car (vector-ref cache i)) 'no-method)) + (vector-set! cache i (car in)) + (outer (cdr in) (if (> misses max-misses) misses max-misses))) + (else + (let ((misses (+ 1 misses))) + (if (>= misses min-misses) + misses ;; this is a return, yo. + (inner (logand mask (+ i 1)) misses)))))))))) ;;; ;;; Memoization |