SchemeでMonadを書こう、という話はちょくちょくある。
実用的な見地からは、Monadが便利なのはモナド則を満たす基本演算を定義 しておけば他の色々な操作がジェネリックに行えることだ。 (call-with-iteratorsさえ定義しておけばgauche.collectionの色んな ジェネリック関数が使えるようになりますよ、というのに似ている)。
ただ、Schemeのような実行時型判定を行う言語でMonadを使おうとすると どうもすっきりいかない。というのは、Monadの基本演算が引数の型だけでなく 戻り値の型でディスパッチする必要があるからだ。 実行時型判定は手元に値が無いとディスパッチできない。まだ手に入れてない 戻り値の型は参考にできないのだ。
Olegさんの上記の記事では、別名で基本演算を定義しておいて、 使うMonadに応じて局所的に束縛を変える方法を提案している。 でもこれはletM (haskellのdo) のようなマクロでしか役に立たない。 mapMみたいなMonadに有用な関数をジェネリックに定義しておくことができない。
これは、Schemeが動的型付けであるがゆえの限界なのだろうか。
いや、そうではない。問題の根っ子は、 そもそもSchemeでの実装はHaskellのそれに比べて与えられている情報が少ない からだ。Haskellでは型という形で付加情報が与えられているわけだから。 それなら、Schemeでも不足する情報を与えてやったら結構いけるんじゃなかろうか。
具体的には、「戻り値に期待するモナドの型を明示してやる」のである。 この発想でちょっとコードを書いてみた。
(なお、別の解として、returnされた値は最終的にどこかで使われるのだし、 使う場所ではどの型を期待してるかわかっているのだから、その時点でディスパッチしてやる、 という賢い手がある。より自由なFreerモナドをSchemeに参照。)
実装の詳細は後回しにして、ちょいと例をみてみよう。
今回のモジュールを使った、Maybe monadの定義。
(define-monad Maybe
(unitM (x) (cons 'Just x))
(bindM (m f) (match m
('Nothing 'Nothing)
(('Just . x) (f x))))
(failM (x) 'Nothing)
(zeroM () 'Nothing)
(plusM (p q) (if (eq? p 'Nothing) q p))
)
unitM, bindM, failM, zeroM, plusM はそれぞれHaskellのreturn, >>=, fail, mzero, mplusに相当する。
これらのmonad操作はそのまま使うことは出来ない。
gosh> (unitM 'x) *** ERROR: unitM: monad is not expected
しかし、次のように、期待するMonadの型を明示してやると動作する。
gosh> (Maybe (unitM 'x)) (Just . x)
All about monadsにある クローン羊の例を書いてみよう。クラスを使っているのは単に表示を見やすくするためで、 Monadとは関係ない。
(define-class <sheep> ()
((name :init-keyword :name)
(father :init-keyword :father)
(mother :init-keyword :mother)))
(define-method write-object ((s <sheep>) out)
(format out "#<sheep ~a>" (ref s 'name)))
(define (sheep name . opts)
(let-optionals* opts ((father #f) (mother #f))
(make <sheep> :name name :father father :mother mother)))
(define (father s)
(cond ((ref s 'father) => unitM)
(else 'Nothing)))
(define (mother s)
(cond ((ref s 'mother) => unitM)
(else 'Nothing)))
(define (mothers-paternal-grandfather s)
(letM* ((m <- (mother s))
(gf <- (father m)))
(father gf)))
;; 何匹か羊を作っておく
(define mary (sheep 'mary))
(define adam (sheep 'adam))
(define john (sheep 'john adam #f))
(define mike (sheep 'mike #f mary))
(define beth (sheep 'beth #f mary))
(define suze (sheep 'suze john beth))
(define don (sheep 'don mike beth))
(define duke (sheep 'duke don suze))
ポイントはfather, mother, およびmothers-paternal-grandfatherの定義。 特定のMonadに限定した操作は出てこない。 しかし、呼び出し側が、Maybe monadを期待していることを明示して呼び出してやると、 次のように動作する。
gosh> (Maybe (mothers-paternal-grandfather duke)) (Just . #<sheep adam>) gosh> (Maybe (mothers-paternal-grandfather don)) Nothing
Monadに関する操作はジェネリックに書ける。
;; Haskellのsequence
;; seqM :: [m a] -> m [a]
(define (seqM ms)
(define (mcons p q)
(bindM p (lambda (x) (bindM q (lambda (y) (unitM (cons x y)))))))
(fold-right mcons (unitM '()) ms))
;; mapM :: (a -> m b), [a] -> m [b]
(define (mapM proc args)
(seqM (map proc args)))
;; foldM :: (a, b -> m a), a, [b] -> m a
(define (foldM proc seed lis)
(if (null? lis)
(unitM seed)
(bindM (proc (car lis) seed)
(lambda (seed2) (foldM proc seed2 (cdr lis))))))
ここにある例：
(define (baz xs)
(define (bar x)
(if (>= x 0)
(unitM (sqrt x))
(failM "I like positive")))
(Maybe (mapM bar xs)))
gosh> (baz '(1 4 9))
(Just 1.0 2.0 3.0)
gosh> (baz '(1 -4 9))
Nothing
State monadの定義は次の通り。
(define-monad State
(unitM (x) (lambda (s) (values x s)))
(bindM (m f) (lambda (s)
(receive (val s*) (m s)
((f val) s*))))
(getM () (lambda (s) (values s s)))
(putM (s) (lambda (_) (values #f s)))
(runM (m init) (m init)))
そして、これは木をトラバースして、葉を訪問順の番号に置き換えた 新たな木を構成するプログラムである。
(define (number-tree tree)
(if (pair? tree)
(letM* ((left <- (number-tree (car tree)))
(right <- (number-tree (cdr tree))))
(unitM (cons left right)))
(letM* ((n <- (getM))
(_ <- (putM (+ n 1))))
(unitM n))))
呼び出す際に、State monadを期待していることを明示する。
gosh> (State (runM (number-tree '(((a . b) . c) (d . e) . f)) 0)) (((0 . 1) . 2) (3 . 4) . 5) 6
もちろん、number-tree自体をState monadに特化したければ、その定義の中で 期待するmonadを明示してもいい。
(define (number-tree tree)
(State
(if (pair? tree)
(letM* ((left <- (number-tree (car tree)))
(right <- (number-tree (cdr tree))))
(unitM (cons left right)))
(letM* ((n <- (getM))
(_ <- (putM (+ n 1))))
(unitM n)))))
List monadの定義：
(define-monad List (unitM (x) (list x)) (bindM (m f) (append-map f m)) (failM (_) '()) (zeroM () '()) (plusM (p q) (append p q)) )
これはAll about monadsに出てきた例。 文字列を16進数、10進数、あるいはアルファベットからなる単語としてパーズし、 全ての可能な結果を返す。 (Haskell版とはparseの引数順が逆になっている。これはfoldMが関数を呼び出す 際の引数順が逆のため)
(use util.match)
(define (parse-hex-digit parsed ch)
(match parsed
(('Hex n) (if (char-set-contains? #[0-9a-fA-F] ch)
(unitM `(Hex ,(+ (* n 16) (digit->integer ch 16))))
(zeroM)))
(_ (zeroM))))
(define (parse-digit parsed ch)
(match parsed
(('Digit n) (if (char-numeric? ch)
(unitM `(Digit ,(+ (* n 10) (digit->integer ch))))
(zeroM)))
(_ (zeroM))))
(define (parse-word parsed ch)
(match parsed
(('Word s) (if (char-alphabetic? ch)
(unitM `(Word ,(string-append s (string ch))))
(zeroM)))
(_ (zeroM))))
(define (parse ch parsed)
(plusM (parse-hex-digit parsed ch)
(plusM (parse-digit parsed ch)
(parse-word parsed ch))))
(define (parse-arg str)
(letM* ((List init <- (plusM (unitM '(Hex 0))
(plusM (unitM '(Digit 0))
(unitM '(Word ""))))))
(foldM parse init (string->list str))))
これまでとちょっと違うのは letM* の束縛時にList monadであることを 明示してるところ。従ってparse-arg自体を走らせる時にはmonad指定は要らない。
実行例：
gosh> (parse-arg "123") ((Hex 291) (Digit 123)) gosh> (parse-arg "123ab") ((Hex 74667)) gosh> (parse-arg "cafebabe") ((Hex 3405691582) (Word "cafebabe")) gosh> (parse-arg "cafeba99") ((Hex 3405691545)) gosh> (parse-arg "cafebaz9") ()
Monadic Programming in Schemeに出てくる、 Numbered monadとそれを使ってノードに番号づけをするコード。 これは事実上、State monadと等価である。
(use util.match)
(define-monad Numbered
(unitM (x) (lambda (count) (cons count x)))
(bindM (m f)
(lambda (count)
(match-let1 (newcount . val) (m count)
((f val) newcount))))
(runM (m init-count) (m init-count))
)
(define (incr n) (cons (+ n 1) n))
(define (make-node val kids)
(letM* ((count <- incr))
(unitM (list 'Node count val kids))))
(define (build-btree depth)
(if (zero? depth)
(make-node depth '())
(letM* ((left <- (build-btree (- depth 1)))
(right <- (build-btree (- depth 1))))
(make-node depth (list left right)))))
実行例。見やすいように結果はインデントしてある。 各ノードは、(Node 通し番号 深さ (子 ...)) という構造。 いちばん最初にくっついてる115は次に使う番号。
gosh> (Numbered (runM (build-btree 3) 100))
(115
Node 114 3
((Node 106 2
((Node 102 1
((Node 100 0 ())
(Node 101 0 ())))
(Node 105 1
((Node 103 0 ())
(Node 104 0 ())))))
(Node 113 2
((Node 109 1
((Node 107 0 ())
(Node 108 0 ())))
(Node 112 1
((Node 110 0 ())
(Node 111 0 ())))))))
Monadic Programming in Scheme の最後に出てくる、IO monadとList monadを混ぜる例。
(define-monad IO
(unitM (x) x)
(bindM (m f) (f m))
(get-charM () (read-char))
(readM () (read))
(put-charM (ch) (write-char ch))
(put-lineM (str) (print str))
)
(define (f)
(IO
(letM* (( (put-lineM "Enter a number:") )
(n <- (readM))
(all-n <- (unitM (iota n 1)))
(evens <- (List
(letM* ((i <- all-n))
(if (even? i) (unitM i) (failM "odd")))))
)
(unitM evens))))
実装戦略はいくつか考えられると思うが、ここでは次のようにした。
(define-module util.monad
(use util.match)
(use util.list)
(use srfi-1)
(use gauche.parameter)
(export define-monad letM*
Identity Maybe List State IO
unitM bindM failM zeroM plusM runM getM putM
seqM mapM foldM)
)
(select-module util.monad)
(define %monad-alist (make-parameter '()))
(define (%monad-alist-lookup name)
(assq-ref (%monad-alist) name))
(define (%monad-alist-register name monad)
(%monad-alist (acons name monad (%monad-alist))))
(define %current-monad
(make-parameter (lambda (key . args)
(errorf "~a: monad is not expected" key))))
(define-syntax define-monad
(syntax-rules ()
((_ name : super (key args . exprs) ...)
(begin
(define-method key args
((%current-monad) 'key . args)) ...
(let ((cmd-alist `((key . ,(lambda args . exprs)) ...)))
(%monad-alist-register
'name
(lambda (selector . rest)
(cond ((assq selector cmd-alist)
=> (lambda (p) (apply (cdr p) rest)))
((%monad-alist-lookup 'super)
=> (cut apply <> selector rest))
(else
(errorf "Monad ~a doesn't support the operation ~s"
'name selector))))))
(define-syntax name
(syntax-rules ()
((_ . body)
(parameterize ((%current-monad (%monad-alist-lookup 'name)))
. body))))))
((_ name (key args . exprs) ...)
(define-monad name : Monad (key args . exprs) ...))
))
(define-syntax letM*
(syntax-rules ()
((letM* () expr)
expr)
((letM* ((var <- init) . more) expr)
(bindM init (lambda (var) (letM* more expr))))
((letM* ((m var <- init) . more) expr)
(m (bindM init (lambda (var) (letM* more expr)))))
((letM* ((action) . more) expr)
(bindM action (lambda (_) (letM* more expr))))
((letM* ((m action) . more) expr)
(m (bindM action (lambda (_) (letM* more expr)))))
))
;; base class
(define-monad Monad : #f
(failM (x) (error x)))
;; Monad definitions and operation definitions comes after this ...
(provide "util/monad")
define-monadの展開中にdefine-methodを使っているのは 定義中に出てきたオペレータ (getM等) がグローバルで定義されることを 保証するためだけなんで、本質ではない。
Gaucheのオブジェクトシステムを使うなら、各monadに対しクラスを 定義してシングルトンインスタンスを作り、それでディスパッチしてもいいだろう。
複数のmonadがもっと複雑に絡み合うとか、monad自体をパラメタライズしたい とかいうケースに対応できるかどうか不明。何かそういう複雑な例があったら 教えてくらはい。
teranishi(2005/08/17 07:31:20 PDT):なるほど、型を陽に渡す方法がありましたか。勉強になります。
ところで、疑問点の件ですが、All About Monads にあるモナド変換子の例しか思いつかなかったので、
ちょっとこの枠組みでやってみました。
(このコードの実行のためには、define-monadの定義内の (let ((cmd-alist ...)) ...) と
(define-syntax name ...) の順番を入れ替える必要があります)
(define (liftM f)
(lambda args (bindM (seqM args) (compose unitM (apply$ f)))))
(define-syntax define-StateT
(syntax-rules ()
((_ name m)
(define-monad name
(unitM (a) (lambda (s) (m (unitM (cons a s)))))
(bindM (x f) (lambda (s) (m (letM* ((ret <- (name (x s))))
(name ((f (car ret)) (cdr ret)))))))
(failM (x) (lambda (_) (m (failM x))))
(getM () (lambda (s) (m (unitM (cons s s)))))
(putM (s) (lambda (_) (m (unitM (cons #f s)))))
(runM (x init) (x init))
(evalStateT (x init) (m ((liftM car) (name (x init)))))
(zeroM () (lambda (_) (m (zeroM))))
(plusM (p q) (lambda (s) (m (plusM (name (p s)) (name (q s))))))))))
(define-StateT NDS List)
内部モナドを渡すとモナドの定義を生成するマクロとして考えてみましたが、 内部モナドが変わるたびに名前を付け直さなければならないし、 モナドの切り替えが多くて煩雑だしで、問題山積ですね。 何かいい方法はないでしょうか。
Shiro(2005/08/17 17:22:26 PDT): そうか、やっぱりパラメタライズしようとすると面倒ですね。 モナド名をマクロにするのは見た目がいいかなと思ってやったんですが、そうすると 「新たなモナドを生成する機構」を全てマクロのドメインに置かないとならなくなるのか… ここに出す前に試していたバージョンでは、モナド自体は実行時オブジェクトで with-monadという構文を使って切替えるようにしてました。それだとたぶん 新たなモナドを生成してゆくのは楽になるかな? それともこれが実行時にコンテキストを切替えてゆくという方法の限界なのかな?
teranishi(2005/08/19 18:35:19 PDT): モナド変換子なんて私はほとんど使いませんし、 使うにしても別の名前を付ければ済む話なので、別にこのままでも構わないと思います。 ただ、特定のモナドの特定の関数を取り出せる方法があるとありがたいですね。 (上のdefine-StateTのbindM,plusMの定義が簡単に書けるので)
(英語版: Scheme:ExplicitMonad:English)