SSブログ

Tcl 8.6 のインラインアセンブラを使って簡易言語を作る [Tcl]

Tcl 8.6から::tcl::unsupported::assembleというコマンドでインラインアセンブラが使えるようになっていた。 これを使うとTclの仮想マシンのバイトコードに対するアセンブラをTclコード中に書くことができる。

unsupportedという記載からもわかるように公式なドキュメントはないが、 故意にエラーを出すことによってエラーメッセージから使い方を忖度することができる。

例えば ::tcl::unsupported::assemble help とすると命令の一覧が出てくる。 (helpというサブコマンドがあるわけではなくて、存在しない命令を与えた時のエラー)

% ::tcl::unsupported::assemble help
bad instruction "help": must be push, add, append, appendArray, appendArrayStk, appendStk, arrayExistsImm, arrayExistsStk, arrayMakeImm, arrayMakeStk, beginCatch, bitand, bitnot, bitor, bitxor, concat, coroName, currentNamespace, dictAppend, dictExists, dictExpand, dictGet, dictIncrImm, dictLappend, dictRecombineStk, dictRecombineImm, dictSet, dictUnset, div, dup, endCatch, eq, eval, evalStk, exist, existArray, existArrayStk, existStk, expon, expr, exprStk, ge, gt, incr, incrArray, incrArrayImm, incrArrayStk, incrArrayStkImm, incrImm, incrStk, incrStkImm, infoLevelArgs, infoLevelNumber, invokeStk, jump, jump4, jumpFalse, jumpFalse4, jumpTable, jumpTrue, jumpTrue4, label, land, lappend, lappendArray, lappendArrayStk, lappendStk, le, lindexMulti, list, listConcat, listIn, listIndex, listIndexImm, listLength, listNotIn, load, loadArray, loadArrayStk, loadStk, lor, lsetFlat, lsetList, lshift, lt, mod, mult, neq, nop, not, nsupvar, over, pop, pushReturnCode, pushReturnOpts, pushResult, regexp, resolveCmd, reverse, rshift, store, storeArray, storeArrayStk, storeStk, strcmp, streq, strfind, strindex, strlen, strmap, strmatch, strneq, strrange, strrfind, sub, tclooClass, tclooIsObject, tclooNamespace, tclooSelf, tryCvtToNumeric, uminus, unset, unsetArray, unsetArrayStk, unsetStk, uplus, upvar, variable, verifyDict, or yield

pushという命令について知りたければ同様にエラーを出してみる。

% ::tcl::unsupported::assemble push
wrong # args: should be "push value"

この調子で調べていくと基本的な命令については何となくわかってくる。 そこでTclバイトコードをターゲットとした簡単な言語を作ってみた。

コンパイラはSMLで、パーサジェネレータとしてProglrを使って作る。

以前の記事 をOCaml+BNFC+JavaからSML+Proglr+Tclに変えて行ったものと思えばよい。 ソースコードの全体はGistにアップロードした。

文法定義

文法定義は下記の通り。

token Add "+" ;
token Sub "-" ;
token Mul "*" ;
token Div "/" ;
token LParen "(" ;
token RParen ")" ;
token Eq "=" ;
token Comma "," ;
token Semi ";" ;
token FunKw "fun" ;
token LetKw "let" ;
token InKw "in" ;
token IfKw "if" ;
token ThenKw "then" ;
token ElseKw "else" ;
token Integer of int;
token Ident of string;
token String of string;
 
Grm. Grm ::= [Top] ;
separator Top ";" ;
 
Fun. Top ::= "fun" Ident "(" [Param] ")" "=" Exp ;
Exp. Top ::= Exp ;
 
separator Param "," ;
Param. Param ::= Ident ;
 
Let. Exp ::= "let" Ident "=" Exp "in" Exp ;
Cnd. Exp ::= "if" Exp "then" Exp "else" Exp ;
 
