monad的Schemer之见

第1章状态monad

第1.1节简谈monad

一个monad是一对函数 ${unit}_{M}$ 和 ${star}_{M}$ , 这两者可以合作完成有趣的事情. 一对特定的 ${unit}_{M}$ 和 ${star}_{M}$ 是一个monad, 如果以下monad律成立:

$({star}_{M} {unit}_{M}) = {identity}_{M}$
$(\circ ({star}_{M} f) {unit}_{M}) = f$
$({star}_{M} (\circ ({star}_{M} f) g)) = (\circ ({star}_{M} f) ({star}_{M} g))$

其中

\circ

是复合函数, 被定义为

(λ (f g) (λ (x) (f (g x))))

, 其取两个函数然后将其复合.

如果我们所做的是给别人呈现新的monad, 那么我们就不得不证明monad律对于我们所提出的 ${unit}_{M}$ 和 ${star}_{M}$ 成立. 但是现在, 我们将只会处理已知的monad. 如果我们想要令别人相信一个monad的确是一个monad, 那么证明就是完全必要的.

我们需要写下我们的代码以使得给定两个表达式, 我们可以很快观察出这两个表达式之中哪一个首先出现. 我们将这种编码风格称为monad风格. 只要你能够识别出何时一个函数调用是(或不是)参数简单的尾调用, 那么理解如何以monad风格编写代码也是容易的事情了. 一旦定义已经被置于monad风格, 那么存在一种机制用来为定义插入操作以给出对于某种effect的刻画. 在这第一次讲座之中, 这将会是对于可修改变量 (settable variable) 的刻画. 在第二次讲座里, 我们将会引入其他effect.

monad风格的函数是基于两个函数之上的: 一个 $unit$ 和一个 $star$ , 并且其必须构成一个monad. 如果你从如下递归函数f的定义开始:

(define f (λ (...) body))

那么monad化的相同函数看起来会是:

(define f
  (λ (unit star)
    (if (monad? unit star)
        (letrec ((f (λ (...) body*)))
          f))))

不幸的是, 保证 $unit$ 和 $star$ 构成一个monad比起编写一个简单谓词要花费更多努力. 暂时, 我们将会假定程序员可以信任 $unit$ 和 $star$ 的确构成了monad, 这简化了我们的定义.

(define f
  (λ (unit star)
    (letrec ((f (λ (...) body*)))
      f)))

我们使用body*来指明body已是monad风格. 但是, 我们不打算传入特定的 $unit$ 和 $star$ , 而是准备全局地define它们以类似于 ${unit}_{state}$ 和 ${star}_{state}$ 这样的唯一名字, 那么body*就会和之前的body看起来如出一辙, 除了会用到特定的 $unit$ 和 $star$ . 这个决定允许我们使用define而非letrec以支持递归.

(define f (λ (...) body*))

使用全局定义只是封装monad的诸多方式之一. 我们可以将这两个函数打包成一个cons序对, 一个向量, 一个可继承的类对象, 诸如此类. 一般而言, 为了支持对于某种effect的刻画, 我们需要一个或者更多的与 $unit$ 和 $star$ 协作的辅助函数. 而当我们遇到这些辅助函数的时候, 我们也会指出它们. 这些辅助函数返回了和 $unit$ 的调用相同种类的值. 但是, 请记住monad仅是一对满足monad律的 $unit$ 和 $star$ .

第1.2节类型和形状

考虑三种类型的值: 纯值, 记以 $a \in A$ ; 参数化于 $A$ 之上的表达式, 记以 $ma \in M A$ ; 还有函数, 记以 $sequel \in Sequel$ , 其接受一个纯值 $a \in A$ , 然后返回了一个monadic值 $mb \in M B$ . 函数 ${unit}_{M}$ 的形状类似于类型 $Sequel$ , 但是其返回一个 $M A$ 而非一个 $M B$ . ${star}_{M}$ 接受两个(curry化了的)参数, 一个 $Sequel$ 和一个 $M A$ , 然后返回一个 $M B$ . 因此, 我们可以记 ${unit}_{M}$ 和 ${star}_{M}$ 的类型如下. $\begin{array}{rcl} {Sequel}_{M} & = & A \to M B \\ {unit}_{M} & : & A \to M A \\ {star}_{M} & : & {Sequel}_{M} \to M A \to M B \end{array}$

这里的第一行告诉我们类型 ${Sequel}_{M}$ 是类型 $A \to M B$ 的缩略, 而接下来的两行分别告诉我们了表达式 ${unit}_{M}$ 和 ${star}_{M}$ 的类型.

根据monad律, 我们知道表达式 $({star}_{M} {unit}_{M})$ 是合法的, 尽管似乎 ${star}_{M}$ 想要的是类型 ${Sequel}_{M}$ 的一个值作为其第一个参数. 因此, 我们必然知道 ${unit}_{M}$ 和一个 ${Sequel}_{M}$ 必然有着类似的形状. 它们都消费一个纯值 $a$ , 然后分别返回一个 $M A$ 或者一个 $M B$ . 更进一步, $({unit}_{M} a)$ 和 $(({star}_{M} {sequel}_{M}) ma)$ 返回了相同的形状, 分别是一个 $M A$ 或者一个 $M B$ .

第1.3节状态monad

以下是 $state$ monad, 如此命名乃是因为其创造了对于一个单独的可变变量的刻画.

