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構築能力を生かしてかなり定義どおりに書ける。

import scala.util.parsing.combinator._
import scala.util.parsing.combinator.syntactical._
import scala.util.parsing.combinator.lexical._
import scala.util.parsing.input.CharArrayReader.EofCh
class Lexer extends StdLexical with ImplicitConversions {
  override def token: Parser[Token] = 
    ( string ^^ StringLit
    | '-' ~> number ^^ { case num => NumericLit("-" + num) }
    | number ^^ NumericLit
    | EofCh ^^^ EOF
    | delim
    | '\"' ~> failure("Unterminated string")
    | rep(chrAny) ^^ checkKeyword
    | failure("Illegal character")
    )


  def number  = zero | (nonzero ~ rep(digit) ^^ {case x ~ y => mkS(x::y)})
  def string = '\"' ~> rep(charSeq | chrExcept('\"', '\n', EofCh)) <~ '\"' ^^ {case x => mkS(x)}
  def checkKeyword(xs : List[Any]) = {
    val strRep = mkS(xs)
    if (reserved contains strRep){ Keyword(strRep) }
    else if(identiferRe.findFirstIn(strRep) != None  ) { Identifier(strRep) }
    else {ErrorToken("Not a Identifier: " + strRep)}
  }

  override def whitespace: Parser[Any] =
    rep( whitespaceChar | '!' ~ rep( chrExcept(EofCh, '\n') ))
  def nonzero = elem("nonzero digit", d => d.isDigit && d != '0')
  def zero: Parser[String] = '0' ^^^ "0"
  def charSeq: Parser[String] =
    ('\\' ~ '\"' ^^^ "\"" |'\\' ~ '\\' ^^^ "\\" |'\\' ~ '/'  ^^^ "/" |'\\' ~ 'b'  ^^^ "\b" | '\\' ~ '0' ^^^ ""
    |'\\' ~ 'f'  ^^^ "\f" |'\\' ~ 'n'  ^^^ "\n" |'\\' ~ 'r'  ^^^ "\r" |'\\' ~ 't'  ^^^ "\t")
  def identiferRe = """^(\w|[^"])+$""".r
  def chrAny = chrExcept(EofCh, ' ', '\n', '\t', '\r', '\"', '!')

  def mkS[A](seq: Seq[A]) = seq mkString ""
}

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

抽象構文木をつくる

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

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

import scala.util.logging.ConsoleLogger
import scala.collection.mutable.{Stack, ArrayBuffer, HashMap}
trait Opecode {
  final val OP_NOP  : byte = 0x00
  final val OP_PUSH : byte = 0x01
  final val OP_CALL : byte = 0x50
  final val OP_RTN  : byte = 0x51
}

abstract class Node {
  type Value
  val v:Value
  def value = v
}
abstract class NodeValue extends Node
case class NodeStr(v:String) extends NodeValue { type Value = String }
case class NodeInt(v:int) extends NodeValue { type Value = int }
case class NodeBool(v:boolean) extends NodeValue { type Value = boolean }
case class NodeSymbol(override val v:String) extends NodeStr(v)
case class NodeQuotation(val v:List[Node]) extends Node{ type Value = List[Node] }
case class NodeOpe(v:byte, operand:List[Node]) extends Node { type Value = byte }
case class NodeNamed(v:Named) extends NodeValue with Opecode{ type Value = Named }
case class NodeProgram(v:List[Node]) extends Node with Opecode{
  type Value = List[Node]
  var quotIndex = 0
  def nextQuotSym = { quotIndex += 1; "quot"+quotIndex }

  def toplevel = {
    val nullsf = List[NodeSymbol]()
    val words = new ArrayBuffer[Node]
    def visitNode(n:Node):List[Node] = n match {
      case NodeNamed(NamedWord(name, sin, sout, body)) => 
         words += NodeNamed(NamedWord(name, sin, sout, body.flatMap(visitNode)))
         List[Node]()
      case NodeQuotation(nodes) => 
        val name = nextQuotSym
        words += NodeNamed(NamedWord(name, nullsf, nullsf, nodes.flatMap(visitNode)))
        List(NodeOpe(OP_PUSH, List(NodeSymbol(name))))
      case x => List(x)
    }
    value.flatMap(visitNode)
    words.toList
  }
}

