-
-
Save ukstv/9316671 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
object Trampolines { | |
def odd[A](as: List[A]): TailRec[Boolean] = | |
as match { | |
case Nil => Return(false) | |
case _ :: xs => Suspend(() => even(xs)) | |
} | |
def even[A](as: List[A]) = as match { | |
case Nil => Return(true) | |
case _ :: xs => Suspend(() => odd(xs)) | |
} | |
sealed trait TailRec[A] { | |
import annotation._ | |
@tailrec final def run: A = this match { | |
case Return(a) => a | |
case Suspend(k) => k().run | |
case FlatMap(x, f) => (x match { | |
case Return(a) => f(a) | |
case Suspend(k) => Suspend(() => f(k())) | |
case FlatMap(a, g) => FlatMap(a, | |
(y: Any) => FlatMap(g(y), f)) | |
}).run | |
} | |
def flatMap[B](f: A => TailRec[B]): TailRec[B] = | |
this match { | |
case FlatMap(x, g) => FlatMap(x, (a: Any) => g(a).flatMap(f)) | |
case x => FlatMap(x, f) | |
} | |
} | |
case class Return[A](a: A) extends TailRec[A] | |
case class Suspend[A](k: () => TailRec[A]) extends TailRec[A] | |
case class FlatMap[A,B](tr: TailRec[A], f: A => TailRec[B]) | |
extends TailRec[B] | |
} | |
import language.higherKinds | |
sealed trait Free[F[_], A] | |
case class Return[F[_], A](a: A) extends Free[F, A] | |
case class Suspend[F[_], A](k: F[Free[F, A]]) extends Free[F, A] | |
object Free { | |
type Pair[A] = (A, A) | |
// Contains one or more of values of type `A` | |
type NonemptyList[A] = Free[Pair, A] | |
// This free monad is isomorphic to List | |
type MaybePair[A] = Option[(A, A)] | |
type List[A] = Free[MaybePair, A] | |
// Option is a free monad over this trivial functor | |
type Trivial[A] = Unit | |
type Option[A] = Free[Trivial, A] | |
// This is something like the set of natural numbers added | |
// to some free term, or zero. | |
type Partial[A] = Free[Option, A] | |
// Trampolining is a free recurson on a lazy identity | |
type TailRec[A] = Free[Function0, A] | |
// The state monad is a free monad over this data type with two constructors | |
sealed trait StateF[S, A] | |
case class SetState[S, A](s: S, k: () => A) extends StateF[S, A] | |
case class GetState[S, A](k: S => A) extends StateF[S, A] | |
type State[S, A] = Free[({type f[x] = StateF[S, x]})#f, A] | |
// We can can make a kind of IO monad that can read and write the console | |
sealed trait Console[A] | |
case class ReadLn[A](k: String => A) | |
case class PrintLn[A](s: String, k: () => A) | |
type ConsoleIO[A] = Free[Console, A] | |
} | |
case class State[S, A](runState: S => (A, S)) { | |
def map[B](f: A => B): State[S, B] = State { s => | |
val (a, s1) = runState(s) | |
(f(a), s1) | |
} | |
def flatMap[B](f: A => State[S,B]): State[S, B] = State { s => | |
val (a, s1) = runState(s) | |
f(a).runState(s1) | |
} | |
} | |
object State { | |
def getState[S]: State[S, S] = State(s => (s, s)) | |
def setState[S](s: S): State[S, Unit] = State(_ => ((), s)) | |
def unit[S, A](a: => A): State[S, A] = State(s => (a, s)) | |
lazy val x: State[Int, Unit] = for { | |
n <- getState | |
_ <- setState(n + 1) | |
_ <- if (n > 1000) x else unit[Int, Unit](()) | |
} yield () | |
} | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment