1
1

More than 5 years have passed since last update.

# パターンマッチの作り方(10) パターンマッチ構文

Last updated at Posted at 2013-06-20

## 使用例

テストコードのタイプ宣言

``````      val t = TVariant(List(
"A"->TStr(List("a"->Ti(32))),
"B"->TStr(List("a"->Ti(32), "b"->Ti(32)))
))
``````

switchのテストコード

``````        // 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"))
``````

## 実装

kNormalのswitchでヴァリアントだった場合はヴァリアントの処理を行います。この処理は通常のESwitchの手前に書かないとうまく行かないので注意が必要です。

``````      case ESwitch(t: TVariant, a: E, cases: List[(E, E)]) =>
val valR = f(a)

val tagR = gid(Ti(32))

// テーブルジャンプ
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)
}

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

val stId = genid("st")
val stR = RL(stT, stId)

for ((e: EVal, (id, t)) <- vs.zip(stT.types)) {
f(e.copy(e.t, e.id, EField(t, stId, id)))
}
f(e)
}
null
``````

## 実装全体

``````package chapter10

import java.io._

sealed trait E {
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 }

sealed trait T
case class Ti(i:Int) extends T
case object Tv 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

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 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")),
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"))

))
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)
}
}
}

object kNormal {
def gid(t:T): R = {
RR(t,genid(""))
}
var ls: List[LL] = null
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))
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 (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)
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)
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)
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保存

// 内部の構造体のアドレスを取得

// キャストする
val stId = genid("st")
val stR = RL(Tp(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) =>
f(a) match {
case 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 (t != b.t) throw new Exception("type mismatch " + t + " " + b.t)
b
}
case a: EField =>
val a2 = arr(a)
val b = gid(a2.t)
b
case ESwitch(t: TVariant, a: E, cases: List[(E, E)]) =>
val valR = f(a)

val tagR = gid(Ti(32))

// テーブルジャンプ
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)
}

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

val stId = genid("st")
val stR = RL(stT, stId)

for ((e: EVal, (id, t)) <- vs.zip(stT.types)) {
f(e.copy(e.t, e.id, EField(t, stId, id)))
}
f(e)
}
null
case e @ ESwitch(t: T, a: E, cases: List[(E, E)]) =>
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)
}
for((n, (_, e)) <- (0 until cases.length).zip(cases)) {
}
null
}
}

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

object env {
var map = Map[String, R]()
map = map + (r.id -> r)
}
}

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) + "*"
}
}
// サイズ計算
def size(t:T):Int = {
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(t) => 8
}
}
/**
* ヴァリアント型の情報を取得
* (型の名前, 構造体, 最大サイズ構造体, 内部の構造体リスト)
*/
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)
(p.waitFor(), stdin, stderr)
}

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

## まとめ

1
1
0

Register as a new user and use Qiita more conveniently

1. You get articles that match your needs
2. You can efficiently read back useful information
3. You can use dark theme
What you can do with signing up
1
1