separator Exp "," ;
 
Add. Exp1 ::= Exp1 "+" Exp2 ;
Sub. Exp1 ::= Exp1 "-" Exp2 ;
 
Mul. Exp2 ::= Exp2 "*" Exp3 ;
Div. Exp2 ::= Exp2 "/" Exp3 ;
 
App. Exp3 ::= Ident "(" [Exp] ")" ;
Int. Exp3 ::= Integer ;
Str. Exp3 ::= String ;
Var. Exp3 ::= Ident ;
 
coercions Exp 3;

言語は関数定義と式の連続であり、式中には条件分岐とローカル変数と四則演算と関数呼び出しが書ける。

ProglrはGLRだが、この文法はLALR(1)になっているはずである。 これを確認するには、最初のtokenの行を省くとBNFCの文法定義と互換性があるので、 BNFCに食べさせてocamlyaccに通す。衝突が報告されないことでLALR(1)であることを確認できる。

Proglrでは字句解析についてはml-ulexで行うのだが、割と自明なので掲載を省く。

これをProglrに通すとパーサーと抽象構文木のデータ型のSMLソースコードが生成される。

コンパイラ

メインとなるProglrのドライバは次のように書く。

fun main () =
  let
    val strm = Lexer.streamifyInstream TextIO.stdIn
    val sourcemap = AntlrStreamPos.mkSourcemap ()
    val ast = hd (Parse.parse sourcemap strm)
  in
    check ast;
    compile ast
  end

何故Parse.parseのhdを取っているのかといえば、Parse.parseが構文木のリストを返すからだ。 これはProglrが一般にCFGを扱うからで、CFGの文法は多義的でありうる。

checkは未定義のローカル変数の使用と、ローカル変数の名前の衝突をチェックする。 後者についてはシャドウイングされるものとみなして名前の付け替えをしてもいいと思うが、 今回は単にチェックするだけにした。

fun nameOf (Param (_, name)) = name
 
fun mem (x, []) = false
  | mem (x, y::ys) = x = y orelse mem (x, ys)
 
fun check (Grm (span, tops)) = List.app (fn top => checkTop (top, [])) tops
and checkTop (Fun (span, name, params, body), env) =
      checkExp (body, map nameOf params)
  | checkTop (Exp (span, exp), env) = checkExp (exp, env)
and checkExp (Let (span, name, value, body), env) = (
      checkExp (value, env);
      if mem (name, env) then raise Fail ("dup var: " ^ name)
      else checkExp (body, name::env))
  | checkExp (Cnd (span, cond, t, f), env) =
      (checkExp (cond, env); checkExp (t, env); checkExp (f, env))
  | checkExp (App (span, rator, rands), env) =
      List.app (fn rand => checkExp (rand, env)) rands
  | checkExp (Add (span, e1, e2), env) =
      (checkExp (e1, env); checkExp (e2, env))
  | checkExp (Sub (span, e1, e2), env) =
      (checkExp (e1, env); checkExp (e2, env))
  | checkExp (Mul (span, e1, e2), env) =
      (checkExp (e1, env); checkExp (e2, env))
  | checkExp (Div (span, e1, e2), env) =
      (checkExp (e1, env); checkExp (e2, env))
  | checkExp (Int (span, int), env) = ()
  | checkExp (Str (span, str), env) = ()
  | checkExp (Var (span, var), env) =
      if mem (var, env) then () else raise Fail ("unknown var: " ^ var)

Tclの仮想マシンはJavaVMと同様のスタックマシンである。 したがってコンパイルは前回の記事と大体同様である。

local
    val n = ref 0
in
    fun newLabel () = "label" ^ Int.toString (!n) before n := !n + 1
end
 
fun println s = (print s; print "\n")
 
