前回は、α変換を作ったので、今回こそ本当にパターンマッチ構文を作るんだよ。何回言ってんだよ。俺。

式

case class EMatch(t:T, d:E, cases:List[(ETag,E)]) extends E

例

以下にマッチ構文の例を示します。

// match構文
EMatch(t, "data2", List(
  ETag(t, "A", List(EId("x"))) -> EBlock(Tv,List(EPrint(x))),
  ETag(t, "B", List(EId("x"),EId("y"))) -> EBlock(Tv,List(EPrint(x),EPrint(y)))
))

実装

テストを実装して、動かしてけばそのうち出来るよ。switch文の実装を参考にしつつ、最初にタグを取り出して、switchで分岐し、分岐先では何もしない状態にまずしました。

次に、バインディングを作ります。α変換されているので特に悩まずに、バインディングのロジックを書きました。そして、それぞれのcaseの処理をコンパイルすれば出来上がりです。switch文より長くはなりましたが、なんとか作る事が出来ました。

そう！ついに出来たのです！ついに！やった！

package chapter11

import java.io._
import util.parsing.input.Positional

sealed trait E extends Positional {
  def t:T
}
case class ELdc(t:T, i:Long) extends E
case class EBin(t:T, s:String, l:E, r:E) extends E
case class EPrint(t:T, a:E) extends E
case class EBlock(t: T, ls: List[E]) extends E
case class EVal(t: T, id: String, a: E) extends E
case class EId(t: T, id: String) extends E
case class EAssign(t: T, a: E, b: E) extends E
case class EField(t: T, id: String, idx: String) extends E
case class ETuple(t:T,ls:List[E]) extends E
case class ETag(t:T,id:String,ls:List[E]) extends E
case class ESwitch(t: T, a: E, cases:List[(E,E)] ) extends E
case object EUnit extends E { def t = Tv }
case class EType(t:T, id:String) extends E
case class ECase(t:T, e:E) extends E

sealed trait T extends Positional
case class Ti(i:Int) extends T
case object Tv extends T
case object Tn extends T
case class TFun(t: T, prms: List[T]) extends T
case class TStr(types: List[(String, T)]) extends T
case class TVariant(ls:List[(String,TStr)]) extends T
case class Tp(t:T) extends T
case class TDef(id:String) extends T

object T {
  def find(t:TStr, a: String): (Int, T) = {
    def f(i: Int, xs: List[(String, T)]): (Int, T) = {
      xs match {
        case List() => (-1, Tv)
        case (x, t) :: xs => if (a == x) (i, t) else f(i + 1, xs)
      }
    }
    f(0, t.types)
  }
}

case class Op(s: String) {
  def apply(t: T, a: E, b: E): E = {
    EBin(t, s, a, b)
  }
}
object EAdd extends Op("add")
object EMul extends Op("mul")

sealed trait R {
  def t:T
  def id:String
}
case class RG(t:T, id: String) extends R
case class RL(t:T, id: String) extends R
case class RR(t:T, id: String) extends R
case class RN(t:T, id: String) extends R

