λで前方参照

Cっぽいλ計算にトポロジカルソートを利用した前方参照を付けてみました。
トップレベルだけは、前方参照できます。

main=mul(add(1)(2))(3)
add=(a)=>(b)=>a+b
mul=(a)=>(b)=>a*b

なプログラムがちゃんと動きます。
以下ソースです。

package C2E7

import util.parsing.combinator._

object tsort extends App {

  // 参照してない物から取り除く
  def apply[A](toPreds: Map[A, Set[A]], done: List[A]): Iterable[A] = {

    // 参照していないものと参照しているものを分ける
    val (noPreds, hasPreds) = toPreds.foldLeft((Map[A,Set[A]](),Map[A,Set[A]]())) {
      case ((no,has),(a1,a2)) =>
        if(a2.isEmpty) (no+(a1->a2),has) else (no,has+(a1->a2))
    }

    // 参照していない集合が空
    if (noPreds.isEmpty) {
      // 参照している集合も空なら終わり
      if (hasPreds.isEmpty) done
      // 参照をもっている物があれば循環参照があるのでエラー
      else sys.error(hasPreds.toString)
    } else {
      // 参照していない物を取り出す
      val found = noPreds.map { case (a1, a2) => a1 }
      // 参照している集合から、参照していない名前を取り除く
      val nextPreds = hasPreds.map{ case (p, a) => (p, a -- found) }
      // 再帰呼び出しする
      tsort(nextPreds, done ++ found)    
    }
  }
}

sealed trait E
case class EInt(a:Int) extends E
case class EAdd(a:E,b:E) extends E
case class EMul(a:E,b:E) extends E
case class ELet(a:String, b:E, c:E) extends E
case class EId(a:String) extends E
case class EFun(m:Map[String,E], a:String, b:E) extends E
case class EApp(a:E, b:E) extends E
case class EAssign(id:String,e:E) extends E
case object EUnit extends E


object graph {


  // 依存グラフ取得
  def getDep(e:E): Set[String] = {
    e match {
      case EAssign(id,e)=> Set(id) ++ getDep(e)
      case EApp(e1,e2)=> getDep(e1)++getDep(e2)
      case EAdd(e1,e2)=> getDep(e1)++getDep(e2)
      case EMul(e1,e2)=> getDep(e1)++getDep(e2)
      case EId(id)=> Set(id)
      case EFun(m,id,e) => getDep(e)--Set(id)
      case ELet(id,e1,e2) => getDep(e1)++(getDep(e2)--Set(id))
      case EInt(_) => Set()
      case EUnit => Set()
    }
  }

  // 依存グラフ取得
  def getDep(p:List[E]):Map[String,Set[String]] = {
    p.foldLeft(Map[String,Set[String]]()){
      case (map,EAssign(id,e)) => map +(id->(getDep(e)--Set(id)))
      case _ => throw new Exception("error")
    }
  }

  case class FoundExprException(e:E) extends Exception

  // a = bという式の連続から1つの式を取得する
  def list2let(p:List[E]):E = {
    println("list "+p)
    val e = try {
      val map = p.foldLeft(Map[String,E]()){
        case (map,e@EAssign(id,_))=>map+(id->e)
        case (_,e) => throw FoundExprException(e)
      }
      val datas = tsort(getDep(p),List())
      datas.foldRight(null:E) {
        case (s,n)=> map(s) match {
          case EAssign("main",b)=>b
          case EAssign(a,b)=>ELet(a,b,n)
          case _ => throw new Exception("error")
        }
      }
    } catch {
      case FoundExprException(e) => e
    }
    println("e="+e)
    e
  }
}

// パーサ
object parse extends RegexParsers{

  def expr: Parser[E] = term~rep("+"~>term) ^^ {
    case a ~ b => b.foldLeft[E](a){case (a, b)=> EAdd(a,b)}
  }

  def term : Parser[E] = app~rep("*"~>app) ^^ {
    case a ~ b => b.foldLeft[E](a){case(a, b) => EMul(a,b)}
  }

  def app : Parser[E] = factor~rep("("~>expr<~")") ^^ {
    case a ~ b => b.foldLeft[E](a){case(a, b) => EApp(a,b)}
  }

  def factor: Parser[E] = intLiteral | valExpr | id | fun | "("~>expr<~")" | block | unit

  def fun: Parser[E] = ("("~>id<~")") ~ ("=>"~> expr) ^^ {
    case (EId(a)~b) => EFun(Map(),a,b)
  }

  def unit: Parser[E] = ";" ^^ {
    a => EUnit
  }

  def top = rep(assign|expr)

  def assign = id ~ ("=" ~> expr) ^^ {
    case EId(a)~b => EAssign(a,b)
  }

  def block: Parser[E] = "{" ~> rep(expr) <~ "}" ^^ {
    a =>
      def c2e(l:List[E]):E = {
        l match {
          case List() => EUnit
          case List(a) => a
          case ELet(a,b,EUnit)::c => ELet(a, b, c2e(c))
          case a::b => ELet(null, a, c2e(b))
        }
      }
      ELet(null,EUnit,c2e(a.filter{a=>a != EUnit}))
  }

  def valExpr : Parser[E] = ("val"~>id)~("="~>expr) ^^ {
    case(EId(a) ~ b) => ELet(a, b, EUnit)
  }

  def intLiteral : Parser[E] = """-?[1-9][0-9]*|0""".r ^^ {
    a => EInt(a.toInt)
  }