fun compile (Grm (span, tops)) = List.app compileTop tops
and compileTop (Fun (span, name, params, body)) = (
      println ("proc " ^ name ^ " {" ^ String.concatWith " " (map nameOf params) ^ "} {");
      println ("::tcl::unsupported::assemble {");
      compileExp body;
      println ("}");
      println ("}"))
  | compileTop (Exp (span, exp)) = (
      println ("::tcl::unsupported::assemble {");
      compileExp exp;
      println ("}"))
and compileExp (Let (span, name, value, body)) = (
      compileExp value;
      println ("store " ^ name);
      println "pop";
      compileExp body)
  | compileExp (Cnd (span, cond, t, f)) =
      let
        val falseLabel = newLabel ()
        val trueLabel = newLabel ()
      in
        compileExp cond;
        println ("jumpFalse " ^ falseLabel);
        compileExp t;
        println ("jump " ^ trueLabel);
        println ("label " ^ falseLabel);
        compileExp f;
        println ("label " ^ trueLabel)
      end
  | compileExp (App (span, rator, rands)) = (
       println ("push " ^ rator);
       List.app compileExp rands;
       println ("invokeStk " ^ Int.toString (length rands + 1)))
  | compileExp (Add (span, e1, e2)) = (
      compileExp e1;
      compileExp e2;
      println "add")
  | compileExp (Sub (span, e1, e2)) = (
      compileExp e1;
      compileExp e2;
      println "sub")
  | compileExp (Mul (span, e1, e2)) = (
      compileExp e1;
      compileExp e2;
      println "mult")
  | compileExp (Div (span, e1, e2)) = (
      compileExp e1;
      compileExp e2;
      println "div")
  | compileExp (Int (span, int)) = println ("push " ^ Int.toString int)
  | compileExp (Str (span, str)) = println ("push {" ^ str ^ "}")
  | compileExp (Var (span, var)) = println ("load " ^ var)

実行

コンパイラはtalという実行ファイルになるようにした。 Tcl上での実行を簡単にするためにシェルスクリプトtalexecを書く。

#/bin/sh
 
TEMP=$(mktemp)
tal < $1 > $TEMP
tclsh $TEMP
rm -f $TEMP

ソースファイルを次のように書くと、

fun f(x) =
  if x then x * f(x - 1)
  else 1;
 
puts(f(10))

実行結果はこうなる。

$ talexec fact.tal
3628800

ここでf関数はTclのプロシージャとして定義される。 putsはTclの組み込みのコマンドである。 関数呼び出しの構文で任意のTclコマンドを呼び出すことができる。

使用した命令

命令 説明
push value valueをスタックに積む
pop スタックから1つ取り出す
store varname スタック最上位の値を変数varnameに格納する。スタックは変更されないので注意。
load varname 変数varnameの値をスタックにロードする
jumpFalse label スタック最上位の値が偽のときlabelにジャンプする
jump label 無条件ジャンプ
label name ラベルの定義
invokeStk count スタックの内容でプロシージャ(コマンド)を呼び出す。countは引数の数+1
add スタックの2要素を取り出し、和をスタックに置く
sub スタックの2要素を取り出し、差をスタックに置く
mult スタックの2要素を取り出し、積をスタックに置く
div スタックの2要素を取り出し、商をスタックに置く

感想

今のところTclのVMに関してあまり特殊なことや優位性があるようには思われないので、 一般的な言語処理系のターゲットとする価値があるかというとなさそうである。 アセンブリにオリジナルソースファイルの行番号を埋め込む方法が無いようである点も不利である。

しかしTclの中でDSLをコンパイルして使いたかったり、 Tclと何らかの密な連携を必要とする場合はインラインアセンブラを使う手もあるだろう。


nice!(0)  コメント(0)  トラックバック(0) 

nice! 0

コメント 0

コメントを書く

お名前:
URL:
コメント:
画像認証:
下の画像に表示されている文字を入力してください。

トラックバック 0

この広告は前回の更新から一定期間経過したブログに表示されています。更新すると自動で解除されます。