object test {
  def main(argv: Array[String]) {
    try {
      val t = TVariant(List(
          "A"->TStr(List("a"->Ti(32))),
          "B"->TStr(List("a"->Ti(32), "b"->Ti(32)))
        ))
      val ast = EBlock(Tv, List(
        EPrint(Ti(32), ELdc(Ti(32), 11)),
        EPrint(Ti(32), EAdd(Ti(32), ELdc(Ti(32), 11), ELdc(Ti(32), 22))),
        // 変数 a 定数
        EVal(Ti(32), "a", ELdc(Ti(32), 11)),
        EPrint(Ti(32), EId(Ti(32), "a")),
        // 変数 b 足し算
        EVal(Ti(32), "b", EAdd(Ti(32), ELdc(Ti(32), 11), ELdc(Ti(32), 22))),
        EPrint(Ti(32), EId(Ti(32), "b")),
        // 変数 c 変数の値
        EVal(Ti(32), "c", EId(Ti(32), "a")),
        EPrint(Ti(32), EId(Ti(32), "c")),
        // 構造体
        EVal(TStr(List(("a", Ti(32)), ("b", Ti(32)))), "aa", null),
        EAssign(Ti(32), EField(Ti(32), "aa", "a"), ELdc(Ti(32), 9)),
        EAssign(Ti(32), EField(Ti(32), "aa", "b"), EId(Ti(32), "c")),
        EPrint(Ti(32), EField(Ti(32), "aa", "a")),
        EPrint(Ti(32), EField(Ti(32), "aa", "b")),
        // 構造体初期化リテラル
        EVal(TStr(List(("a", Ti(32)), ("b", Ti(32)))), "ab",
          ETuple(TStr(List(("a", Ti(32)), ("b", Ti(32)))),
            List(ELdc(Ti(32),123),ELdc(Ti(32),456)))),
        EPrint(Ti(32), EField(Ti(32), "ab", "a")),
        EPrint(Ti(32), EField(Ti(32), "ab", "b")),

        // ヴァリアント
        EVal(TVariant(List(
          "A"->TStr(List("a"->Ti(32))),
          "B"->TStr(List("a"->Ti(32), "b"->Ti(32)))
        )),"data", null),

        EVal(TVariant(List(
            "A"->TStr(List("a"->Ti(32))),
            "B"->TStr(List("a"->Ti(32), "b"->Ti(32)))
          )),
          "data2",
          ETag(TVariant(List(
            "A"->TStr(List("a"->Ti(32))),
            "B"->TStr(List("a"->Ti(32), "b"->Ti(32)))
            )),
            "B",
            List(
              ELdc(Ti(32), 555),
              ELdc(Ti(32), 777)
          ))
        ),
        // switch
        ESwitch(Ti(32), ELdc(Ti(32), 2), List(
          ELdc(Ti(32), 1) -> EPrint(Ti(32), ELdc(Ti(32), 10001)),
          ELdc(Ti(32), 2) -> EPrint(Ti(32), ELdc(Ti(32), 10002)),
          ELdc(Ti(32), 3) -> EPrint(Ti(32), ELdc(Ti(32), 10003))
        )),
        ESwitch(Ti(32), ELdc(Ti(32), 0), List(
          ELdc(Ti(32), 1) -> EPrint(Ti(32), ELdc(Ti(32), 10001)),
          ELdc(Ti(32), 2) -> EPrint(Ti(32), ELdc(Ti(32), 10002)),
          ELdc(Ti(32), 3) -> EPrint(Ti(32), ELdc(Ti(32), 10003))
        )),
        
        // alpha test
        EVal(Ti(32), "a", ELdc(Ti(32), 1000)),
        EPrint(Ti(32), EId(Ti(32), "a")),
        EVal(Ti(32), "a", EAdd(Ti(32), EId(Ti(32),"a"), ELdc(Ti(32),2000))),
        EPrint(Ti(32), EId(Ti(32), "a")),
        // alpha block test
        EBlock(Tv, List(
          EVal(Ti(32), "a", ELdc(Ti(32), 5000)),
          EPrint(Ti(32), EId(Ti(32), "a"))
        )),
        EPrint(Ti(32), EId(Ti(32), "a")),

        // match構文
        ESwitch(t, EId(t,"data2"), List(
          ETag(t, "A", List(EVal(Ti(32),"x",null))) -> EBlock(Tv,List(EPrint(Ti(32),EId(Ti(32),"x")))),
          ETag(t, "B", List(EVal(Ti(32),"x",null),EVal(Ti(32),"y",null))) -> EBlock(Tv,List(EPrint(Ti(32),EId(Ti(32),"x")),EPrint(Ti(32),EId(Ti(32),"y"))))
        )),

        EVal(t, "data3",
          ETag(t, "A", List(
              ELdc(Ti(32), 333)
          ))
        ),
        ESwitch(t, EId(t,"data3"), List(
          ETag(t, "A", List(EVal(Ti(32),"x",null))) -> EBlock(Tv,List(
              EPrint(Ti(32),EId(Ti(32),"x")))),
          ETag(t, "B", List(EVal(Ti(32),"x",null),EVal(Ti(32),"y",null))) -> EBlock(Tv,List(
              EPrint(Ti(32),EId(Ti(32),"x")),
              EPrint(Ti(32),EId(Ti(32),"y"))))
        )),
        EVal(Ti(32),"x",ELdc(Ti(32),10)),
        EPrint(Ti(32),EId(Ti(32),"x")),
        EType(TStr(List(("a", Ti(32)), ("b", Ti(32)))), "Dt"),
        EVal(TDef("Dt"), "a2", null),
        EAssign(Ti(32), EField(Ti(32), "a2", "a"), ELdc(Ti(32), 9)),
        EPrint(Ti(32), EField(Ti(32), "a2", "a"))
        
      ))
      println("ast=" + ast)
      val ast2 = alpha(ast)
      println("ast2=" + ast2)
      val ll = kNormal(ast2)
      println("ll=" + ll)
      val ll2 = constFold(ll)
      emit("e.ll", ll2)
      println(exec("llc e.ll -o e.s"))
      println(exec("llvm-gcc -m64 e.s -o e"))
      println(exec("./e"))
    } catch {
      case e:Throwable => e.printStackTrace()
    }
  }
}

