mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 21:40:33 +02:00
Code Activity

vlist: Slightly improve readability and consistency.

Browse source 
* module/ice-9/vlist.scm (define-inline): Fix case with non-singleton
  body.
  (make-vhash-assoc): Remove.  Change to...
  (%vhash-assoc): ... this, using `define-inline'.
This commit is contained in:
Ludovic Courtès 2010-02-05 10:38:38 +01:00
parent d8873dfe47
commit 0c368d2b28
1 changed files with 34 additions and 37 deletions
Download patch file Download diff file Expand all files Collapse all files

71
module/ice-9/vlist.scm
View file

@ -73,7 +73,7 @@
(define-syntax name (define-syntax name
(syntax-rules () (syntax-rules ()
((_ formals ...) ((_ formals ...)
body ...)))))) (begin body ...)))))))
(define-inline (make-block base offset size hash-tab?) (define-inline (make-block base offset size hash-tab?)
;; Return a block (and block descriptor) of SIZE elements pointing to BASE ;; Return a block (and block descriptor) of SIZE elements pointing to BASE
@ -408,55 +408,52 @@ with @var{value}. Use @var{hash} to compute @var{key}'s hash."
(define vhash-consq (cut vhash-cons <> <> <> hashq)) (define vhash-consq (cut vhash-cons <> <> <> hashq))
(define vhash-consv (cut vhash-cons <> <> <> hashv)) (define vhash-consv (cut vhash-cons <> <> <> hashv))
(define-syntax make-vhash-assoc ;; This hack to make sure `vhash-assq' gets to use the `eq?' instruction instead
;; This hack to make sure `vhash-assq' gets to use the `eq?' instruction ;; of calling the `eq?' subr.
;; instead of calling the `eq?' subr. (define-inline (%vhash-assoc key vhash equal? hash)
(syntax-rules () (define khash
((_ key vhash equal? hash) (let ((size (block-size (vlist-base vhash))))
(begin (and (> size 0) (hash key size))))
(define khash
(let ((size (block-size (vlist-base vhash))))
(and (> size 0) (hash key size))))
(let loop ((base (vlist-base vhash)) (let loop ((base (vlist-base vhash))
(khash khash) (khash khash)
(offset (and khash (offset (and khash
(block-hash-table-ref (vlist-base vhash) (block-hash-table-ref (vlist-base vhash)
khash))) khash)))
(max-offset (vlist-offset vhash))) (max-offset (vlist-offset vhash)))
(let ((answer (and offset (block-ref base offset)))) (let ((answer (and offset (block-ref base offset))))
(cond ((and (pair? answer) (cond ((and (pair? answer)
(<= offset max-offset) (<= offset max-offset)
(let ((answer-key (caar answer))) (let ((answer-key (caar answer)))
(equal? key answer-key))) (equal? key answer-key)))
(car answer)) (car answer))
((and (pair? answer) (cdr answer)) ((and (pair? answer) (cdr answer))
=> =>
(lambda (next-offset) (lambda (next-offset)
(loop base khash next-offset max-offset))) (loop base khash next-offset max-offset)))
(else (else
(let ((next-base (block-base base))) (let ((next-base (block-base base)))
(and next-base (and next-base
(> (block-size next-base) 0) (> (block-size next-base) 0)
(let* ((khash (hash key (block-size next-base))) (let* ((khash (hash key (block-size next-base)))
(offset (block-hash-table-ref next-base khash))) (offset (block-hash-table-ref next-base khash)))
(loop next-base khash offset (loop next-base khash offset
(block-offset base))))))))))))) (block-offset base))))))))))
(define* (vhash-assoc key vhash #:optional (equal? equal?) (hash hash)) (define* (vhash-assoc key vhash #:optional (equal? equal?) (hash hash))
"Return the first key/value pair from @var{vhash} whose key is equal to "Return the first key/value pair from @var{vhash} whose key is equal to
@var{key} according to the @var{equal?} equality predicate." @var{key} according to the @var{equal?} equality predicate."
(make-vhash-assoc key vhash equal? hash)) (%vhash-assoc key vhash equal? hash))
(define (vhash-assq key vhash) (define (vhash-assq key vhash)
"Return the first key/value pair from @var{vhash} whose key is @code{eq?} to "Return the first key/value pair from @var{vhash} whose key is @code{eq?} to
@var{key}." @var{key}."
(make-vhash-assoc key vhash eq? hashq)) (%vhash-assoc key vhash eq? hashq))
(define (vhash-assv key vhash) (define (vhash-assv key vhash)
"Return the first key/value pair from @var{vhash} whose key is @code{eqv?} to "Return the first key/value pair from @var{vhash} whose key is @code{eqv?} to
@var{key}." @var{key}."
(make-vhash-assoc key vhash eqv? hashv)) (%vhash-assoc key vhash eqv? hashv))
(define* (vhash-delete key vhash #:optional (equal? equal?) (hash hash)) (define* (vhash-delete key vhash #:optional (equal? equal?) (hash hash))
"Remove all associations from @var{vhash} with @var{key}, comparing keys "Remove all associations from @var{vhash} with @var{key}, comparing keys