同じ:testを指定するのが面倒 — #:g1

Posted 2011-02-26 05:00:00 GMT

(member "bar"
        (delete "foo"
                (delete-duplicates
                  (copy-list '(delete "foo" "bar" "baz" "foo" "FOO")))))
のような物を書いた場合、比較するものが文字列になるため、デフォルトのeqlでは比較できていないことになります。
きちんと比較できるようにするには、:testにstring=などを指定して比較にstring=を使うことにしてやれば良いのですが、
(member "bar"
        (delete "foo"
                (delete-duplicates
                  (copy-list '(delete "foo" "bar" "baz" "foo" "FOO"))
                  :test #'string=)
                :test #'string=)
        :test #'string=))
という風になります。長くて重複しているわけです。
これが面倒だなあと以前から思っていたので、どうにかできないかと思ってマクロを書いてみました。
(defvar *foo-operators*
  (atap ()
    ;; clパッケージから:testを受け付けるオペレーターを探す
    (do-symbols (sym :cl)
      (when (and (fboundp sym)
                 (member 'test (member '&key (kl:flatten (swank::arglist sym)))
                         :key #'princ-to-string :test #'string-equal))
        (push sym it)))))

(defun add-test (expr test-fn) (labels ((*self (expr) (destructuring-bind (&optional car &rest cdr) expr (cond ((null expr) () ) ;; ((consp car) (cons (*self car) (*self cdr))) ;; ((eq 'quote car) expr) ;; ((member car *foo-operators*) `(,car ,@(*self cdr) :test ,test-fn)) ;; ('T (cons car (*self cdr))))))) (*self expr)))

(defmacro with-default-test (test &body body) `(progn ,@(add-test body test)))

上のatapは、
(let ((it () ))
  ...
  it)
と等価です。RubyのtapやGaucheのrlet1のアナフォリック版というところです。
使い方は、
(with-default-test (f (x y) (string-equal x y))
  (member "bar"
          (delete "foo"
                  (delete-duplicates
                   (copy-list '(delete "foo" "bar" "baz" "foo" "FOO"))))))
という感じに書くと
(progn
 (member "bar"
         (delete "foo"
                 (delete-duplicates
                  (copy-list '(delete "foo" "bar" "baz" "foo" "FOO"))
                  :test (f (x y) (string-equal x y)))
                 :test (f (x y) (string-equal x y)))
         :test (f (x y) (string-equal x y))))
という風になります。
ちなみに、既に:testが指定されていたらどうするかは考えていないのですが、指定のものを優先とするのが妥当かなと思っています。

comments powered by Disqus