Scalaで自作するプログラミング言語処理系

class R[S](val test: Seq[S] => Option[Seq[S]])

case class One[S](r: S) extends R[S](Some(_).filter(_.head == r).map(_.tail))

case class Cat[S](l: R[S], r: R[S]) extends R[S](seq => l.test(seq).map(r.test).flatten)
case class Alt[S](l: R[S], r: R[S]) extends R[S](seq => l.test(seq).orElse(r.test(seq)))

case class Opt[S](r: R[S]) extends R[S](seq => r.test(seq).orElse(Some(seq)))
case class Rep[S](r: R[S]) extends R[S](seq => Cat(r, Opt(Rep(r))).test(seq))

val ZLO = Cat(One('Z'), Cat(Alt(Rep(One('L')), One('G')), One('O')))
println(if(ZLO.test("ZLLLLLLLLLLLLLLLLO").isDefined) "OK" else "NO")

class Grid[S](rule: Rule[S], data: Array[Array[S]]) {
  def update = {
    val next = rule(data.map(_.toSeq).toSeq)
    next.zip(data).foreach(_.copyToArray(_))
  }
}

class Rule[S](rule: Seq[Seq[S]] => S, d: Int = 1) {
  def ROI[V](i: Int)(s: Seq[V]) = Range.inclusive(i - d, i + d).map(Math.floorMod(_, s.size)).map(s)
  def apply(s: Seq[Seq[S]]) = s.indices.map(x => s(x).indices.map(y => rule(ROI(x)(s).map(ROI(y)))))
}

object WireWorldRule extends Rule[Char](ROI => (ROI(1)(1), ROI.flatten.count(_ == 'H')) match {
  case ('W', 1) => 'H'
  case ('W', 2) => 'H'
  case ('W', _) => 'W'
  case ('H', _) => 'T'
  case ('T', _) => 'W'
  case ('B', _) => 'B'
})

class UTM[V](data1: Seq[V], data2: Seq[V], b1: V, b2: V, mL: V, mR: V, var s1: V, var s2: Int = 0) {
  val tape1 = data1.zipWithIndex.map(_.swap).to(collection.mutable.SortedMap)
  val tape2 = data2.zipWithIndex.map(_.swap).to(collection.mutable.SortedMap)
  var hd1, hd2 = 0
  def r1 = tape1.getOrElse(hd1, b1)
  def r2 = tape2.getOrElse(hd2, b2)
  def apply(sop: V) = Iterator.continually(s2 match {
    case 0 if r2 == s1 => (s1 = s1, s2 = 1, tape1(hd1) = r1, hd1 += 0, hd2 += 1)
    case 0 if r2 != s1 => (s1 = s1, s2 = 0, tape1(hd1) = r1, hd1 += 0, hd2 += 5)
    case 1 if r2 == r1 => (s1 = s1, s2 = 2, tape1(hd1) = r1, hd1 += 0, hd2 += 1)
    case 1 if r2 != r1 => (s1 = s1, s2 = 0, tape1(hd1) = r1, hd1 += 0, hd2 += 4)
    case 2 if r2 != b2 => (s1 = r2, s2 = 3, tape1(hd1) = r1, hd1 += 0, hd2 += 1)
    case 3 if r2 != b2 => (s1 = s1, s2 = 4, tape1(hd1) = r2, hd1 += 0, hd2 += 1)
    case 4 if r2 == b1 => (s1 = s1, s2 = 5, tape1(hd1) = r1, hd1 += 0, hd2 += 1)
    case 4 if r2 == mL => (s1 = s1, s2 = 5, tape1(hd1) = r1, hd1 -= 1, hd2 += 1)
    case 4 if r2 == mR => (s1 = s1, s2 = 5, tape1(hd1) = r1, hd1 += 1, hd2 += 1)
    case 5 if r2 == b2 => (s1 = s1, s2 = 0, tape1(hd1) = r1, hd1 += 0, hd2 += 1)
    case 5 if r2 != b2 => (s1 = s1, s2 = 5, tape1(hd1) = r1, hd1 += 0, hd2 -= 1)
  }).takeWhile(t => s1 != sop || s2 != 0).map(t => tape1.values.mkString)
}