object alpha {

  def find(id: String, env: Map[String, String]): String = {
    if (env.contains(id)) env(id) else id
  }

  def apply(e: E): E = {
    f(e, Map()) match { case(e, _) => e }
  }
  def l(ls:List[E],env:Map[String,String]):(List[E],Map[String, String]) = {
    val (ls2,env2) = ls.foldLeft(List[E](), env) {
      case ((ls, env), a) =>
        val (a1, env1) = f(a, env)
        ((a1 :: ls), env1)
    }
    (ls2.reverse,env2)
  }
  def l2(ls:List[(E,E)],env:Map[String,String]):(List[(E,E)],Map[String, String]) = {
    val (cases1, env2) = ls.foldLeft(List[(E,E)](), env) {
      case ((ls, env), (a,b)) =>
        val (a1, env1) = f(a, env)
        val (b1, env2) = f(b, env1)
        (((a1,b1) :: ls), env)
    }
    (cases1.reverse, env2)
  }
  def f(e: E, env: Map[String, String]): (E, Map[String, String]) = {
    e match {
      case e @ EBin(t: T, i: String, a: E, b: E) =>
        val (a1, env1) = f(a, env)
        val (b1, env2) = f(b, env1)
        (e.copy(t, i, a1, b1), env2)
      case e @ ELdc(t: T, i: Long) => (e.copy(t, i), env)
      case e @ EBlock(t: T, ls: List[E]) =>
        val (ls1, env1) = l(ls, env)
        (e.copy(t, ls1), env)
      case e @ EPrint(t: T, a: E) =>
        val (a1, env1)  = f(a, env)
        (e.copy(t, a1), env1)
      case e @ EVal(t: T, id: String, a) =>
        val (a1,env1) = if (a == null) (null, env) else f(a, env)
        val id2 = if (env.contains(id)) genid(".") else id
        (e.copy(t, id2, a1), env1 + (id -> id2))
      case e @ EId(t: T, id: String) => (e.copy(t, find(id, env)), env)
      case e @ EField(t: T, id: String, idx: String) =>
        (e.copy(t, find(id, env), idx), env)
      case e @ EAssign(t: T, a: E, b: E) =>
        val (a1, env1) = f(a, env)
        val (b1, env2) = f(b, env1)
        (e.copy(t, a1, b1), env2)
      case e @ ESwitch(t: T, a: E, cases:List[(E,E)]) =>
        val (a1, env1) = f(a, env)
        val (cases1, _) = l2(cases, env1)
        (e.copy(t, a1, cases1), env)
      case e @ EUnit => (e, env)
      case e @ ETag(t: T, id:String, ls: List[E]) =>
        val (ls1, env1) = l(ls, env)
        (e.copy(t, id, ls1), env1)
      case e @ ETuple(t:T,ls:List[E]) =>
        val (ls1, env1) = l(ls, env)
        (e.copy(t, ls1), env1)
      case e @ EType(t:T, id:String) => (e.copy(t, id), env)
      case e : ECase => throw new Exception("error")
    }
  }
}

object kNormal {
  def gid(t:T): R = {
    RR(t,genid(""))
  }
  var ls: List[LL] = null
  def add(l: LL) {
    ls = l :: ls
  }

