This is the mail archive of the guile@cygnus.com mailing list for the guile project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]

Re: hash-table-for-each, hash-table-map



here are my attempts at some hash table utility functions.  suggestions
welcome.

kind regards,
-russ



(define (hash-table-map proc ht)
  "for each key/value association in HT, calls the supplied PROC with
the key and value as arguments and builds a list of PROC's return values.  
the list of return values is returned."
  (let ((v-len (vector-length ht)))
    (define (handle-row row ret-ls)
      (if (= row v-len)
	  ret-ls
	  (handle-ls (+ 1 row) (vector-ref ht row) ret-ls)))
    (define (handle-ls row ls ret-ls)
      (if (null? ls)
	  (handle-row row ret-ls)
	  (let ((pair (car ls)))
	    (handle-ls row (cdr ls) (cons (proc (car pair) (cdr pair)) ret-ls)))))
    (handle-row 0 '())))

(define (hash-table-predicate proc ht)
  "for each key/value association in HT, calls the supplied PROC with
the key and value as arguments.  an alist is returned that includes each
key/value pair for which PROC returned any value other than '#f'.  do not
mutate the association pairs in the returned alist: they are shared with HT."
  (let ((v-len (vector-length ht)))
    (define (handle-row row ret-ls)
      (if (= row v-len)
	  ret-ls
	  (handle-ls (+ 1 row) (vector-ref ht row) ret-ls)))
    (define (handle-ls row ls ret-ls)
      (if (null? ls)
	  (handle-row row ret-ls)
	  (let* ((pair (car ls))
		 (status (proc (car pair) (cdr pair))))
	  (handle-ls row (cdr ls) (if status (cons pair ret-ls) ret-ls)))))
    (handle-row 0 '())))

(define (hash-table-for-each proc ht)
  "for each key/value association in HT, calls the supplied PROC with
the key and value.  the return values from PROC or ignored.  returns
#t."
  (let ((v-len (vector-length ht)))
    (define (handle-row row)
      (if (= row v-len)
	  #t
	  (handle-ls (+ 1 row) (vector-ref ht row))))
    (define (handle-ls row ls)
      (if (null? ls)
	  (handle-row row)
	  (let ((pair (car ls)))
	    (proc (car pair) (cdr pair))
	    (handle-ls row (cdr ls)))))
  (handle-row 0)))

(define foo (make-hash-table 10))
(hashq-set! foo 'russ 1)
(hashq-set! foo 'ellen 2)
(hashq-set! foo 'mike 3)
(hashq-set! foo 'jim 4)
(hash-table-map (lambda (key val) (+ 1 val)) foo)
(hash-table-for-each (lambda (key val) (printf "%a %a\n" key val)) foo)
(hash-table-predicate (lambda (key val) (< val 3)) foo)

---
"Crime does not pay... as well as politics."
		--A. E. Newman