``` 1 trait Free[F[_],A] {
2  private case class FlatMap[B](a: Free[F,A], f:A => Free[F,B]) extends Free[F,B]
3  def unit(a: A) = Return(a)
4  def flatMap[B](f: A => Free[F,B])(implicit F: Functor[F]): Free[F,B] = this match {
5      case Return(a) => f(a)
6      case Suspend(k) => Suspend(F.map(k)( _ flatMap f))
7      case FlatMap(b,g) => FlatMap(b, x => g(x) flatMap f) //FlatMap(b, g andThen (_ flatMap f))
8  }
9  def map[B](f: A => B)(implicit F: Functor[F]): Free[F,B] = flatMap(a => Return(f(a)))
10 }
11 case class Return[F[_],A](a: A) extends Free[F,A]
12 case class Suspend[F[_],A](ffa: F[Free[F,A]]) extends Free[F,A]
13 trait Trampoline[A] {
14   private case class FlatMap[B](a: Trampoline[A], f: A => Trampoline[B]) extends Trampoline[B]
15     final def runT: A = resume match {
16         case Right(a) => a
17         case Left(k) => k().runT
18     }
19     def unit[A](a: A) = Done(a)
20     def flatMap[B](f: A => Trampoline[B]): Trampoline[B] = this match {
21 //        case FlatMap(b,g) => FlatMap(b, g andThen (_ flatMap f)
22 //        case FlatMap(b,g) => FlatMap(b, x => FlatMap(g(x),f))
23     case FlatMap(b,g) => FlatMap(b, x => g(x) flatMap f)
24         case x => FlatMap(x,f)
25     }
26     def map[B](f: A => B): Trampoline[B] = flatMap(a => More(() => Done(f(a))))
27     final def resume: Either[() => Trampoline[A],A] = this match {
28         case Done(a) => Right(a)
29         case More(k) => Left(k)
30         case FlatMap(a,f) => a match {
31             case Done(v) => f(v).resume
32             case More(k) => Left(() => FlatMap(k(),f))
33             case FlatMap(b,g) => FlatMap(b, g andThen (_ flatMap f)).resume
34         }
35     }
36 }
37 case class Done[A](a: A) extends Trampoline[A]
38 case class More[A](k: () => Trampoline[A]) extends Trampoline[A]```

``` 1 trait Free[F[_],A] {
2  private case class FlatMap[B](a: Free[F,A], f:A => Free[F,B]) extends Free[F,B]
3  def unit(a: A) = Return(a)
4  def flatMap[B](f: A => Free[F,B])(implicit F: Functor[F]): Free[F,B] = this match {
5      case Return(a) => f(a)
6      case Suspend(k) => Suspend(F.map(k)( _ flatMap f))
7      case FlatMap(b,g) => FlatMap(b, x => g(x) flatMap f) //FlatMap(b, g andThen (_ flatMap f))
8  }
9  def map[B](f: A => B)(implicit F: Functor[F]): Free[F,B] = flatMap(a => Return(f(a)))
10  final def resume(implicit F: Functor[F]): Either[F[Free[F,A]],A] = this match {
11        case Return(a) => Right(a)
12        case Suspend(k) => Left(k)
13        case FlatMap(a,f) => a match {
14            case Return(v) => f(v).resume
15            case Suspend(k) => Left(F.map(k)(_ flatMap f))
16            case FlatMap(b,g) => FlatMap(b, g andThen (_ flatMap f)).resume
17        }
18  }
19 }
20 case class Return[F[_],A](a: A) extends Free[F,A]
21 case class Suspend[F[_],A](ffa: F[Free[F,A]]) extends Free[F,A]```

Free类型的resume函数与Trampoline的基本一致，只有返回类型和增加了参数implicit F: Functor［F]，因为Free[F,A]的F必须是个Functor：用Functor F可以产生Free[F,A]。

```1 trait Interact[A]
2 case class Ask(prompt: String) extends Interact[String]
3 case class Tell(msg: String) extends Interact[Unit]```

```1 trait Interact[A]
2 case class Ask[A](prompt: String, next: A) extends Interact[A]
3 case class Tell[A](msg: String, next: A) extends Interact[A]```