  def arr(e: E): R = {
    e match {
      case EField(t, id, idx) =>
        env.map(id) match {
          case i:R =>
            val ((n, nt), reg1) = (T.find(i.t.asInstanceOf[TStr],idx), gid(t))
            add(LLField(reg1, i, RN(Ti(64),"0"), RN(nt,""+n)))
            reg1
          case t => throw new Exception("type mismatch " + t)
        }
      case EId(t, id) => env.map(id)
      case _ => throw new Exception("error")
    }
  }

  def findTag(tagId:String, n:Int, ls:List[(String, TStr)]):(Int, TStr) = ls match {
    case List() => throw new Exception("not found "+tagId)
    case (stId,stT:TStr)::ls => if (stId == tagId) (n,stT) else findTag(tagId, n + 1, ls)
  }

  def f(a: E): R = {
    a match {
      case EBin(t, op, a1, b1) =>
        (f(a1), f(b1), gid(t)) match {
          case (a, b, id) =>
            if (t != a.t || t != b.t) throw new Exception("type mismatch " + t)
            add(LLBin(id, op, a, b))
            id
        }
      case ELdc(t, i) => RN(t, ""+i)
      case EPrint(t, a) =>
        f(a) match {
          case a =>
            if (t != a.t) throw new Exception("type mismatch t=" + t + " ta=" + a.t)
            add(LLCall(null, RG(TFun(Tv, List(t)), "print_" + emit.llt(t)), List((a.t, a))))
            a
        }
      case EBlock(t, ls) =>
        ls.foldLeft(null: R) {
          case (tid, l) => f(l)
        }
      case EVal(t: TStr, id, tpl) =>
        emit.llstruct(t)
        env.add(RL(t,id))
        add(LLAlloca(RL(t,id)))
        tpl match {
          case ETuple(_, ls) =>
            for ((e, (name, t)) <- ls.zip(t.types)) {
              f(EAssign(t, EField(t, id, name), e))
            }
          case null =>
          case _ => throw new Exception("error")
        }
        RL(t,id)
      case EVal(t: TVariant, id, tpl) =>
        val (_, valT, maxT, _) = emit.llvariantInfo(t)
        env.add(RL(t,id))
        add(LLAlloca(RL(t,id)))
        tpl match {
          case ETag(_, tagId, ls) =>
            val (tagIdx, stT) = findTag(tagId, 0, t.ls)
            val tagR = gid(stT)
            // tag id のアドレス取得
            add(LLField(tagR, RL(valT, id), RN(Ti(64), "0"), RN(Ti(32), "0")))
            // tag id保存
            add(LLStore(RN(Ti(32),""+tagIdx), tagR))

            // 内部の構造体のアドレスを取得
            val maxAdrR = gid(Tp(maxT))
            add(LLField(maxAdrR, RL(valT, id), RN(Ti(64), "0"), RN(Ti(32), "1")))

            // キャストする
            val stId = genid("st")
            val stR = RL(Tp(stT), stId)
            add(LLBitCast(stR, maxAdrR))

            // 登録する
            env.add(RL(stT, stId))

            // 各フィールド値を設定する
            for ((e, (id, t)) <- ls.zip(stT.types)) {
              f(EAssign(t, EField(t, stId, id), e))
            }
          case null =>
          case _ => throw new Exception("error")
        }
        RL(t,id)
      case e @ EVal(t, id, a) =>
        val t2 = env.stripT(t)
        t2 match {
          case t: TStr => f(e.copy(t = t))
          case t: TVariant => f(e.copy(t = t))
          case _ =>
            env.add(RL(t, id))
            f(a) match {
              case a =>
                add(LLAssign(RL(a.t, id), a))
                RL(a.t, id)
            }
        }
      case EId(t, id) => env.map(id)
      case EAssign(t, a, b) =>
        (arr(a), f(b)) match {
          case (a, b) =>
            if (env.stripT(t) != env.stripT(b.t)) throw new Exception("type mismatch " + t + " " + b.t)
            add(LLStore(b, a))
            b
        }
      case a: EField =>
        val a2 = arr(a)
        val b = gid(a2.t)
        add(LLLoad(b, a2))
        b
      case ESwitch(t: TVariant, a: E, cases: List[(E, E)]) =>
        val valR = f(a)
        val tagAdrR = gid(valR.t)
        add(LLField(tagAdrR, valR, RN(Ti(64), "0"), RN(Ti(32), "0")))

        val tagR = gid(Ti(32))
        add(LLLoad(tagR, tagAdrR))

        // テーブルジャンプ
        val lbl = genid("match")
        val ls = for ((ETag(tl: TVariant, id, vs), _) <- cases) yield {
          val (tagIdx,stT) = findTag(id, 0, tl.ls)
          (tagIdx.asInstanceOf[Long], lbl + "." + tagIdx)
        }
        add(LLSwitch(tagR, lbl, ls))

        // 各ケース
        val (_, _, maxT, _) = emit.llvariantInfo(env.stripT(a.t).asInstanceOf[TVariant])
        for ((ETag(tl: TVariant, id, vs), e) <- cases) {
          val (tagIdx,stT) = findTag(id, 0, tl.ls)
          add(LLLabel(lbl + "." + tagIdx))

          val maxAdrR = gid(Tp(maxT))
          add(LLField(maxAdrR, valR, RN(Ti(64), "0"), RN(Ti(32), "1")))

          val stId = genid("st")
          val stR = RL(stT, stId)
          add(LLBitCast(RL(Tp(stT), stId), maxAdrR))
          env.add(stR)

          for ((e: EVal, (id, t)) <- vs.zip(stT.types)) {
            f(e.copy(e.t, e.id, EField(t, stId, id)))
          }
          f(e)
          add(LLGoto(lbl))
        }
        add(LLLabel(lbl))
        null
      case e @ ESwitch(t: T, a: E, cases: List[(E, E)]) =>
        env.stripT(a.t) match {
          case t:TVariant => return f(e.copy(t=t))
          case _ =>
        }
        val ra = f(a)
        val lbl = genid("switch")
        val (length, ls) = cases.foldLeft(0, List[(Long, String)]()) {
          case ((n, ls), (ELdc(tl, a), _)) => (n + 1, (a, lbl + n) :: ls)
          case ((n, ls), (EUnit, _)) => (n + 1, (-1L, lbl + n) :: ls)
        }
        add(LLSwitch(ra, lbl, ls.reverse))
        for((n, (_, e)) <- (0 until cases.length).zip(cases)) {
          add(LLLabel(lbl + n)); f(e); add(LLGoto(lbl))
        }
        add(LLLabel(lbl))
        null
      case EType(t: T, id: String) =>
        env.map = env.map + (id -> RR(t, null))
        null
    }
  }

  def apply(a: E): List[LL] = {
    ls = List[LL]()
    f(a)
    ls.reverse
  }
}

object env {
  var map = Map[String, R]()
  def add(r: R) {
    map = map + (r.id -> r)
  }
  def add(id:String, r:R) {
    map = map + (id -> r)
  }
  def findTag(t:TVariant, id:String):TStr = {
    for((tag,t) <- t.ls) {
      if(tag==id) return t
    }
    throw new Exception("not found tag "+id)
  }
  def stripT(t:T):T = {
    t match {
      case TDef(id) =>
        val r = env.map(id)
        if(r.id != null) throw new Exception(id + " is not type")
        stripT(r.t)
      case t => t
    }
  }
}

sealed trait LL
case class LLCall(id: R, op: R, prms: List[(T, R)]) extends LL
case class LLBin(id: R, op: String, a: R, b: R) extends LL
case class LLAssign(s: R, d: R) extends LL
case class LLField(id1: R, aid: R, z: R, b: R) extends LL
case class LLAlloca(id: R) extends LL
case class LLLoad(id1: R, id2: R) extends LL
case class LLStore(id1: R, id2: R) extends LL
case class LLBitCast(did: R, sid:R) extends LL
case class LLSwitch(reg:R, label:String, cases:List[(Long,String)]) extends LL
case class LLGoto(label:String) extends LL
case class LLLabel(s: String) extends LL

