ミイラになって未来を作る

オンライン演習システムのおかげでようやく、型理論が分かってきました。
身に付いて来たといったほうがいいのかな。

知識としてあるだけではなくて、実際に手を動かさないと覚えないんですね。
逆に言えば手を動せば覚えは速い。

でもさすがに、大きすぎる計算は計算機にやらせたほうが楽です。
そのプログラムをかけるってことは理解しているってことでもある訳ですし。

ということで、F#とか使ってないので、忘れたのでやっぱりScalaが楽なのと最近使ってないのとで、Scalaで処理系を書いて、導出木も出力させてみました。EvalML1,EvalML2,EvalML3を処理系に解かせるほうが、正確で速いっす。
あまりにも大きくて扱いきれなくなった計算も計算出来ました。

あらためて、Parser Combinatorはとても便利だなぁと感じます。
また、Anyを使いつつパターンマッチ出来るScalaはLispの動的な部分とパターンマッチが使える素晴らしい言語だなぁと思います。パーサ書くのにググるとymnkさんやkmizuさんやきしださんの記事が非常に役立ちました。感謝です。

なんか、前は、処理系を作るだけで大変だったわけです。また他の人が作った処理系をみてうーむ。って唸ってた感じでした。
でも今回は、手計算して慣れています。手計算していた事をコンピュータにやらせるイメージが頭にあって、それを書き下すだけなので凄く楽しい作業になりました。

おお、ちゃんとやってる、やってると。
他の人が作った物をみるだけだと、たぶん、分け分からない出力が出ているだけにしか見えないんですけど、自分で手計算してみていたので、詳細を見る気力も出ます。手計算するよりはずっと楽なのです。

という事で、以下EvalML3の導出木を出力するソースです。EvalML1,EvalML2もあるけど不完全だし、あまりそろいすぎていると、ソースを読んで把握しようとしてしまったりして導出木の理解の妨げになる可能性もあるので、十分理解した上でご利用ください。

package EvalML3;

import util.parsing.combinator._

object parser extends RegexParsers{
  val keywords = List("then","if", "else", "rec", "let", "in", "fun")
  def eexpr: Parser[(List[Any],Any)] = (env<~"|-") ~ expr ^^ {case a~b=>(a,b)}
  def env: Parser[List[Any]] = repsep((id<~"=")~expr ^^ {case a~b=>(a,b)},",") ^^ {a => a.reverse}
  def id: Parser[Any] = "[a-zA-Z_][a-zA-Z_0-9]*".r ^? {
    case a if keywords.indexOf(a) == -1 => a
  }
  def expr: Parser[Any] = lt~rep("<"~lt) ^^ {
    case a ~ b => b.foldLeft[Any](a){case (a, op ~ r)=> (a,op,r)}
  }
  def lt = term~rep(("+"|"-")~term) ^^ {
    case a ~ b => b.foldLeft[Any](a){case (a, op ~ r)=> (a,op,r)}
  }
  def term : Parser[Any] = app~rep("*"~app) ^^ {
    case a ~ b => b.foldLeft[Any](a){case(a,"*" ~ r) => (a,"*",r)}
  }
  def app: Parser[Any] = factor ~ rep(factor) ^^ {
    case a ~ b => b.foldLeft[Any](a) { case (a, b) => ("app", a, b) }
  }
  def factor: Parser[Any] = intLiteral | boolLiteral | recValue | funValue | "("~>expr<~")" |
    ifExpr | letrecExpr | letExpr | funExpr | id
  def intLiteral : Parser[Any] = """-?[1-9][0-9]*|0""".r ^^ {a=>a.toInt}
  def boolLiteral : Parser[Any] = "true" ^^ {a=>true} | "false" ^^ {a=>false}
  def ifExpr: Parser[Any] = "if"~> (expr<~"then")~(expr<~"else")~expr ^^ {
    case a~b~c => ("if", a, b, c)
  }
  def letExpr: Parser[Any] = "let"~>(id<~"=")~(expr<~"in")~expr ^^ {
    case a~b~c => ("let", a, b, c)
  }
  def letrecExpr: Parser[Any] = "let"~>"rec"~>(id<~"=")~("fun"~>id<~"->")~(expr<~"in")~expr ^^ {
    case a~b~c~d => ("letrec", a, b, c, d)
  }
  def funValue: Parser[Any] = ("("~>env<~")")~("["~>funExpr<~"]") ^^ {
    case a~b => ("funv", a, b)
  }
  def recValue: Parser[Any] = ("("~>env<~")")~("["~>"rec"~>id<~"=")~(funExpr<~"]") ^^ {
    case a~b~c => ("rec", a, b, c)
  }
  def funExpr: Parser[Any] = "fun"~>(id<~"->")~expr ^^ {
    case a~b => ("fun", a, b)
  }
  def appExpr: Parser[Any] = expr ~ expr ^^ {
    case a~b => ("app", a, b)
  }
  def parse(str:String) = parseAll(eexpr, str) match {
    case Success(tree,_) => tree
    case e => throw new Exception(""+e)
  }
}
 