case class CUTM(data1: String, data2: String) extends UTM(data1, data2, ' ', '*', 'L', 'R', 'I')
CUTM("0111111", "I0a0RI1a1Ra0a0Ra1a1Ra b Lb0c1Lb1b0Lb F1 c0c0Lc1c1Lc F R")('F').foreach(println)

def ZLO: R[Char] = Cat(One('Z'), Cat(Alt(One('L'), new R(ZLO.test(_))), One('O')))
println(ZLO.test("ZZZZZZZZZZZZZZZZZZZZZZZZZLOOOOOOOOOOOOOOOOOOOOOOOOO").isDefined)

object ArithStackMachine extends collection.mutable.Stack[Int]() {
  def apply(program: String): Int = program.split(" +").map {
    case "+" => push(((a: Int, b: Int) => b + a)(pop(), pop()))
    case "-" => push(((a: Int, b: Int) => b - a)(pop(), pop()))
    case "*" => push(((a: Int, b: Int) => b * a)(pop(), pop()))
    case "/" => push(((a: Int, b: Int) => b / a)(pop(), pop()))
    case num => this.push(num.toInt)
  }.lastOption.map(_ => pop()).last
}

println(ArithStackMachine("1 2 + 10 20 - *")) // -30
println(ArithStackMachine("3 4 * 10 20 * +")) // 212

class PEG[+M](f: String => Option[Out[M]]) {
  def skip = Reg("""\s*""".r) ~> this <~ Reg("""\s*""".r)
  def / [R >: M](q: => PEG[R]): PEG[R] = new Alt(this, q)
  def ~ [R](q: => PEG[R]): PEG[(M, R)] = new Cat(this, q)
  def <~[R](q: => PEG[R]) = this ~ q ^ (_._1)
  def ~>[R](q: => PEG[R]) = this ~ q ^ (_._2)
  def ^ [T](f: M => T) = new Map(this, f)
  def * = new Rep(this)
  def ? = new Opt(this)
  def apply(in: String) = f(in)
}

case class Out[+M](m: M, in: String) {
  def tuple[R](o: Out[R]) = Out(m -> o.m, o.in)
  def apply[R](p: PEG[R]) = p(in).map(tuple(_))
  def toSome = Out(Some(m), in)
}

case class Str(p: String) extends PEG(s => Option.when(s.startsWith(p))(Out(p, s.substring(p.length))))
case class Reg(p: Regex) extends PEG(p.findPrefixMatchOf(_).map(m => Out(m.matched, m.after.toString)))

class Alt[L, R >: L](p: => PEG[L], q: => PEG[R]) extends PEG[R](s => p(s) orElse q(s))
class Cat[+L, +R](p: => PEG[L], q: => PEG[R]) extends PEG(p(_).map(_ apply q).flatten)

class Map[+S, +T](p: => PEG[S], f: S => T) extends PEG[T](p(_).map(t => Out(f(t.m), t.in)))
class Opt[+T](p: => PEG[T]) extends PEG(s => p(s).map(_.toSome).orElse(Some(Out(None, s))))

class And[+T](p: => PEG[T]) extends PEG(s => if(p(s).isDefined) Some(Out(None, s)) else None)
class Not[+T](p: => PEG[T]) extends PEG(s => if(p(s).isDefined) None else Some(Out(None, s)))

class Rep[+T](p: => PEG[T]) extends PEG(s => {
  def ca(a: Out[T]): Out[Seq[T]] = Out(a.m +: re(a.in).m, re(a.in).in)
  def re(s: String): Out[Seq[T]] = p(s).map(ca).getOrElse(Out(Nil, s))
  Some(re(s))
})