object constFold {
  var map: Map[R, R] = null
  def m(v: R): R = {
    if (map.contains(v)) m(map(v)) else v
  }
  def fs(prms: List[(T, R)]): List[(T, R)] = {
    prms.map {
      case (t, v) => (t, m(v))
    }
  }
  def apply(ls: List[LL]): List[LL] = {
    map = Map()
    ls.foldLeft(List[LL]()) {
      case (ls, l @ LLCall(id, op, prms)) => l.copy(prms = fs(prms)) :: ls
      case (ls, l @ LLBin(id, op, a, b)) => l.copy(a = m(a), b = m(b)) :: ls
      case (ls, l @ LLAssign(s, d)) => map = map + (s -> d); ls
      case (ls, l @ LLAlloca(id: R)) => l.copy(m(id)) :: ls
      case (ls, l @ LLField(id, id2, id3, id4)) => l.copy(id, m(id2), m(id3), m(id4)) :: ls
      case (ls, l @ LLStore(id1, id2)) => l.copy(m(id1), m(id2)) :: ls
      case (ls, l @ LLLoad(id1, id2)) => l.copy(m(id1), m(id2)) :: ls
      case (ls, l @ LLBitCast(did, sid)) => l.copy(m(did),m(sid)) :: ls
      case (ls, l @ LLSwitch(n, lbl, cases)) => l.copy(m(n), lbl, cases)::ls
      case (ls, l @ LLLabel(_)) => l::ls
      case (ls, l @ LLGoto(_)) => l::ls
      case (ls, l) => throw new Exception("error no implementation "+l)
    }.reverse
  }
}

object emit {

  def llt(t:T):String = {
    t match {
      case Ti(i) => "i" + i
      case Tv => "void"
      case TFun(t, ls) => llt(t) + "(" + ls.map(llt).mkString(", ") + ")*"
      case t:TStr => llstruct(t)
      case t:TVariant => llvariant(t)
      case Tp(t) => llt(t) + "*"
      case t:TDef => llt(env.stripT(t))
      case Tn => throw new Exception("error")
    }
  }
  // サイズ計算
  def size(t:T):Int = {
    env.stripT(t) match {
      case t@TStr(ls) =>
        llstruct(t) // 構造体の登録
        ls.foldLeft(0) { case (s,(n,t)) => s + size(t) }
      case Ti(n) => n / 8
      case Tv => 0
      case t:TFun => 8
      case t:TVariant =>
        val (_, _, m, _) = llvariantInfo(t)
        size(m) + 4
      case Tp(n) => 8
      case Tn => throw new Exception("error")
      case t:TDef => throw new Exception("error")
    }
  }
  /**
   * ヴァリアント型の情報を取得
   * (型の名前, 構造体, 最大サイズ構造体, 内部の構造体リスト)
   */
  def llvariantInfo(v:TVariant):(String,TStr,TStr,List[TStr]) = {
    val (maxsize, maxt, tys) = v.ls.foldLeft((0, null:TStr, List[TStr]())) {
      case ((n:Int,t,ls),(name:String,vt:T)) =>
        val sizevt = size(vt)
        if (sizevt > n) (sizevt, vt,vt::ls) else (n, t,vt::ls)
    }
    val t = TStr(List("tag"->Ti(32),"data"->maxt))
    (llstruct(t), t, maxt, tys)
  }

  def llvariant(v:TVariant):String = {
    llvariantInfo(v) match {
      case (s,_,_,_) => s
    }
  }

  def llr(r:R): String = {
    r match {
      case RG(t,id) => "@" + id
      case RL(t,id) => "%" + id
      case RR(t,id) => "%." + id
      case RN(t,id) => "" + id
    }
  }
  