```1 trait Interact[A]
2 case class Ask[A](prompt: String, next: A) extends Interact[A]
3 case class Tell[A](msg: String, next: A) extends Interact[A]
4 implicit val interactFunctor = new Functor[Interact] {
5     def map[A,B](ia: Interact[A])(f: A => B): Interact[B] = ia match {
7             case Tell(x,n) => Tell(x,f(n))
8     }
9 }                                                 //> interactFunctor  : ch13.ex1.Functor[ch13.ex1.Interact] = ch13.ex1\$\$anonfun\$```

``` 1 def liftF[F[_],A](fa: F[A])(implicit F: Functor[F]): Free[F,A] = {
2     Suspend(F.map(fa)(a => Return(a)))
3 }                                                 //> liftF: [F[_], A](fa: F[A])(implicit F: ch13.ex1.Functor[F])ch13.ex1.Free[F,
4                                                   //| A]
5 implicit def LiftInteract[A](ia: Interact[A]): Free[Interact,A] = liftF(ia)
6                                                   //> LiftInteract: [A](ia: ch13.ex1.Interact[A])ch13.ex1.Free[ch13.ex1.Interact,
7                                                   //| A]
8 val prg = for {
11     _ <- Tell(s"Hello \$first \$last",())
12 } yield ()                                        //> prg  : ch13.ex1.Free[ch13.ex1.Interact,Unit] = Suspend(Ask(What's your firs
14                                                   //| ())))))))```

```1  def foldMap[G[_]](f: F ~> G)(implicit F: Functor[F], G: Monad[G]): G[A] = resume match {
2        case Right(a) => G.unit(a)
3        case Left(k) => G.flatMap(f(k))(_ foldMap f)
4  }```

foldMap通过调用resume引入了Trampoline运行机制。

```1 trait StateF[S,A]
2 case class Get[S,A](f: S => A) extends StateF[S,A]
3 case class Put[S,A](s: S, a: A) extends StateF[S,A]```

```1 mplicit def stateFFunctor[S] = new Functor[({type l[x] = StateF[S,x]})#l] {
2     def map[A,B](sa: StateF[S,A])(f: A => B): StateF[S,B] = sa match {
3          case Get(g) => Get( s => f(g(s)) )
4          case Put(s,a) => Put(s, f(a))
5     }
6 }                                                 //> stateFFunctor: [S]=> ch13.ex1.Functor[[x]ch13.ex1.StateF[S,x]]```

`1 type FreeState[S,A] = Free[({type l[x] = StateF[S,x]})#l, A]`

Free[F,A]里的Functor F只接受一个类型参数。StateF[S,A]有两个类型参数，我们必须用type lambda来解决类型参数匹配问题。

```1 def unit[S,A](a: A): FreeState[S,A] = Return[({type l[x] = StateF[S,x]})#l, A](a)
2                                                   //> unit: [S, A](a: A)ch13.ex1.FreeState[S,A]
3 def getState[S]: FreeState[S,S] = Suspend[({type l[x] = StateF[S,x]})#l, S](
4     Get(s => Return[({type l[x] = StateF[S,x]})#l, S](s)))
5                                                   //> getState: [S]=> ch13.ex1.FreeState[S,S]
6 def setState[S](s: S): FreeState[S,Unit]  = Suspend[({type l[x] = StateF[S,x]})#l, Unit](
7     Put(s, Return[({type l[x] = StateF[S,x]})#l, Unit](())))
8                                                   //> setState: [S](s: S)ch13.ex1.FreeState[S,Unit]```

```1 def evalS[S,A](s: S, t: FreeState[S,A]): A = t.resume match {
2     case Right(a) => a
3     case Left(Get(f)) => evalS(s, f(s))
4     case Left(Put(n,a)) => evalS(n,a)
5 }                                                 //> evalS: [S, A](s: S, t: ch13.ex1.FreeState[S,A])A```

