这一节主要是关于free monad

初见Free Monad

这一节的内容也是基于Why free monads matter

Let’s try to come up with some sort of abstraction that represents the essence of a syntax tree. … Our toy language will only have three commands:

先看一个具体语法的例子

1
2
3
4
data Toy b next =
Output b next
|Bell next
| Done

翻译成Scala

1
2
3
4
sealed trait Toy[+A, +Next]
case class Output[A, Next](a: A, next: Next) extends Toy[A, Next]
case class Bell[Next](next: Next) extends Toy[Nothing, Next]
case class Done() extends Toy[Nothing, Nothing]

这样有一个问题,每一次添加一个命令都要改变一个类型。在haskell里面更明显。

Fix来救场

我们找一个类型把他们包起来

1
data Fix f = Fix (f (Fix f))

这个形式是不是挺眼熟。 写成scala

1
2
3
4
case class Fix[F[_]](f: F[Fix[F]])
object Fix {
def fix[A](toy: Toy[A, Fix[Toy[A, ?]]]) = Fix[Toy[A, ?]](toy)
}

可以简单的试一下,

1
2
fix[String](Output("S", fix(Done())))
// res0: Fix[[β$1$]Toy[String,β$1$]] = Fix(Output(S,Fix(Done())))

FixE

既然是解析语法,有一个明显的问题就是如果语法错了呢?比如,根本不存在一个Done,程序不会终止。

我们改进刚才的设计,得到FixE

1
data FixE f e = Fix (f (FixE f e)) | Throw e
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
sealed trait FixE[F[_], E]
object FixE {
case class Fix[F[_], E](f: F[FixE[F ,E]]) extends FixE[F, E]
case class Throwy[F[_], E](e: E) extends FixE[F, E]
def fix[A, E](toy: Toy[A, FixE[Toy[A, ?], E]]): FixE[Toy[A, ?], E]
= Fix[Toy[A, ?], E](toy)
def throwy[F[_], E](e: E): FixE[F, E] = Throwy(e)
def catchy[F[_]: Functor, E1, E2](ex: => FixE[F, E1])
(f: E1 => FixE[F, E2]): FixE[F, E2] = ex match {
case Fix(x) => Fix[F, E2](Functor[F].map(x) { catchy(_)(f)})
case Throwy(e) => f(e)
}
}

然后,我们把Toy声明成Functor

1
2
3
4
5
6
7
8
implicit def ToyFunctor[Y]: Functor[Toy[Y, ?]] = new Functor[Toy[Y, ?]] {
override def map[A, B](fa: Toy[Y, A])(f: (A) => B): Toy[Y, B] =
fa match {
case o: Output[Y, A] => Output(o.a, f(o.next))
case b: Bell[A] => Bell(f(b.next))
case Done() => Done()
}
}

最后,我们写个例子看看(写到这我已经忍不住吐槽scala语法了,实在不太适合写这种东西,到处都是类型,由于不如haskell那样自然处理kind,所以写起来很难看)

1
2
3
4
5
6
7
8
case class IncompleteException()
def subroutine = FixE.fix[Char, IncompleteException](
Output('A',
FixE.throwy[Toy[Char, ?], IncompleteException](IncompleteException())))
def program = FixE.catchy[Toy[Char, ?], IncompleteException, Nothing](subroutine) { _ =>
FixE.fix[Char, Nothing](Bell(FixE.fix[Char, Nothing](Done())))
}

Free Monad part 1

其实free monad已经存在了。

1
data Free f r = Free (f (Free f r)) | Pure r

而且,他在fFunctor的时候是一个Monad

1
2
3
4
instance (Functor f) => Monad (Free f) where
return = Pure
(Free x) >>= f = Free (fmap (>>= f) x)
(Pure r) >>= f = f r

其中return就是throw,而pure就是catch。而在Scala中,对应的是Free[S[+_], +A]return对应Free.point>>=就是flatMap

我们看看用scalaz来实现。

1
2
3
4
5
6
7
8
def output[A](a: A): Free[Toy[A, ?], Unit] =
Free.roll[Toy[A, ?], Unit](Output(a, Free.pure[Toy[A, ?], Unit](())))
def bell[A]: Free[Toy[A, ?], Unit] =
Free.roll(Bell(Free.point[Toy[A, ?], Unit](())))
def done[A]: Free[Toy[A, ?], Unit] = Free.roll[Toy[A, ?], Unit](Done())

但是这里有点太麻烦了,我们可以完全可以直接使用liftF。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
object Toy {
implicit def ToyFunctor[Y]: Functor[Toy[Y, ?]] = new Functor[Toy[Y, ?]] {
override def map[A, B](fa: Toy[Y, A])(f: (A) => B): Toy[Y, B] =
fa match {
case o: Output[Y, A] => Output(o.a, f(o.next))
case b: Bell[A] => Bell(f(b.next))
case Done() => Done()
}
}
def output[A](a: A): Free[Toy[A, ?], Unit] =
Free.liftF[Toy[A, ?], Unit](Output(a, ()))
def bell[A]: Free[Toy[A, ?], Unit] =
Free.liftF[Toy[A, ?], Unit](Bell())
def done[A]: Free[Toy[A, ?], Unit] = Free.liftF[Toy[A, ?], Unit](Done())
}

不过这个程序感觉没什么效果,我们搞一个能把它打印出来的。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
def showProgram[R: Show, A: Show](p: Free[Toy[A, ?], R]): String =
p.resume.fold({
case Output(a, next) =>
"output " + Show[A].shows(a) + "\n" + showProgram(next)
case Bell(next) =>
"bell " + "\n" + showProgram(next)
case Done() =>
"done\n"
},
{r: R => "return" + Show[R].shows(r) + "\n"})
def pretty[R: Show, A: Show](p: Free[Toy[A, ?], R]) = print(showProgram(p))
pretty(program)
// output A
bell
done
res0: Unit = ()

free monad and List

其实对比ListFree

1
2
data Free f r = Free (f (Free f r)) | Pure r
data List a = Cons a (List a) | Nil

可以把Free自己看成一个functorlistFree本身可以看做一个Cons

很多地方都是说Free Monad其实就是AST+Interpreter,其实这种时候看看Haskell就比Scala清晰多了。通过类型建立ADT,(话说这个在写《TAPL》第一章那个无类型的lambda验算的时候就感觉很方便),然后通过lift把对应的functor升级成Free Monad,最后定义个Interpreter,针对不同的lift之前的类型进行处理就行了。

其实这个倒是写了很长时间,但是感觉自己理解的差了不少,也没结束,正好最近在知乎上看到了大神的解释。其中对CoYoneda的介绍很实用。即,ADT不满足Functor的时候通过实现Coyoneda来构造一个Functor




X