(define unit_state ;A -> MA
  (λ (a)
    (λ (s) ;This function is a MA.
      `(,a . ,s))))
;诸多编程语言实际上称unit为return

(define star_state ;Sequel -> MA -> MB
  (λ (sequel)
    (λ (ma)
      (λ (s) ;This function is a MB.
        (let ((p (ma s)))
          (let ((new-a (car p)) (new-s (cdr p)))
            (let ((mb (sequel new-a)))
              (mb new-s))))))))

让我们稍微分析一下这些定义. ${unit}_{state}$ 接受一个纯值 $a \in A$ , 然后返回一个 $M A$ , 这个函数期望接受一个状态 $s \in S$ . 当 $M A$ 得到一个状态的时候, 就返回一个序对. 这个序对的 $car$ 部分是一个纯值, 而 $cdr$ 部分则是一个额外的值. 这个纯值传递给一个 $Sequel$ 以产生一个 $M B$ , 而这个额外的值又传递给了这个得到的 $M B$ .

对于调用 $state$ $M A$ 或者 $state$ $M B$ 所返回的序对, 其 $car$ 部分是纯值, 而 $cdr$ 部分则是额外的值. 这提醒我们这些结构总是会有一个纯值, 而纯值有的时候是没有用的. $cdr$ 里的东西是额外的值, 其用以支持各种各样的刻画.

我们可以观察到 ${star}_{state}$ 接受两个(curry化了的)值, 一个函数 $Sequel$ 和一个 $M A$ , 而对于状态而言 $M A$ 恰好是函数. 考虑 $(λ (ma) body)$ , 那么 $body$ 应该是一个 $M B$ . 但是, 在 ${star}_{state}$ 的定义之中, $ma$ 在 $sequel$ 之前被调用. 我们令序对 $p$ 是应用 $ma$ 于某个 $s$ 的结果, 那么 $p$ 的 $car$ 是某个纯值 $new-a$ , 其会被传递给 $sequel$ . 应用 $sequel$ 于 $new-a$ 的结果是一个 $mb$ , 据我们所知, 其期望着一个状态, 而这个状态就在 $p$ 的 $cdr$ 之中. 因此, 我们可以说 $ma$ 进入的时候是以一个状态, 而从 $mb \in M B$ 退出的时候则是以一个可能不同的状态.

monad的类型信息告诉了我们该如何使用 $unit$ 和 $star$ 来以monad风格定义函数. 那么, 现在让我们来看一个例子. 我们的问题是取一个整数的嵌套(至任意深度的)列表, 然后返回一对值. 这个序对的第一个项应该是同样的列表, 除了其中的偶数都已经被移除, 第二个项则是被删除的偶数的数目. 我们称这个函数为remberevensXcountevens. 这里的X指明函数会返回一个eXtra值.

在我们移步至remberevensXcountevens的monadic定义之前, 让我们先来看一个简单的直接风格的定义. 我们从一个驱动过程remberevensXcountevens_2pass开始, 其会调用两个辅助函数remberevens_pure和countevens_pure.

(define remberevensXcountevens_2pass
  (λ (l) `(,(remberevens_pure l) . ,(countevens_pure l))))
(define remberevens_pure
  (λ (l)
    (cond
      ((null? l) '())
      ((list?? (car l))
       (cons (remberevens_pure (car l)) (remberevens_pure (cdr l))))
      ((odd? (car l)) (cons (car l) (remberevens_pure (cdr l))))
      (else (remberevens_pure (cdr l))))))
(define countevens_pure
  (λ (l)
    (cond
      ((null? l) 0)
      ((list?? (car l))
       (+ (countevens_pure (car l)) (countevens_pure (cdr l))))
      ((odd? (car l)) (countevens_pure (cdr l)))
      (else (add1 (countevens_pure (cdr l)))))))
;原文这里存在笔误, 将两处x误写作了l
(define list??
  (λ (x)
    (or (null? x) (pair? x))))

> (remberevensXcountevens_2pass '(2 3 (7 4 5 6) 8 (9) 2))
((3 (7 5) (9)) . 5)

remberevensXcountevens_2pass能够给出正确的结果, 但是却非常低效: 它对于列表l处理了两遍. 存在着一种众人皆知的解法, 其只需要处理一遍, 但是需要我们将代码转换为延续传递风格.

(define remberevensXcountevens_cps
  (λ (l k)
    (cond
      ((null? l) (k `(() . 0)))
      ((list?? (car l))
       (remberevensXcountevens_cps
        (car l)
        (λ (pa)
          (remberevensXcountevens_cps
           (cdr l)
           (λ (pd)
             (k `(,(cons (car pa) (car pd))
                  . ,(+ (cdr pa) (cdr pd)))))))))
      ((odd? (car l))
       (remberevensXcountevens_cps
        (cdr l)
        (λ (p)
          (k `(,(cons (car l) (car p))
               . ,(cdr p))))))
      (else
       (remberevensXcountevens_cps
        (cdr l)
        (λ (p)
          (k `(,(car p) . ,(add1 (cdr p))))))))))

译注: 实际上比起这种写法, 一般人用延续传递风格编写这个过程会让k接受两个参数, 这样会更简单一些.