class Fold[T](p: => PEG[T], q: => PEG[(T, T) => T]) extends PEG({
  (p ~ (q ~ p).*)^(x => x._2.foldLeft(x._1)((l, r) => r._1(l, r._2)))
} apply(_))

class Sep[T](p: => PEG[T], q: => PEG[_]) extends Fold[Seq[T]](p.? ^ (_.toSeq), q^(_ => _ ++ _))

class PEGs {
  implicit def implicitText(p: String): PEG[String] = new Str(p).skip
  implicit def implicitRegex(p: Regex): PEG[String] = new Reg(p).skip
}

object ArithPEGs extends PEGs {
  def add: PEG[String] = new Fold(mul, ("+" / "-").^(op => (a, b) => s"$a $b $op"))
  def mul: PEG[String] = new Fold(num, ("*" / "/").^(op => (a, b) => s"$a $b $op"))
  def num: PEG[String] = "[0-9]+".r / ("(" ~> add <~ ")")
  def apply(e: String) = +ArithStackMachine(add(e).get.m)
}

object LispPEGs extends PEGs {
  def sexp: PEG[S] = list / quot / real / name
  def list = "(" ~> (sexp.* ^ List) <~ ")"
  def real = "[0-9]+".r ^ (real => Real(BigDecimal(real)))
  def name = """[^'`,@\(\)\s]+""".r ^ (name => Name(name))
  def quot = "'" ~> sexp ^ (Seq(Name("quote"), _)) ^ List
}

abstract class S(val exp: String, eval: S => Env => S) {
  override def toString = exp
  def apply(env: Env): S = eval(this)(env)
  def apply(env: Env)(args: Seq[S]): S = apply(env).asInstanceOf[Form].app(args, env)
}

case class Name(name: String) extends S(name, v => env => env.apply(v))
case class Real(real: BigDecimal) extends S(real.toString, v => _ => v)

case class List(list: Seq[S]) extends S(list.mkString("(", " ", ")"), _ => list.head(_)(list.tail))

class Form(exp: String, val app: (Seq[S], Env) => S) extends S(exp, v => _ => v)
class Lambda(p: List, v: S, e: Env) extends Form(s"(lambda $p $v)", (a, s) => v(Env(Some(e), p, s(a))))
class Syntax(p: List, v: S, e: Env) extends Form(s"(syntax $p $v)", (a, s) => v(Env(Some(e), p, a))(s))

case class Env(out: Option[Env], params: List, args: Seq[S]) {
  val map = params.list.zip(args).to(collection.mutable.Map)
  def apply(name: S): S = {
    if(map.isDefinedAt(name)) map(name)
    else if(out.nonEmpty) out.get(name)
    else sys.error(s"$name undeclared")
  }
  def apply(args: Seq[S]): Seq[S] = args.map(_.apply(this))
}

object LambdaForm extends Form("lambda", (a, s) => new Lambda(a.head.asInstanceOf[List], a(1), s))
object SyntaxForm extends Form("syntax", (a, s) => new Syntax(a.head.asInstanceOf[List], a(1), s))

class Code(op: FaVM => Unit) {
  def apply(vm: FaVM) = (op(vm), vm.pc += 1)
}

case class Closure(from: Int, out: Env)

case class Promise(thunk: Closure, var cache: Any = null, var empty: Boolean = true)

case class Env(local: Seq[Any], out: Env = null) {
  def apply(depth: Int, index: Int): Any = depth match {
    case 0 => this.local(index)
    case d => out(d - 1, index)
  }
}

case class Load(nest: Int, id: Int) extends Code(vm => vm.data.push(vm.call.env(nest, id)))

class FaVM(val codes: Seq[Code], var pc: Int = 0) {
  val call = new Stack[Env]
  val data = new Stack[Any]
  while(pc < codes.size) codes(pc)(this)
}

