Shammer's Philosophy

My private adversaria

with-open-passive-socket 改 ver 20110709

with-open-passive-socket 改 ver 20110706 - Shammerismの内容でもいいのだが、このマクロの場合はメインの処理に相当する部分が when に渡されることになるので、メインの処理をつなぎ合わせるときに progn はなくてもいい。と、いうわけで progn を外してやってみた。

(defmacro with-open-passive-socket (&rest body)
  (let ((server-symbol-value (caar body))
	(server-listen-addr (cadar body))
	(server-listen-port (caddar body))
	(main-body (let ((temp-body nil))
		     (dolist (x (cdr body))
		       (setf temp-body (append temp-body (list x))))
		     temp-body)))
    `(let ((,server-symbol-value (open-socket-server ,server-listen-addr ,server-listen-port)))
       (unwind-protect
	    (when ,server-symbol-value
	      ,main-body)
	 (unless (null ,server-symbol-value)
	   (format t "Close server socket...~%")
	   (close-server-socket ,server-symbol-value))))))

しかし、これだとうまく動作しなかった。エラーになった部分をよく見ると、

((LOG-OWN-IP-PORT-INFO SERVER)
 (DO ()
     (NIL)
   (LET* ((CLIENT (ACCEPT-CLIENT-SOCKET SERVER))
          (STREAM (MAKE-SOCKET-STREAM CLIENT)))
     (LOG-PEER-IP-PORT-INFO CLIENT)
 ...

となっている。これは when に渡される部分なので、実際に実行されるコードは

(WHEN
 ((LOG-OWN-IP-PORT-INFO SERVER)
   (DO ()
       (NIL)
     (LET* ((CLIENT (ACCEPT-CLIENT-SOCKET SERVER))
           (STREAM (MAKE-SOCKET-STREAM CLIENT)))
       (LOG-PEER-IP-PORT-INFO CLIENT)
       ...

という感じになっていることになる。when の直後の ( が一つ邪魔だ。(progn (some-function ...)) であれば問題なく解釈できるが、*1 だとそりゃエラーにもなるわ。。。この一番外側の余計な括弧を外してやらないといけない。さあ、@ の出番でございます!

(defmacro with-open-passive-socket (&rest body)
  (let ((server-symbol-value (caar body))
	(server-listen-addr (cadar body))
	(server-listen-port (caddar body))
	(main-body (let ((temp-body nil))
		     (dolist (x (cdr body))
		       (setf temp-body (append temp-body (list x))))
		     temp-body)))
    `(let ((,server-symbol-value (open-socket-server ,server-listen-addr ,server-listen-port)))
       (unwind-protect
	    (when ,server-symbol-value
	      ,@main-body)
	 (unless (null ,server-symbol-value)
	   (format t "Close server socket...~%")
	   (close-server-socket ,server-symbol-value))))))

これで問題なく動作するようになった。

*1:some-function ...