``` 1 def zipIndex[A](as: List[A]): List[(Int, A)] = {
2     evalS(1, as.foldLeft(unit[Int,List[(Int,A)]](List()))(
3       (acc,a) => for {
4           xs <- acc
5           n <- getState
6           _ <- setState(n+1)
7       } yield (n, a) :: xs)).reverse
8 }                                                 //> zipIndex: [A](as: List[A])List[(Int, A)]
9
10 zipIndex((0 to 10000).toList)                     //> res0: List[(Int, Int)] = List((1,0), (2,1), (3,2), (4,3), (5,4), (6,5), (7,
11                                                   //| 6), (8,7), (9,8), (10,9), (11,10), (12,11), (13,12), (14,13), (15,14), (16,
12                                                   //| 15), (17,16), (18,17), (19,18), (20,19), (21,20), (22,21), (23,22), (24,23)```

```1 trait StackOps[A]
2 case class Push[A](value: Int, ops:A) extends StackOps[A]
3 case class Add[A](ops: A) extends StackOps[A]
4 case class Mul[A](ops: A) extends StackOps[A]
5 case class Dup[A](ops: A) extends StackOps[A]
6 case class End[A](ops: A) extends StackOps[A]```

```1 implicit val stackOpsFunctor: Functor[StackOps] = new Functor[StackOps] {
2     def map[A,B](oa: StackOps[A])(f: A => B): StackOps[B] = oa match {
3         case Push(v,a) => Push(v,f(a))
5         case Mul(a) => Mul(f(a))
6         case Dup(a) => Dup(f(a))
7         case End(a) => End(f(a))
8     }
9 }```

这里的next看起来是多余的，但它代表的是下一步运算。有了它才可能得到Functor实例，即使目前每一个操作都是完整独立步骤。

``` 1 def liftF[F[_],A](fa: F[A])(implicit F: Functor[F]): Free[F,A] = {
2     Suspend(F.map(fa)(a => Return(a)))
3 }                                                 //> liftF: [F[_], A](fa: F[A])(implicit F: ch13.ex1.Functor[F])ch13.ex1.Free[F,
4                                                   //| A]
5 implicit def liftStackOps[A](sa: StackOps[A]): Free[StackOps,A] = liftF(sa)
6                                                   //> liftStackOps: [A](sa: ch13.ex1.StackOps[A])ch13.ex1.Free[ch13.ex1.StackOps,
7                                                   //| A]
8 val stkprg = for {
9     _ <- Push(1,())
10     _ <- Push(2,())
12 } yield x                                         //> stkprg  : ch13.ex1.Free[ch13.ex1.StackOps,Unit] = Suspend(Push(1,Suspend(Pu

``` 1 def push(value: Int) = Push(value,())             //> push: (value: Int)ch13.ex1.Push[Unit]
3 def sub = Sub(())                                 //> sub: => ch13.ex1.Sub[Unit]
4 def mul = Mul(())                                 //> mul: => ch13.ex1.Mul[Unit]
5 def end = End(())                                 //> end: => ch13.ex1.End[Unit]
6 val stkprg = for {
7     _ <- push(1)
8     _ <- push(2)
10     _ <- push(4)
11     _ <- mul
12 } yield ()                                        //> stkprg  : ch13.ex1.Free[ch13.ex1.StackOps,Unit] = Suspend(Push(1,Suspend(Pu

```1  def foldMap[G[_]](f: F ~> G)(implicit F: Functor[F], G: Monad[G]): G[A] = resume match {
2        case Right(a) => G.unit(a)
3        case Left(k) => G.flatMap(f(k))(_ foldMap f)
4  }```

``` 1  final def foldRun[B](b: B)(f: (B, F[Free[F,A]]) => (B, Free[F,A]))(implicit F: Functor[F]): (B, A) = {
2       @annotation.tailrec
3       def run(t: Free[F,A], z: B): (B, A) = t.resume match {
4               case Right(a) => (z, a)
5               case Left(k) => {
6                   val (b1, f1) = f(z, k)
7                   run(f1,b1)
8               }
9       }
10       run(this,b)
11  }```