class Stack[E] extends collection.mutable.Stack[E] {
  def popN(n: Int) = Seq.fill(n)(pop).reverse
  def popAs[Type]: Type = pop.asInstanceOf[Type]
  def topAs[Type]: Type = top.asInstanceOf[Type]
  def env = (this :+ null).top.asInstanceOf[Env]
}

case class Push(v: Any) extends Code(vm => vm.data.push(v))

class Arity(n: Int, f: Function[Seq[Any], Any]) extends Code(vm => vm.data.push(f(vm.data.popN(n))))
class Typed(val n: Int, val op: String, val t: Type, f: Function[Seq[Any], Any]) extends Arity(n, f)

class Op(op: Typed*)(val table: Map[(String, Type), Typed] = op.map(op => (op.op, op.t) -> op).toMap)

object AddOp extends Op(IAdd, DAdd, SAdd, ISub, DSub, SSub)()
object MulOp extends Op(IMul, DMul, IDiv, DDiv, IMod, DMod)()
object RelOp extends Op(IGt, DGt, ILt, DLt, IGe, DGe, ILe, DLe)()
object EqlOp extends Op(IEq, DEq, SEq, BEq, INe, DNe, SNe, BNe)()
object LogOp extends Op(IAnd, BAnd, IOr, BOr)()

case object INeg extends Typed(1, "-", It, -_.head.asInstanceOf[I])
case object DNeg extends Typed(1, "-", Dt, -_.head.asInstanceOf[D])

import java.lang.{String => S}, scala.{Any => A, Int => I, Double => D, Boolean => B}

case object IAdd extends Typed(2, "+", It, v => v.head.asInstanceOf[I] + v.last.asInstanceOf[I])
case object DAdd extends Typed(2, "+", Dt, v => v.head.asInstanceOf[D] + v.last.asInstanceOf[D])
case object SAdd extends Typed(2, "+", St, v => v.head.asInstanceOf[S] + v.last.asInstanceOf[S])

case object IDiv extends Typed(2, "/", It, v => v.head.asInstanceOf[I] / v.last.asInstanceOf[I])
case object DDiv extends Typed(2, "/", Dt, v => v.head.asInstanceOf[D] / v.last.asInstanceOf[D])

case object IGt extends Typed(2, ">", It, v => v.head.asInstanceOf[I] > v.last.asInstanceOf[I])
case object DGt extends Typed(2, ">", Dt, v => v.head.asInstanceOf[D] > v.last.asInstanceOf[D])

case object IAnd extends Typed(2, "&", It, v => v.head.asInstanceOf[I] & v.last.asInstanceOf[I])
case object BAnd extends Typed(2, "&", Bt, v => v.head.asInstanceOf[B] & v.last.asInstanceOf[B])

class Jump(op: FaVM => Option[Int]) extends Code(vm => op(vm).foreach(to => vm.pc = to - 1))

case class Skip(plus: Int) extends Jump(vm => Some(vm.pc + plus))
case class Skin(plus: Int) extends Jump(vm => Option.when(!vm.data.popAs[B])(vm.pc + plus))

case class Def(size: Int) extends Jump(vm => Some {
  vm.data.push(Closure(vm.pc + 1, vm.call.env))
  vm.pc + size
})

case object Ret extends Jump(vm => Some {
  vm.call.remove(0).asInstanceOf[Env]
  vm.data.remove(1).asInstanceOf[Int]
})

case class Call(argc: Int) extends Jump(vm => Some {
  val args = vm.data.popN(argc)
  val func = vm.data.popAs[Closure]
  vm.call.push(Env(args, func.out))
  vm.data.push(vm.pc + 1)
  func.from
})

case object Arg extends Code(vm => vm.data.push(Promise(vm.data.popAs[Closure])))

case object Get extends Code(vm => vm.data.push(vm.data.popAs[Promise].cache))
case object Nil extends Code(vm => vm.data.push(vm.data.topAs[Promise].empty))
case object Ref extends Code(vm => vm.data.push(vm.data.topAs[Promise].thunk))

