;;; 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)))