[xyzzy:08953] Re: リストから取得した要素について

[Yoshitaka Nishiguti <pocari@xxxxxxxxxxxxxxx>]

こんばんは。西口です。

(cond
 ((string-equal ext "cpp")
  'hoge)
 ((string-equal ext "c")
  'boo)
 ((string-equal ext "h")
  'piyo))

のような処理を見て、

(setq full-path "d:/hoge/hoge.cpp")
(case-ex ((pathname-type full-path) :test #'string-equal)
  ("cpp" 'hoge)
  ("c"   'boo)
  ("h"   'piyo))
hoge

みたいにできるかなーと思ったらできません。
調べたら、eqlで比較されちゃうんですね。

というわけで、比較関数を指定できるcaseを書いてみました。

;;
(defmacro case-ex ((key &key (test #'eql)) &body body)
  (let ((key-sym (gensym)))
    (labels ((inner (k lst)
	       (when lst
		 (if (consp (caar lst))
		     `(if (member ,k ',(caar lst) :test ,test)
			  ,(cadar lst)
			,(inner k (cdr lst)))
		   (if (or (eq (caar lst) t)
			   (eq (caar lst) 'otherwise))
		       (cadar lst)
		     `(if (funcall ,test ,k ,(caar lst))
			  ,(cadar lst)
			,(inner k (cdr lst))))))))
      `(let ((,key-sym ,key))
	 ,(inner key-sym body)))))
;;

(setq full-path "d:/hoge/hoge.cpp")
=> "d:/hoge/hoge.cpp"

(case-ex ((pathname-type full-path) :test #'string-equal)
  ("cpp" 'hoge)
  ("c"   'boo)
  ("h"   'piyo))
=> hoge

(case-ex (keyform &key test)
  (lst1 expr2)
  (lst2 expr2)
  ...)
test省略時はcaseと同じくeqlです。

多分大丈夫・・・かな？