Emacs Lisp で switch~case的なやつ

switch~case的なのが無くて不便なのでLispマクロで作ってみました。
作ったのは10年位前かな(。´・ω・)?
どうやって作ったのかも思い出せないので質問されると困る(´・ω・)

(defmacro case-fn (expr fn &rest clauses)
  "Eval EXPR and choose among clauses on that value.
Each clause looks like (KEYLIST BODY...).  EXPR is evaluated and compared
against each key in each KEYLIST; the corresponding BODY is evaluated.
If no clause succeeds, cl-case returns nil.  A single atom may be used in
place of a KEYLIST of one atom.  A KEYLIST of t or `otherwise' is
allowed only in the final clause, and matches if no other keys match.
Key values are compared by `fn'.

example 1: following :-> message/returns \"matched 2\"

(case-fn 2 (lambda (x y) (equal x y))
	 (1 (message \"matched 1\"))
	 (2 (message \"matched 2\"))
	 (t (message \"matched t\")))

example 2: following :-> message/returns \"matched 1\"

(case-fn 2 (lambda (x y) (% x y))
	 (1 (message \"matched 1\"))
	 (2 (message \"matched 2\"))
	 (t (message \"matched t\")))

\n(fn EXPR fn (KEYLIST BODY...)...)"
  (declare (indent 1) (debug (form &rest (sexp body))))
  (macroexp-let2 macroexp-copyable-p temp expr
    (let* ((head-list nil))
      `(cond
        ,@(mapcar
           (lambda (c)
             (cons (cond ((memq (car c) '(t otherwise)) t)
                         ((eq (car c) 'cl--ecase-error-flag)
                          `(error "cl-ecase failed: %s, %s"
                                  ,temp ',(reverse head-list)))
                         ((listp (car c))
                          (setf head-list (append (car c) head-list))
                          `(cl-member ,temp ',(car c) :test ,fn))
                         (t
                          (if (memq (car c) head-list)
                              (error "Duplicate key in case: %s"
                                     (car c)))
                          (push (car c) head-list)
                          `(funcall ,fn ,temp ,(car c))))
                   (or (cdr c) '(nil))))
           clauses)))))

この記事が気に入ったらサポートをしてみませんか?