Re: Re: case 構文のキーを括弧でくくると何が変わるのか

• Re: case 構文のキーを括弧でくくると何が変わるのか - the Unspeakable One
• http://d.hatena.ne.jp/kitokitoki/20101001/p1

参考:

• CLHS: Macro CASE, CCASE, ECASE

otherwise-clause なしの case をざっくり実装してみると、こんな感じ。

(defmacro %with-ca/dr (obj &body body)
  `(let* ((#1=#:obj ,obj)
          (car (car #1#))
          (cdr (cdr #1#)))
     ,@body))
=> %with-ca/dr

(defmacro case%0 (key-form &rest clauses)
  `(let ((#1=#:key ,key-form))
     ,(labels ((expand-clauses (clauses)
                 (if (null clauses)
                   nil
                   (%with-ca/dr (car clauses)
                     `(if (,(if (consp car) 'member 'eql) #1# ',car)
                        (progn ,@cdr)
                        ,(expand-clauses (cdr clauses)))))))
        (expand-clauses clauses))))
=> case%0

(setq letter 'u)
=> u

(macroexpand-1 `(case%0 letter (s 's) (t 't) (u 'u) (otherwise 'nothing)))
=> (let ((#1=#:key letter))
     (if (eql #1# 's) (progn 's)
       (if (eql #1# 't) (progn 't)
         (if (eql #1# 'u) (progn 'u)
           (if (eql #1# 'otherwise)
             (progn 'nothing) nil)))))
=> t

これに otherwise-clause を使えるようにするんだけど、otherwise-clause ってなによ？というのを確認する。

Macro CASE, CCASE, ECASE

Syntax:

case keyform {normal-clause}* [otherwise-clause] => result*

ccase keyplace {normal-clause}* => result*

ecase keyform {normal-clause}* => result*

normal-clause::= (keys form*)
otherwise-clause::= ({otherwise | t} form*)
clause::= normal-clause | otherwise-clause

CLHS: Macro CASE, CCASE, ECASE

• clause の先頭が {otherwise | t}
• case 式の最後の clause は otherwise-clause かもしれない

ということになってる。

ポイントは、clauses の最後以外で「先頭が {otherwise|t} な clause」が現れた場合にどうするか。別の言い方をすると otherwise-clause は clauses の最後でなければならないのかどうか。

clauses の最後かどうかを *気にしない* で「先頭が {otherwise|t} なら otherwise-clause」にするとこうなる。たぶん PAIP の説明というのはこういう実装のことを言ってるんだと思う。

(defmacro case%1 (key-form &rest clauses)
  `(let ((#1=#:key ,key-form))
     ,(labels ((expand-clauses (clauses)
                 (if (null clauses)
                   nil
                   (%with-ca/dr (car clauses)
                     (cond ((member car '(otherwise t) :test #'eq)
                            `(progn ,@cdr))
                           (t
                            `(if ,(if (consp car)
                                    `(member #1# ',car)
                                    `(eql #1# ',car))
                               (progn ,@cdr)
                               ,(expand-clauses (cdr clauses)))))))))
        (expand-clauses clauses))))
=> case%1

(macroexpand-1 '(case%1 letter (s 's) (t 't) (u 'u) (otherwise 'nothing)))
=> (let ((#1=#:key letter))
     (if (eql #1# 's) (progn 's)
       (progn 't)))
=> t

次に clauses の最後だけ otherwise-clause かもしれない、という実装。たぶん SBCL がこれ。途中に出てきた (t ...) や (otherwise ...) を何も言わずに (if (eql #:key 't) (progn ...) ..) に展開してくれる。気が利かない、というところか。

(defmacro case%2 (key-form &rest clauses)
  `(let ((#1=#:key ,key-form))
     ,(labels ((expand-clauses (clauses)
                 (%with-ca/dr (car clauses)
                   (if (= (length clauses) 1)
                     ;; 最後の clause
                     (if (member car '(otherwise t) :test #'eq)
                       `(progn ,@cdr)
                       `(if (,(if (consp car) 'member 'eql) #1# ',car)
                          (progn ,@cdr)))
                     ;; 最後以外の clause
                     `(if (,(if (consp car) 'member 'eql) #1# ',car)
                        (progn ,@cdr)
                        ,(expand-clauses (cdr clauses)))))))
        (expand-clauses clauses))))
=> case%2

(macroexpand-1 '(case%2 letter (s 's) (t 't) (u 'u) (otherwise 'nothing)))
=> (let ((#1=#:key letter))
     (if (eql #1# 's) (progn 's)
       (if (eql #1# 't) (progn 't)
         (if (eql #1# 'u) (progn 'u)
           (progn 'nothing)))))
=> t

`(if (,(if (consp car) 'member 'eql) #1# ',car) (progn ,@(cdar clauses)) ..) が2回出てくるあたり「うげぇ」ってなるけど、説明用なので許してください。

余談: clauses を展開するのに mapcar とか使ってると、最後の clause だけ別の処理というのがやりにくかっただろうな、と思ったりしました。

そいで、途中に出てきた (t ...) や (otherwise ...) はどうしよう？ということになるのだけど

keys---a designator for a list of objects. In the case of case, the symbols t and otherwise may not be used as the keys designator. To refer to these symbols by themselves as keys, the designators (t) and (otherwise), respectively, must be used instead.

CLHS: Macro CASE, CCASE, ECASE

を厳密に適用するならエラーでもいいような気もするけど、「融通が利かない」とか「空気読め」って言われそう。というか仕様で定められてないエラー投げるってどうなのよ。

という訳で警告を出すことにする。CCL はできる子。

(defmacro case%3 (key-form &rest clauses)
  `(let ((#1=#:key ,key-form))
     ,(labels ((expand-clauses (clauses)
                 (%with-ca/dr (car clauses)
                   (if (= (length clauses) 1)
                     ;; 最後の clause
                     (if (member car '(otherwise t) :test #'eq)
                       `(progn ,@cdr)
                       `(if (,(if (consp car) 'member 'eql) #1# ',car)
                          (progn ,@cdr)))
                     ;; 最後以外の clause
                     (progn
                       (if (member car '(otherwise t) :test #'eq)
                         (warn "ｺﾞﾙｧ"))
                       `(if (,(if (consp car) 'member 'eql) #1# ',car)
                          (progn ,@cdr)
                          ,(expand-clauses (cdr clauses))))))))
        (expand-clauses clauses))))
=> case%3

(macroexpand-1 '(case%3 letter (s 's) (t 't) (u 'u) (otherwise 'nothing)))
;; simple-warning: ｺﾞﾙｧ
=> (let ((#1=#:key letter))
     (if (eql #1# 's) (progn 's)
       (if (eql #1# 't) (progn 't)
         (if (eql #1# 'u) (progn 'u)
           (progn 'nothing)))))
=> t

あれ。CCL とも SBCL とも違う挙動になっちゃった。

ちなみに: xyzzy の場合

(macroexpand-1 '(case letter (s 's) (t 't) (u 'u) (otherwise 'nothing)))
=> (let ((#1=#:key letter))
     (if (eql #1# 's) (progn 's)
       (progn 't)))
=> t

（このエントリの）ChangeLog

• 2010-11-04
  • キーを括弧でくくった場合のことを忘れてたので修正
  • 微妙にリファクタリングした
  • コードは gist にしとけば良かったと思った