続・Lisp Condition Level 2・concat 完成?

背景

Lisp Condition Level 2 - Shammerismの続きです。
前回うまくいかなかった自作 condition の利用だが、どうやら define-condition で :report をしていなかったのがいけないようだ。
参照:http://www.lispworks.com/documentation/lw61/CLHS/Body/f_error.htm

define-condition 変更

(define-condition arguments-not-string-error (error)
  ((text :initarg :text :reader get-error-message))
  (:report (lambda (condition stream)
	     (format stream "~S.~%"
		     (get-error-message condition)))))

concat の実装

labels で定義した string-listp を一部変更。cond 節の (stringp strings) はなくても期待の動作をしてくれそうなので削除。
(defun concat (string1 &rest strings)
  (labels ((string-listp (l)
	     (if (null l)
		 t
		 (if (listp l)
		     (and (stringp (car l)) (string-listp (cdr l)))))))
    (if (stringp string1)
	(cond ((null strings)
	       string1)
	      ((string-listp strings)
	       (let ((result string1))
		 (dolist (s strings)
		   (setf result (concatenate 'string result s)))
		 result))
	      (t
	       (error
		(make-condition
		 'arguments-not-string-error
		 :text "Passed arguments includes objects which is not a string."))))
	(error
	 (make-condition
	  'arguments-not-string-error
	  :text (format nil "concat first argument should be string, but ~A is ~A."
			string1 (type-of string1)))))))

実行結果

ちゃんとエラーが投げられるようになった。

? (concat "abc" "def")
"abcdef"
? (concat "abc" "xyz" 100)
> Error: "Passed arguments includes objects which is not a string.".
>
> While executing: CONCAT, in process listener(1).
> Type :POP to abort, :R for a list of available restarts.
> Type :? for other options.
1 > q
? (concat "abc" "def" 100 "xyz")
> Error: "Passed arguments includes objects which is not a string.".
>
> While executing: CONCAT, in process listener(1).
> Type :POP to abort, :R for a list of available restarts.
> Type :? for other options.
1 >