``` 1 type Stack = List[Int]
2 def stackFn(stack: Stack, prg: StackOps[Free[StackOps,Unit]]): (Stack, Free[StackOps,Unit]) = prg match {
3     case Push(v, n) => {
4         (v :: stack, n)
5     }
7         val hf :: hs :: t = stack
8         ((hf + hs) :: stack, n)
9     }
10     case Sub(n) => {
11         val hf :: hs :: t = stack
12         ((hs - hf) :: stack, n)
13     }
14     case Mul(n) => {
15         val hf :: hs :: t = stack
16         ((hf * hs) :: stack, n)
17     }
18 }                                                 //> stackFn: (stack: ch13.ex1.Stack, prg: ch13.ex1.StackOps[ch13.ex1.Free[ch13.
19                                                   //| ex1.StackOps,Unit]])(ch13.ex1.Stack, ch13.ex1.Free[ch13.ex1.StackOps,Unit])```

```1 val stkprg = for {
2     _ <- push(1)
3     _ <- push(2)
5     _ <- push(4)
6     _ <- mul
7 } yield ()                                        //> stkprg  : ch13.ex1.Free[ch13.ex1.StackOps,Unit] = Suspend(Push(1,Suspend(Pu
9 stkprg.foldRun(List[Int]())(stackFn)              //> res0: (List[Int], Unit) = (List(12, 4, 3, 2, 1),())```

```1 type StackState[A] = State[Stack,A]
3     def unit[A](a: A) = State(s => (a,s))
4     def flatMap[A,B](sa: StackState[A])(f: A => StackState[B]): StackState[B] = sa flatMap f
6                                                   //| main\$1\$\$anon\$5@26f67b76```

``` 1 object StackOperator extends (StackOps ~> StackState) {
2   def apply[A](sa: StackOps[A]): StackState[A] = sa match {
3       case Push(v,n) => State((s: Stack) => (n, v :: s))
4       case Add(n) => State((s: Stack) => {
5           val hf :: hs :: t = s
6           (n, (hf + hs) :: s)
7       })
8       case Sub(n) => State((s: Stack) => {
9           val hf :: hs :: t = s
10           (n, (hs - hf) :: s)
11       })
12       case Mul(n) => State((s: Stack) => {
13           val hf :: hs :: t = s
14           (n, (hf * hs) :: s)
15       })
16   }
17 }```

`1 stkprg.foldMap(StackOperator).runS(List[Int]())   //> res1: (Unit, ch13.ex1.Stack) = ((),List(12, 4, 3, 2, 1))`

0 条评论

• ### Scalaz（32）－ Free ：lift - Monad生产线

在前面的讨论里我们提到自由数据结构就是产生某种类型的最简化结构，比如：free monoid, free monad, free category等等。...

• ### Scalaz（31）－ Free ：自由数据结构－算式和算法的关注分离

我们可以通过自由数据结构（Free Structure）实现对程序的算式和算法分离关注（separation of concern）。算式（Abstrac...

• ### 客户执行需与客户确认内容

工作这么多年做客户项目遇到了不少坑，这些内容之前一直没有重视，现在一点一点整理出来，便于客户执行与客户的沟通。

• ### [算法题] 计算结构体的大小

计算结构体的大小      C代码中定义的结构体是一块连续内存，各成员按照定义的顺序依次在其中存放。编译器在完成语法分析后，需要计算它的大小，然后才能正确地为结...

• ### Python——量化分析常用命令介绍（三）

量化分析整体思路虽不难，但是要代码实现，其实挺繁杂的，需要很多铺垫工作，比如要先搭建自己的数据库。

• ### Kotlin中级（6）- - - Kotlin类之的继承.md

因为Any这个类只是给我们提供了equals、hashcode、toString三个方法，我们可以看看Any这个类的源码实现

• ### 大数据的那些事(4):活雷锋与风口的猪

按照惯例今天应该是继续讲三驾马车的BigTable，但是一则BigTable这东西不容易一下子说清楚。二则我觉得是时候停一下技术，多聊点八卦。所以我们来讲讲这个...

• ### 大数据的那些事(4):活雷锋与风口的猪

按照惯例今天应该是继续讲三驾马车的BigTable，但是一则BigTable这东西不容易一下子说清楚。二则我觉得是时候停一下技术，多聊点八卦。所以我们来讲讲这个...

• ### 我的非线性视频编辑器MiaoVideoCut(1) --- 视频基础知识及环境搭建

所谓视频编码方式就是指通过特定的压缩技术，将某个视频格式的文件转换成另一种视频格式文件的方式。视频流传输中最为重要的编解码标准有国际电联的H.261、H.26...