case object Set extends Code(vm => vm.data.popAs[Promise].cache = vm.data.pop)
case object Fix extends Code(vm => vm.data.topAs[Promise].empty = false)

trait AST {
  def res(implicit env: Seq[DefST]): Type
  def gen(implicit env: Seq[DefST]): Seq[Code]
  def acc(unify: => Unit)(v: Type) = util.Try(unify).map(_ => v).get
}

case class LitST(value: Any) extends AST {
  def res(implicit env: Seq[DefST]) = Atom(value.getClass)
  def gen(implicit env: Seq[DefST]) = Seq(Push(value))
}

case class StrST(string: String) extends AST {
  def res(implicit env: Seq[DefST]) = Atom(classOf[String])
  def gen(implicit env: Seq[DefST]) = LitST(StringContext.processEscapes(string)).gen
}

case class UnST(op: String, expr: AST) extends AST {
  def res(implicit env: Seq[DefST]) = acc(Form(v).unify(Form(expr.res)))(v)
  def gen(implicit env: Seq[DefST]) = expr.gen :+ UnOp.table(op, v.prune)
  val v = new Link
}

case class AddST(op: String, e1: AST, e2: AST) extends AST {
  def res(implicit env: Seq[DefST]) = acc(Form(v, v).unify(Form(e1.res, e2.res)))(v)
  def gen(implicit env: Seq[DefST]) = e1.gen ++ e2.gen :+ AddOp.table(op, v.prune)
  val v = new Link
}

case class MulST(op: String, e1: AST, e2: AST) extends AST {
  def res(implicit env: Seq[DefST]) = acc(Form(v, v).unify(Form(e1.res, e2.res)))(v)
  def gen(implicit env: Seq[DefST]) = e1.gen ++ e2.gen :+ MulOp.table(op, v.prune)
  val v = new Link
}

case class IfST(c: AST, e: (AST, AST)) extends AST {
  def pos(pos: Seq[Code]) = (Skin(2 + pos.size) +: pos)
  def neg(neg: Seq[Code]) = (Skip(1 + neg.size) +: neg)
  def res(implicit env: Seq[DefST]) = acc(Form(Bt, v, v).unify(Form(c.res, e._1.res, e._2.res)))(v)
  def gen(implicit env: Seq[DefST]) = c.gen ++ pos(e._1.gen) ++ neg(e._2.gen)
  val v = new Link
}

case class DefST(params: Seq[String], value: AST) extends AST {
  val args = params.map(_ -> new Link).toMap
  def get(name: String, depth: Int) = Load(depth, params.indexOf(name)) -> args(name)
  def res(implicit env: Seq[DefST]) = Form(params.map(args) :+ value.res(env :+ this) :_*)
  def gen(implicit env: Seq[DefST]) = tag(value.gen(env :+ this))
  def tag(codes: Seq[Code]) = Def(codes.size + 2) +: codes :+ Ret
}

case class StIdST(val name: String) extends AST {
  def resolve(env: Seq[DefST], nest: Int = 0): (Load, Link) = {
    if(env.last.params.contains(name)) env.last.get(name, nest)
    else if(env.size >= 2) resolve(env.init, nest + 1)
    else sys.error(s"parameter $name is not declared")
  }
  def res(implicit env: Seq[DefST]) = resolve(env)._2.prune
  def gen(implicit env: Seq[DefST]) = Seq(resolve(env)._1)
}

case class LzIdST(val name: StIdST) extends AST {
  def res(implicit env: Seq[DefST]) = name.res
  def gen(implicit env: Seq[DefST]) = (name.gen ++ head ++ name.gen ++ tail)
  val (head, tail) = List(Nil, Skin(6), Ref, Call(0)) -> List(Fix, Set, Get)
}

