equal-case

equal等値なキーを扱えるようにしたcase。
主にstring型に対して適用することを想定。

;; TODO: 重複キーのチェック(警告)をつけるべき
(defmacro equal-case (expr &rest clauses)
  (let ((v (gensym)))
    `(let ((,v ,expr))
       (cond ,@(stable-sort
                (mapcar 
                 (lambda (clause) 
                   (destructuring-bind (keys . forms) clause
                     (cond ((member keys '(t otherwise))  ; (otherwise|t ...)なら
                            `(t ,@forms))
                           ((consp keys)                  ; ((... ... ...) ...)なら
                            `((member ,v ',keys :test #'equal) ,@forms))
                           (t                             ; (... ...)なら
                            `((equal ,v ,keys) ,@forms)))))
                 clauses)
                ;; otherwise or t が、一番最後の節になるようにする
                #'< :key (lambda (x) (if (eq (car x) t) 1 0)))))))

;; ついでにアナフォリック版も定義
(defmacro a.equal-case (expr &rest clauses)
  `(let ((it ,expr))
     (equal-case it
       ,@clauses)))

使用例。

> (equal-case "integer" 
     ("string"            'int) 
     (otherwise           'unknown) 
     (("integer" "float") 'number))
--> NUMBER

> (a.equal-case "number" 
     ("string"            (format nil "~A is ~A" it 'int))
     (otherwise           (format nil "~A is ~A" it 'unknown))
     (("integer" "float") (format nil "~A is ~A" it 'number)))
--> "number is UNKNOWN"