object Main {

  def main(args: Array[String]): Unit = {
    test("""|- let fact = fun self -> fun n ->
                 if n < 2 then 1 else n * self self (n - 1) in
               fact fact 3""")
  }
  def test(src:String) {
    val e = parser.parse(src)
    println(e)
    println(eval(e._1,e._2)._1)
  }
 
  def eval(env:List[Any],e:Any):(String,Any) = {
    e match {
      case (a,"+",b) =>
        val a1 = eval(env, a)
        val b1 = eval(env, b)
        val (a2:Int,b2:Int) = (a1._2,b1._2)
        val r = a2 + b2;
        (es(env)+ts(e) + " evalto " + r +" by E-Plus{\n"
         +addLn(a1._1+";\n"
         +b1._1+";\n"
         +a1._2+" plus "+b1._2+" is "+r +" by B-Plus{}\n")
         +"}", r)
      case (a,"-",b) =>
        val a1 = eval(env,a)
        val b1 = eval(env,b)
        val (a2:Int,b2:Int) = (a1._2,b1._2)
        val r = a2 - b2;
        (es(env)+ts(e) + " evalto " + r +" by E-Minus{\n"
         +addLn(a1._1+";\n"
         +b1._1+";\n"
         +a1._2+" minus "+b1._2+" is "+r +" by B-Minus{}\n")
         +"}", r)
      case (a,"*",b) =>
        val a1 = eval(env,a)
        val b1 = eval(env,b)
        val (a2:Int,b2:Int) = (a1._2,b1._2)
        val r = a2 * b2;
        (es(env)+ts(e) + " evalto " + r +" by E-Times{\n"
         +addLn(a1._1+";\n"
         +b1._1+";\n"
         +a1._2+" times "+b1._2+" is "+r +" by B-Times{}\n")
         +"}", r)
      case (a,"<",b) =>
        val a1 = eval(env,a)
        val b1 = eval(env,b)
        val (a2:Int,b2:Int) = (a1._2,b1._2)
        val r = a2 < b2;
        (es(env)+ts(e) + " evalto " + r +" by E-Lt{\n"
         +addLn(a1._1+";\n"
         +b1._1+";\n"
         +a1._2+" less than "+b1._2+" is "+r +" by B-Lt{}\n")
         +"}", r)
      case ("if",e1,e2,e3) =>
        val i1 = eval(env,e1)
        i1._2 match {
        case true =>
          val i2 = eval(env,e2)
          (es(env)+ts(e)+" evalto "+i2._2+ " by E-IfT{\n"+
           addLn(i1._1+";\n"+
           i2._1+"\n")+
           "}", i2._2)
        case false =>
          val i2 = eval(env,e3)
          (es(env)+ts(e)+" evalto "+i2._2+ " by E-IfF{\n"+
           addLn(i1._1+";\n"+
           i2._1+"\n")+
           "}", i2._2)
        }
      case ("let", x, e1, e2) =>
        val v1 = eval(env, e1)
        val v = eval((x,v1._2)::env, e2)
        (es(env)+ts(e)+" evalto "+ts(v._2)+" by E-Let{\n"+addLn(v1._1+";\n"+v._1)+"\n}",v._2)
      case ("fun", x, e1) =>
        val v = ("funv",env,e)
        (es(env)+ts(e)+" evalto "+ts(v)+" by E-Fun{}",v)
      case ("app", e1, e2) =>
        val v1 = eval(env, e1)
        v1._2 match {
                    
          case ("funv", env2:List[Any], ("fun", x, e0)) =>
            val v2 = eval(env, e2)
            val v = eval((x,v2._2)::env2, e0)
            (es(env)+ts(e)+" evalto "+ts(v._2)+" by E-App{\n"+addLn(v1._1+";\n"+v2._1+";\n"+v._1)+"\n}",v._2)
          case ("rec", env2:List[Any], x, y, e0) =>
            val v2 = eval(env, e2)
            val v = eval((y,v2._2)::(x,("rec", env2, x, y, e0))::env2, e0)
            (es(env)+ts(e)+" evalto "+ts(v._2)+" by E-AppRec{\n"+addLn(v1._1+";\n"+v2._1+";\n"+v._1)+"\n}",v._2)
        }
      case ("letrec", x, y, e1, e2) =>
        val v = eval((x, ("rec", env, x, y, e1))::env, e2)
        (es(env)+ts(e)+" evalto "+ts(v._2)+" by E-LetRec{\n"+addLn(v._1)+"\n}",v._2)
      case a:Int => 
        (es(env)+a + " evalto "+a+" by E-Int{}", a)
      case a:String =>
        env match {
          case (name,v)::env2 if(name==a) =>
              (es(env)+a +" evalto "+ts(v)+" by E-Var1{}", v)
          case (name,v)::env2 =>
              val v2= eval(env2, a)
              (es(env)+a+" evalto "+ts(v2._2)+" by "+"E-Var2{\n"+addLn(v2._1)+"\n}", v2._2)
          case _ => throw new Exception("error "+a)
        }
    }
  }
  def ts(a:Any):String = a match {
    case ("fun",a,b) => "(fun "+ts(a)+" -> "+ts(b)+")"
    case ("funv",l:List[Any],("fun",a,b)) => "("+ee(l)+")[fun "+ts(a)+" -> "+ts(b)+"]"
    case ("rec",l:List[Any],x,a,b) => "("+ee(l)+")[rec "+x+" = fun "+ts(a)+" -> "+ts(b)+"]"
    case ("app",a,b) => "("+ts(a)+" ("+ts(b)+"))"
    case (a,op,b) => ts(a) + " "+op+" " + ts(b)
    case ("if",a,b,c) => "(if "+ts(a)+" then "+ts(b)+" else "+ts(c)+")"
    case ("let",a,b,c) => "(let "+ts(a)+" = "+ts(b)+" in "+ts(c)+")"
    case ("letrec",a,x,b,c) => "(let rec "+ts(a)+" = fun "+ts(x)+" -> "+ts(b)+" in "+ts(c)+")"
    case a => ""+a
  }
  def ee(a:List[Any]):String = {
    a.foldRight(""){
      case ((a,b),"") => a + " = "+ts(b)
      case ((a,b),s) => s + ", "+ a + " = "+ ts(b)
    }
  } 
  def es(a:List[Any]):String = {
    ee(a) match {
    case "" =>  "|- "
    case s => s + " |- "
    }
  }
  def addLn(s:String):String = s.replaceAll("""(?m)^""","  ");
}