  def o(id: R, out: String) {
    if (id != null) asm(llr(id) + " = " + out)
    else asm(out)
  }
  def f(l: LL) {
    l match {
      case LLCall(id, op, prms) =>
        val ps = prms.map { case (a, b) => llt(a) + " " + llr(b) }.mkString(", ")
        o(id, "call " + llt(op.t) + " " + llr(op) + "(" + ps + ") nounwind")
      case LLBin(id, op, a, b) =>
        o(id, op + " " + llt(id.t) + " " + llr(a) + ", " + llr(b))
      case _:LLAssign => throw new Exception("error")
      case LLField(reg1: R, addr: R, zero: R, a: R) =>
        o(reg1, "getelementptr inbounds " + llt(addr.t) + "* " + llr(addr) + ", " + llt(zero.t) + " " + llr(zero) + ", " + llt(a.t) + " " + llr(a))
      case LLLoad(reg1: R, reg2: R) =>
        o(reg1, "load " + llt(reg1.t) + "* " + llr(reg2))
      case LLStore(reg1: R, reg2: R) =>
        asm("store " + llt(reg1.t) + " " + llr(reg1) + ", " + llt(reg1.t) + "* " + llr(reg2))
      case LLAlloca(reg: R) =>
        o(reg, "alloca " + llt(reg.t))
      case LLBitCast(d: R, s:R) =>
        o(d, "bitcast " + llt(s.t) + " " + llr(s) + " to " + llt(d.t))  
      case LLSwitch(n, lbl, cases) =>
        asm("switch "+llt(n.t)+" "+llr(n)+", label %"+lbl+ " [")
        for((a,b) <- cases) {
          asm("  i32 " + a + ", label %"+b)
        }
        asm("]")
      case LLLabel(l) =>
        asm.label(l+":")
      case LLGoto(l) =>
        asm("br label %"+l)
    }
  }

  var structs: Map[TStr, String] = Map()
  def llstruct(t: TStr): String = {
    if (structs.contains(t)) return structs(t)
    val name = genid("%.struct")
    structs = structs + (t -> name)
    name
  }

  def apply(file: String, ls: List[LL]) {
    asm.open(file)
    structs.foreach { case (t, n) =>
        asm(n + " = type {" + t.types.map { case (a, b) => llt(b) }.mkString(", ") + "}")
    }
    asm.label("@.str = private constant [4 x i8] c\"%d\\0A\\00\"")
    asm.label("define void @print_i32(i32 %a) nounwind ssp {")
    asm.label("entry:")
    asm("call i32 (i8*, ...)* @printf(i8* getelementptr inbounds ([4 x i8]* @.str, i64 0, i64 0), i32 %a) nounwind")
    asm("ret void")
    asm.label("}")
    asm.label("define void @print_i8(i8 %a) nounwind ssp {")
    asm.label("entry:")
    asm("call i32 (i8*, ...)* @printf(i8* getelementptr inbounds ([4 x i8]* @.str, i64 0, i64 0), i8 %a) nounwind")
    asm("ret void")
    asm.label("}")

    asm.label("declare i32 @printf(i8*, ...) nounwind")

    asm.label("define i32 @main() nounwind ssp {")
    asm.label("entry:")
    ls.foreach(f)
    asm("ret i32 0")
    asm.label("}")
    asm.close()
  }
}

object genid {
  var id = 0
  def apply(s: String): String = {
    id += 1
    s + id
  }
}
object asm {
  var p: PrintWriter = null
  def open(file: String) {
    p = new PrintWriter(new BufferedWriter(new FileWriter(file)))
  }

  var indent: String = ""

  def apply(s: String, n: String = "") {
    val v = indent + s + "\t" + n + "\n"
    p.print(v)
  }
  def label(s: String) {
    asm.indent = "";
    apply(s)
    asm.indent = "\t";
  }
  def close() {
    p.close()
  }
}

object exec {
  def apply(cmd: String): (Int, String, String) = {
    val p = Runtime.getRuntime().exec(cmd)
    val stdin = (readAll(p.getInputStream()))
    val stderr = (readAll(p.getErrorStream()))
    (p.waitFor(), stdin, stderr)
  }

  def readAll(p: InputStream): String = {
    def f(s: String, i: BufferedReader): String = {
      i.readLine() match {
        case null => s
        case a => f(s + a + "\n", i)
      }
    }
    f("", new BufferedReader(new InputStreamReader(p)))
  }
}

まとめ

結構、長い戦いでした。最初は簡単だと思って始めたのですが、アレが足りない、コレが足りないと、結構足りない事が多くて、その足りない要素一つ一つが結構難しかったりしました。しかし、それでもコツコツと要素を潰して行く事でなんとかかんとか、パターンマッチを実装出来ました。

ということで、この話はここまでにしても良いと思うのですが、パーサとか型チェックがないじゃないか？って言う問題があるので、この話をもう少し進めて行ってみようと思います。

とりあえず、パーサを作って、必要なら型チェックをする。そうすることで、おお、ホントにパターンマッチできるなと実感出来るはずです。

参考文献