abstract class Named(name:String)
case class NamedWord(name:String, stackin:List[NodeSymbol], stackout:List[NodeSymbol], body:List[Node]) extends Named(name)
case class NamedNativeWord[T](name:String, stackin:List[NodeSymbol], 
  stackout:List[NodeSymbol], body:()=>T) extends Named(name)
class NamedTable extends HashMap[String, Named] {
}

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

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

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

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

class SimpleFactorInterp extends StdTokenParsers with ImplicitConversions with Opecode{
  type Tokens = Lexer
  val lexical = new Tokens
  lexical.reserved ++= List("t", "f", "(", ")", "[", "]", ":", ";", "--")
  lexical.delimiters ++= List("\n", " ", "\t")
  import lexical.{NumericLit, StringLit, Keyword, Identifier}

  def program     = rep(lWord) ^^ { case nodes => NodeProgram(nodes) }
  def lWord       = ":" ~ lSymbol ~ "(" ~ rep(lSymbol) ~ "--" ~ rep(lSymbol) ~ ")" ~ rep(lExpr) ~ ";" ^^ 
                        { case ":" ~ name ~ "(" ~ sin ~ "--" ~ sout ~ ")" ~ body ~ ";" =>
                            NodeNamed(NamedWord(name.value, sin, sout, body+NodeOpe(OP_RTN, List[Node]()))) }
  def lExpr:Parser[Node] = (lString | lNumber | lBool | lInvokeWord | lQuotation)
  def lString     = accept("string", { case StringLit(n)  =>  NodeOpe(OP_PUSH, List(NodeStr(n))) })
  def lNumber     = accept("number", { case NumericLit(n) =>  NodeOpe(OP_PUSH, List(NodeInt(n.toInt))) })
  def lBool       = accept("boolean",{ case Keyword("t")  =>  NodeOpe(OP_PUSH, List(NodeBool(true)))
                                       case Keyword("f")  =>  NodeOpe(OP_PUSH, List(NodeBool(false)))  })
  def lInvokeWord    = accept("symbol", { case Identifier(n) => NodeOpe(OP_CALL, List(NodeSymbol(n))) })
  def lQuotation      = "[" ~> rep(lExpr) <~ "]" ^^ { case expr => NodeQuotation(expr+NodeOpe(OP_RTN, List[Node]())) }

  def lSymbol        = accept("symbol", { case Identifier(n) => NodeSymbol(n) })

  protected val stack = new Stack[Node]
  protected var namedTable = new NamedTable

  def parse(input: String) = 
    phrase(program)(new lexical.Scanner(input)) match {
      case Success(programNode, _) => initTopLevel(programNode.toplevel)
      case x                       => error(x.toString)
    }

  def initTopLevel(toplevelNodes:List[Node]) = {
    def sl(v:String) = v.split(" ").map(NodeSymbol).toList
    def nword[T](n:String, sin:String, sout:String, m:()=>T) =
      (n, NamedNativeWord(n, sl(sin), sl(sout), m))
    namedTable ++= List(
      nword("drop", "x", "", ()=>{ pop }),
      nword("dup", "x", "x x", ()=>{ val v = pop; npush(v,v) }),
      nword("rotate", "x y z", "y z x", ()=> npop(3) match {
        case List(x, y, z) => npush(y, z, x)
      }),
      nword("swap", "x y", "y x", ()=> npop(2) match {
        case List(x, y) => npush(y, x)
      }),

      nword("+", "x y", "z", ()=>{ iArI2(_+_) }),
      nword("-", "x y", "z", ()=>{ iArI2(_-_) }),
      nword("*", "x y", "z", ()=>{ iArI2(_*_) }),
      nword("/", "x y", "z", ()=>{ iArI2(_/_) }),

      nword(">", "x y", "?", ()=>{ ilB2(_>_) }),
      nword("<", "x y", "?", ()=>{ ilB2(_<_) }),
      nword("==", "x y", "?", ()=>{ ilB2(_==_) }),
      nword(">=", "x y", "?", ()=>{ ilB2(_>=_) }),
      nword("<=", "x y", "?", ()=>{ ilB2(_<=_) }),

      nword("not", "?", "?", ()=> pop match {
        case NodeBool(v) => push(NodeBool(!v))
      }),
      nword("and", "? ?", "?", ()=> (pop, pop) match {
        case (NodeBool(true), NodeBool(true)) => push(NodeBool(true))
        case (NodeBool(_), NodeBool(_)) => push(NodeBool(false))
      }),
      nword("or", "? ?", "?", ()=> (pop, pop) match {
        case (NodeBool(false), NodeBool(false)) => push(NodeBool(false))
        case (NodeBool(_), NodeBool(_)) => push(NodeBool(true))
      }),

      nword(".", "obj", "", ()=>{ println(pop.value) }),
      nword("call", "quot", "", ()=> pop match {
        case NodeSymbol(qname) => callWord(qname)
      }),

      nword("if", "? quot quot", "", ()=> (pop, pop, pop) match {
        case (_, NodeSymbol(qname), NodeBool(true))   => callWord(qname)
        case (NodeSymbol(qname),  _, NodeBool(false)) => callWord(qname)
      }),

      nword("string>number", "str", "x", ()=> pop match {
        case NodeStr(str) => push(NodeInt(str.toInt))
      }),
      nword(">string", "obj", "str", ()=> { push(NodeStr(pop.value.toString)) })

    )
    toplevelNodes.foreach { 
      case NodeNamed(n@NamedWord(name, _, _, _)) => namedTable(name) = n
      case _ => ()
    }
  }

  def evaluate(input:String, args:Array[String]) = {
    parse(input)
    args.map(NodeStr).foreach(push _)
    callWord("main")
  }

  def callWord(wordName:String):unit = 
    namedTable(wordName.ensuring(namedTable.contains _, "word '"+wordName+"' is not defined.")) match {
      case NamedNativeWord(_, sin, sout, body) => try { 
          body()
        } catch {
          case e => wordError(wordName, sin, sout)
                    throw e
        }
      case NamedWord(_, sin, sout, body) => 
        body foreach { 
          case NodeOpe(OP_PUSH, List(v, _*)) => push(v)
          case NodeOpe(OP_CALL, List(NodeSymbol(name), _*)) => 
            try {
              callWord(name)
            }catch {
              case e => wordError(wordName, sin, sout)
                        throw e
            }
          case NodeOpe(OP_RTN, _) => ()
        }
    }

  def npop(n:int):List[Node] = (1 to n).map(x=>pop).reverse.toList
  def npush(ns:Node*) = ns.reverse.foreach(push(_))

  def iArI2(f:(int,int)=>int) = (pop, pop) match {
    case (NodeInt(v1), NodeInt(v2)) => push(NodeInt(f(v2,v1)))
  }
  def ilB2(f:(int,int)=>boolean) = (pop, pop) match {
    case (NodeInt(v1), NodeInt(v2)) => push(NodeBool(f(v2,v1)))
  }
  def wordError(name:String, sin:List[NodeSymbol], sout:List[NodeSymbol]) = {
    printf("word '%s' ( %s -- %s ).\n", name, sin.map(_.value).mkString(" "),
                                              sout.map(_.value).mkString(" "))
  }
  def push(a:Node) = stack.push(a)
  def pop = stack.pop

}

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

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

wordは

: add ( x y -- z )
 +
;

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

あとは自明なので省略。

実行

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

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

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

サンプルコード

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

object SimpleFactor extends ConsoleLogger{
  def main(args: Array[String]) = {
    log("Starting SimpleFactor.")
    log("-"*40)
    val ip = new SimpleFactorInterp
    ip.evaluate("""
! Performs a factorial calculation.
: main ( str -- ) 
string>number fact .
;

: fact ( x -- y ) dup factit ;

: factit ( x y -- z )
  dup 1 <=
    [ drop ]
    [ 1 - dup rotate * swap factit ] if
;

    """, args)
  }
}

SimpleFactor.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