> (remberevensXcountevens_cps '(2 3 (7 4 5 6) 8 (9) 2) (λ (p) p))
((3 (7 5) (9)) . 5)

接下来我们将直接风格的remberevens_pure转换为monad风格. cond的第四个子句是一个尾调用, 故保持不变就好. 对于第三个子句, 我们取(具有简单参数的)非尾调用, 然后将其变为 ${star}_{state}$ 的第二个(curry化了的)参数.

((star_state ...)
 (remberevens_pure (cdr l)))

围绕非尾调用的上下文进入了...之中, 于是我们必须要有一个变量用于绑定调用(remberevens_pure (cdr l))的结果, 那么让我们称之为d.

((star_state (λ (d) ...))
 (remberevens_pure (cdr l)))

如果我们有了一个简单表达式 (没有递归函数调用的表达式), 诸如(cons (car l) d), 那么为了monad化这个表达式, 我们使用

{unit}_{state}

来包裹这个简单表达式.

((star_state (λ (d) (unit_state (cons (car l) d))))
 (remberevens_pure (cdr l)))

考虑第二个子句. 这里我们有两个(具有简单参数的)非尾(递归)调用, 于是我们需要给予它们一个顺序.

((star_state (λ (a) ...))
 (remberevens_pure (car l)))

在(λ (a) ...)的体里, 我们进行下一个调用.

((star_state (λ (a)
               ((start_state (λ (d) ...))
                (remberevens_pure (cdr l)))))
 (remberevens_pure (car l)))

最后, 我们来处理递归调用的结果, 那么就是(cons a d), 这是一个简单表达式. 又一次, 我们需要做的事情就是用

{unit}_{state}

来包裹这个表达式.

((star_state (λ (a)
               ((start_state (λ (d) (unit_state (cons a d))))
                (remberevens_pure (cdr l)))))
 (remberevens_pure (car l)))

第一个子句是简单的, 所以说我们将'()传递给

{unit}_{state}

. 现在, 我们有了结果.

(define remberevens
  (λ (l)
    (cond
      ((null? l) (unit_state '()))
      ((list?? (car l))
       ((star_state (λ (a)
                      ((star_state (λ (d) (unit_state (cons a d))))
                       (remberevens (cdr l)))))
        (remberevens (car l))))
      ((odd? (car l))
       ((star_state (λ (d) (unit_state (cons (car l) d))))
        (remberevens (cdr l))))
      (else
       (remberevens (cdr l))))))

当然了, 到现在为止我们处理的只是remberevens, 而我们真正想要的是remberevensXcountevens. 似乎我们只完成了一半的工作, 但是monad风格的优美之处在于其实我们已经快要完成了. 让我们将这个函数改名为remberevensXcountevens_almost, 并让我们看看我们离目标还有多远.

(define remberevensXcountevens_almost
  (λ (l)
    (cond
      ((null? l) (unit_state '()))
      ((list?? (car l))
       ((star_state (λ (a)
                      ((star_state (λ (d) (unit_state (cons a d))))
                       (remberevensXcountevens_almost (cdr l)))))
        (remberevensXcountevens_almost (car l))))
      ((odd? (car l))
       ((star_state (λ (d) (unit_state (cons (car l) d))))
        (remberevensXcountevens_almost (cdr l))))
      (else
       (remberevensXcountevens_almost (cdr l))))))

首先, (remberevensXcountevens_almost l)会返回什么呢? 其会返回一个函数, 这个函数接受一个状态, 然后返回一对值, 即一个纯值 (应该是(remberevens_pure l)会返回的) 和一个额外值 (应该是移除的偶数的数目). 以下是对于remberevensXcountevens_almost的一个测试.

> ((remberevensXcountevens_almost '(2 3 (7 4 5 6) 8 (9) 2)) 0)
((3 (7 5) (9)) . 0)

这个测试里的0有什么用呢? 它是状态s的初值. 当数字的列表为空会发生什么? 其会返回(unit_state '()), 而我们知道这是函数(λ (s) `(() . ,s)), 通过将a替换为空表. 然后, s会被替换为0, 这就产生了序对(() . 0).

但是, 我们的答案只是近乎于正确, 因为我的错误的部分仅是数目不对. 什么时候我们需要计数呢? 当我们知道(car l)是一个偶数的时候. 所以说, 让我们再来看看else子句.

(remberevensXcountevens_almost (cdr l))

我们该如何修订这个表达式以修正bug呢? 这是一个尾调用, 所以说我们将该调用移入sequel的体内.

((star_state (λ (_)
               (remberevensXcountevens_almost (cdr l))))
 ...)

然后我们应该制造一个

M A

出来, 其可以通过

{star}_{state}

给出对于effect的刻画. 既然状态monad的

M A

看起来像是(λ (s) `(,a . ,s^)), 那么我们也必须使用这样的格式, 并且既然我们不会关心_被绑定到了什么值上, 所以说我们令这个纯值为符号_也就可以了, 这给出了以下代码.

((star_state (λ (_)
               (remberevensXcountevens_almost (cdr l))))
 (λ (s) `(_ . ,s^)))

剩下来我们需要做的事情是确定我们想要s^是什么. 既然进入这个

M A

的s是当前的计数, 那么我们可以令s^为(add1 s), 这将我们导向了完整的else子句.

((star_state (λ (_)
               (remberevensXcountevens_almost (cdr l))))
 (λ (s) `(_ . ,(add1 s))))

现在代码就是全部正确的了, 所以我们可以把下标从名字里去掉.

(define remberevensXcountevens
  (λ (l)
    (cond
      ((null? l) (unit_state '()))
      ((list?? (car l))
       ((star_state (λ (a)
                      ((star_state (λ (d) (unit_state (cons a d))))
                       (remberevensXcountevens (cdr l)))))
        (remberevensXcountevens (car l))))
      ((odd? (car l))
       ((star_state (λ (d) (unit_state (cons (car l) d))))
        (remberevensXcountevens (cdr l))))
      (else
       ((star_state (λ (_)
                      (remberevensXcountevens (cdr l))))
        (λ (s) `(_ . ,(add1 s))))))))

> ((remberevensXcountevens '(2 3 (7 4 5 6) 8 (9) 2)) 0)
((3 (7 5) (9)) . 5)

译注: 实际上, 还可以换个写法.

(define remberevensXcountevens
  (λ (l)
    (cond
      ((null? l) (unit_state '()))
      ((list?? (car l))
       ((star_state (λ (a)
                      ((star_state (λ (d) (unit_state (cons a d))))
                       (remberevensXcountevens (cdr l)))))
        (remberevensXcountevens (car l))))
      ((odd? (car l))
       ((star_state (λ (d) (unit_state (cons (car l) d))))
        (remberevensXcountevens (cdr l))))
      (else
       ((star_state (λ (d)
                      (λ (s)
                        `(,d . ,(add1 s)))))
        (remberevensXcountevens (cdr l)))))))

让我们来思考之前延续传递风格版本的定义. 两个程序都能计算出正确的答案, 但是它们做事的方式相当不同. 为了表明我们所言非虚, 让我们追踪每个版本的程序里add1和+的动向. 以下是追踪remberevensXcountevens_cps时所发生的:

> (remberevensXcountevens_cps '(2 3 (7 4 5 6) 8 (9) 2) (λ (p) p))
(add1 0)
(add1 1)
(add1 0)
(+ 0 1)
(add1 1)
(+ 2 2)
(add1 4)
((3 (7 5) (9)) . 5)

从对于执行过程的追踪可以看出, remberevensXcountevens_cps计算出5是通过对于输入中的子列表计算子答案, 然后使用+合并子答案得到的.

与之相对的是, 让我们看看对于monad版本程序remberevensXcountevens的追踪:

> ((remberevensXcountevens '(2 3 (7 4 5 6) 8 (9) 2)) 0)
(add1 0)
(add1 1)
(add1 2)
(add1 3)
(add1 4)
((3 (7 5) (9)) . 5)

现在对于add1的调用遵循着可以预测的模式, 而+压根就没有用到! 比起我们在对于remberevensXcountevens_cps的追踪中看到的由子答案构筑答案的现象, 这个版本看起来我们是在对于计数器进行逐步增量.

实际上, monad版本的计算非常类似于我们使用全局变量counter (初始化为0) 然后简单通过(set! counter (add1 counter))来增长计数的情况. 但是, 我们甚至没有用到set!. 转而, 状态monad为我们提供了对于全局可变变量的刻画. 这是一种极其强大的想法. 现在我们可以编写程序来提供对于effectful计算的忠实模拟, 但是却并不需要实际执行任何side effects. 也就是说, 我们得到了effectful计算的通常好处, 却没有通常的缺陷.

一个关于状态monad的最后观察是辅助函数(λ (s) `(_ . ,(add1 s)))并不包含自由变量, 本可以赋予一个全局性的名字, 让我们称其为incr_state:

(define incr_state
  (λ (s) `(_ . ,(add1 s))))

但是如果这样的话,

sequel

和其

ma

\begin{matrix} (λ (_) ...) & ;sequel \\ ⇑ \\ (λ (s) `(_ . ,(add1 s))) & ;ma \end{matrix}

之间的关系就不甚明了了. 纯值, 即符号_, 在将状态传给

ma

之后得到的序对的

car

部分里, 然后其会被绑定至

sequel

的形式变量_上. 作成这种绑定是

{star}_{state}

的工作之一.

练习 (可以见之前的译注):

第1.4节推导状态monad

如果我们取remberevensXcountevens的代码, 并将unit_state和star_state代之以它们的定义, 那么对于(let ((x e)) body)或者等价的((λ (x) body) e)存在着将body中的x替换为e的机会. 如果我们知道x在body之中恰出现一次, 那么这些是保持正确性和效率的变换. {译注: 依赖于代码是pure的.} 我们这里所执行的变换的详细步骤见于附录 (总计三十六步), 但是其结果是状态传递风格的代码, 其中状态作为参数进出于每个递归函数调用. 我们可能写过这种代码, 但是却不知道状态monad的存在.

(define remberevensXcountevens_sps
  (λ (l s)
    (cond
      ((null? l) `(() . ,s))
      ((list?? (car l))
       (let* ((p (remberevensXcountevens_sps (car l) s)))
         (let ((p^ (remberevensXcountevens_sps (cdr l) (cdr p))))
           `(,(cons (car p) (car p^)) . ,(cdr p^)))))
      ((odd? (car l))
       (let ((p (remberevensXcountevens_sps (cdr l) s)))
         `(,(cons (car l) (car p)) . ,(cdr p))))
      (else
       (let ((p (remberevensXcountevens_sps (cdr l) s)))
         `(,(car p) . ,(add1 (cdr p))))))))

> (remberevensXcountevens_sps '(2 3 (7 4 5 6) 8 (9) 2) 0)
((3 (7 5) (9)) . 5)

我们也可以从remberevensXcountevens_sps出发推导unit_state和star_state, 因为这种变换是可逆的. {译注: 非常可疑的说法.}

这就结束了第一次讲座, 第二次讲座里我将呈现各种其他monad以及如何使用它们.

译者: 这次讲座有一些脚注, 所以现在我们整合一下, 呈现在下方.

我们可以定义bind_state, 使得参数采用事情发生的顺序.

(define bind_state
  (λ (ma sequel)
    ((star_state sequel) ma)))

那么

((star_state (λ (a)
               ((star_state (λ (d) (unit_state (cons a d))))
                (remberevensXcountevens (cdr l)))))
 (remberevensXcountevens (car l)))

可以写成

(bind_state
 (remberevensXcountevens (car l))
 (λ (a)
   (bind_state
    (remberevensXcountevens (cdr l))
    (λ (d)
      (unit_state (cons a d))))))

我们甚至还可以模仿Haskell的do和Scheme的let*编写一个宏do*_state.

(define-syntax do*_state
  (syntax-rules ()
    ((_ () body) body)
    ((_ ((a ma) (b mb) ...) body)
     ((star_state
       (λ (a)
         (do*_state ((b mb) ...) body)))
      ma))))

那么还可以写成

(do*_state
 ((a (remberevensXcountevens (car l)))
  (d (remberevensXcountevens (cdr l))))
 (unit_state (cons a d)))

第2章其他一些monad

第2.1节可能monad (Maybe Monad)

以下是 $maybe$ monad.

(define unit_maybe
  (λ (a)
    `(,a . _))) ;This MA get its type from the type of a.

(define star_maybe
  (λ (sequel)
    (λ (ma)
      (cond ;This is a MB.
        ((eq? (cdr ma) '_)
         (let ((a (car ma)))
           (sequel a)))
        (else (let ((mb ma))
                mb))))))

$cdr$ 里的标记_指明了纯值就在 $car$ 里, 这和之前的状态monad是一样的. 我们立即发现对于这个monad而言似乎存在着多余的方面. 如果你回忆一下状态monad, 会发现一切都是自足的; 然而, 在这里事情并不那么明朗显然. 但是, 既然 ${unit}_{maybe}$ 里用了符号_, ${star}_{maybe}$ 对于符号_又有专门的分派, 所以至少monad律的前两个等式是成立的.

如果你使用过Scheme的assq, 那么就会明白为了检查可能的失败, 程序的结构是多么得病态 (what an ill-structured mess). 可能monad允许编程者在更高层次进行思考, 从而忽略处理失败. 考虑new-assq, 其类似于assq. 它的工作是返回一个 $M A$ (此时是一个序对), 其 $car$ 会是p*中第一个满足 $car$ 匹配v的序对的 $cdr$ .

(define new-assq
  (λ (v p*)
    (cond
      ((null? p*) `(_ . fail))
      ((eq? (caar p*) v)
       (unit_maybe (cdar p*)))
      (else
       ((star_maybe (λ (a) (unit_maybe a)))
        (new-assq v (cdr p*)))))))

既然(new-assq v (cdr p*))是一个尾调用, 我们可以依据

η

归约和monad律第一等式重写new-assq, 即

(define new-assq
  (λ (v p*)
    (cond
      ((null? p*) `(_ . fail))
      ((eq? (caar p*) v)
       (unit_maybe (cdar p*)))
      (else
       (new-assq v (cdr p*))))))

每个cond的子句的右支都应该是

M A

. 终结递归调用的是前两个子句. (鉴于(_ . fail)的

cdr

是符号fail, 所以说你不会将其与

cdr

为符号_的情况混淆.) 为了看看我们如何使用new-assq, 请看以下测试.

> ((star_maybe (λ (a) (new-assq a '((1 . 10) (2 . 20)))))
   ((λ (ma1 ma2)
      (cond
        ((eq? (cdr ma1) '_) ma1)
        (else ma2)))
    (new-assq 8 '((7 . 1) (9 . 3)))
    (new-assq 8 '((9 . 4) (6 . 5) (8 . 2) (7 . 3)))))

我们需要验证 ${star}_{maybe}$ 的第二个(curry化了的)参数的确是一个 $M A$ . 以上的两个cond子句里, 结果均是一个 $M A$ . 这里我们在两个不同的关联列表里寻找8. 然后, 我们取了纯值2, 在第三个关联列表里寻找它. 这将返回(20 . _). 在cond子句里, 当我们失败时, 我们将会尝试另外一个 $M A$ , 但是如果成功, 就会使用第一个. 然后, a就会被绑定到纯值2. 我们的这个定义的一个缺陷在于前两次对于new-assq的调用都会被求值, 这是因为我们并不是在类似于Haskell这样的按需调用语言里进行编程. 如果我们想要获得通常Haskell的好处, 就需要重新定义第二个 $M A$ 为一个thunk.

> ((star_maybe (λ (a) (new-assq a '((1 . 10) (2 . 20)))))
   ((λ (Ma1 Ma2)
      (cond
        ((eq? (cdr Ma1) '_) Ma1)
        (else (Ma2))))
    (new-assq 8 '((7 . 1) (9 . 3)))
    (λ () (new-assq 8 '((9 . 4) (6 . 5) (8 . 2) (7 . 3))))))
(20 . _)

显然, 我们仍然信任第二个(curry化了的)参数将求值至一个

M A

. 从结构上来说, 我们本也可以选择使用#f而非(_ . fail), 然后据此修改我们的各个定义. 然而, 因为我们接下来要呈现异常monad, 所以说我们想要坚持现在的这种表示.

练习: 修改可能monad, 其中假设每个 $M A$ 都是一个thunk.

第2.2节异常monad

以下是异常monad (exception monad), 其中纯值还是在 $car$ 里, 而这一次异常 (一个字符串) 出现在 $cdr$ 里, 尽管任何不是符号_其实都可以.

(define unit_exception
  (λ (a)
    `(,a . _))) ;This MA gets its type from the type of a.
(define star_exception
  (λ (sequel)
    (λ (ma)
      (cond ;This is a MB.
        ((eq? (cdr ma) '_)
         (let ((a (car ma)))
           (sequel a)))
        (else (let ((mb ma))
                mb))))))

${unit}_{exception}$ 和 ${star}_{exception}$ 的定义实际上和之前的可能monad是等同的. 我们的例子来源于Jeff Newbern的All About Monads.

引用一下Newbern的话, 这个例子试图parse十六进制数字, 并且在遇到非法字符时会抛出异常. 以下的char-hex->integer里的else分支里的异常 $M A$ 构造指明了要抛出异常. 如果char-hex->integer产生的 $M A$ 是一个异常, 那么sequel就不会被调用, 接受纯值的变量a也不会得到绑定. 转而, 这个异常会作为答案返回.

(define parse-hex-c*
  (λ (c* pos n)
    (cond
      ((null? c*) (unit_exception n))
      (else
       ((star_exception
         (λ (a)
           (parse-hex-c*
            (cdr c*) (+ pos 1) (+ (* n 16) a))))
        (char-hex->integer (car c*) pos))))))
(define char-hex?
  (λ (c)
    (or (char-numeric? c) (char<=? #\a c #\f))))
(define char-hex->integer/safe
  (λ (c)
    (- (char->integer c)
       (if (char-numeric? c)
           (char->integer #\0)
           (- (char->integer #\a) 10)))))
(define char-hex->integer
  (λ (c pos)
    (cond
      ((char-hex? c)
       (unit_exception
        (char-hex->integer/safe c)))
      (else
       `(_ . ,(format "At index ~s: bad char ~s" pos c))))))

当然了, parse-hex-c*的优美之处在于你纯粹地进行思考, parse-hex-c*的定义中并没有指出什么可能会导致异常.

> (parse-hex-c* (string->list "ab") 0 0)
(171 . _)
> (parse-hex-c* (string->list "a5bex21b") 0 0)
(_ . "At index 4: bad char x")

通常来说, 这传递给parse-hex-c*的两个0应该藏于parse-hex-c*的接口之下, 这通过局部定义很容易实现. 总之, 还可以进行种种改进. 然而, 这些只会使得理解异常monad更为困难, 而理解异常monad才是本节的主题.

练习:

接下来的是 $writer$ monad.

第2.3节 writer monad

以下是 $writer$ monad.

(define unit_writer
  (λ (a)
    `(,a . ,mzero^list))) ;This pair is a MA.
(define star_writer
  (λ (sequel)
    (λ (ma)
      (let ((a (car ma))) ;This is a MB.
        (let ((mb (sequel a)))
          (let ((new-b (car mb)))
            `(,new-b . ,(mplus^list (cdr ma) (cdr mb)))))))))

我们需要以下辅助定义.

(define mzero^list '())
(define mplus^list append)

我们现在要定义remberevensXevens, 其和remberevensXcountevens接受同样的参数, 返回的序对则在 $cdr$ 上有所不同: 不是返回计数, 而是按照移除顺序返回偶数的列表.

(define remberevensXevens
  (λ (l)
    (cond
      ((null? l) (unit_writer '()))
      ((list?? (car l))
       ((star_writer
         (λ (a)
           ((star_writer
             (λ (d) (unit_writer (cons a d))))
            (remberevensXevens (cdr l)))))
        (remberevensXevens (car l))))
      ((odd? (car l))
       ((star_writer
         (λ (d) (unit_writer (cons (car l) d))))
        (remberevensXevens (cdr l))))
      (else
       ((star_writer
         (λ (_) (remberevensXevens (cdr l))))
        `(_ . (,(car l))))))))

> (remberevensXevens '(2 3 (8 (5 6 7) 4 8 7) 8 2 9))
((3 ((5 7) 7) 9) . (2 8 6 4 8 8 2))

这在结构上类似于异常monad, 除了我们使用了一个幺半群 (monoid) 来构筑我们的结果. 幺半群是一个序对, 由一个抽象加法和一个抽象零元构成. (当然了, 加法需要满足结合律, 零元需要是加法的单位元.) {译注: 数学的上下文里一般把交换幺半群的操作才称为加法, 不要混淆.} 这里我们使用的幺半群是 $(append, ())$ .

练习: 通过重新定义某个全局变量, 但不改变remberevensXevens的定义和测试程序, 使得返回的序对的 $cdr$ 反转.

> (remberevensXevens '(2 3 (8 (5 6 7) 4 8 7) 8 2 9))
((3 ((5 7) 7) 9) . (2 8 8 4 6 8 2))

译注: 显然, 我们应该改变mplus^list的定义.

(define mplus^list
  (λ (l1 l2)
    (append l2 l1)))

这是考虑了

(reverse (append l1 l2)) = (append (reverse l2) (reverse l1))

下一个monad是 $list$ monad.

第2.4节列表monad

以下是列表monad.

(define unit_list
  (λ (a)
    `(,a . ()))) ;This pair is a MA.
(define star_list
  (λ (sequel)
    (λ (ma)
      (cond ;This is a MB.
        ((eq? (car ma) '_) '(_ . _))
        (else
         (let ((mb (sequel (car ma))))
           (let ((extra (append (cdr mb) (mapcan sequel (cdr ma)))))
             `(,(car mb) . ,extra))))))))
(define mapcan
  (λ (f ls)
    (cond
      ((null? ls) '())
      (else
       (append (f (car ls))
               (mapcan f (cdr ls)))))))
;老实说, 不是很理解 (怀疑有问题
;和同学吃完火锅回来, 想了一会儿, 的确很有问题

;依照我的直觉, star_list的定义应该改成
(define star_list
  (λ (sequel)
    (λ (ma)
      (mapcan sequel ma))))
;另外, 其实mapcan用append-map就好啦
;不过, 我猜测本来另写mapcan是为了强调用了mplus^list?
;可惜也并没有这么写

;而且, 依照我的习惯, unit_list应该定义成
(define unit_list
  (λ (a)
    (list a)))

我们知道一个 $M A$ 是一个由纯值构成的列表, 于是每个(sequel a)都返回一个 $M B$ , 因而mapcan的结果会是纯值的列表. {译注: 这个因果关系也令我感到匪夷所思, 不过在明白正确的定义之后, 可能也不难理解. $M A$ 和 $M B$ 其实都是纯值的列表, 所以说想要将调用数次sequel得到的数个 $M B$ 再拼成一个 $M B$ , 就需要用到mplus^list (其实也就是append) 展平.}

考虑来自于Jeff Newbern的教程中的例子. 使用列表monad的标准例子是parse具有歧义的文法. 以下所展示的只是一个将数据理解为十六进制值, 十进制值, 以及单纯由alphanumeric字符构成的词进行parse的简单例子. 注意到十六进制的位, 十进制的位, 以及alphanumeric字符之间是有重合的, 所以说这会导致歧义. 例如, dead作为十六进制值和词都是合法的. 10作为十进制值是 $10$ , 而作为十六进制值是 $16$ . (10作为词也是合法的.)

在以下对于parse-c*的定义之中, 我们首先创建了三个特化的parser, 其接受一个带标记的纯值和一个新的字符. 然后, 我们定义一个函数, 其接受一个带标记的纯值和一个字符列表. 相同的字符会被传递给这三个已经定义了的parser, 连带着带标记的纯值. 每个parser都会返回一个 $M A$ , 然后他们会由 ${mplus}^{list}$ 组合成一个列表.

(define parse-c*
  (λ (a c*)
    (cond
      ((null? c*) (unit_list a))
      (else
       ((star_list
         (λ (a) (parse-c* a (cdr c*))))
        (mplus^list
         (parse-hex-digit a (car c*))
         (parse-dec-digit a (car c*))
         (parse-alphanumeric a (car c*))))))))
(define parse-hex-digit
  (λ (a c)
    (cond
      ((and (eq? (car a) 'hex-number)
            (char-hex? c))
       (unit_list
        `(hex-number . ,(+ (* (cdr a) 16)
                           (char-hex->integer/safe c)))))
      (else mzero^list))))
(define parse-dec-digit
  (λ (a c)
    (cond
      ((and (eq? (car a) 'dec-number)
            (char-numeric? c))
       (unit_list
        `(dec-number . ,(+ (* (cdr a) 10)
                           (- (char->integer c)
                              (char->integer #\0))))))
      (else mzero^list))))
(define parse-alphanumeric
  (λ (a c)
    (cond
      ((and (eq? (car a) 'word)
            (or (char-alphabetic? c)
                (char-numeric? c)))
       (unit_list
        `(word . ,(string-append (cdr a) (string c)))))
      (else mzero^list))))

译者: 后面的测试我也看了一下, 感觉也不是很有趣. 所以说, 我去看了看Dan Friedman抄的Haskell教程原文的例子. 好吧, 确实不是很有趣. 不过, 至少类比来看原作者还定义了

(define parse-c
  (λ (a c)
    (mplus^list
     (parse-hex-digit a c)
     (parse-dec-digit a c)
     (parse-alphanumeric a c))))
(define parse-arg
  (λ (s)
    ((star_list
      (λ (a) (parse-c* a (string->list s))))
     (mplus^list
      (unit_list '(hex-number . 0))
      (unit_list '(dec-number . 0))
      (unit_list '(word . ""))))))

当然, 由此parse-c*也应该重新定义一下, 变成

(define parse-c*
  (λ (a c*)
    (cond
      ((null? c*) (unit_list a))
      (else
       ((star_list
         (λ (a) (parse-c* a (cdr c*))))
        (parse-c a (car c*)))))))

看点我自己的测试.

> (parse-arg "dead")
((hex-number . 57005) (word . "dead"))
> (parse-arg "1234")
((hex-number . 4660) (dec-number . 1234) (word . "1234"))
> (parse-arg "abc@x")
()

然后, 给parse-c加个printf再看看. 之所以给parse-c加, 是因为三个子parser的调用实际上都要经过它. 看到parse-c调用一次, 等价于三个子parser给被调用了一次. 如果每个子parser都追踪, 那就太多了.

> (parse-arg "dead")
parse-c:
a: (hex-number . 0)
c: #\d

parse-c:
a: (hex-number . 13)
c: #\e

parse-c:
a: (hex-number . 222)
c: #\a

parse-c:
a: (hex-number . 3562)
c: #\d

parse-c:
a: (dec-number . 0)
c: #\d

parse-c:
a: (word . "")
c: #\d

parse-c:
a: (word . "d")
c: #\e

parse-c:
a: (word . "de")
c: #\a

parse-c:
a: (word . "dea")
c: #\d

((hex-number . 57005) (word . "dead"))

这结束了对于列表monad的讨论. 下一个monad是 $environment$ monad.

第2.5节环境monad

以下是环境monad.

(define unit_environment
  (λ (a)
    (λ (env)
      a)))
(define star_environment
  (λ (sequel)
    (λ (ma)
      (λ (env)
        (let ((a (ma env)))
          (let ((mb (sequel a)))
            (mb env)))))))
;似乎作者正在重写这一节的内容, 但是还没有完成
;环境monad和reader monad是相同的东西
;我怀疑作者是先写的reader monad,
;但是现在准备改成环境monad

译者: 原文写的是

(define unit_environment
  (λ (a)
    (λ (env)
      (let ((ma a))
        ma))))

这肯定是不对的, 可能是作者犯糊涂了.

$reader$ monad可以等效为状态monad, 但是我们只能够初始化状态. 在某种意义上说, 之前我们并不修改状态的例子其实可以视为reader monad的例子. reader monad的可能用法之一是初值可能是包含了令人感兴趣的全局信息的关联列表, 那么reader monad能够使你访问这些信息. 你可以理解为, 相对于状态monad而言, reader monad也是对于某个全局变量的刻画, 只是这个变量的值不能被修改.

...

这结束了我们对于reader monad的讨论. 接下来我们要使用类似于Scheme的call/cc的运算符来定义程序. 正如我们将会看到的, 它几乎与Scheme的相同, 但又不那么相同.

第2.6节延续monad

以下是 $continuation$ monad.

(define unit_continuation
  (λ (a)
    (λ (k) ;This function is a MA.
      (k a))))
(define star_continuation
  (λ (sequel)
    (λ (ma)
      (λ (k) ;This function is a MB.
        (let ((k^ (λ (a)
                    (let ((mb (sequel a)))
                      (mb k)))))
          (ma k^))))))

如果我们使用延续monad来修改remberevensXcountevens_cps的定义, 那么remberevensXcountevens_continuation就会变成一个单参数的过程了. {译注: 不过, 延续monad的 $M A$ 还是要接受一个作为延续的参数的.}

(define remberevensXcountevens_continuation
  (λ (l)
    (cond
      ((null? l) (unit_continuation '(() . 0)))
      ((list?? (car l))
       ((star_continuation
         (λ (pa)
           ((star_continuation
             (λ (pd)
               (unit_continuation
                `(,(cons (car pa) (car pd))
                  . ,(+ (cdr pa) (cdr pd))))))
            (remberevensXcountevens_continuation (cdr l)))))
        (remberevensXcountevens_continuation (car l))))
      ((odd? (car l))
       ((star_continuation
         (λ (p)
           (unit_continuation
            `(,(cons (car l) (car p)) . ,(cdr p)))))
        (remberevensXcountevens_continuation (cdr l))))
      (else
       ((star_continuation
         (λ (p)
           (unit_continuation
            `(,(car p) . ,(add1 (cdr p))))))
        (remberevensXcountevens_continuation (cdr l)))))))

> ((remberevensXcountevens_continuation
    '(2 3 (7 4 5 6) 8 (9) 2))
   (λ (p) p))
((3 (7 5) (9)) . 5)

显然, 这段代码可以视为延续传递风格, 但又没有显式用到延续. 甚至和之前的存储传递风格一样, 我们可以从这个定义重写得到延续传递风格的版本. 感兴趣的读者可以尝试一下. {译注: 实际上, 之前的原文写的是状态传递风格, 不过存储传递风格这个术语的确用得更多.}

以下是callcc的定义. 正如这个名字所暗示的那样, 它允许我们编写monadic程序时使用类似于Scheme的call/cc的机制.

(define callcc
  (λ (f)
    (λ (k)
      (let ((k-as-proc
             (λ (a)
               (λ (k_ignored)
                 (k a)))))
        (let ((ma (f k-as-proc)))
          (ma k))))))

译者: 从某种意义上来说, callcc的参数k具有双重作用. 从概念上来说, 它是所谓的当前延续. 这个当前延续(的包装版本)会传递给f, 使得f的体中在调用它时返回一个恰当的monadic值, 这个monadic值会忽略其所接受的延续, 转而使用之前所保存的当前延续. 另外, 这个k (未经包装的当前延续) 也会直接传递给f的体, 作为当前延续使用.

在callcc的定义之中, 我们打包了当前的延续k以忽略未来的当前延续而调用现在存储的这个当前延续. 这就是绑定到k-as-proc的对象. {译注: 更准确地说, 给k-as-proc喂一个纯值之后会产生一个monadic值.} 我们将包装了的延续传递给f, 其会返回一个 $M A$ , 然后其又会被传递进入时的当前的延续k. 我们使用一个程序来描述callcc. 这个程序的参数也接受嵌套的整数列表, 然后返回其中的数字之积. 当遇到数字0的时候, 这个过程应该立即返回0. 出于乐趣, 我们给退出之后添加了一些代码, 以确保它并不会发生. 如果不加这冗余的代码, 或许不会令某些人信服. 这种证明手法在于使得(exit 0)位于非尾位置, 让sequel做些什么. 不过若是我们的callcc以预想的方式工作, 那么这个sequel就会被直接忽略.

(define product
  (λ (ls exit)
    (cond
      ((null? ls) (unit_continuation 1))
      ((list?? (car ls))
       ((star_continuation
         (λ (a)
           ((star_continuation
             (λ (d)
               (unit_continuation (* a d))))
            (product (cdr ls) exit))))
        (product (car ls) exit)))
      ((zero? (car ls))
       ((star_continuation
         (λ (_)
           (unit_continuation (sub1 _))))
        (exit 0)))
      (else
       ((star_continuation
         (λ (d)
           (unit_continuation
            (* (car ls) d))))
        (product (cdr ls) exit))))))

以下的第一个测试处理的是基本情况, 1会直接返回, out不会被调用.

> ((callcc
    (λ (out) (product '() out)))
   (λ (x) x))
1

下一个例子对应于Scheme的(add1 (call/cc (λ (out) (product '() out)))). {译注: 当然了, 这里的product是按照通常方式而非monad风格定义的.} 这表明了callcc具有某种可复合性.

> (((star_continuation
     (λ (a)
       (unit_continuation
        (add1 a))))
    (callcc
     (λ (out)
       (product '() out))))
   (λ (x) x))
2

第三个例子和第二个例子, 只是out会被调用, 我们需要保证这种情况下的可复合性.

> (((star_continuation
     (λ (a)
       (unit_continuation
        (add1 a))))
    (callcc
     (λ (out)
       (product '(5 0 5) out))))
   (λ (x) x))
1

以下是一个非常正常的例子. 因为列表里没有0, 所以out不会被调用. {译注: 尽管如此, 作为延续的(λ (x) x)还是会在最后被调用.}

> ((callcc
    (λ (out)
      (product '(2 3 (7 4 5 6) 8 (9) 2) out)))
   (λ (x) x))
725760

让我们来看最后一个例子, 其应该等价于以下的Scheme例子. {译注: Dan Friedman称其为简单的例子, 我希望他只是在开玩笑. 尽管我可以理解这个例子, 但我实在拒绝称这个例子为简单的.}

(call/cc
 (λ (k0)
   ((car (call/cc
          (λ (k1)
            (k0 (- (call/cc
                    (λ (k2)
                      (k1 `(,k2))))
                   1)))))
    3)))

但是, 对于这个表达式进行monad化有点tricky. {译注: 如果你能理解上面的表达式, 那么monad化就不tricky了.} 延续k1中的((car []) 3)需要移到第一个sequel的位置, 同理(k0 (- [] 1))需要移到第二个sequel的位置.

> ((callcc
    (λ (k0)
      ((star_continuation
        (λ (a) ((car a) 3)))
       (callcc
        (λ (k1)
          ((star_continuation
            (λ (n) (k0 (- n 1))))
           (callcc
            (λ (k2) (k1 `(,k2))))))))))
   (λ (x) x))
2

下一个monad是 $identity$ monad.

第2.7节恒等monad

以下是 $identity$ monad.

(define unit_identity
  (λ (a)
    (let ((ma a))
      ma)))
(define star_identity
  (λ (sequel)
    (λ (ma)
      (let ((a ma)) ;This is a MB.
        (sequel a)))))

考虑第一次讲座里的remberevens. {译注: 那是已经monad化了的版本.} 我们取该定义, 然后将unit_state替换为unit_identity, star_state替换为star_identity, 接着我们就得到了以下定义.

(define remberevens
  (λ (l)
    (cond
      ((null? l) (unit_identity '()))
      ((list?? (car l))
       ((star_identity
         (λ (a)
           ((star_identity (λ (d) (unit_identity (cons a d))))
            (remberevens (cdr l)))))
        (remberevens (car l))))
      ((odd? (car l))
       ((star_identity (λ (d) (unit_identity (cons (car l) d))))
        (remberevens (cdr l))))
      (else
       (remberevens (cdr l))))))

> (remberevens '(2 3 (7 4 5 6) 8 (9) 2))
(3 (7 5) (9))

这是一个纯粹的解法, 因为有着非常干净的 $unit$ 和 $star$ : 相当于恒等函数. 将恒等monad修改为使用 $car$ 部分有着纯值的序对是平凡的事情.

第3章附录

第3.1节状态传递风格的推导

第3.2节结论

我们使用了Wadler的方法来解释来源于The Essence of Functional Programming的monad. 但是, 存在着不同之处. Wadler使用了bind, 而我则像Moggi一样使用了star. Wadler展示了如何扩展解释器, 而我展示了如何扩展The Little Schemer中的程序. Wadler假定能够阅读Haskell程序, 我则假定理解函数作为值以及能够阅读Scheme程序. 最后, 我相信我的方法对于新人更加清晰, 而Wadler的方法更适合成熟的读者.

monad的Schemer之见

第1章 状态monad

第1.1节 简谈monad

第1.2节 类型和形状

第1.3节 状态monad

第1.4节 推导状态monad

第2章 其他一些monad

第2.1节 可能monad (Maybe Monad)

第2.2节 异常monad

第2.3节 writer monad

第2.4节 列表monad

第2.5节 环境monad

第2.6节 延续monad

第2.7节 恒等monad

第3章 附录

第3.1节 状态传递风格的推导

第3.2节 结论

第3.3节 致谢