Pi in Effekt

pi.effekt.scala

// Happy Pi-Day! Here's an Effekt program that approximates pi using
// lambda calculus, a Sierpinski-like fractal, NbE, streams, and effects

// a rendering of the generated fractal:
// https://lambda-screen.marvinborner.de/?term=FGgFzhl94HOX7QLwUDnOgA%3D%3D

import io
import stream
import process
import stringbuffer

val PI = """
  00010100011010000000010
  11100111000011001011111
     01111       00000
     01110       01110
     01011       11110
     11010       00000
     10111       10000
    01010        000001110
   01110          0111010
"""

/// smaller = more precise
/// WARNING: takes exponentially more space/time!
/// the approximations will be streamed to stdout when not using sbt
val LIMIT = 0.000001

type Name = Int

effect fresh(): Name
effect lookup[A](n: Name): A

/// perfectly normal map type
/// this is really inefficient :)
type Env[A] = (=> A / lookup[A] at {}) => A at {}

/// lambda term
type Term {
  Abs(n: Name, t: Term)
  App(a: Term, b: Term)
  Var(n: Name)
}

/// lambda term in normal domain
type Value {
  VNeu(neu: Neutral)
  VClo(n: Name, t: Term, env: Env[Value])
}

/// lambda term in neutral domain (not yet reducible)
type Neutral {
  NVar(n: Name)
  NApp(a: Neutral, b: Value)
}

/// the unpainted area of the fractal is pi/4
def areaToPi(area: Double) = (1.0 - area) * 4.0

/// true if the term represents a pixel (area = 1)
def pixel?(v: Term): Bool = if (v is Abs(w, Abs(b, Var(x))) and (x == w || x == b))
  true else false // ugh

/// count the amount of subterms that make up the current area
def countSplit(t: Neutral): Int = {
  var count = 1
  var iter = t
  while (iter is NApp(a, _) and a is NApp(_, _)) {
    count = count + 1
    iter = a
  }
  if (iter is NApp(NVar(_), _)) count
  else 1
}

/// evaluate a single term without going into abstractions
def eval(env: Env[Value], t: Term): Value = t match {
  case Abs(n, t) => VClo(n, t, box(env))
  case App(a, b) => env(box { apply(eval(env, a), eval(env, b)) } )
  case Var(n)    => env(box { do lookup(n) })
}

/// apply terms in their normal domain
/// this does the actual substitution via lookup handling (or bubbling up respectively)
def apply(a: Value, b: Value): Value = a match {
  case VNeu(neu)       => VNeu(NApp(neu, b))
  case VClo(n, t, env) => eval(box { f => try f() with lookup[Value] { v =>
    resume(if (v == n) b else env(f))
  }}, t)
}

/// reflect variable name to the neutral domain
def reflect(n: Name): Value = VNeu(NVar(n))

/// convert terms to their normal form (in term domain)
def reify(area: Double, split: Bool, v: Value): Unit / { fresh, emit[Double] } = v match {
  case VNeu(NApp(a, b)) => {
    var newArea = area
    if (split) newArea = area / countSplit(NApp(a, b)).toDouble
    reify(newArea, false, VNeu(a))
    reify(newArea, false, b)
  }
  case VNeu(_) => ()
  case VClo(n, t, _) and pixel?(Abs(n, t)) => do emit(area)
  case _ and area > LIMIT => reify(area, true, apply(v, reflect(do fresh())))
  case _ => ()
}

/// measure area generated by strong normalization of the term (upto LIMIT size)
def measure(t: Term): Double = {
  var area = 0.0

  var i = 0
  try reify(1.0, false, eval(box(box { f => try f() with lookup[Value] { i =>
    resume(reflect(i))
  }}), t))
  with fresh { i = i + 1; resume(i) }
  with emit[Double] { n =>
    area = area + n
    println(areaToPi(area))
    resume(())
  }

  area
}

/// parse named term from BLC stream (de Bruijn)
def parse(): Term / { read[Bool], stop } = {
  def go(): Term / { fresh, lookup[Int] } =
    (do read[Bool](), do read[Bool]) match {
      case (false, false) => {
        val n = do fresh()
        Abs(n, try go() with lookup[Int] { i =>
          resume(if (i == 0) n else do lookup(i - 1))
        })
      }
      case (false, true ) => App(go(), go())
      case (true , false) => Var(do lookup(0))
      case (true , true ) => {
        var i = 1
        while (do read[Bool]()) i = i + 1
        Var(do lookup(i))
      }
    }

  var i = 0
  try go()
  with fresh { i = i + 1; resume(i) }
  with lookup[Int] { n =>
    println("error: free variable " ++ n.show)
    exit(1)
  }
}

/// helper function for pretty string interpolation of terms
def pretty { s: () => Unit / { literal, splice[Term] } }: String = {
  with stringBuffer

  try { s(); do flush() }
  with literal { l => resume(do write(l)) }
  with splice[Term] { t =>
    t match {
      case Abs(n, t) => do write("λ" ++ n.show ++ pretty".${t}")
      case App(a, b) => do write(pretty"(${a} ${b})")
      case Var(v)    => do write(v.show)
    }
    resume(())
  }
}

/// convert char stream to bit stream, skipping non-bit chars
def bits { p: () => Unit / { read[Bool], stop } }: Unit / read[Char] =
  try exhaustively { p() }
  with read[Bool] {
    with exhaustively
    val c = do read[Char]()
    if (c == '0') resume { false }
    if (c == '1') resume { true  }
  }

def main() = {
  with feed(PI) // yummy
  with bits

  val term = parse()
  println(pretty"Parsed term: ${term}")

  val area = areaToPi(measure(term))
  println(s"Measured area: ${area.show}")
}