  def id : Parser[EId] = """[_a-zA-Z][_a-zA-Z0-9]*""".r ^^ {
    a => EId(a)
  }


  def apply(str:String) = {
    parseAll(top, str) match {
      case Success(tree,_) => graph.list2let(tree)
      case e => throw new Exception(""+e)
    }
  }
}

object eval {
  def apply(env:Map[String,E], e:E):E = {
    println("eval "+env+" |- "+e)
    e match {
    case EInt(a) => EInt(a)
    case EAdd(a, b) =>
      (eval(env,a),eval(env, b)) match {
        case (EInt(a1), EInt(b1)) => EInt(a1 + b1)
        case _ => throw new Exception("error "+e)
      }
    case EMul(a, b) =>
      (eval(env,a),eval(env, b)) match {
        case (EInt(a1), EInt(b1)) => EInt(a1 * b1)
        case _ => throw new Exception("error "+e)
      }
    case ELet(null, b, c) => eval(env,b); eval(env,c)
    case ELet(a, b, c) => eval(env+(a->eval(env,b)),c)
    case EId(a) => env(a)
    case EFun(m,a,b) => EFun(env,a,b) 
    case EApp(a, b) =>
      (eval(env,a),eval(env, b)) match {
        case (EFun(m,name,body), b1:E) => eval(m+(name->b1), body)
        case _ => throw new Exception("error "+e)
      }
    case EUnit => EUnit
    case EAssign(a,b) => throw new Exception("error")

    }
  }
}

object main extends App {

  def test(env:Map[String,E],s:String,e:E) {
    val e2 = parse(s)
    if (e2 != e) throw new Exception("error "+s+"  expected "+e+" but found "+e2)
    println(s+"="+eval(env,e2))
  }

  def test(s:String,e:E) {
    val e2 = parse(s)
    println("test "+s)
    val e3 = eval(Map(), e2)
    if (e3 != e) throw new Exception("error "+s+"  expected "+e+" but found "+e3)
    println(s+"="+e3)
  }


  val progs = List(
    EAssign("main",EApp(EApp(EId("sub"), EApp(EApp(EId("add"), EInt(1)),EInt(2))),EInt(2))),
    EAssign("add",EFun(Map(),"a",EFun(Map(),"b",EAdd(EId("a"),EId("b"))))),
    EAssign("sub",EFun(Map(),"a",EFun(Map(),"b",EMul(EId("a"),EId("b")))))
  )

  println(graph.list2let(progs))

  test(Map(),"1",EInt(1))
  test(Map("a"->EInt(1)),"a", EId("a"))
  test(Map(),"1+2", EAdd(EInt(1),EInt(2)))
  test(Map(),"val a = 1", ELet("a",EInt(1),EUnit))
  test(Map(),"{}", ELet(null, EUnit, EUnit))

  test(Map(),"{1}",ELet(null,EUnit,EInt(1)))
  test(Map("a"->EInt(1)),"{a}", ELet(null,EUnit,EId("a")))
  test(Map(),"{1+2}", ELet(null,EUnit,EAdd(EInt(1),EInt(2))))
  test(Map(),"{val a = 1}", ELet(null,EUnit,ELet("a",EInt(1),EUnit)))
  test(Map(),"{{}}", ELet(null, EUnit,ELet(null, EUnit, EUnit)))

  test(Map(),"{1 1}",ELet(null, EUnit,ELet(null,EInt(1),EInt(1))))
  test(Map(),"{1 2 3}",ELet(null, EUnit, ELet(null,EInt(1),ELet(null, EInt(2), EInt(3)))))
  test(Map(),"{val a = 1 a}", ELet(null,EUnit,ELet("a",EInt(1),EId("a"))))
  test(Map(),"{val a = 1 val b = 2}",ELet(null,EUnit, ELet("a",EInt(1),ELet("b",EInt(2),EUnit))))
  test(Map(),"{{ val a = 1} val b = 2}",ELet(null,EUnit, ELet(null,ELet(null,EUnit, ELet("a",EInt(1),EUnit)),ELet("b",EInt(2),EUnit))))
  test("{val a = 5 { val a = 1 {}} val b = 2 a}", EInt(5))
  test(Map(),"(a)=>a", EFun(Map(),"a", EId("a")))
  test(Map(),"((a)=>a)(2)", EApp(EFun(Map(), "a", EId("a")),EInt(2)))
  test("((a)=>a+a)(4)", EInt(8))
  test("((a)=>(b)=>a+b)(4)(5)", EInt(9))
  test("{val f4=((a)=>(b)=>a+b)(4) val f2=((a)=>(b)=>a+b)(2) f4(5)+f2(8)}", EInt(19))
  test("{(a)=>(b)=>(c)=>a+b*c}(4)(5)(6)", EInt(34))
  test("{val a = 1 val f=(b)=>a+b f(2)}", EInt(3))
  test("{val a = 1 a}", EInt(1))
  test("{1}", EInt(1))
  test("""
{
  val add = (a)=>(b)=>a+b
  val mul = (a)=>(b)=>a*b
  mul(add(1)(2))(3)
}
""",EInt(9))

  test("""
main=mul(add(1)(2))(3)
add=(a)=>(b)=>a+b
mul=(a)=>(b)=>a*b
""",EInt(9))

  test("""
main = {
  val a = add(1)(2)
  val a = mul(a)(3)
  a
}
add = (a)=>(b)=>a+b
mul = (a)=>(b)=>a*b
""",EInt(9))

}