Created
July 1, 2020 04:40
-
-
Save justinhj/1e7ce28d57cf2fdc27921533315c957b to your computer and use it in GitHub Desktop.
Fixed version of https://www.scala-lang.org/old/node/46
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 callccInterpreter { | |
type Answer = Value; | |
/** | |
* A continuation monad. | |
*/ | |
case class Cont[A](in: (A => Answer) => Answer) { | |
def bind[B](k: A => Cont[B]) = Cont[B](c => in (a => k(a) in c)) | |
def map[B](f: A => B): Cont[B] = bind(x => unitM(f(x))) | |
def flatMap[B](f: A => Cont[B]): Cont[B] = bind(f) | |
} | |
def unitM[A](a: A) = Cont[A](c => c(a)) | |
def id[A] = (x: A) => x | |
def showM(m: Cont[Value]): String = (m in id).toString() | |
def callCC[A](h: (A => Cont[A]) => Cont[A]) = | |
Cont[A](c => h(a => Cont[A](_ => c(a))) in c) | |
type Name = String | |
trait Term | |
case class Var(x: Name) extends Term | |
case class Con(n: Int) extends Term | |
case class Add(l: Term, r: Term) extends Term | |
case class Lam(x: Name, body: Term) extends Term | |
case class App(fun: Term, arg: Term) extends Term | |
case class Ccc(x: Name, t: Term) extends Term | |
trait Value | |
case object Wrong extends Value { | |
override def toString() = "wrong" | |
} | |
case class Num(n: Int) extends Value { | |
override def toString() = n.toString() | |
} | |
case class Fun(f: Value => Cont[Value]) extends Value { | |
override def toString() = "<function>" | |
} | |
type Environment = List[(Name, Value)]; | |
def lookup(x: Name, e: Environment): Cont[Value] = e match { | |
case List() => unitM(Wrong) | |
case (y, b) :: e1 => if (x == y) unitM(b) else lookup(x, e1) | |
} | |
def add(a: Value, b: Value): Cont[Value] = (a, b) match { | |
case (Num(m), Num(n)) => unitM(Num(m + n)) | |
case _ => unitM(Wrong) | |
} | |
def apply(a: Value, b: Value): Cont[Value] = a match { | |
case Fun(k) => k(b) | |
case _ => unitM(Wrong) | |
} | |
def interp(t: Term, e: Environment): Cont[Value] = t match { | |
case Var(x) => lookup(x, e) | |
case Con(n) => unitM(Num(n)) | |
case Add(l, r) => for ( | |
a <- interp(l, e); | |
b <- interp(r, e); | |
c <- add(a, b)) | |
yield c | |
case Lam(x, t) => unitM(Fun(a => interp(t, (x, a) :: e))) | |
case App(f, t) => for ( | |
a <- interp(f, e); | |
b <- interp(t, e); | |
c <- apply(a, b)) | |
yield c | |
case Ccc(x, t) => callCC(k => interp(t, (x, Fun(k)) :: e)) | |
} | |
def test(t: Term): String = showM(interp(t, List())) | |
val term0 = App(Lam("x", Add(Var("x"), Var("x"))), Add(Con(10), Con(11))) | |
val term1 = App(Con(1), Con(2)) | |
val term2 = Add(Con(1), Ccc("k", Add(Con(2), App(Var("k"), Con(4))))) | |
def main(args: Array[String]) = { | |
println(test(term0)) | |
println(test(term1)) | |
println(test(term2)) | |
} | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment