今回はパーサと型チェックを作ります。Scalaだとパーサコンビネータのライブラリが標準でついているのでそれを使います。PackRatParserを使うとメモ化されメモリは食いますが高速に処理できるそうですので、こちらを使いました。また、正規表現も使いたいので、RegexpParserを使いました。
パーサコンビネータの良い所は小さいパーサを先に作ってそれを元に拡張して行けばよいので作るのが楽です。また、Yaccとは違ってコンフリクトが起きないので簡単です。お手軽なパーサを書くならパーサコンビネータは良いものです。
パーサを作るだけで、終わらせたい所ですが、構造体やヴァリアントの型を使うにはtypedef宣言のような構文がないと不便なので、そちらも追加しました。
型のチェックと型推論は似ているのですが、推論は大変なのでチェックをしつつ推論っぽいことが出来そうな時だけ推論っぽいことをしてみます。
型推論っぽい実装については、2週間で出来る！スクリプト言語の作り方[1]を参考にしました。
パーサコンビネータの作成は、Packrat Parserを使ってみた[2]や、tapl-scala[3] を参考にしました。
正規表現のパーサコンビネータについては、RegexParsersで手軽にScalaのパーサコンビネータを使ってみる[4]を参考にしました。
型チェックの実装
この型チェックの実装とパーサの作成の解説は、型チェックの実装から書いてありますが、パーサから実装した方が良いと思います。ああ、型チェックが必要だ。って箇所が出てきますので。そこの対策がこの型チェックの実装です。こちらの実装を先に書いているのは、型チェックの実装を先に作ってもエラーが出ないからです。
環境を作って型を環境に保存し、また取り出して取り出して、２項演算子の型を求めると言った処理を追加します。
α変換を行った後に型チェックを行う事で、名前がぶつからないようになっていますが、これが良い事なのかどうかは分かりません。とにかく、うまくいっていればいいですよね。それで、テスト的なプログラムが動作するくらいまで出来たら終了としました。
import util.parsing.input.Positional
sealed trait E をPositionalを継承して位置情報を格納出来るようにします。
sealed trait E extends Positional {
タイプ宣言用の型と、Switchケース用のパーサ用のECaseを追加します。
case class EType(t:T, id:String) extends E
case class ECase(t:T, e:E) extends E
sealed trait T をPositionalを継承して位置情報を格納出来るようにします。
sealed trait T extends Positional
型の決まっていない型Tnと型の名前指定型TDefの追加をします。
case object Tn extends T
case class TDef(id:String) extends T
テストコードの追加をします。
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"))
α変換に型の追加します。
case e @ EType(t:T, id:String) => (e.copy(t, id), env)
case e : ECase => throw new Exception("error")
kNormalにTDef対策で、env.stripTを入れ、型が構造体かヴァリアントだったら型を変えて再度読み込みします。
env.stripTは型にTDefが入っていた場合に、TDefを取り除く処理です。TDefが邪魔なのでどこかで奇麗に取り除きたい所ですが、アドホックにエラーが出た箇所に入れています。
f(a) match {
case a =>
add(LLAssign(RL(a.t, id), a))
RL(a.t, id)
}
↓
val t2 = env.stripT(t)
t2 match {
case t: TStr => f(e.copy(t = t))
case t: TVariant => f(e.copy(t = t))
case _ =>
f(a) match {
case a =>
add(LLAssign(RL(a.t, id), a))
RL(a.t, id)
}
}
env.stripTを入れます。
if (t != b.t) throw new Exception("type mismatch " + t + " " + b.t)
↓
if (env.stripT(t) != env.stripT(b.t)) throw new Exception("type mismatch " + t + " " + b.t)
env.stripTを入れます。
val (_, _, maxT, _) = emit.llvariantInfo(a.t.asInstanceOf[TVariant])
↓
val (_, _, maxT, _) = emit.llvariantInfo(env.stripT(a.t).asInstanceOf[TVariant])
env.stripTを入れます。
env.stripT(a.t) match {
case t:TVariant => return f(e.copy(t=t))
case _ =>
}
タイプを追加します。
case EType(t: T, id: String) =>
env.map = env.map + (id -> RR(t, null))
null
追加処理を追加します。
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
}
}
case t:TDef => llt(env.stripT(t))
case Tn => throw new Exception("error")
env.stripTを入れます。
t match {
↓
env.stripT(t) match {
Tn,TDefは無いはずなのでエラーにします。
case Tn => throw new Exception("error")
case t:TDef => throw new Exception("error")
パーサの実装
実装ははじめに数値と識別子を実装して動かしてみました。次に、足し算、かけ算とprintの実装。ASTをコンパイルしてしまえば、動くので動かしながら、後は、ASTのテストを再現するコードを書いて、テストしながら成長させて行きました。それで、型のチェックが必要な箇所がでて来たのでコメントアウトしてパーサを作るだけで飛ばしたりして先に作っていました。
parse.scalaの実装
package chapter11
import util.parsing.combinator._
import util.parsing.input.Positional
object parser extends RegexParsers with PackratParsers {
def p(e:PackratParser[E]) = positioned(e)
def t(e:PackratParser[T]) = positioned(e)
// skip C/C++ style comments and whitespace.
override protected val whiteSpace = """((/\*(?:.|\r|\n)*?\*/)|//.*|\s+)+""".r
lazy val id: PackratParser[String] = memo("""[A-Za-z_][\w_]*""".r)
lazy val lng: PackratParser[E] = p(memo("""(0|[1-9][0-9]*)""".r ^^ {case a => ELdc(Ti(32),a.toLong)}))
lazy val tpl: PackratParser[E] = p(("(" ~> expr) ~ rep("," ~> expr) <~ ")" ^^ { case a~b => ETuple(Tn, a::b) })
lazy val tpl2: PackratParser[List[E]] = ("(" ~> expr) ~ rep("," ~> expr) <~ ")" ^^ { case a~b => a::b }
lazy val _val: PackratParser[E] = p(("val" ~> id)~ ("=" ~> lng) ^^ { case a~b => EVal(Ti(32),a,b)} |
("val" ~> id)~ (":" ~> id) ~ ("=" ~> id) ~ tpl2 ^^ { case a~t~id~ls => EVal(mkT(t),a,ETag(mkT(t),id,ls))} |
("val" ~> id)~ (":" ~> id) ~ ("=" ~> tpl) ^^ { case a~t~tpl => EVal(mkT(t),a,tpl)} |
("val" ~> id)~ (":" ~> id) ~ ("=" ~> expr) ^^ { case a~t~tpl => EVal(mkT(t),a,tpl)} |
("val" ~> id)~ (":" ~> id) ^^ { case a~t => EVal(mkT(t),a,null)})
lazy val _id: PackratParser[E] = p(id ^^ { case a => EId(Tn, a)})
def calc(op: String, op2:String):PackratParser[(E,E)=>E] = op ^^ {
a => (a:E,b:E) => Op(op2)(Tn, a, b)
}
lazy val eq: PackratParser[E] = p(expr ~ rep( "=" ~> expr) ^^ {
case a~b =>
b.foldLeft(a){case (a,b) => EAssign(Ti(32), a, b)}})
lazy val t1: PackratParser[E] = p(chainl1(eq,eq, calc("*","mul") | calc("/","div") | calc("%","mod")))
lazy val term: PackratParser[E] = p(chainl1(t1, t1, calc("+","add") | calc("-","sub")))
lazy val print: PackratParser[E] = p("print_i" ~> "(" ~> expr <~ ")" ^^ {case a => EPrint(Ti(32),a) })
lazy val block: PackratParser[E] = p("{" ~> rep(expr) <~ "}" ^^ {case a => EBlock(Tv,a)})
lazy val typ: PackratParser[T] = t(id ^^ {case a => mkT(a)})
lazy val ctyps: PackratParser[List[(String,TStr)]] = rep((id <~ "(") ~ (typs <~ ")") ^^ { case a~b => (a,TStr(b))})
lazy val typs: PackratParser[List[(String,T)]] = rep((id <~ ":") ~ typ ^^ { case a~b => (a,b)})
lazy val typdef: PackratParser[E] = ("type" ~> id) ~ ("=" ~> "struct" ~> "{" ~> typs <~ "}") ^^ { case a~b => EType(TStr(b), a)} |
("type" ~> id) ~ ("=" ~> "enum" ~> "{" ~> ctyps <~ "}") ^^ { case a~b => EType(TVariant(b), a)}
lazy val fields: PackratParser[E] = (id <~ ".") ~ id ^^ { case a~b => EField(Ti(32),a,b)}
lazy val cases: PackratParser[List[(E,E)]] = rep(("case" ~> ((lng^^ {case a=>ECase(Tn,a)})|tag) <~ ":") | expr ) ^^ {case a:List[E] =>
a.foldLeft(List[(E,E)]()){
case (l,ECase(_,a)) => (a,EBlock(Tv,List()))::l
case ((tag,EBlock(_,bls))::ls,a) => (tag,EBlock(Tv,bls:::List(a)))::ls
case _ => throw new Exception("error")
}.reverse
}
lazy val switch: PackratParser[E] = ("switch" ~> "(" ~> expr <~ ")") ~ ("{" ~> cases <~ "}") ^^ {case a~b => ESwitch(Ti(32), a, b)}
lazy val tpl3: PackratParser[List[String]] = ("(" ~> id) ~ rep("," ~> id) <~ ")" ^^ { case a~b => a::b }
lazy val tag: PackratParser[ECase] = id ~ tpl3 ^^ {case a~b => ECase(Tn,ETag(Tn,a,b.map{case a => EVal(Tn,a,null)}))}
lazy val expr: PackratParser[E] = typdef | term | block | switch | print | lng | _val | fields | _id
def mkT(a:String):T = {
a match {
case "Int" => Ti(32)
case a => TDef(a)
}
}
}
object typing {
def apply(e:E):E = {
val r = f(e)
env.map=Map()
r
}
def add(id:String, t:T):T = {
env.add(RL(t,id))
t
}
def f(e:E):E = {
e match {
case e @ ELdc(Tn, i:Long) => e.copy(t=Ti(32))
case e @ ELdc(t:T, i:Long) => e
case e @ EBin(t:T, s:String, l:E, r:E) => val (l2,r2) = (f(l),f(r)); e.copy(t=l2.t, l=l2, r=r2)
case e @ EPrint(t:T, a:E) => val a2 = f(a); e.copy(a2.t, a2)
case e @ EBlock(t: T, ls: List[E]) => e.copy(ls=ls.map(f))
case e @ EVal(Tn, id: String, a: E) => val a2 = f(a); e.copy(t=add(id,a.t), a=a2)
case e @ EVal(t: T, id: String, null) => add(id,t); e
case e @ EVal(t: T, id: String, a: ETuple) => e.copy(t=add(id,t), a=f(a.copy(t=t)))
case e @ EVal(t: T, id: String, a: E) =>
val a2 = f(a)
if(env.stripT(a2.t) != env.stripT(t)) throw new Exception("error "+a2+" "+a2.t +" != "+t)
e.copy(t=add(id,t), a=a2)
case e @ EId(t: T, id: String) => val r=env.map(id); e.copy(t=r.t)
case e @ EAssign(t: T, a: E, b: E) => val a2 = f(a); val b2 = f(b); e.copy(a2.t, a2, b2)
case e @ EField(Tn, id: String, idx: String) => val r = env.map(id); f(e.copy(t=r.t))
case e @ EField(t: T, id: String, idx: String) =>
t match {
case t@TStr(ls) => val (idx2,tt) = T.find(t, idx); e.copy(t=tt)
case t:TDef => env.stripT(t) match { case t:TDef => throw new Exception("type error "+t) case t => println(t); f(e.copy(t=t)) }
case t => e
}
case e @ ETuple(t:T,ls:List[E]) => e.copy(ls=ls.map(f))
case e @ ETag(t:T,id:String,ls:List[E]) => val r = env.map(id); e.copy(t=r.t,ls=ls.map(f) )
case e @ ESwitch(t: T, d: E, cases:List[(E,E)] ) =>
val d2 = f(d)
val dt = env.stripT(d2.t)
e.copy(
a=d2,
cases=cases.map{
case (a@ETag(t,id,ls),b)=>
val ls2 = env.findTag(dt.asInstanceOf[TVariant],id).types.zip(ls) map {
case ((_,t), e @ EVal(_,id2,_)) => add(id2,t); e.copy(t,id2)
case _ => throw new Exception("error")
}
(a.copy(t=dt,ls=ls2), f(b))
case (a,b) => (a,f(b))
})
case e @ EUnit => e
case e @ EType(t@TVariant(ls), id:String) => env.add(id, RR(t,null));for((tag,_)<-ls) env.add(tag, RR(t,null)); e
case e @ EType(t:T, id:String) => env.add(id, RR(t, null)); e
case e @ ECase(t:T, a:E) => f(a)
}
}
}
object parseTest {
def main(args:Array[String]) {
run("""{
print_i(100+2*3)
print_i(10)
print_i(20)
}""")
run("""{
val a = 10
print_i(a)
print_i(a+10*a)
}""")
// 構造体
run("""{
type SA = struct { a:Int b:Int }
val c = 10
val aa:SA
aa.a = 9
aa.b = c
print_i(aa.a)
print_i(aa.b)
}""")
// 構造体初期化リテラル
run("""{
type SA = struct { a:Int b:Int }
val ab:SA = (123,456)
print_i(ab.a)
print_i(ab.b)
}""")
// ヴァリアント
run("""{
type Data = enum { A(a:Int) B(a:Int b:Int) }
val data:Data
val data2:Data = B(555,777)
}""")
run("""{
// switch
switch(2) {
case 1: print_i(10001)
case 2: print_i(10002)
case 3: print_i(10003) print_i(10004)
}
print_i(1)
switch(0) {
case 1: print_i(10001)
case 2: print_i(10002)
case 3: print_i(10003)
}
}""")
run("""{
// alpha test
val a = 1000
print_i(a)
val a:Int = a + 2000
print_i(a)
// alpha block test
{
val a = 5000
print_i(a)
}
print_i(a)
}""")
run("""{
type Data = enum { A(a:Int) B(a:Int b:Int) }
val data2:Data = B(555,777)
// match構文
switch(data2) {
case A(x) : print_i(x)
case B(x,y) : print_i(x) print_i(y)
}
val data3:Data = A(333)
switch(data3) {
case A(x) : print_i(x)
case B(x,y) : print_i(x) print_i(y)
}
val x = 10
print_i(x)
}""")
}
def run(src:String) {
println("src="+src)
val result = parser.parseAll(parser.block,src)
if(!result.successful) {
println(result)
throw new Exception(result+"")
}
val ast = result.get
env.map = Map("Int"->RR(Ti(32),null))
println("ast="+ast)
val ast2 = alpha(ast)
val ast3 = typing(ast2)
println("ast3="+ast3)
val ll = kNormal(ast3)
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"))
}
}
core.scala
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)))
}
}
まとめ
パーサコンビネータでパーサを作り、ASTに型チェックを入れた事で、動作するようになりました。おそらくテストコード以外のコードを動かそうとするとバグが出ると思いますが(出ないかもしれないですが)、バグ潰しを始めると大変なのでここまでとします。
今後の予定
この後の予定は、ほんとうに使える言語に仕上げて行ったりする事と、パターンマッチの作り方を奇麗に纏める事です。文章能力は低いので大変ですけど、悩んでない方が多分分かりやすいだろうというのがあってそのように作ろうと思っています。今回はScalaで作成しましたが、Haxeで作ってみるのもありだよなぁと思っています。Haxeで作れば、CPPに変換できるのでC言語風の言語で奇麗にネイティブなコンパイラをかけるはずなんです。問題は、パーサコンビネータのライブラリである、ParserXをCPPで出力しようとするとエラーになってしまうので、パーサは別な方法で実装する必要があります。
参考文献
[1]２週間でできる！スクリプト言語の作り方
[2]Packrat Parserを使ってみた
[3]tapl-scala
[4]RegexParsersで手軽にScalaのパーサコンビネータを使ってみる