Skip to content

Instantly share code, notes, and snippets.

@xuwei-k
Last active August 29, 2015 14:15
  • Star 1 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save xuwei-k/1cb8954c6adf61f18643 to your computer and use it in GitHub Desktop.
stack safe Ideal Monad in Scala
scalaVersion := "2.11.5"
libraryDependencies += "org.scalaz" %% "scalaz-core" % "7.1.1"
licenses := Seq("MIT License" -> url("http://www.opensource.org/licenses/mit-license.php"))
import scala.annotation.tailrec
import scalaz._
import scalaz.Leibniz.===
object Ideal {
private final case class Pure[F[_], A](a: A) extends Ideal[F, A]
private final case class Suspend[F[_], A](fa: F[A]) extends Ideal[F, A]
private sealed abstract case class Gosub[F[_], B]() extends Ideal[F, B] {
type C
val a: () => Ideal[F, C]
val f: C => Ideal[F, B]
}
def pure[F[_], A](a: A): Ideal[F, A] = Pure(a)
def ideal[F[_], A](fa: F[A]): Ideal[F, A] = Suspend(fa)
def suspend[F[_], A](a: => Ideal[F, A]): Ideal[F, A] =
Ideal.gosub[F, A, A](a)(Ideal.pure)
def gosub[F[_], A, B](a0: => Ideal[F, A])(f0: A => Ideal[F, B]): Ideal[F, B] =
new Gosub[F, B] {
type C = A
val a = () => a0
val f = f0
}
implicit def idealInstance[F[_]]: Monad[({type l[a] = Ideal[F, a]})#l] =
new Monad[({type l[a] = Ideal[F, a]})#l]{
override def point[A](a: => A) =
Pure(a)
override def bind[A, B](fa: Ideal[F, A])(f: A => Ideal[F, B]) =
fa flatMap f
}
type IdealTrampoline[A] = Ideal[Function0, A]
}
sealed abstract class Ideal[F[_], A] {
import Ideal._
final def flatMap[B](f: A => Ideal[F, B]): Ideal[F, B] =
this match {
case a @ Gosub() =>
gosub(a.a())(x => gosub(a.f(x))(f))
case a =>
gosub(a)(f)
}
@tailrec final def resume(implicit F: MonadIdeal[F]): F[A] \/ A =
this match {
case Pure(a) =>
\/-(a)
case Suspend(t) =>
-\/(t)
case x @ Gosub() =>
x.a() match {
case Pure(a) =>
x.f(a).resume
case Suspend(t) =>
-\/(F.idealize(F.map(t)(x.f)))
case y @ Gosub() =>
y.a().flatMap(z => y.f(z) flatMap x.f).resume
}
}
final def foldMap[M[_]](f: F ~> M)(implicit S: MonadIdeal[F], M: Applicative[M]): M[A] =
this.resume match {
case -\/(s) =>
f(s)
case \/-(r) =>
M.pure(r)
}
final def run(implicit ev: Ideal[F, A] === IdealTrampoline[A]): A = {
import std.function._
ev(this).foldMap(NaturalTransformation.refl).apply()
}
}
import Ideal.IdealTrampoline
import scalaz._
object IdealTrampoline {
def done[A](a: A): IdealTrampoline[A] =
Ideal.pure(a)
def delay[A](a: => A): IdealTrampoline[A] =
suspend(done(a))
def suspend[A](a: => IdealTrampoline[A]): IdealTrampoline[A] =
Ideal.suspend[Function0, A](a)
implicit val trampolineInstance: Monad[IdealTrampoline] =
new Monad[IdealTrampoline] {
override def point[A](a: => A) =
Ideal.pure[Function0, A](a)
def bind[A, B](ta: IdealTrampoline[A])(f: A => IdealTrampoline[B]) =
ta flatMap f
}
}
import Ideal.IdealTrampoline
import scalaz.Free.Trampoline
import scalaz.syntax.bind._
object Main {
def freeTrampoline(x: Int): Int = {
import scalaz.Trampoline._
def fib(n: Int): Trampoline[Int] =
if (n < 2) done(n)
else for {
x <- suspend(fib(n - 1))
y <- suspend(fib(n - 2))
} yield (x + y)
fib(x).run
}
def idealTrampoline(x: Int): Int = {
import IdealTrampoline._
def fib(n: Int): IdealTrampoline[Int] =
if (n < 2) done(n)
else for {
x <- suspend(fib(n - 1))
y <- suspend(fib(n - 2))
} yield (x + y)
fib(x).run
}
def scalaStd(x: Int): Int = {
import scala.util.control.TailCalls._
def fib(n: Int): TailRec[Int] =
if (n < 2) done(n)
else for {
x <- tailcall(fib(n - 1))
y <- tailcall(fib(n - 2))
} yield (x + y)
fib(x).result
}
def time[A](label: String)(a: => A): A = {
System.gc()
val s = System.nanoTime
val r = a
println(label + " " + ((System.nanoTime - s) / 1000000.0))
r
}
def main(args: Array[String]): Unit = {
val x = 35
val a = time("ideal")(idealTrampoline(x))
val b = time("free")(freeTrampoline(x))
val c = time("std")(scalaStd(x))
assert(a == b && b == c)
}
}
import scalaz._
trait MonadIdeal[F[_]] extends Functor[F] {
def idealize[A](fa: F[Ideal[F, A]]): F[A]
}
object MonadIdeal{
def fromMonad[F[_]](implicit F: Monad[F]): MonadIdeal[F] =
new MonadIdeal[F] {
override def idealize[A](fa: F[Ideal[F, A]]) =
F.bind(fa)(_.resume(this).map(F.point(_)).merge)
override def map[A, B](fa: F[A])(f: A => B) =
F.map(fa)(f)
}
implicit val function0MonadIdeal: MonadIdeal[Function0] =
new MonadIdeal[Function0] {
override def idealize[A](fa: () => Ideal[Function0, A]) =
() => fa.apply().resume.leftMap(_.apply()).merge
override def map[A, B](fa: () => A)(f: A => B) =
std.function.function0Instance.map(fa)(f)
}
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment