モナド的な何かに向かって

Scheme でプログラムを書いていると (Scheme に限らずなんですが)、このようなパターンが繰り返し出てくることに気付きます:

(let ((the-value (func-which-returns-useful-value-or-#f)))
  (if the-value
    (do-something-based-on the-value)))

ある処理の結果に基づいて別の処理を行いたいんですが、元の処理の結果が有用なものかどうか分からないため、if でテストを行う必要がある、というものです。

この面倒な手続きを簡略化する一つの方法が、Paul Graham の On Lisp にある次のマクロです:

(define-syntax when-bind
  (syntax-rules ()
    ((_ (var exp) body ...)
     (let ((var exp))
       (and var
          (begin body ...))))))

これを用いると、最初のパターンが次のように書けるようになります:

(when-bind (the-value (func-which-returns-useful-value-or-#f))
  (do-something-based-on the-value))

バインディングとテストを一つに纏めることができ、コードが簡潔になります。

さて、同じく On Lisp に fif という関数があります:

(define fif
  (case-lambda
   ((pred then)
    (fif pred then ignore))
   ((pred then else)
    (lambda (x)
        (if (pred x)
            (then x)
            (else x))))))

(define (ignore . _) #f)

ふと、これで when-bind を書き換えてみたらどうだろう、ということを思い付いたんです。こうなりました:

((fif not ignore
      do-something-based-on)
 (func-which-returns-useful-value-or-#f))

印象がずいぶん違いますが、やっていることはほぼ同じです。func-... の結果が #f (false) の時は ignore が呼ばれ、それ以外のときは do-something... にその値が渡されることになります。

ここで注目していただきたいのが、変数 (the-value) へのバインディングがコードから消えてしまっている、という点です。

このように、コード上から関数への引数を消していくことを「ポイントフリー・スタイル」と言うそうです。

何だか楽しそうなので、手当たり次第に when-bind の部分を fif に置き換えていったところ、また新たな繰り返しパターンに気付きました。

"not ignore" の部分です。同じことの繰り返しは明らかに無駄なことをしているサインですよね。

そこで、fif を簡略化して、値が #f でない時だけその値を関数に渡す、という関数を作ることにしました (ここまで考えたところで Haskell のモナドを思い出したので、それらしい名前にしてみました)。

(define (>>= x f)
  (and x (f x)))

モナドに関する詳しい説明は控えますが、副作用 (再代入) の無い Haskell において、状態の変化に基づく処理の流れ・連鎖を実現する機構らしいです。ここでは Maybe モナドというものを意識しています。

この関数を使うと、これまでの例が次のように書けます:

(>>= (func-which-returns-useful-value-or-#f)
     do-something-based-on)

(相方の return を欠き、モナド則も何も考えていない粗雑なものですが、十分便利そうです)

さらに、モナドと言えば処理を繋ぐもの、ということで、この即席の >>= でも連結処理が可能かどうかテストしてみましょう。(a b c) というリストの要素を頭から順に検索する、という演算を行います:

(require (lib "26.ss" "srfi"))

(>>=
 (>>=
  (>>= (memq 'a '(a b c))  ; (a b c) -> (a b c)
       (cut memq 'b <>))   ; (a b c) -> (b c)
  (cut memq 'c <>))        ; (b c)   -> (c)
 car)
; => c

ネストの仕方が分かりにくいのが欠点ですが、ちゃんと意図通りに動作しています。

なお、cut は関数の部分適用を行うマクロです (関数自体を空欄 <> にしてしまうことも出来ます)。その場で lambda を使わずに関数を作りたい場合に便利です (JavaScript 版)。

途中で失敗するケースについても見てみましょう:

(>>=
 (>>=
  (>>= (memq 'a '(a b c))  ; (a b c) -> (a b c)
       (cut memq 'd <>))   ; (a b c) -> #f
  (lambda (l) (/ 1 0)))    ; ??
 car)
; => #f

存在しないキー d を検索した時点で処理が終了し、その後のゼロ除算は実行されません (全体の返り値は #f となっています)。

途中で失敗するかもしれない処理を繋ぐ、という点で Haskell の Maybe モナドと同等の機能があっさり手に入ったことになります。

実際的な例についても見ておきましょう。HTTP ヘッダーから Content-Length の値を取り出して数値化する、というものです (PLT Scheme を使っています):

(require (lib "url.ss" "net"))

(call/input-url
    (string->url
     "http://downloads.bbc.co.uk/rmhttp/downloadtrial/radio4/today/today_20070620-0800_40_pc.mp3")
  get-impure-port
  (lambda (in)
    (print
     (>>=
      (>>= (regexp-match
            #rx"(?mi:^content-length: +([0-9]+))"
            (purify-port in))
           cadr)
      string->number))))
; => 4415388

regexp-match の結果が (whole-match $1 $2 ...) というリストで返ってくるため、最初のマッチ・グループを cadr で取り出し、それを数値に変換しています。

リソースによっては Content-Length を返さないため、>>= の使いどころだと思います。

ちなみに、compose を使って (compose string->number cadr) とすると >>= は一つで済みます。

最後に、>>= の、値を受け取らないバージョンも作ってみます:

(define (>> x f)
  (>>= x (lambda (_) (f))))

使用例:

(>> (display "hello, world!")
    newline)
; => hello, world!\n

(>>= だと "newline: expects argument of type ; given #" のようなエラーになります)

参考資料:
Understanding monads - Wikibooks
All About Monads
Monad - HaskellWiki

追記 [20070624]:
>>= 演算子の連結に関して、ネストの仕方が分かりにくいと書きましたが、Lisp が前置記法であることの利点を忘れてました。こうすれば良かったですね:

(define (>>= x f . ff)
    (and x (if (null? ff)
               (f x)
               (apply >>= (f x) ff))))
(define (>> x . ff)
    (apply >>= x (map (lambda (f)
                        (lambda (_) (f)))
                      ff)))

memq の例リライト:

(>>= (memq 'a '(a b c)) (cut memq 'b <>) (cut memq 'c <>) car)

これでかなり便利になります。

;; scsh (Scheme shell) のパイプの用法 (| (cmd1) (cmd2) ...) を見て気付きました。