Scalaでスタック指向言語をサクッと実装する

Scalaにはご存知のとおり scala.util.parsing.combinator というパーサコンビネータライブラリがある。さらには scala.util.parsing.ast というのもあるわけだけど、これは激しく開発中な感じ。Scalaはバージョンがあがるとこういう開発中ライブラリはごそっと変わったりするので今はおいておく。ちなみに、2.7.1では前のパーサコンビネータは scala.util.parsing.combinatorold といういかにも使いたくない名前にされてしまった。

パーサコンビネータといえば言語処理系だ（そうか？）。というわけで scala.util.parsing.ast は置いておいて、とりあえずASTについてほとんど考える必要がない、簡単なスタック指向言語を実装してみることにする。実行はScala 2.7.1.finalで。

スタック指向言語とは

こんなブログを見ている人は、だいたいスタック指向言語を知っているだろうから俺みたいな素人が書いてもなんだけど、一応。 スタック指向言語にはForthやPostScriptやFactorがある。素晴らしく簡単にいうと、 「とりあえずスタックがあればなんとかなるよね」 という言語だ。

んでスタック使うなら逆ポーランドで書いてあったら、処理も楽だしいいんじゃね、読みにくい？Lispだって慣れてる人は無問題なんだし、慣れの問題じゃね、という感じである。

関数（スタック指向言語ではwordという）もスタックに値をつんで実行すればいい。wordから値を返すときも返したい分だけスタックにつめばいい。というわけで、非常に単純なのである。

今回は Factor ライクなスタック指向言語処理系（インタプリタ）「SimpleFactor」を作ってみることに。文法とかはだいたいFactorと一緒なのでさきにFactorの文法を学んでおくと分かりやすい。

まずはレクサ

まずはレクサを作る。サポートするリテラルは文字列、整数値、真偽値で以下のような感じ。

  • 文字列： "hoge"
  • 整数値： 10, -10
  • 真偽値： t,f

あと、コメントは ! から行末までとする。ソースはこんな感じで、ScalaのDSL構築能力を生かしてかなり定義どおりに書ける。

 1import scala.util.parsing.combinator._
 2import scala.util.parsing.combinator.syntactical._
 3import scala.util.parsing.combinator.lexical._
 4import scala.util.parsing.input.CharArrayReader.EofCh
 5class Lexer extends StdLexical with ImplicitConversions {
 6  override def token: Parser[Token] = 
 7    ( string ^^ StringLit
 8    | '-' ~> number ^^ { case num => NumericLit("-" + num) }
 9    | number ^^ NumericLit
10    | EofCh ^^^ EOF
11    | delim
12    | '\"' ~> failure("Unterminated string")
13    | rep(chrAny) ^^ checkKeyword
14    | failure("Illegal character")
15    )
16
17
18  def number  = zero | (nonzero ~ rep(digit) ^^ {case x ~ y => mkS(x::y)})
19  def string = '\"' ~> rep(charSeq | chrExcept('\"', '\n', EofCh)) <~ '\"' ^^ {case x => mkS(x)}
20  def checkKeyword(xs : List[Any]) = {
21    val strRep = mkS(xs)
22    if (reserved contains strRep){ Keyword(strRep) }
23    else if(identiferRe.findFirstIn(strRep) != None  ) { Identifier(strRep) }
24    else {ErrorToken("Not a Identifier: " + strRep)}
25  }
26
27  override def whitespace: Parser[Any] =
28    rep( whitespaceChar | '!' ~ rep( chrExcept(EofCh, '\n') ))
29  def nonzero = elem("nonzero digit", d => d.isDigit && d != '0')
30  def zero: Parser[String] = '0' ^^^ "0"
31  def charSeq: Parser[String] =
32    ('\\' ~ '\"' ^^^ "\"" |'\\' ~ '\\' ^^^ "\\" |'\\' ~ '/'  ^^^ "/" |'\\' ~ 'b'  ^^^ "\b" | '\\' ~ '0' ^^^ ""
33    |'\\' ~ 'f'  ^^^ "\f" |'\\' ~ 'n'  ^^^ "\n" |'\\' ~ 'r'  ^^^ "\r" |'\\' ~ 't'  ^^^ "\t")
34  def identiferRe = """^(\w|[^"])+$""".r
35  def chrAny = chrExcept(EofCh, ' ', '\n', '\t', '\r', '\"', '!')
36
37  def mkS[A](seq: Seq[A]) = seq mkString ""
38}

