## 动力学知识库

` 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) => a17 case Left(k) => k().runT18  }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).resume32 case More(k) => Left(() => FlatMap(k(),f))33 case FlatMap(b,g) => FlatMap(b, g andThen (_ flatMap f)).resume34  }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).resume15 case Suspend(k) => Left(F.map(k)(_ flatMap f))16 case FlatMap(b,g) => FlatMap(b, g andThen (_ flatMap f)).resume17  }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 {6 case Ask(x,n) => Ask(x,f(n))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 { 9 first <- Ask("What's your first name?",())10 last <- Ask("What's your last name?",())11 _ <- Tell(s"Hello \$first \$last",())12 } yield () //> prg : ch13.ex1.Free[ch13.ex1.Interact,Unit] = Suspend(Ask(What's your firs13 //| t name?,Suspend(Ask(What's your last name?,Suspend(Tell(Hello () (),Return(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) => a3 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)] 910 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))4 case Add(a) => Add(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,())11 _ <- Add(())12 } yield x //> stkprg : ch13.ex1.Free[ch13.ex1.StackOps,Unit] = Suspend(Push(1,Suspend(Pu13 //| sh(2,Suspend(Add(Suspend(Pop(Return(())))))))))`

` 1 def push(value: Int) = Push(value,()) //> push: (value: Int)ch13.ex1.Push[Unit] 2 def add = Add(()) //> add: => ch13.ex1.Add[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) 9 _ <- add10 _ <- push(4)11 _ <- mul12 } yield () //> stkprg : ch13.ex1.Free[ch13.ex1.StackOps,Unit] = Suspend(Push(1,Suspend(Pu13 //| sh(2,Suspend(Add(Suspend(Push(4,Suspend(Mul(Return(())))))))))))`

`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  } 6 case Add(n) => { 7 val hf :: hs :: t = stack 8 ((hf + hs) :: stack, n) 9  }10 case Sub(n) => {11 val hf :: hs :: t = stack12 ((hs - hf) :: stack, n)13  }14 case Mul(n) => {15 val hf :: hs :: t = stack16 ((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)4 _ <- add5 _ <- push(4)6 _ <- mul7 } yield () //> stkprg : ch13.ex1.Free[ch13.ex1.StackOps,Unit] = Suspend(Push(1,Suspend(Pu8 //| sh(2,Suspend(Add(Suspend(Push(4,Suspend(Mul(Return(())))))))))))9 stkprg.foldRun(List[Int]())(stackFn) //> res0: (List[Int], Unit) = (List(12, 4, 3, 2, 1),())`

`1 type StackState[A] = State[Stack,A]2 implicit val stackStateMonad = new Monad[StackState] {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 f5 } //> stackStateMonad : ch13.ex1.Monad[ch13.ex1.StackState] = ch13.ex1\$\$anonfun\$6 //| [email protected]`

` 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 = s10 (n, (hs - hf) :: s)11  })12 case Mul(n) => State((s: Stack) => {13 val hf :: hs :: t = s14 (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))`