はじめに

　ハッシュテーブルに対する処理を簡単に行いたいと思いました。
　単純にハッシュテーブルの中に何が入っているかを確認したいときでも、SBCLではハッシュテーブルが格納されている変数名をREPLに打つと、下のように表示されて何が入っているか分かりません。

hash_table.lisp

(defparameter *hash* (make-hash-table))
(setf (gethash 'color *hash*) 'red)
(setf (gethash 'height *hash*) 185)
(setf (gethash 'weight *hash*) 110)
(setf (gethash 'name *hash*) "Mukku")

#<HASH-TABLE :TEST EQL :COUNT 4 {10036DA9B3}>

　CLISPだと中身も表示されます。

#S(HASH-TABLE :TEST FASTHASH-EQL (NAME . "Mukku") (WEIGHT . 110) (HEIGHT . 185) (COLOR . RED))

　なのでSBCLでハッシュテーブルの中身を確認するときは、下のようなコードを実行しています。

hash.lisp

(maphash #'(lambda (key value)
			 (format t "~A => ~A~%" key value))
		 *hash*)

; COLOR => RED
; HEIGHT => 185
; WEIGHT => 110
; NAME => Mukku

　loopマクロを使うと下のようなコードになります。

loop.lisp

(loop for key being each hash-key of *hash*
	  using (hash-value value)
	  do (format t "~A => ~A~%" key value))

; COLOR => RED
; HEIGHT => 185
; WEIGHT => 110
; NAME => Mukku

　これを簡単に書くためのマクロを練習がてら実装してみました。

実装

　ここのマクロはデフォルトではハッシュテーブルのキーが変数key、値が変数valueとなっています。ですがソースコードの可読性向上のために、キーと値に任意の変数名を割り当てたいことも多いと思います。そういう時にある程度制約はありますが、変数名を指定できるようにしました。

hash_macro.lisp

(defmacro hash (hash-table &body body)
  (let ((first-body (first body)))
    (cond
	  ((and (listp first-body)
			(= (length first-body) 2))
	   (if (fboundp (car first-body))
           (error (format nil"~A is function" (car first-body)))
           (cond
             ((and (not (car first-body))
                   (cadr first-body))
              `(maphash #'(lambda (key ,(cadr first-body))
                            ,@(cdr body))
                        ,hash-table))
             ((and (car first-body)
                   (not (cadr first-body)))
              `(maphash #'(lambda (,(car first-body) value)
                            ,@(cdr body))
                        ,hash-table))
             ((and (not (car first-body)) (not (cadr first-body))))
              `(maphash #'(lambda (key value)
                            ,@(cdr body))
                        ,hash-table))
             (t
              `(maphash #'(lambda ,first-body
                            ,@(cdr body))
                        ,hash-table)))))
	  (t
	   `(maphash #'(lambda (key value)
					 ,@body)
				 ,hash-table)))))

;; loop版
(defmacro hash/loop (hash-table &body body)
  (let ((first-body (first body)))
	(cond
	  ((and (listp first-body)
			(= (length first-body) 2))
       (if (fboundp (car first-body))
           (error (format nil"~A is function" (car first-body)))
           (cond
             ((and (not (car first-body))
			   (cadr first-body))
		  `(loop for key being each hash-key of ,hash-table
				 using (hash-value ,(cadr first-body))
				 do ,@(cdr body)))
		 ((and (car first-body)
			   (not (cadr first-body)))
		  `(loop for ,(car first-body) being each hash-key of ,hash-table
				 using (hash-value value)
				 do ,@(cdr body)))
		 ((and (not (car first-body)) (not (cadr first-body))))
		  `(loop for key being each hash-key of ,hash-table
			  using (hash-value value)
				 do ,@(cdr body)))
		 (t
		   `(loop for ,(car first-body) being each hash-key of ,hash-table
				  using (hash-value ,(cadr first-body))
				  do ,@(cdr body))))))
      (t
	   `(loop for key being each hash-key of ,hash-table
			  using (hash-value value)
			  do ,@body)))))

使い方

　下のハッシュテーブルを例にします。

hash_table2.lisp

(defparameter *heights* (make-hash-table))
(setf (gethash 'gachapin *heights*) 165)
(setf (gethash 'mukku *heights*) 185)
(setf (gethash 'mumin *heights*) 20)

test.lisp

(hash *heights*
  (format t "~A => ~A~%" key value))

; GACHAPIN => 165
; MUKKU => 185
; MUMIN => 20

(hash *heights*
  (chara height)
  (format t "~A => ~A~%" chara height))

; GACHAPIN => 165
; MUKKU => 185
; MUMIN => 20


(hash *heights*
  (chara nil)
  (format t "~A => ~A~%" chara value))

; GACHAPIN => 165
; MUKKU => 185
; MUMIN => 20


(hash *heights*
  (nil height)
  (format t "~A => ~A~%" key height))

; GACHAPIN => 165
; MUKKU => 185
; MUMIN => 20

(hash *heights*
  (chara height)
  (format t "~A => ~A~%" chara height))

; GACHAPIN => 165
; MUKKU => 185
; MUMIN => 20

(hash *heights*
  (nil nil)
  (format t "~A => ~A~%" key value))

; GACHAPIN => 165
; MUKKU => 185
; MUMIN => 20

　hashマクロの第2引数が要素2で、carが関数でないリストであると、それをハッシュテーブルのキーと値の変数名として扱います。carが関数だとエラーが出るようになっています。
　また片方だけ指定し、もう一方をnilにすると、指定した方は変数名を、指定していない方はデフォルトの変数名を使用するようになっています。また両方がnilの場合、デフォルト値を使用するようにしました。

おわりに

　初めはキーワード引数を指定すると、指定した変数名とデフォルトの変数名を簡単に設定できると思っていました。しかし&bodyの前に&keyは書けないということを理解していませんでした。
　またマクロ名を考えるのも難しく、最終的にhashという名前になってしまいました。いい名前が考えつかなかったです。
　初めはもっと簡単に書いて終わる予定でしたが、色々追加することになりました。考えたものをすぐコードに書くことができ、実行できるのがLispを書いていて楽しいところです。ですが冗長な部分も多く存在していて、重複したところをマクロにしたりすると、もっとすっきり書けるのかなと思っています。

補足

　with-hash-table-iteratorというものもあることを知りました。使い方は下のようになっています。

with_hash_table_iterator.lisp

(with-hash-table-iterator (iterator *heights*)
  (loop (multiple-value-bind (entry-p key value) (iterator)
		  (if entry-p
			  (format t "~A => ~A~%" key value)
			  (return)))))

; GACHAPIN => 165
; MUKKU => 185
; MUMIN => 20

修正

　第2引数carが関数だとエラーになる仕様だと、初めに1引数の関数が使えないということになってしまいます。なのでこの仕様は取り除こうと思います。修正したコードは下のようになっています。

hash_macro2.lisp

(defmacro hash (hash-table &body body)
  (let ((first-body (first body)))
    (cond
	  ((and (listp first-body)
			(= (length first-body) 2)
            (not (fboundp (car first-body))))
	   (cond
         ((and (not (car first-body))
               (cadr first-body))
          `(maphash #'(lambda (key ,(cadr first-body))
                        ,@(cdr body))
                    ,hash-table))
         ((and (car first-body)
               (not (cadr first-body)))
          `(maphash #'(lambda (,(car first-body) value)
                        ,@(cdr body))
                    ,hash-table))
         ((and (not (car first-body)) (not (cadr first-body))))
          `(maphash #'(lambda (key value)
                        ,@(cdr body))
                    ,hash-table))
         (t
          `(maphash #'(lambda ,first-body
                        ,@(cdr body))
                    ,hash-table))))
	  (t
	   `(maphash #'(lambda (key value)
					 ,@body)
				 ,hash-table)))))

;; loop版
(defmacro hash/loop (hash-table &body body)
  (let ((first-body (first body)))
	(cond
	  ((and (listp first-body)
			(= (length first-body) 2)
            (not (fboundp (car first-body))))
       (cond
         ((and (not (car first-body))
               (cadr first-body))
          `(loop for key being each hash-key of ,hash-table
                 using (hash-value ,(cadr first-body))
                 do ,@(cdr body)))
         ((and (car first-body)
               (not (cadr first-body)))
          `(loop for ,(car first-body) being each hash-key of ,hash-table
                 using (hash-value value)
                 do ,@(cdr body)))
         ((and (not (car first-body)) (not (cadr first-body))))
          `(loop for key being each hash-key of ,hash-table
                 using (hash-value value)
                 do ,@(cdr body)))
         (t
          `(loop for ,(car first-body) being each hash-key of ,hash-table
                 using (hash-value ,(cadr first-body))
                 do ,@(cdr body)))))
      (t
	   `(loop for key being each hash-key of ,hash-table
			  using (hash-value value)
			  do ,@body)))))

　まだバグが残っているかもしれませんが、気付き次第修正していこうと思います。