Scalaで処理系を作る場合はとりあえず StdLexical を継承して拡張すれば、だいたいOK。ここでは Token を返すレクサを定義する。 Keyword や StringLit といった Token を継承したケースクラスは scala.util.parsing.sytax.StdTokens で定義されていて、 StdLexical は StdTokens をMix-inしている。

抽象構文木をつくる

次に、このトークンの並びから文法を定義して、それに従って抽象構文木を作るわけだけど、スタック指向言語の場合、ここで難しいことはあまりない。

とりあえず、処理(といっても4種類、しかもうち2種類は意味なし）と、抽象構文木をあらわすケースクラスを作る。インタプリタなのでオペコードとかする意味はないけど、こうしとくとVMにしようと思ったとき楽なのでそうした。というよりエミュとかを作ることが好きなので、こういう数値を見ると安心するのである。

 1import scala.util.logging.ConsoleLogger
 2import scala.collection.mutable.{Stack, ArrayBuffer, HashMap}
 3trait Opecode {
 4  final val OP_NOP  : byte = 0x00
 5  final val OP_PUSH : byte = 0x01
 6  final val OP_CALL : byte = 0x50
 7  final val OP_RTN  : byte = 0x51
 8}
 9
10abstract class Node {
11  type Value
12  val v:Value
13  def value = v
14}
15abstract class NodeValue extends Node
16case class NodeStr(v:String) extends NodeValue { type Value = String }
17case class NodeInt(v:int) extends NodeValue { type Value = int }
18case class NodeBool(v:boolean) extends NodeValue { type Value = boolean }
19case class NodeSymbol(override val v:String) extends NodeStr(v)
20case class NodeQuotation(val v:List[Node]) extends Node{ type Value = List[Node] }
21case class NodeOpe(v:byte, operand:List[Node]) extends Node { type Value = byte }
22case class NodeNamed(v:Named) extends NodeValue with Opecode{ type Value = Named }
23case class NodeProgram(v:List[Node]) extends Node with Opecode{
24  type Value = List[Node]
25  var quotIndex = 0
26  def nextQuotSym = { quotIndex += 1; "quot"+quotIndex }
27
28  def toplevel = {
29    val nullsf = List[NodeSymbol]()
30    val words = new ArrayBuffer[Node]
31    def visitNode(n:Node):List[Node] = n match {
32      case NodeNamed(NamedWord(name, sin, sout, body)) => 
33         words += NodeNamed(NamedWord(name, sin, sout, body.flatMap(visitNode)))
34         List[Node]()
35      case NodeQuotation(nodes) => 
36        val name = nextQuotSym
37        words += NodeNamed(NamedWord(name, nullsf, nullsf, nodes.flatMap(visitNode)))
38        List(NodeOpe(OP_PUSH, List(NodeSymbol(name))))
39      case x => List(x)
40    }
41    value.flatMap(visitNode)
42    words.toList
43  }
44}
45
46abstract class Named(name:String)
47case class NamedWord(name:String, stackin:List[NodeSymbol], stackout:List[NodeSymbol], body:List[Node]) extends Named(name)
48case class NamedNativeWord[T](name:String, stackin:List[NodeSymbol], 
49  stackout:List[NodeSymbol], body:()=>T) extends Named(name)
50class NamedTable extends HashMap[String, Named] {
51}

Node という抽象クラスを継承して、いろんなノードを定義する。だいたい名前をみてのとおりだけど、わかりにくいところだとこんな感じ。

  • NodeNamed：名前付けされた値への参照
  • NodeSymbol：word名
  • NodeQuotation：無名関数(quotationという)
  • NodeProgram：プログラム全体

Named は名前付けされた値なわけだけど、今回変数にあたるものはないので、wordのみがコレにあたる。 NamedWord がSimpleFactorで書かれたふつーのword、 NamedNativeWord はいわゆる組み込みwordでScalaで書いたものをあらわす。 NamedTable はその対応を保存する単なるハッシュマップ。

さて、ではこいつらを使って構文木を作って実行する。

  1class SimpleFactorInterp extends StdTokenParsers with ImplicitConversions with Opecode{
  2  type Tokens = Lexer
  3  val lexical = new Tokens
  4  lexical.reserved ++= List("t", "f", "(", ")", "[", "]", ":", ";", "--")
  5  lexical.delimiters ++= List("\n", " ", "\t")
  6  import lexical.{NumericLit, StringLit, Keyword, Identifier}
  7
  8  def program     = rep(lWord) ^^ { case nodes => NodeProgram(nodes) }
  9  def lWord       = ":" ~ lSymbol ~ "(" ~ rep(lSymbol) ~ "--" ~ rep(lSymbol) ~ ")" ~ rep(lExpr) ~ ";" ^^ 
 10                        { case ":" ~ name ~ "(" ~ sin ~ "--" ~ sout ~ ")" ~ body ~ ";" =>
 11                            NodeNamed(NamedWord(name.value, sin, sout, body+NodeOpe(OP_RTN, List[Node]()))) }
 12  def lExpr:Parser[Node] = (lString | lNumber | lBool | lInvokeWord | lQuotation)
 13  def lString     = accept("string", { case StringLit(n)  =>  NodeOpe(OP_PUSH, List(NodeStr(n))) })
 14  def lNumber     = accept("number", { case NumericLit(n) =>  NodeOpe(OP_PUSH, List(NodeInt(n.toInt))) })
 15  def lBool       = accept("boolean",{ case Keyword("t")  =>  NodeOpe(OP_PUSH, List(NodeBool(true)))
 16                                       case Keyword("f")  =>  NodeOpe(OP_PUSH, List(NodeBool(false)))  })
 17  def lInvokeWord    = accept("symbol", { case Identifier(n) => NodeOpe(OP_CALL, List(NodeSymbol(n))) })
 18  def lQuotation      = "[" ~> rep(lExpr) <~ "]" ^^ { case expr => NodeQuotation(expr+NodeOpe(OP_RTN, List[Node]())) }
 19
 20  def lSymbol        = accept("symbol", { case Identifier(n) => NodeSymbol(n) })
 21
 22  protected val stack = new Stack[Node]
 23  protected var namedTable = new NamedTable
 24
 25  def parse(input: String) = 
 26    phrase(program)(new lexical.Scanner(input)) match {
 27      case Success(programNode, _) => initTopLevel(programNode.toplevel)
 28      case x                       => error(x.toString)
 29    }
 30
 31  def initTopLevel(toplevelNodes:List[Node]) = {
 32    def sl(v:String) = v.split(" ").map(NodeSymbol).toList
 33    def nword[T](n:String, sin:String, sout:String, m:()=>T) =
 34      (n, NamedNativeWord(n, sl(sin), sl(sout), m))
 35    namedTable ++= List(
 36      nword("drop", "x", "", ()=>{ pop }),
 37      nword("dup", "x", "x x", ()=>{ val v = pop; npush(v,v) }),
 38      nword("rotate", "x y z", "y z x", ()=> npop(3) match {
 39        case List(x, y, z) => npush(y, z, x)
 40      }),
 41      nword("swap", "x y", "y x", ()=> npop(2) match {
 42        case List(x, y) => npush(y, x)
 43      }),
 44
 45      nword("+", "x y", "z", ()=>{ iArI2(_+_) }),
 46      nword("-", "x y", "z", ()=>{ iArI2(_-_) }),
 47      nword("*", "x y", "z", ()=>{ iArI2(_*_) }),
 48      nword("/", "x y", "z", ()=>{ iArI2(_/_) }),
 49
 50      nword(">", "x y", "?", ()=>{ ilB2(_>_) }),
 51      nword("<", "x y", "?", ()=>{ ilB2(_<_) }),
 52      nword("==", "x y", "?", ()=>{ ilB2(_==_) }),
 53      nword(">=", "x y", "?", ()=>{ ilB2(_>=_) }),
 54      nword("<=", "x y", "?", ()=>{ ilB2(_<=_) }),
 55
 56      nword("not", "?", "?", ()=> pop match {
 57        case NodeBool(v) => push(NodeBool(!v))
 58      }),
 59      nword("and", "? ?", "?", ()=> (pop, pop) match {
 60        case (NodeBool(true), NodeBool(true)) => push(NodeBool(true))
 61        case (NodeBool(_), NodeBool(_)) => push(NodeBool(false))
 62      }),
 63      nword("or", "? ?", "?", ()=> (pop, pop) match {
 64        case (NodeBool(false), NodeBool(false)) => push(NodeBool(false))
 65        case (NodeBool(_), NodeBool(_)) => push(NodeBool(true))
 66      }),
 67
 68      nword(".", "obj", "", ()=>{ println(pop.value) }),
 69      nword("call", "quot", "", ()=> pop match {
 70        case NodeSymbol(qname) => callWord(qname)
 71      }),
 72
 73      nword("if", "? quot quot", "", ()=> (pop, pop, pop) match {
 74        case (_, NodeSymbol(qname), NodeBool(true))   => callWord(qname)
 75        case (NodeSymbol(qname),  _, NodeBool(false)) => callWord(qname)
 76      }),
 77
 78      nword("string>number", "str", "x", ()=> pop match {
 79        case NodeStr(str) => push(NodeInt(str.toInt))
 80      }),
 81      nword(">string", "obj", "str", ()=> { push(NodeStr(pop.value.toString)) })
 82
 83    )
 84    toplevelNodes.foreach { 
 85      case NodeNamed(n@NamedWord(name, _, _, _)) => namedTable(name) = n
 86      case _ => ()
 87    }
 88  }
 89
 90  def evaluate(input:String, args:Array[String]) = {
 91    parse(input)
 92    args.map(NodeStr).foreach(push _)
 93    callWord("main")
 94  }
 95
 96  def callWord(wordName:String):unit = 
 97    namedTable(wordName.ensuring(namedTable.contains _, "word '"+wordName+"' is not defined.")) match {
 98      case NamedNativeWord(_, sin, sout, body) => try { 
 99          body()
100        } catch {
101          case e => wordError(wordName, sin, sout)
102                    throw e
103        }
104      case NamedWord(_, sin, sout, body) => 
105        body foreach { 
106          case NodeOpe(OP_PUSH, List(v, _*)) => push(v)
107          case NodeOpe(OP_CALL, List(NodeSymbol(name), _*)) => 
108            try {
109              callWord(name)
110            }catch {
111              case e => wordError(wordName, sin, sout)
112                        throw e
113            }
114          case NodeOpe(OP_RTN, _) => ()
115        }
116    }
117
118  def npop(n:int):List[Node] = (1 to n).map(x=>pop).reverse.toList
119  def npush(ns:Node*) = ns.reverse.foreach(push(_))
120
121  def iArI2(f:(int,int)=>int) = (pop, pop) match {
122    case (NodeInt(v1), NodeInt(v2)) => push(NodeInt(f(v2,v1)))
123  }
124  def ilB2(f:(int,int)=>boolean) = (pop, pop) match {
125    case (NodeInt(v1), NodeInt(v2)) => push(NodeBool(f(v2,v1)))
126  }
127  def wordError(name:String, sin:List[NodeSymbol], sout:List[NodeSymbol]) = {
128    printf("word '%s' ( %s -- %s ).\n", name, sin.map(_.value).mkString(" "),
129                                              sout.map(_.value).mkString(" "))
130  }
131  def push(a:Node) = stack.push(a)
132  def pop = stack.pop
133
134}

はじめの方でプログラムの文法を定義し、 Token から Node のリストへ変換し、 NodeProgram にする。処理の簡単さのため、プログラムはwordから構成されていて、プログラム開始時にはmain wordから実行が開始されるとするので

1def program     = rep(lWord) ^^ { case nodes => NodeProgram(nodes) }

wordは

1: add ( x y -- z )
2 +
3;

という感じに定義するので lWord の定義になっている。ほとんどそのまま書いた感じだ。 ( x y -- z ) の部分はスタックエフェクトといって、このwordがスタックにどのような影響を与えるのかを記述している。あくまで説明であって本質的な意味はない。 ( x y -- z ) ならスタックから2個取り出されて、結果が1個詰まれるのだな、ということがわかる。

あとは自明なので省略。

実行

そんなこんなでソースコードから NodeProgram が作れるようになった。次に NodeProgram からTOPレベル環境を作る。

ここでは、 NodeProgram に含まれるquotationを(実行する際の）簡単さのためNamedWordに変換し、変換後のNamedWordの呼び出しに変換する。組み込みwordもここで定義している。これはこの部分で定義すると、クロージャになるため定義が簡単だから( pop や push といった SimpleFactorInterp のメソッドがそのまま書ける)である。また、パターンマッチを活用することで非常に直感的に書けていることが見て取れるかと。やっぱりパターンマッチ最高だわぁ･･･。そして出揃ったTOPレベルのwordを NamedTable にマッピングし、TOPレベル環境の作成が完了する。

あとは main wordを呼び出すだけ。

サンプルコード

こんな感じ。サンプルでは10の階乗を計算している。

 1object SimpleFactor extends ConsoleLogger{
 2  def main(args: Array[String]) = {
 3    log("Starting SimpleFactor.")
 4    log("-"*40)
 5    val ip = new SimpleFactorInterp
 6    ip.evaluate("""
 7! Performs a factorial calculation.
 8: main ( str -- ) 
 9string>number fact .
10;
11
12: fact ( x -- y ) dup factit ;
13
14: factit ( x y -- z )
15  dup 1 <=
16    [ drop ]
17    [ 1 - dup rotate * swap factit ] if
18;
19
20    """, args)
21  }
22}
23
24SimpleFactor.main(Array("10"))

ここで使っているwordを簡単に説明すると

  • `string>number`:スタックからpopし、文字列を数値に変換してpushする
  • `*`: スタックから2個popし、掛けたものをpushする
  • `-`: スタックから2個popし、引き算したものをpushする
  • `<=`:スタックから2個popし、 <= な比較をして真偽値をpushする
  • `.`: スタックからpopし、文字列表現を表示する
  • `dup`:スタックからpopし、それを2回pushする
  • `drop`:スタックからpopする
  • `rotate`:「x y z」というスタックのトップ部分を、「y z x」にローテーションする
  • `swap`:「x y」というスタックのトップ部分を「y x」に入れ替える
  • `if`:「真偽値 真のとき実行するquotation 偽のとき実行するquotation」というスタックのトップ部分から条件を判定しquotationを実行する

てな感じ。これだけの命令でもちゃんとプログラムが書けて、条件分岐、ループが実現できるのはスタック指向言語を知らない人から見ると面白い部分かも。 3 fact なら

  • [ 3 3 ] : fact内 dup
  • [ 3 3 3 ] : factit内 dup
  • [ 3 3 3 1 ] : 1
  • [ 3 3 f ] : <=
  • [ 3 3 f quot ] : [ drop ]
  • [ 3 3 f quot quot ] : [1 - ... ]
  • [ 3 3 ] : if
  • [ 3 3 1 ] : 1
  • [ 3 2 ] : -
  • [ 3 2 2 ] : dup
  • [ 2 2 3 ] : rotate
  • [ 2 6 ] : *
  • [ 6 2 ] : swap
  • factitに戻る

こんな感じで計算される。

またLispのS式とマクロによる拡張性は名高いと思うが、スタック指向言語も単純に空白で区切られたwordが並んでいる、という点で非常に自己拡張性が高い。こういう変態的(?)な部分も魅力の一つ。

ForthはSUNのOpen Firmware、Firefox4で採用が予定されているJavascriptの処理系Tamarinの中など、今でもあまり表には見えてこない部分で使用されているので、これを機会にスタック指向言語を嗜んでみては。Forthは基本だけど、今なら注目され始めている(？)Factorかなあ。

簡単に作れます

というわけでScalaで簡単なスタック指向言語処理系を作ってみたわけだけど、非常に簡単。さくっと作れる。 scala.util.parsing.ast ができたら、またなんか処理系を試し書きしてみようかな。 　 　

comments powered by Disqus