takada-atです。 前回の記事では、TwitterAPIを取得するライブラリを作成してみました。 その際にメッセージパッシングによる関数呼び出しを利用しましたが、どうも関数のディスパッチの部分が冗長に感じられます。 やりたいことは下のような感じです。 要するに、dispatch関数に、適切なシンボルをわたしたときに、それに応じて関数を呼び出してほしい。

(define (make-twitter-client username password)
  (define (some-function) ...)
  (define (some-function2) ...)
  ...
  (define (dispatch symbol . args)
      (cond ((eq? symbol 'some-function) (some-function))
            ((eq? symbol 'some-function2) (some-function2))))
dispatch)

PHPで書くと以下のようになります。要するに、引数にメッセージをわたして外からは呼べない関数を呼んでほしいわけです。

class SomeClass{
    public function dispatch($symbol){
        switch($symbol){
            case "some_function":
                some_function(); break;
            case "some_function2":
                some_function2(); break;
        }
    }
    private function some_function(){}
    private function some_function2(){}
}

しかし条件分岐を使った呼び出しはどうも冗長です。どうせ関数名をシンボルにわたしてそれを呼び出すだけなのだから、もっと簡単に書けないものでしょうか。 そこでSchemeのマクロに挑戦してみます。 マクロを使ったコード書き換えを利用すれば簡単な表記を実現できるはずです。 まず目標地点。以下のような書き方をめざします。 make-dispatcherマクロに、dispatcherから呼び出したい関数の名前をわたすだけ。

 (make-dispatcher func1 func2 func3)

そこで書いてみたのが以下のマクロです。

(define-syntax make-dispatcher
  (syntax-rules ()
    ;;引数が1つの場合
    ((_ f1)
     ;;以下のコードに置き換え
     (lambda (sym . args)
       (if (eq? sym 'f1)
           ;;シンボルとf1が等しいならf1を呼ぶ
           (apply f1 args)
           ;;等しくなければエラー
           (error "no such procedure"))))
    ;;引数が2つ以上の場合
    ((_ f1 f2 ...)
      ;;以下のコードに置き換え
       (lambda (sym . args)
         (if (eq? sym 'f1)
             ;;シンボルとf1が等しいならf1を呼ぶ
             (apply f1 args)
             ;;引数をへらして再帰
             (apply (make-dispatcher f2 ...) (cons sym args)))))
    ))

引数が1つの場合は簡単です。シンボルと関数名を比較し、同じなら呼び出す、違うならエラー。 引数が1つ以上の場合は、先頭の引数についてのみ比較を行ない、シンボルと関数名が違っている場合は、引数を1つへらして、もう1度make-dispatcherマクロを再帰的に呼び出しています。 これを使えばずっとシンプルに書くことができます。 今まで下のように書いていたのが、

  (define (dispatch symbol . args)
      (cond ((eq? symbol 'replies) (replies))
            ((eq? symbol 'friends-timeline) (friends-timeline))
            ((eq? symbol 'post) (apply post args))
            (else (error "no such procedure"))
            ))

こんなに短かくなるんです。

(make-dispatcher replies friends-timeline post)