[Small-cl-src] (loop for (key value) in-hash table do ...)

[Helmut Eller]

;;; A little hack to get nicer syntax for hash-tables with LOOP.
;;; Works in CMUCL.
;;;
;;; Example:
#|
;; cons up some random hash table
(setq *htab* (let ((htab (make-hash-table)))
	       (dotimes (i 50 htab)
	         (setf (gethash i htab) (cons (random 200) (random (1+ i)))))))

;; convert it to a list
(loop for (i (r1 . r2)) in-hash *htab*
      collect (list i r1 r2))

|#

(in-package :ansi-loop)

;; Add a for-in-hash clause to loop.
;; (loop for (key value) in-hash <hashtable> ...)
(defun loop-for-in-hash (key-val htab-form type)
  (declare (ignore type))
  (destructuring-bind (key val) key-val
    (let ((more? (loop-gentemp 'more?))
	  (next (loop-gentemp 'next))
	  (htab (loop-gentemp 'htab))
	  (key-tmp (loop-gentemp 'key-tmp))
	  (val-tmp (loop-gentemp 'val-tmp)))
      (loop-make-variable htab htab-form nil) ; bind htab first
      (loop-make-variable more? nil nil)
      (loop-make-variable key-tmp nil nil)
      (loop-make-variable val-tmp nil nil)
      (push `(with-hash-table-iterator (,next ,htab)) *loop-wrappers*)
      (loop-make-iteration-variable key nil 't)
      (loop-make-iteration-variable val nil 't)
      (list `(progn (multiple-value-setq (,more? ,key-tmp ,val-tmp) (,next))
		    (not ,more?))
	    (list key key-tmp 
		  val val-tmp)))))

(let* ((env *loop-ansi-universe*)
       (htab (loop-universe-for-keywords env)))
  (setf (gethash (string :in-hash) htab) (list 'loop-for-in-hash)))