読者です 読者をやめる 読者になる 読者になる

きくらげ観察日記

好きなことを、適当に。

Gaucheでモナド その2

Gauche

inkar-us-i.hatenablog.com

このときはGauche歴半日くらいだったんで中置<-演算子とか定義してて微妙な感じの構文だったので、もう少しLispらしいモナドを書いてみました。

(define *monad-stack* '())

(define (push-monad! monad)
  (set! *monad-stack* (cons monad *monad-stack*)))

(define (pop-monad!)
  (set! *monad-stack* (cdr *monad-stack*)))

(define-class <monad> ()
  ((return :init-keyword :return :getter monad-return)
   (bind :init-keyword :bind :getter monad-bind)))

(define (mbind mexpr cont)
  (let ((monad (car *monad-stack*)))
    ((monad-bind monad) mexpr cont)))

(define (mreturn expr)
  (let ((monad (car *monad-stack*)))
    ((monad-return monad) expr)))

(define-syntax mlet*-body
  (syntax-rules ()
    ((_ () body) body)
    ((_ () body body2 rest ...)
     (mbind body (^(_) (mlet*-body () body2 rest ...))))
    ((_ ((name mexpr) binds ...) body ...)
     (mbind mexpr (^(name) (mlet*-body (binds ...) body ...))))))

(define-syntax mlet*
  (syntax-rules ()
    ((_ monad binds body ...)
     (dynamic-wind
         (^() (push-monad! monad))
         (^() (mlet*-body binds body ...))
         (^() (pop-monad!))))))

do記法というか、F#のコンピュテーション式に近いかもしれないです(F#全然知らないけど)。

あとはmlet*の中でdynamic-windしてるので、例えばStateモナドの中身で継続呼んでMaybeモナドの中に突っ込む、みたいな状況になったとしてもバグらないようになっています。

使用例:

;; リストモナド
(define list-monad
  (make <monad>
    :return list
    :bind (^(xs f) (concatenate (map f xs)))))

;; Maybeモナド(というかand-letモナド)
(define maybe-monad
  (make <monad>
    :return identity
    :bind (^(mvalue f) (if (eq? mvalue #f) #f (f mvalue)))))

(mlet*
 list-monad
 ((x '(1 2 3 4 5))
  (y '(2 4 6 8 9)))
 (mreturn (cons x y)))
;; =>
;; ((1 . 2) (1 . 4) (1 . 6) (1 . 8) (1 . 9)
;;  (2 . 2) (2 . 4) (2 . 6) (2 . 8) (2 . 9)
;;  (3 . 2) (3 . 4) (3 . 6) (3 . 8) (3 . 9)
;;  (4 . 2) (4 . 4) (4 . 6) (4 . 8) (4 . 9)
;;  (5 . 2) (5 . 4) (5 . 6) (5 . 8) (5 . 9))

(mlet*
 maybe-monad
 ((x 1)
  (y 2))
 (mreturn (+ x y)))
;; => 3

(mlet*
 maybe-monad
 ((x #f)
  (y 2))
 (mreturn (+ x y)))
;; => #f

ちなみにこれは(mlet* ...)全体が評価されるタイミングでmreturnが呼ばれる必要があるので、stateモナドとかは作れません。