case class LzArgST(body: AST) extends AST {
  def res(implicit env: Seq[DefST]) = body.res
  def gen(implicit env: Seq[DefST]) = DefST(Seq(), body).gen :+ Arg
}

case class CallST(f: AST, args: Seq[AST]) extends AST {
  def res(implicit env: Seq[DefST]) = acc(Form(args.map(_.res) :+ v :_*).prune.unify(f.res))(v)
  def gen(implicit env: Seq[DefST]) = f.gen ++ args.map(_.gen).flatten :+ Call(args.size)
  val v = new Link
}

trait Type {
  def prune = this
  def unify(t: Type): Unit
}

case class Atom(atom: Class[_]) extends Type {
  def unify(t: Type) = t.prune match {
    case t: Link => t.unify(this)
    case t: Type => require(this == t)
  }
}

case class Form(dom: Type*) extends Type {
  def unify(t: Type) = t.prune match {
    case t: Form => t.align(this)
    case t: Type => t.unify(this)
  }
  def align(t: Form) = {
    require(this.dom.size == t.dom.size)
    dom.zip(t.dom).map(_.prune.unify(_))
  }
}

class Link(var to: Option[Type] = None) extends Type {
  def unify(t: Type) = t.prune match {
    case t: Form => to = Some(Loop(t, this).prune)
    case t: Type => to = Option.when(this != t)(t)
  }
  override def prune = to.map(_.prune).getOrElse(this)
}

case class Loop(form: Form, link: Link) extends Type {
  def unify(t: Type) = t match {
    case t: Form => link.unify(t)
    case t: Type => require(this == t)
  }
  override def prune = if(form.dom.contains(link)) this else form
}

object Bt extends Atom(classOf[java.lang.Boolean])
object It extends Atom(classOf[java.lang.Integer])
object Dt extends Atom(classOf[java.lang.Double])
object St extends Atom(classOf[java.lang.String])

object FavaPEGs extends PEGs {
  def expr: PEG[AST] = (cond / or) <~ ("//" ~ ".*$".r).?
  def cond = (or <~ "?") ~ (expr ~ (":" ~> expr)) ^ IfST
  def or   = new Fold(and, "|" ^ (op => LogST(op, _, _)))
  def and  = new Fold(eql, "&" ^ (op => LogST(op, _, _)))
  def eql  = new Fold(rel, """(!|=)=""".r ^ (op => EqlST(op, _, _)))
  def rel  = new Fold(add, """[<>]=?""".r ^ (op => RelST(op, _, _)))
  def add  = new Fold(mul, """[\+\-]""".r ^ (op => AddST(op, _, _)))
  def mul  = new Fold(unr, """[\*/%]""".r ^ (op => MulST(op, _, _)))
  def unr  = ("+" / "-" / "!").* ~ call ^ ((o,e) => o.foldRight(e)(UnST))
  def call = fact ~ args.* ^ ((f,a) => a.foldLeft(f)(CallST))
  def args = "(" ~> new Sep(expr ^ LzArgST, ",") <~")"
  def fact = func / bool / text / real / int / name / ("(" ~> expr <~ ")")
  def func = pars ~ ("=>" ~> expr) ^ ((p,e) => DefST(p, e))
  def pars = "(" ~> new Sep(name, ",") <~ ")" ^ (_.map(_.name.name))
  def bool = ("true" / "false") ^ (_.toBoolean) ^ LitST
  def text = ("\"" ~> """([^"\\]|\\[\\'"bfnrt])*""".r <~ "\"") ^ StrST
  def int  = """\d+""".r ^ (_.toInt) ^ LitST
  def real = """(\d+\.\d*|\d*\.\d+)""".r ^ (_.toDouble) ^ LitST
  def name = """[@A-Z_a-z][@0-9A-Z_a-z]*""".r ^ StIdST ^ LzIdST
}

println(new FaVM(FavaPEGs.expr("((x,y)=>x+y)(2,3)").get.m.code(Root)).data.pop)