How To Become A Hacker: 2015

2015年7月17日金曜日

乱数を作ろう

機械語には乱数は無い

ここんとこ、色々古いCPU、例えば6502とかZ80の資料を眺めていたんですが。

基本的には(当たり前かもしれないですが)機械語では「擬似乱数列」ってのは用意されてないんですね。

スーファミのCPUは65816と言うApple II GSで使用されていた、あまりメジャーじゃないCPUが使われています。

90年代初頭のスーファミの時代、ゲームプログラマはアセンブリ言語でプログラムする事が多かった模様です。そして当時は(ある程度は用意されてたみたいですが)開発ツールなんてのも今のようにゴージャスじゃなかった模様です。

と言う事は、かなりの確率で、例えばアクションゲームとかシューティングならさておき、RPG等、自作のアセンブリで書いた乱数ライブラリを使ってたりしたんじゃないでしょうか。そうじゃないと16bit CPU程度ではスピードはあんま稼げなかった筈なんですよね。

擬似乱数。果たしてどうやってプログラムするんでしょう。

SICPの乱数

話は唐突に飛びますが。

計算機プログラムの構造と解釈でも中途半端に(笑)、擬似乱数の作り方が載っています。

「ランダムに選ばれた」の意味は明瞭ではない. おそらく望んでいるのは randの次々の呼び出しは一様分布という統計の性質を持つ数列を生成することである. 適切な数列の発生法はここでは論じない. そうではなく, 手続きrand-updateがあり, ある数x₁から出発し,
x₂ = (rand-update x₁)x₃ = (rand-update x₂)
を作ると, 値の列x₁, x₂, x₃, ... は望みの統計的性質を持つと仮定する.
randをある固定した値random-initに初期化される局所状態変数xを持った手続きとして実装出来る. randを呼び出す度にxの現在値のrand-updateを計算し, これを乱数として返し, またそれをxの新しい値とする.
(define rand
  (let ((x random-init))
    (lambda ()
      (set! x (rand-update x))
      x)))
もちろん同じ乱数の列を単にrand-updateを直接呼び出すことで, 代入なしに生成することが出来る. しかしプログラムの乱数を使う部分は rand-updateに引数として渡すxの値をしっかり覚えていなければならないことを意味する.

そして注釈には次のような記述があります。

rand-updateを実装する通常のやり方は, a, b, mを適切に選んだ整数とし, mを法としてxをax + bで更新する規則を使うことである.

要するに具体的な例は全く紹介されてないんですね(笑)。
そこでWikipediaを頼ったコードは次のようなモノです。

	;;; Wikipediaの作例によるrand-update
	(define (rand-update x)
	(let ((a 3) (b 5) (m 13))
	(modulo (+ (* a x) b) m)))

	;;; 乱数の初期値も Wikipedia に倣って8とする
	(define random-init 8)

	;;; SICP の rand
	(define rand
	(let ((x random-init))
	(lambda ()
	(set! x (rand-update x))
	x)))

view raw rand-update.rkt hosted with ❤ by GitHub

これは線形合同法と言う極めて単純なやり方なんですが。ところが精度がメチャクチャ悪いんですね。
SICPではこの後、円周率πをモンテカルロ・シミュレーションで求めよう、ってトピックになるわけですが。

	(define (estimate-pi trials)
	(sqrt (/ 6 (monte-carlo trials cesaro-test))))


	(define (cesaro-test)
	(= (gcd (rand) (rand)) 1))


	(define (monte-carlo trials experiment)
	(define (iter trials-remaining trials-passed)
	(cond ((= trials-remaining 0)
	(/ trials-passed trials))
	((experiment)
	(iter (- trials-remaining 1) (+ trials-passed 1)))
	(else
	(iter (- trials-remaining 1) trials-passed))))
	(iter trials 0))

view raw monte-carlo.rkt hosted with ❤ by GitHub

ところが、これやってみりゃ分かるんですが、円周率πに届かないんですよ(笑)。

	> (estimate-pi 10000)
	2.449489742783178

view raw monte-carlo-fact.rkt hosted with ❤ by GitHub

さては、この結果知ってて「乱数作成」をサラーっと流したんじゃねぇの(笑)。
もう、SICP、こんなんばっかだよ(苦笑)。

Schemeと乱数

ところで。
実はSchemeって仕様には乱数が含まれてないんですね。
まあ、もちろん、各実装には実装依存で乱数生成プログラムが入ってるんでしょうが、あくまで「仕様としては」乱数は持ってません。
そう言う意味では結構メンドくせぇプログラミング言語なんですよね(笑)。

最強の乱数生成法

統計処理言語Rやお馴染みのPythonではメルセンヌ・ツイスタと言われる乱数生成プログラムが組み込まれています。メルセンヌ・ツイスタは今のトコ、史上最強と言われる擬似乱数生成プログラムで、仕様がない言語で最強の乱数列が使い放題なんですよねぇ。
一方Lispはどうか、と言うと例えば、Common Lispなんかにはメルセンヌ・ツイスタのライブラリが公開されていて、共有されています。
Schemeは・・・・・・まあ、実装次第なんでしょうねぇ。Gaucheなんかはメルセンヌ・ツイスタを使ってたと思うんですが、他の実装だと保証の限りじゃないです。まあ、こう言う時、「ライブラリを共有しづらい」Schemeだとやりにくいですね(R7RSでだいぶ仕様上は改善されていますが)。
さて、Racketはどうでしょうか?

Racketの乱数

残念ながらRacketの乱数はメルセンヌ・ツイスタではございません(笑)。RacketのDocumentationによると、L’Ecuyer’s MRG32k3a algorithmと言うアルゴリズムを用いてるそうです。
何だそりゃ。初めて聞きました。
実はCのソースコードが公開されていました。

	/*
	32-bits Random number generator U(0,1): MRG32k3a
	Author: Pierre L'Ecuyer,
	Source: Good Parameter Sets for Combined Multiple Recursive Random
	Number Generators,
	Shorter version in Operations Research,
	47, 1 (1999), 159--164.
	---------------------------------------------------------
	*/
	#include "MRG32k3a.h"

	#define norm 2.328306549295728e-10
	#define m1 4294967087.0
	#define m2 4294944443.0
	#define a12 1403580.0
	#define a13n 810728.0
	#define a21 527612.0
	#define a23n 1370589.0

	/***
	The seeds for s10, s11, s12 must be integers in [0, m1 - 1] and not all 0.
	The seeds for s20, s21, s22 must be integers in [0, m2 - 1] and not all 0.
	***/

	#define SEED 12345

	static double s10 = SEED, s11 = SEED, s12 = SEED,
	s20 = SEED, s21 = SEED, s22 = SEED;


	double MRG32k3a (void)
	{
	long k;
	double p1, p2;
	/* Component 1 */
	p1 = a12 * s11 - a13n * s10;
	k = p1 / m1;
	p1 -= k * m1;
	if (p1 < 0.0)
	p1 += m1;
	s10 = s11;
	s11 = s12;
	s12 = p1;

	/* Component 2 */
	p2 = a21 * s22 - a23n * s20;
	k = p2 / m2;
	p2 -= k * m2;
	if (p2 < 0.0)
	p2 += m2;
	s20 = s21;
	s21 = s22;
	s22 = p2;

	/* Combination */
	if (p1 <= p2)
	return ((p1 - p2 + m1) * norm);
	else
	return ((p1 - p2) * norm);
	}

view raw MRG32k3a.c hosted with ❤ by GitHub

これって結構シンプルじゃね?
さぁ、やっと本題です(笑)。
今回はこのMRG32k3aと言うアルゴリズムをRacketで「遅延評価を使って」実装してみたいと思います。SICPの遅延評価の乱数ストリームの仇をここで取ります(笑)。

遅延評価の友

ところで。
Schemeでは仕様上、遅延評価に絡んだ機能はdelayとforceしか提供していません。
これだけだと甚だメンド臭く、「マトモに遅延評価をさせる」には、色々基本的な遅延評価用の手続きを実装しないといけません。事実、SICPの遅延評価の項目だとそこに結構な量が割かれているんですよね。
それじゃああんまりにもメンドくせえだろ、って言う貴方に朗報です(笑)。
実は分かりづらいんですが、SRFI-41ってのがあって、これを呼び出せば遅延評価の基本機構は使い放題、となります。
主なトコではstream-cons、stream-car、stream-cdr、stream-null、stream-map、stream-filter、stream-constant、stream-ref、stream-from等等等、SICP程度のお題ならこの程度で大体書けるようになってるライブラリです。
便利でこの辺考えなくって良いんで、これを使いましょう。

※ 何故SRFI-41が「分かりづらい」かと言うと、遅延評価、つまりlazy-evaluationとして題名が付いてなくって「stream」と言う分かりづらい用語になってるからに他ならない。これは歴史的要因で、今ではlazy-evaluationと言う呼び方の方が妥当になってるが、過去にはそのままstreamと呼ばれてた事に由来する。

実装方針

最終的には単一のプロシージャにまとめますが、途中までは色々バラバラのパーツとして組み立てて行こうと思います。じゃないと遅延評価って良くわかりませんからね。

大域変数

まずは大域変数をCコードに則って定義していきます。まあ、最終的にはこれらはletで局所変数化されるんですが、最初はまあ、Cのコードそのままで書いていきます。

	(define norm 2.328306549295728e-10)
	(define m1 4294967087.0)
	(define m2 4294944443.0)
	(define a12 1403580.0)
	(define a13n 810728.0)
	(define a21 527612.0)
	(define a23n 1370589.0)


	(define SEED 12345)

view raw Global Variables for MRG32k3a.rkt hosted with ❤ by GitHub

この辺はまあ、いいですよね。乱数の種、SEEDも12345と言うフザけた(笑)値が与えられています。
ちなみに、実はm1、m2と言う2つの値は2の32乗から下2つの素数の模様です。

Component

さて、Cソースのコメントで、取り敢えずComponent 1と書かれたところに着目してみます。

	/* Component 1 */
	p1 = a12 * s11 - a13n * s10;
	k = p1 / m1;
	p1 -= k * m1;
	if (p1 < 0.0)
	p1 += m1;
	s10 = s11;
	s11 = s12;
	s12 = p1;

view raw Component 1.c hosted with ❤ by GitHub

さすがC、Lisp慣れしてると物凄くゴチャゴチャして見えますが(笑)。
原因の一つってのはここの箇所って実は「2つの事柄が1つにまとまってる」からなんですよね。

ここで行われてるのは次の2つです。

p1 なる値の計算
s10、s11、s12と言う3つの数の更新

当然Lisperとしては(笑)、「2つの計算目的は2つのプロシージャで書くべきだ」と言う原則を守ろうと思います。

さて、では手始めに2番から行きますか。

実はさっき定義しなかったんですが、原版ではs10、s11、s12と言う3つの値も大域変数として定義されています。

しかし「遅延評価を持ったLisp」であるSchemeではこれはやるべきじゃないトコなんですよね。

つまり、「各値を更新する」んじゃなくって、s10、s11、s12、そしてその後にはs13、s14・・・って「続いていくだろう」無限ストリームがある、って考えた方がスマートなわけです。

実際は、元のCコードを見ると、

(SEED SEED SEED p1 ....)

と言うようなカタチの無限ストリームを想定出来そうだ、って事ですよね。そしてp1以降は適当なプロシージャ、具体的には1の「計算によって」得られた数値がハマっていく。

そう言う想定から言うとまずは次のような「ストリーム生成」プロシージャをでっち上げられます。

	(define (stream1 s10 s11 s12)
	(stream-cons s10 (stream1 s11 s12 (Component1 s10 s11))))

view raw stream1.rkt hosted with ❤ by GitHub

そしてp1を計算するComponent1なるプロシージャを設計すれば良い。オリジナルのCコードだと次の部分ですね。

	p1 = a12 * s11 - a13n * s10;
	k = p1 / m1;
	p1 -= k * m1;
	if (p1 < 0.0)
	p1 += m1;

view raw Part of Component1.c hosted with ❤ by GitHub

ちなみに、最初、この2行目と3行目で何やってんだかサッパリ分かんなかったんですけど、何とこれ剰余計算やってるみたいです(笑)。え"え"え"え"え"、とか思ったんですが(苦笑)。うげぇ(笑)。
何で%使わねぇのかな。不思議です。ま、いいや(苦笑)。
つまり、この部分をSchemeで書くとこうなる、って事ですね。

	(define (Component1 s10 s11)
	(let ((p1 (modulo (- (* a12 s11) (* a13n s10)) m1)))
	(if (negative? p1)
	(+ p1 m1)
	p1)))

view raw Component1.rkt hosted with ❤ by GitHub

stream1とComponent1を組み合わせると、例えば実行結果は次のようになります。

	> (define s1 (stream1 SEED SEED SEED))
	> s1
	#<stream>
	> (stream->list 10 s1)
	'(12345
	12345
	12345
	3023790853.0
	3023790853.0
	3385359573.0
	1322208174.0
	2930192941.0
	2462079208.0
	2386811717.0)

view raw test of Component1.rkt hosted with ❤ by GitHub

stream1の最初と2番目と3番目の値はSEEDの値、4番目、5番目の値はそれぞれ1番目と2番目、2番目と3番目の値を使って計算してるから同じ値、6番目からガラッと変わってきますね。
これはstream->listと言うプロシージャでアタマ10個分だけ「実体化」させたわけですが、これがずーっと「無限ストリーム」として続いていくわけです。

Component2

基本ロジックはComponent1と全く同じなんでサクッと書いていきます。

	(define (stream2 s20 s21 s22)
	(stream-cons s20 (stream2 s21 s22 (Component2 s20 s22))))

	(define (Component2 s20 s22)
	(let ((p2 (modulo (- (* a21 s22) (* a23n s20)) m2)))
	(if (negative? p2)
	(+ p2 m2)
	p2)))

view raw Component2.rkt hosted with ❤ by GitHub

ただしComponent1とは使ってる引数の値と引数の順番が若干違うんで引っかからないように(笑)。

Combination

現時点ストリームが2つあります。p1、p2はそれぞれのストリームの4番目からスタートして、条件に従ってどっちかを選択してちょこちょこと計算して新しいストリームに組み込まれるわけです。
この辺をstream-mapを使って上手いこと実装します。

	(define (Combination stream1 stream2)
	(let ((stream1 (stream-cdr (stream-cdr (stream-cdr stream1))))
	(stream2 (stream-cdr (stream-cdr (stream-cdr stream2)))))
	(stream-map (lambda (p1 p2)
	(* (- p1 (if (<= p1 p2)
	(- p2 m1)
	p2)) norm))
	stream1 stream2)))

view raw Combination.rkt hosted with ❤ by GitHub

Combinationは新しいストリーム、ここでは乱数列を返します。
ちょっとまた、アタマ10個くらいstream->listで実体化させて見てみます。

	> (define s (Combination (stream1 SEED SEED SEED)
	(stream2 SEED SEED SEED)))
	> s
	#<stream>
	> (stream->list 10 s)
	'(0.12701112204657714
	0.3185275653967945
	0.3091860155832701
	0.8258468629271136
	0.2216299157820229
	0.5333953879182788
	0.4807742033156181
	0.3555598794381262
	0.13598841039594017
	0.7558522371615436)

view raw test for Combination.rkt hosted with ❤ by GitHub

おお、上手く動いてるようですね。
例えば乱数列の100番目、1000番目、10000番目はそれぞれ

	> (stream-ref s 100)
	0.07967177768510994
	> (stream-ref s 1000)
	0.9014158012565428
	> (stream-ref s 10000)
	0.1110427223837204

view raw test for Combination 2.rkt hosted with ❤ by GitHub

となります。
おお、面白い(笑)。これで(基本的に)実装は完了です。

ソースコード

最後に各パーツを局所手続き化して全コードをまとめます。

	#lang racket

	(require srfi/41)

	;; 32-bits Random number generator U(0,1): MRG32k3a
	;; Author: Pierre L'Ecuyer,
	;; Source: Good Parameter Sets for Combined Multiple Recursive Random
	;; Number Generators,
	;; Shorter version in Operations Research,
	;; 47, 1 (1999), 159--164.
	;; Ported to Scheme by Cametan
	;; ---------------------------------------------------------

	(define (make-MRG32k3a)
	(let ((norm 2.328306549295728e-10)
	(m1 4294967087.0)
	(m2 4294944443.0)
	(a12 1403580.0)
	(a13n 810728.0)
	(a21 527612.0)
	(a23n 1370589.0)


	(SEED 12345))

	(letrec ((stream1
	(lambda (s10 s11 s12)
	(stream-cons s10 (stream1 s11 s12 (Component1 s10 s11)))))

	(Component1
	(lambda (s10 s11)
	(let ((p1 (modulo (- (* a12 s11) (* a13n s10)) m1)))
	(if (negative? p1)
	(+ p1 m1)
	p1))))

	(stream2
	(lambda (s20 s21 s22)
	(stream-cons s20 (stream2 s21 s22 (Component2 s20 s22)))))

	(Component2
	(lambda (s20 s22)
	(let ((p2 (modulo (- (* a21 s22) (* a23n s20)) m2)))
	(if (negative? p2)
	(+ p2 m2)
	p2))))

	(Combination
	(lambda (stream1 stream2)
	(let ((stream1 (stream-cdr (stream-cdr (stream-cdr stream1))))
	(stream2 (stream-cdr (stream-cdr (stream-cdr stream2)))))
	(stream-map (lambda (p1 p2)
	(* (- p1 (if (<= p1 p2)
	(- p2 m1)
	p2)) norm))
	stream1 stream2)))))

	(Combination (stream1 SEED SEED SEED)
	(stream2 SEED SEED SEED)))))

view raw make-MRG32k3a.rkt hosted with ❤ by GitHub

2015年2月26日木曜日

言語処理系とは: 補題

うーん、昨日やってた簡単なインタプリタ/コンパイラ作成ですが、気になってた再帰部分を末尾再帰に書き換えられるのか、ってやってみたんですが、上手く行かなかったですね。
継続受け渡しで書き換えると形式的には末尾再帰になるんですが、最適化はされなさそうです。
あと、コンパイラのコードもちょっとムダな部分があったんで、より関数プログラミングっぽく書きなおしてみました。

	#lang racket

	(require srfi/1)

	;;; 字句解析を行う関数 getToken

	(define (getToken)
	(let again ((n 0) (c (read-char)))
	(case c
	((#\+) (values n 'PLUS_OP))
	((#\-) (values n 'MINUS_OP))
	((#\newline #\return) (values n 'EOL))
	((#\space) (again n (read-char)))
	(else
	(if (char-numeric? c)
	(letrec ((proc
	(lambda (n c)
	(+ (* n 10)
	(apply - (map char->integer `(,c #\0)))))))
	(let loop ((n (proc n c)) (c (peek-char)))
	(if (char-numeric? c)
	(let ((c (read-char)))
	(loop (proc n c) (peek-char)))
	(values n 'NUM))))
	(error "bad char '~a'" c))))))

	;;; 構文木を作るプログラム
	(define (readExpr tokenVal currentToken)
	(let ast ((e (readNum tokenVal currentToken)))
	(let-values (((tokenVal currentToken) (getToken)))
	(if (or (eq? currentToken 'PLUS_OP) (eq? currentToken 'MINUS_OP))
	(ast
	(alist-cons 'right (let-values (((v t) (getToken)))
	(readNum v t))
	(alist-cons 'left e
	(alist-cons 'op currentToken '()))))
	e))))

	(define (readNum tokenVal currentToken)
	(let ((e '()))
	(if (eq? currentToken 'NUM)
	(alist-cons 'val tokenVal (alist-cons 'op 'NUM e))
	(error "bad expression: NUM expected\n"))))

	;;; 解釈実行: インタプリタ

	;(define (evalExpr e)
	; (case (cdr (assq 'op e))
	; ((NUM) (cdr (assq 'val e)))
	; ((PLUS_OP) (+ (evalExpr (cdr (assq 'left e)))
	; (evalExpr (cdr (assq 'right e)))))
	; ((MINUS_OP) (- (evalExpr (cdr (assq 'left e)))
	; (evalExpr (cdr (assq 'right e)))))
	; (else (error "evalExpr: bad expression\n"))))

	;; 普通の末尾再帰にはならない
	(define (evalExpr e cont)
	(case (cdr (assq 'op e))
	((NUM) (cont (cdr (assq 'val e))))
	((PLUS_OP) (evalExpr (cdr (assq 'right e))
	(lambda (v)
	(evalExpr (cdr (assq 'left e))
	(lambda (u)
	(cont (+ u v)))))))
	((MINUS_OP) (evalExpr (cdr (assq 'right e))
	(lambda (v)
	(evalExpr (cdr (assq 'left e))
	(lambda (u)
	(cont (- u v)))))))
	(else (error "evalExpr: bad expression\n"))))

	;;; main プログラム

	;(define (main)
	; (let-values (((tokenVal currentToken) (getToken)))
	; (let ((e (readExpr tokenVal currentToken)))
	; (display (evalExpr e)))))

	(define (main)
	(let-values (((tokenVal currentToken) (getToken)))
	(let ((e (readExpr tokenVal currentToken)))
	(evalExpr e display))))

view raw interpreter.rkt hosted with ❤ by GitHub

	#lang racket

	(require srfi/1)

	;;; 字句解析を行う関数 getToken

	(define (getToken)
	(let again ((n 0) (c (read-char)))
	(case c
	((#\+) (values n 'PLUS_OP))
	((#\-) (values n 'MINUS_OP))
	((#\newline #\return) (values n 'EOL))
	((#\space) (again n (read-char)))
	(else
	(if (char-numeric? c)
	(letrec ((proc
	(lambda (n c)
	(+ (* n 10)
	(apply - (map char->integer `(,c #\0)))))))
	(let loop ((n (proc n c)) (c (peek-char)))
	(if (char-numeric? c)
	(let ((c (read-char)))
	(loop (proc n c) (peek-char)))
	(values n 'NUM))))
	(error "bad char '~a'" c))))))

	;;; 構文木を作るプログラム
	(define (readExpr tokenVal currentToken)
	(let ast ((e (readNum tokenVal currentToken)))
	(let-values (((tokenVal currentToken) (getToken)))
	(if (or (eq? currentToken 'PLUS_OP) (eq? currentToken 'MINUS_OP))
	(ast
	(alist-cons 'right (let-values (((v t) (getToken)))
	(readNum v t))
	(alist-cons 'left e
	(alist-cons 'op currentToken '()))))
	e))))

	(define (readNum tokenVal currentToken)
	(let ((e '()))
	(if (eq? currentToken 'NUM)
	(alist-cons 'val tokenVal (alist-cons 'op 'NUM e))
	(error "bad expression: NUM expected\n"))))

	;;; コンパイラ
	(define (compileExpr e)
	(list->vector (reverse (Codes e '() values))))

	;(define (Codes e nCode)
	; (case (cdr (assq 'op e))
	; ((NUM) (cons `((opcode . PUSH)
	; (operand ,@(cdr (assq 'val e)))) nCode))
	; ((PLUS_OP) (cons '((opcode . ADD))
	; (Codes (cdr (assq 'right e))
	; (Codes (cdr (assq 'left e)) nCode))))
	; ((MINUS_OP) (cons '((opcode . SUB))
	; (Codes (cdr (assq 'right e))
	; (Codes (cdr (assq 'left e)) nCode))))))

	;; 普通の末尾再帰にはならない
	(define (Codes e nCode cont)
	(case (cdr (assq 'op e))
	((NUM) (cont (cons `((opcode . PUSH)
	(operand ,@(cdr (assq 'val e)))) nCode)))
	((PLUS_OP) (Codes (cdr (assq 'left e)) nCode
	(lambda (v)
	(Codes (cdr (assq 'right e)) v
	(lambda (u)
	(cont (cons '((opcode . ADD)) u)))))))
	((MINUS_OP) (Codes (cdr (assq 'left e)) nCode
	(lambda (v)
	(Codes (cdr (assq 'right e)) v
	(lambda (u)
	(cont (cons '((opcode . SUB)) u)))))))))

	;;; コード生成。
	;;; スタックマシンのコードを Scheme になおして出力する。

	;(define (codeGen Codes)
	; ; この辺で、今回のスタックマシンに必要な基本関数を文字列として定義する。
	; (let ((template "(define (push n stack)\n (cons n stack))\n
	;(define (pop stack)\n (values (car stack) (cdr stack)))\n
	;(define-syntax define-alu\n (syntax-rules ()\n ((_ name sym)\n (define (name stack)\n (let-values (((b stack) (pop stack)))\n (let-values (((a stack) (pop stack)))\n (push (sym a b) stack)))))))\n
	;(define-alu add +)\n
	;(define-alu sub -)\n
	;(define (print stack)\n (let-values (((a stack) (pop stack)))\n (display a)\n (newline)\n stack))\n\n")
	; (nCode (vector-length Codes))) ; 入力されたコードの長さ
	; ;; ここの手続き(proc)はインデントの為で実は必須ではない。
	; (letrec ((proc
	; (lambda (x . y)
	; (let ((z (* 2 x)))
	; (make-string (if (null? y)
	; z
	; (+ z (car y))) #\space)))))
	; ;; 関数本体。
	; ;; Scheme のコードを文字列として組み立てる。
	; (let loop ((i 0) (n nCode) (str (string-append (proc nCode 5) "'()")))
	; (if (= i nCode)
	; (display (string-append template
	; "(define (main)\n"
	; str
	; ")\n"))
	; (case (cdr (assq 'opcode (vector-ref Codes i)))
	; ((PUSH) (loop (+ i 1) (- n 1)
	; (string-append (proc n)
	; "(push "
	; (number->string
	; (cdr
	; (assq 'operand
	; (vector-ref Codes i))))
	; " \n" str ")")))
	; ((ADD) (loop (+ i 1) (- n 1)
	; (string-append (proc n)
	; "(add \n"
	; str
	; ")")))
	; ((SUB) (loop (+ i 1) (- n 1)
	; (string-append (proc n)
	; "(sub \n"
	; str
	; ")")))
	; ((PRINT) (loop (+ i 1) (- n 1)
	; (string-append (proc n)
	; "(print \n"
	; str
	; ")")))))))))

	(define (codeGen Codes)
	; この辺で、今回のスタックマシンに必要な基本関数を文字列として定義する。
	(let ((template "(define (push n stack)\n (cons n stack))\n
	(define (pop stack)\n (values (car stack) (cdr stack)))\n
	(define-syntax define-alu\n (syntax-rules ()\n ((_ name sym)\n (define (name stack)\n (let-values (((b stack) (pop stack)))\n (let-values (((a stack) (pop stack)))\n (push (sym a b) stack)))))))\n
	(define-alu add +)\n
	(define-alu sub -)\n
	(define (print stack)\n (let-values (((a stack) (pop stack)))\n (display a)\n (newline)\n stack))\n\n")
	(nCode (vector-length Codes))) ; 入力されたコードの長さ
	;; ここの手続き(proc)はインデントの為で実は必須ではない。
	(letrec ((proc
	(lambda (x . y)
	(let ((z (* 2 x)))
	(make-string (if (null? y)
	z
	(+ z (car y))) #\space)))))
	;; 関数本体。
	;; Scheme のコードを文字列として組み立てる。
	(let loop ((i 0) (n nCode) (str (string-append (proc nCode 5) "'()")))
	(if (= i nCode)
	(display (string-append template
	"(define (main)\n"
	str
	")\n"))
	(loop (+ i 1) (- n 1)
	(string-append (proc n)
	(case (cdr (assq 'opcode (vector-ref Codes i)))
	((PUSH) (string-append "(push "
	(number->string
	(cdr
	(assq 'operand
	(vector-ref Codes i))))
	"\n"))
	((ADD) "(add \n")
	((SUB) "(sub \n")
	((PRINT) "(print \n"))
	str
	")")))))))


	;;; main プロシージャ
	(define (main)
	(let-values (((v t) (getToken)))
	(let ((e (readExpr v t)))
	(let ((Codes (vector-append (compileExpr e) #(((opcode . PRINT))))))
	(codeGen Codes)))))

view raw compiler.rkt hosted with ❤ by GitHub

さて、lexと格闘、です。

2015年2月25日水曜日

言語処理系とは

さて、ここ数日、ハードウェアの動作を勉強しようと思って、このページを参考にしててちょこちょこプログラムをSchemeで書く為に格闘してました。
いやぁ、なかなかC言語を読むのが難しくて手こずってたんですが、ある程度カタチになったんで、メモ代わりに。

しっかし、Cのプログラム見てると、大域変数使いまくりで、破壊的変更ありーの、ポインタなんて出てきた日にゃあ何やってんだか一発で分からんし、ホント困ったもんですよ。
例によって、関数プログラミング的に解題していきたいと思います。

インタプリタとコンパイラ

言語処理系とは、プログラミング言語で記述されたプログラムを計算機上で実行するためのソフトウエアである。そのための構成として、大別して２つの構成方法がある。

インタープリター（interpreter,翻訳系）：言語の意味を解析しながら、その意味する動作を実行する。

コンパイラ（compiler,通訳系）：言語を他の言語に変換し、その言語のプログラムを計算機上で実行させるもの。狭い意味でコンパイラは、言語を機械語に変換し、実行するものであるが、他の言語、あるいは仮想機械コードに変換するものもコンパイラと呼ぶ。他の言語に変換するときには、特に translatorと呼ぶ場合もある。

元のプログラムをソースプログラム、翻訳の結果と得られるプログラムをオブジェクトプログラムと呼ぶ。機械語で直接、計算機上で実行できるプログラムを実行プログラムと呼ぶ。オブジェクトプログラムがアセンブリプログラムの場合には、アセンブラにより機械語に翻訳されて、実行プログラムを得る。他の言語の場合には、オブジェクトプログラムの言語のコンパイラでコンパイルすることにより、実行プログラムが得られる。仮想マシンコードの場合には、オブジェクトコードはその仮想マシンにより、インタプリトされて実行される。

はい、左様でやんすね。

言語処理系の基本構成

コンパイラにしてもインタプリターにしても、その構成は多くの共通部分を持つ。すなわち、ソースプログラムの言語の意味を解釈する部分は共通である。インタプリターは、解釈した意味の動作をその場で実行するのに対し、コンパイラではその意味の動作を行うコードを出力する。
言語処理系は、大きく分けて、次のような部分からなる。

字句解析(lexical analysis): 文字列を言語の要素（トークン、token）の列に分解する。

構文解析(syntax analysis): token列を意味を反映した構造に変換。この構造は、しばしば、木構造で表現されるので、抽象構文木（abstract syntax tree）と呼ばれる。ここまでの言語を認識する部分を言語のparserと呼ぶ。

意味解析(semantics analysis): 構文木の意味を解析する。インタプリターでは、ここで意味を解析し、それに対応した動作を行う。コンパイラでは、この段階で内部的なコード、中間コードに変換する。

最適化(code optimization): 中間コードを変形して、効率のよいプログラムに変換する。

コード生成(code generation): 内部コードをオブジェクトプログラムの言語に変換し、出力する。例えば、ここで、中間コードよりターゲットの計算機のアセンブリ言語に変換する。

コンパイラの性能とは、如何に効率のよいオブジェクトコードを出力できるかであり、最適化でどのような変換ができるかによる。インタープリタでは、プログラムを実行するたびに、字句解析、構文解析を行うために、実行速度はコンパイラの方が高速である。もちろん、機械語に翻訳するコンパイラの場合には直接機械語で実行されるために高速であるが、コンパイラでは中間コードでやるべき操作の全体を解析することができるため、高速化が可能である。
また、中間言語として、都合のよい中間コードを用いると、いろいろな言語から中間言語への変換プログラムを作ることで、それぞれの言語に対応したコンパイラを作ることができる。

まず、元々はその、字句解析と構文解析をどうやるんだ、ってのの疑問からスタートしたわけですが。
まあ、続けてやっていきましょうか。

例題: 式の評価

さて、例として最も簡単な数式の評価について、インタプリターとコンパイラを作ってみることにする。目的は，
12 + 3 - 4
の式の入力に対し、この式を計算し、
11
と出力するプログラムを作ることである。これは、式という「プログラミング言語」を処理する言語処理系である。「式」という言語では、tokenとして、数字と"+"や"-"といった演算子がある。
まずは、字句解析ではこれらのトークンを認識する。例えば、上の例では、

１２の数字、＋の演算子、３の数字、－の演算子、４の数字、終わり
という列に変換する。
tokenは、tokenの種類と12の数字という場合の12の値の2つの組で表される。以下にtokenの種類を定義するexprParser.hを示す。

とまあ、ここでCで書かれたソースが示されるんですが、色々やってみた結果、こういうヘッダファイルで定義される #define マクロなんかはSchemeじゃ要らねぇな、ってのが分かりました。最初はCコードに則ってやってこう、って思ったんですが、どうも具合が良くないんでオミットです。何せ、Lisp系言語だとシンボルがそのまま使えるんでこういう「Cっぽい」定義は要らないですね。

字句解析を行う関数getTokenを示す。

さあて、これがまず最初凄くツマッてたトコなんですよね～。まず、ungetcって何だ?とか思って(笑)。
良く分からんC言語の関数で、調べてみると次のような事が書いてある。

読み込んだ文字を1文字押し戻すとは、どういう事なんだ？というわけですが、

戻すには ungetc()を使用します。

読み込んだ文字とは、、ファイル読み込みや、キーボードからの入力などの
ストリームと呼ばれるものから読み込んだ文字です。
その文字を、fgetc()や、getchar()などで読み込んだ後、
またもう1度ストリームに戻してしまう、というのが ungetc()の処理です。

うそぉん、ストリームから取ってきた文字をまたストリームに戻せるんかい、とか思って(笑)。さすがC言語(苦笑)。
あっれぇ、Schemeにはread-charに対してunread-charなんてあっただろうか、と困ってたわけですね(笑)。当然無いですがね(苦笑)。
そんな時にSagittarius Schemeの作者の人から助け舟が。

@cametan_001 peek-charで足りないんですか？
— Kei (@tk_riple) February 23, 2015

あ、そう、こういう時peek-charを使うんだ、って今回初めて知った次第です(笑)。ダメじゃん(笑)。
仕様書見ても良く分かんなかったもんな～。

[[手続き]] (peek-char)
[[手続き]] (peek-char port)
入力ポートportから取り出すことができる次の文字を返すが、次の文字を指し示す様なポートの更新は行なわれない(ポート内の位置は変わらない)。取り出す文字が存在しなかった場合はファイル終りオブジェクトが返される。port引数は省略でき、その場合のデフォルトはcurrent-input-portが返す値である。
注: peek-charの呼び出しで返される値は、同じポートに対するread-charの呼び出しで返される値と同じものである。唯一の違いは、ポートに対する直後のread-char呼び出しもしくはpeek-char呼び出しで、直前のpeek-char呼び出しで返された値が返されるという点である。特に対話型ポートに対してpeek-charを呼び出した場合、入力を待ち続けてread-charがハングする時には、peek-charも必ずハングすることになる。

わりぃ、ホンマ、何言ってるんだかサッパリ分からん(苦笑)。
まあ、要するにこういう事らしいです。ストリームに例えば、"1 2 3 4 5"ってあった場合、read-charは"1"を取ってきたあとストリームを"2 3 4 5"に更新するけど、peek-charの場合は"1 2 3 4 5"から"1"を取ってもストリームを"1 2 3 4 5"のままに置いておくそうです。
まあ、敢えて言うと、こういう入出力系ってインタプリタで試しづらいんですよね。read-charだとまだいいんですが、peek-charだと無限ループみたいな事になって、何だか良く分からん事になります。

	> (read-char)
	'hoge
	#\'
	> (read-char)
	#\h
	> (read-char)
	#\o
	> (read-char)
	#\g
	> (read-char)
	#\e
	> (read-char)
	#\newline
	> (peek-char)
	'hoge
	#\'
	> (peek-char)
	#\'
	> (peek-char)
	#\'
	> (peek-char)
	#\'
	> (peek-char)
	#\'
	> (peek-char)
	#\'
	>

view raw peek-char-test.rkt hosted with ❤ by GitHub

インタプリタ上のReaderで'hogeと入力すると、ストリームに'hogeが入って、次からread-charを呼び出すと、ストリームに残ってた文字が一字づつ出力されていきます。
一方、peek-charの場合、ポートが更新されないんで永遠に一文字目の#\'がずーっと出力され続けますね。これを解除するにはもう一度read-charを呼んでポートを更新しないといけません。

これさえ分かればCのソースをSchemeで書きなおすのは簡単です。

	;;; 字句解析を行う関数 getToken

	(define (getToken)
	(let again ((n 0) (c (read-char)))
	(case c
	((#\+) (values n 'PLUS_OP))
	((#\-) (values n 'MINUS_OP))
	((#\newline #\return) (values n 'EOL))
	((#\space) (again n (read-char)))
	(else
	(if (char-numeric? c)
	(letrec ((proc
	(lambda (n c)
	(+ (* n 10)
	(apply - (map char->integer `(,c #\0)))))))
	(let loop ((n (proc n c)) (c (peek-char)))
	(if (char-numeric? c)
	(let ((c (read-char)))
	(loop (proc n c) (peek-char)))
	(values n 'NUM))))
	(error "bad char '~a'" c))))))

view raw getToken.rkt hosted with ❤ by GitHub

Scheme版では、exprParser.hで大域変数として定義されてたtokenValとcurrentTokenの2つをgetTokenプロシージャ内部から多値で返すようにしています。わざわざ大域変数として定義して破壊的に変更するのも嫌ですしね。

この関数は、字句を読み込み、currentTokenにtokenの種類、NUMの場合に tokenValに値を返す。

だから、Scheme版は本当に値を返してますが、オリジナルのCコードは返してませんね。大域変数を書き換えてるわけで、副作用目的の、要するに「手続き」がこのC版getTokenの正体です。大体、関数の型がvoidですしね。
Scheme版getTokenの動作は次のようになります。

	> (getToken)
	12 + 3 - 4
	12
	'NUM
	> (getToken)
	0
	'PLUS_OP
	> (getToken)
	3
	'NUM
	> (getToken)
	0
	'MINUS_OP
	> (getToken)
	4
	'NUM
	> (getToken)
	0
	'EOL

view raw getToken.rkt hosted with ❤ by GitHub

"12 + 3 - 4"と言う入力を分解して、要素が数値の場合はtokenValとしてその値を返し(数値じゃない場合は0)、それとそのtokenValの「情報」をcurrentTokenとして返します。
こういうテストがC言語だとやりづらいトコロです(main関数が無い状態だとどう動作してるんだか分かったモンじゃないし、要コンパイルなのが自明です)。

BNFと構文木

では、この「式」というプログラミング言語の構文とはどのようなものであろうか。例えば、次のような規則が構文である。
　　足し算の式　:=  式　＋の演算子　式
　　引き算の式　:=  式　－の演算子　式
　　式　:= 数字　|  足し算の式 ｜　引き算の式
このような記述を、BNF (Backus Naur Form または Buckus Normal Form) という。
このような構造を反映するデータ構造を作るのが、構文解析である。図に示す。

構文解析のデータ構造は、以下のような構造体を作る。これをexprParser.hに定義しておく。

さて、ここでまた悩んだんですよね～。Schemeでもrecord-typeを使って構造体で作るべきか?
大体、構造体絡むと破壊的変更が避けられなくなったりするんですよねぇ。しかもCのコード見ると、何だか循環参照のように見えるし・・・(実は違うそうですが)。
結局、わざわざ構造体で構文木を定義するのは止めました。これはリストを持たない貧弱なCだから必要なんであって、SchemeなんかのLisp系言語では必要ない。要するに直接構文木(らしきもの)をリストを使って直接生成してやれば良い、って事です。
つまり、例えば上のような

[12の数字] [+演算子] [3の数字] [4の数字] [-演算子] [終わり]

と言うトークン列に対して

'([-演算子] ([+演算子] [12の数字] [3の数字]) [4の数字])

みたいなリストを生成して返してやれば良い、って事です。しかも、連想リストを生成するようにしてみます。

この構文木を作るプログラムが、readExpr.cである。このプログラムでは、exprParser.hで定義されているASTを使って、構文木を作っている。このデータ構造は式の場合は、演算子とその左辺の式と右辺の式を持つ。数字の場合はこれらを使わずに値のみを格納する。tokenを読むたびに、データ構造を作っている。

ASTは定義しない事にしましたが、tokenを読むたびにデータ構造を作り出して、構文木のデータ構造を作って返すのはLispではお手の物です。次が等価のScheme版readExprです。

	;;; 構文木を作るプログラム
	(define (readExpr tokenVal currentToken)
	(let ast ((e (readNum tokenVal currentToken)))
	(let-values (((tokenVal currentToken) (getToken)))
	(if (or (eq? currentToken 'PLUS_OP) (eq? currentToken 'MINUS_OP))
	(ast
	(alist-cons 'right (let-values (((v t) (getToken)))
	(readNum v t))
	(alist-cons 'left e
	(alist-cons 'op currentToken '()))))
	e))))

	(define (readNum tokenVal currentToken)
	(let ((e '()))
	(if (eq? currentToken 'NUM)
	(alist-cons 'val tokenVal (alist-cons 'op 'NUM e))
	(error "bad expression: NUM expected\n"))))

view raw readExpr.rkt hosted with ❤ by GitHub

オリジナルのコードだと、大域変数がgetToken呼び出す度に書き換えられてて、その破壊的変更をアテにするプログラミングな為、これを関数プログラミングで再現するにはどうすりゃエエんだ、ってんで結構悩んだんですよねぇ。本当だったらもっと綺麗に書けたんじゃねぇの、って若干心残りがあるんですが、一応オリジナルのロジックを出来るだけ尊重するようにはしてみました。
また、オリジナル版だと、破壊的変更前提の無引数の手続きなんですが、Scheme版だと、やっぱりtokenValとcurrentTokenを受け取るプロシージャにしています。
では、動作を見てみます。

	> (let-values (((tokenVal currentToken) (getToken)))
	(readExpr tokenVal currentToken))
	12 + 3 - 4
	'((right (val . 4) (op . NUM))
	(left
	(right (val . 3) (op . NUM))
	(left (val . 12) (op . NUM))
	(op . PLUS_OP))
	(op . MINUS_OP))

view raw readExpr-test.rkt hosted with ❤ by GitHub

さっきの設計と真逆になってるように見えますが、これで良いのです。そもそも、連想リストだと順序には意味がありません。
基本的な構文構造を表現する連想リスト(構文木リスト = AST)は

'((op . currentToken) (val . tokenVal) (left . 左の枝) (right . 右の枝))

となっていて、valは数値の時にしか生成されず、また、leftやrightの中も再帰的にASTが収まっていきます。

解釈実行: インタプリター

この構文木を解釈して実行する、すなわちインタプリターをつくってみることにする。その動作は、

式が数字であれば、その数字を返す。

式が演算子を持つ演算式であれば、左辺と右辺を解釈実行した結果を、演算子の演算を行い、その値を返す。

このプログラムがevalExpr.cである。 evalExpr.cは、構文木ASTを解釈して、解釈する。

数字のASTつまり、opがNUMであれば、その値を返す。

演算式であれば、左辺を評価した値と右辺を評価した値をopに格納されている演算子にしたがって、計算を行う。

これらは再帰的に呼び出しが行われていることに注意しよう。

まあ、今までも何度かインタプリタは書いてきましたが、構文木を使って、ってのは初めてですね。

	;;; 解釈実行: インタプリタ

	(define (evalExpr e)
	(case (cdr (assq 'op e))
	((NUM) (cdr (assq 'val e)))
	((PLUS_OP) (+ (evalExpr (cdr (assq 'left e)))
	(evalExpr (cdr (assq 'right e)))))
	((MINUS_OP) (- (evalExpr (cdr (assq 'left e)))
	(evalExpr (cdr (assq 'right e)))))
	(else (error "evalExpr: bad expression\n"))))

view raw evalExpr.rkt hosted with ❤ by GitHub

構造はほぼオリジナルのコードと同じです。特に手を加えてはいません。
しっかし、ひっさしぶりに末尾再帰じゃない再帰コード書いたんで気持ち悪いですね(笑)。オリジナルのC版も、これじゃあ大して効率良く無いんじゃないでしょうか。あー、そうか、コンパイラ書く為の前フリか(笑)。
evalExprの動作テストは以下の通り。

	> (let-values (((tokenVal currentToken) (getToken)))
	(let ((e (readExpr tokenVal currentToken)))
	(evalExpr e)))
	12 + 3 - 4
	11

view raw evalExpr-test.rkt hosted with ❤ by GitHub

キチンと計算されてますね。

mainプログラムでは、関数readExprを呼び、構文木を作り、それを関数 evalExprで解釈実行して、その結果を出力する。これが、インタプリターである。先のプログラムと大きく違うのは、式の意味を表す構文木が内部に生成されていることである。この構文木の意味を解釈するのがインタプリターである。 (readExprでは１つだけ先読みが必要であるので、getTokenを呼び出している)

うーん、正直、なんで

if(currentToken != EOL){

 printf("error: EOL expected\n");
 exit(1);
    }

なんてのがあるんだか分からないですね。これねぇ方が動くんだけど・・・。
まあいいや、上記のコード部分を除いてSchemeで書いたmainプロシージャが次になります。

	;;; main プログラム

	(define (main)
	(let-values (((tokenVal currentToken) (getToken)))
	(let ((e (readExpr tokenVal currentToken)))
	(display (evalExpr e)))))

view raw main.rkt hosted with ❤ by GitHub

さっき書いたテストまんまそのまんまですね。
では動作確認です。

	> (main)
	12 + 3 - 4
	11

view raw main-test.rkt hosted with ❤ by GitHub

完璧ですね。
ではScheme版インタプリタのソースコード全容を。

	#lang racket

	(require srfi/1)

	;;; 字句解析を行う関数 getToken

	(define (getToken)
	(let again ((n 0) (c (read-char)))
	(case c
	((#\+) (values n 'PLUS_OP))
	((#\-) (values n 'MINUS_OP))
	((#\newline #\return) (values n 'EOL))
	((#\space) (again n (read-char)))
	(else
	(if (char-numeric? c)
	(letrec ((proc
	(lambda (n c)
	(+ (* n 10)
	(apply - (map char->integer `(,c #\0)))))))
	(let loop ((n (proc n c)) (c (peek-char)))
	(if (char-numeric? c)
	(let ((c (read-char)))
	(loop (proc n c) (peek-char)))
	(values n 'NUM))))
	(error "bad char '~a'" c))))))

	;;; 構文木を作るプログラム
	(define (readExpr tokenVal currentToken)
	(let ast ((e (readNum tokenVal currentToken)))
	(let-values (((tokenVal currentToken) (getToken)))
	(if (or (eq? currentToken 'PLUS_OP) (eq? currentToken 'MINUS_OP))
	(ast
	(alist-cons 'right (let-values (((v t) (getToken)))
	(readNum v t))
	(alist-cons 'left e
	(alist-cons 'op currentToken '()))))
	e))))

	(define (readNum tokenVal currentToken)
	(let ((e '()))
	(if (eq? currentToken 'NUM)
	(alist-cons 'val tokenVal (alist-cons 'op 'NUM e))
	(error "bad expression: NUM expected\n"))))

	;;; 解釈実行: インタプリタ

	(define (evalExpr e)
	(case (cdr (assq 'op e))
	((NUM) (cdr (assq 'val e)))
	((PLUS_OP) (+ (evalExpr (cdr (assq 'left e)))
	(evalExpr (cdr (assq 'right e)))))
	((MINUS_OP) (- (evalExpr (cdr (assq 'left e)))
	(evalExpr (cdr (assq 'right e)))))
	(else (error "evalExpr: bad expression\n"))))

	;;; main プログラム

	(define (main)
	(let-values (((tokenVal currentToken) (getToken)))
	(let ((e (readExpr tokenVal currentToken)))
	(display (evalExpr e)))))

view raw interpreter.rkt hosted with ❤ by GitHub

では、次はいよいよコンパイラ、です。

コンパイラとは

次にコンパイラをつくってみる。コンパイラとは、解釈実行する代わりに、実行すべきコード列に変換するプログラムである。実行すべきコード列は、通常、アセンブリ言語（機械語）であるが、そのほかのコードでもよい。中間コードとして、スタックマシンのコードを仮定することにする。スタックマシンは以下のコードを持つことにする。

PUSH n ：　数字nをスタックにpushする。

ADD ：　スタックの上２つの値をpopし、それらを加算した結果をpushする。

SUB : スタックの上２つの値をpopし、減算を行い、pushする。

PRINT: スタックの値をpopし、出力する。

コンパイラは、このスタックマシンのコードを使って、式を実行するコード列を作る。例えば、図で示した例の式12+3-4は下のようなコードになる。
  PUSH 12
  PUSH 3
  ADD
  PUSH 4
  SUB 
  PRINT
スタックマシンでの実行は以下のように行われる。

stackCode.hには、コードとその列を格納する領域を定義してある。

	#define PUSH 0
	#define ADD 1
	#define SUB 2
	#define PRINT 3

	#define MAX_CODE 100

	typedef struct _code {
	int opcode;
	int operand;
	} Code;

	extern Code Codes[MAX_CODE];
	extern int nCode;

view raw stackCode.h hosted with ❤ by GitHub

この辺の定義もSchemeには要らないですね。シンボルとリストで凌ぎましょう。

コンパイルの手順は、以下のようになる。

式が数字であれば、その数字をpushするコードを出す。

式が演算であれば、左辺と右辺をコンパイルし、それぞれの結果をスタックにつむコードを出す。その後、演算子に対応したスタックマシンのコードを出す。

式のコンパイルしたら、PRINTのコードを出しておく。

この中間コードを生成するのが、compileExpr.cである。構文木を入力して、再帰的に上のアルゴリズムを実行する。コードはCodesという配列に格納しておく。

さて、compileExprですが、Scheme版では2つに分けました。

	;;; コンパイラ
	(define (compileExpr e)
	(list->vector (reverse (Codes e '()))))

	(define (Codes e nCode)
	(case (cdr (assq 'op e))
	((NUM) (cons `((opcode . PUSH)
	(operand ,@(cdr (assq 'val e)))) nCode))
	((PLUS_OP) (cons '((opcode . ADD))
	(Codes (cdr (assq 'right e))
	(Codes (cdr (assq 'left e)) nCode))))
	((MINUS_OP) (cons '((opcode . SUB))
	(Codes (cdr (assq 'right e))
	(Codes (cdr (assq 'left e)) nCode))))))

view raw compileExpr.rkt hosted with ❤ by GitHub

一つは構文木を受け取って、上のロジックに従って命令のリストを生成するCodes、もう一つは構文木を受け取ってCodesを呼び出し、結果のリストを反転させた後、vector(Cで言う配列にあたる)に変換するcompileExprです。
ちなみに、Codesが全体的に生成するのは、見た目は連想リストですが、連想リストではありません。と言うのも、今回生成するのはアセンブリ的なリストなんで「順序が重要」だからです。連想リストはハッシュ的に順序は重要じゃないんで、リストとして順序を保持したままベクタへ変換する必要性があるから、です(ただし、要素は連想リストです)。
では動作テストです。

	> (define e (let-values (((tokenVal currentToken) (getToken)))
	(readExpr tokenVal currentToken)))
	12 + 3 - 4
	> e
	'((right (val . 4) (op . NUM))
	(left
	(right (val . 3) (op . NUM))
	(left (val . 12) (op . NUM))
	(op . PLUS_OP))
	(op . MINUS_OP))
	> (Codes e '())
	'(((opcode . SUB))
	((opcode . PUSH) (operand . 4))
	((opcode . ADD))
	((opcode . PUSH) (operand . 3))
	((opcode . PUSH) (operand . 12)))
	> (compileExpr e)
	'#(((opcode . PUSH) (operand . 12))
	((opcode . PUSH) (operand . 3))
	((opcode . ADD))
	((opcode . PUSH) (operand . 4))
	((opcode . SUB)))

view raw compileExpr-test.rkt hosted with ❤ by GitHub

見て分かる通り、"12 + 3 - 4"と言う入力が、opcodeとoperandと言う2つのキーを持つ、連想リストを5要素としたベクタ(配列)に変換されています。ベクタの番号0～4は結果、実行順序を表してる事になりますね。

コード生成では、ここではスタックマシンのコードをCに直して出力することにしよう。Cで実行させるために、mainにいれておくことにする。このプログラムが、codeGen.cである。

Cで書いてきたのにCで出力する、なんつーのはバカっぽいな、とか思ったんですが(笑)、郷に入りては郷に従え、でSchemeで書いてきたのにSchemeで出力します(爆)。
ちなみに、最初は、オリジナルのコードに従って書いてたんですが、上手く動いたのをきっかけにしてもうちょっと欲が出てきたんですね。
元のコードにはいくつかちょっと特徴があります。

スタックマシンが別にあるわけじゃなくって、スタックマシン自体も毎回コンパイルで生成してる。
printfが多用されているが、結果的にCコードである「文字列」を生成してるだけである。従って本来なら、Cコードを生成する文字列をでっち上げるのが実は大半の本質的作業である。

つまり、SchemeでSchemeコードを生成するにせよ

スタックマシン自体を毎回生成してるようなコードを吐いて構わない。
結局文字列を生成、加工するだけで良い

と言う2点が極めて重要なんです。それでスタックマシン用のコードをSchemeのコードとして変換出来るわけです。

それで、もう一つあって、最初はSchemeコードを生成する際、これは大方、破壊的変更を多用した「いわゆる」スタックマシンをSchemeで書いてるように生成すれば良いのかな、って思ってたんですが、生成されるコードも関数プログラミング様式で生成出来ないか、って思い直したわけです。

初め、それは大変なんじゃないか、って思ってたんですが、出力を噛まさずに文字列だけで操作するなら、むしろ再帰と相性が良い、ってのが分かったんですね。

っつーか、Lispなんかの関数プログラミングだと、プログラミングやってる側だと書くのも読むのも大変になるネストの深さになるわけですが、そこはコンパイラ、全く人間の「可読性」関係無く文字列操れるじゃん、ってぇんで書いてみたのが次のコードになります。

	;;; コード生成。
	;;; スタックマシンのコードを Scheme になおして出力する。

	(define (codeGen Codes)
	; この辺で、今回のスタックマシンに必要な基本関数を定義して文字列として出力する。
	(display "(define (push n stack)\n
	(cons n stack))\n
	(define (pop stack)\n
	(values (car stack) (cdr stack)))\n
	(define-syntax define-alu\n
	(syntax-rules ()\n
	((_ name sym)\n
	(define (name stack)\n
	(let-values (((b stack) (pop stack)))\n
	(let-values (((a stack) (pop stack)))\n
	(push (sym a b) stack)))))))\n
	(define-alu add +)\n
	(define-alu sub -)\n
	(define (print stack)\n
	(let-values (((a stack) (pop stack)))\n
	(for-each display `(,a \"\n\"))\n
	stack))\n")
	(let ((nCode (vector-length Codes))) ; 入力されたコードの長さ
	;; ここの手続き(proc)はインデントの為で実は必須ではない。
	(letrec ((proc
	(lambda (n)
	(make-string (* 2 n) #\space))))
	;; 関数本体。
	;; Scheme のコードを文字列として組み立てる。
	(let loop ((i 0) (n nCode) (str "'()"))
	(if (= i nCode)
	(display (string-append "(define (main)\n" str ")\n"))
	(case (cdr (assq 'opcode (vector-ref Codes i)))
	((PUSH) (loop (+ i 1) (- n 1)
	(string-append (proc n)
	"(push "
	(number->string
	(cdr
	(assq 'operand
	(vector-ref Codes i))))
	" \n" str ")")))
	((ADD) (loop (+ i 1) (- n 1)
	(string-append (proc n)
	"(add \n"
	str
	")")))
	((SUB) (loop (+ i 1) (- n 1)
	(string-append (proc n)
	"(sub \n"
	str
	")")))
	((PRINT) (loop (+ i 1) (- n 1)
	(string-append (proc n)
	"(print \n"
	str
	")")))))))))

view raw codeGen.rkt hosted with ❤ by GitHub

ちょっとどういうSchemeコードを生成するのか、見てみましょうか。

	> (define e (let-values (((tokenVal currentToken) (getToken)))
	(readExpr tokenVal currentToken)))
	12 + 3 - 4
	> e
	'((right (val . 4) (op . NUM))
	(left
	(right (val . 3) (op . NUM))
	(left (val . 12) (op . NUM))
	(op . PLUS_OP))
	(op . MINUS_OP))
	> (define code
	(compileExpr e))
	> code
	'#(((opcode . PUSH) (operand . 12))
	((opcode . PUSH) (operand . 3))
	((opcode . ADD))
	((opcode . PUSH) (operand . 4))
	((opcode . SUB)))
	> (codeGen code)
	(define (push n stack)

	(cons n stack))

	(define (pop stack)

	(values (car stack) (cdr stack)))

	(define-syntax define-alu

	(syntax-rules ()

	((_ name sym)

	(define (name stack)

	(let-values (((b stack) (pop stack)))

	(let-values (((a stack) (pop stack)))

	(push (sym a b) stack)))))))

	(define-alu add +)

	(define-alu sub -)

	(define (print stack)

	(let-values (((a stack) (pop stack)))

	(for-each display `(,a "
	"))

	stack))
	(define (main)
	(sub
	(push 4
	(add
	(push 3
	(push 12
	'()))))))
	>

view raw codeGen-test.rkt hosted with ❤ by GitHub

最後の(codeGen code)ってのでSchemeコードを生成するわけですね。
前半の部分は言わばテンプレで、毎回codeGenが呼び出される度に「スタックマシン」を生成します。
実際にcodeGenが毎回生成してるのがmainプロシージャの部分で、結果、

"12 + 3 - 4"

と言う入力が、

(define (main)
  (sub 
    (push 4 
      (add 
        (push 3 
          (push 12 
'()))))))

に書き換えられてて、これはホント、そのまま関数プログラミングでのスタイルです。空リストをスタックに見立てて、内側のプロシージャは外側へと結果を返して、外側のプロシージャはそれを引数として受け取って・・・って連鎖してるわけですね。
ぶっちゃけ、人としてはあまり書きたくないスタイルですが(笑)、コンパイラなら別にへっちゃらで言われた通りに変換していってくれて、実はコード生成は、再帰を使う限り、こっちの方が(この例だと)簡単なんじゃないか、ってカンジです。

コンパイラのmainプログラムであるが、readExprまではインタープリタと同じである。標準出力に出力されるプログラムに適当に名前をつけ（たとえば、 output.c）これをCコンパイラでコンパイルして実行すればよい。（assembler のファイルの場合はasコマンドでコンパイルする。）

そう、displayせずにファイルに書き出せば、要するにコンパイラとして機能する、って事です。これは面白い。

	;;; main プロシージャ
	(define (main)
	(let-values (((v t) (getToken)))
	(let ((e (readExpr v t)))
	(let ((Codes (vector-append (compileExpr e) #(((opcode . PRINT))))))
	(codeGen Codes)))))

view raw main.rkt hosted with ❤ by GitHub

例えば、実験として、次のような式を入力してもガンガン「関数型」のコードに変換してくれます。

	> (main)
	1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10
	(define (push n stack)

	(cons n stack))

	(define (pop stack)

	(values (car stack) (cdr stack)))

	(define-syntax define-alu

	(syntax-rules ()

	((_ name sym)

	(define (name stack)

	(let-values (((b stack) (pop stack)))

	(let-values (((a stack) (pop stack)))

	(push (sym a b) stack)))))))

	(define-alu add +)

	(define-alu sub -)

	(define (print stack)

	(let-values (((a stack) (pop stack)))

	(for-each display `(,a "
	"))

	stack))
	(define (main)
	(print
	(add
	(push 10
	(add
	(push 9
	(add
	(push 8
	(add
	(push 7
	(add
	(push 6
	(add
	(push 5
	(add
	(push 4
	(add
	(push 3
	(add
	(push 2
	(push 1
	'())))))))))))))))))))))

view raw main-test.rkt hosted with ❤ by GitHub

すげぇバカバカしいんですが、面白いです(笑)。なかなか構文解析とかコンパイラ書くのって面白いな、って感動しました。

コンパイラの全ソースコードは次のようなものです。

	#lang racket

	(require srfi/1)

	;;; 字句解析を行う関数 getToken

	(define (getToken)
	(let again ((n 0) (c (read-char)))
	(case c
	((#\+) (values n 'PLUS_OP))
	((#\-) (values n 'MINUS_OP))
	((#\newline #\return) (values n 'EOL))
	((#\space) (again n (read-char)))
	(else
	(if (char-numeric? c)
	(letrec ((proc
	(lambda (n c)
	(+ (* n 10)
	(apply - (map char->integer `(,c #\0)))))))
	(let loop ((n (proc n c)) (c (peek-char)))
	(if (char-numeric? c)
	(let ((c (read-char)))
	(loop (proc n c) (peek-char)))
	(values n 'NUM))))
	(error "bad char '~a'" c))))))

	;;; 構文木を作るプログラム
	(define (readExpr tokenVal currentToken)
	(let ast ((e (readNum tokenVal currentToken)))
	(let-values (((tokenVal currentToken) (getToken)))
	(if (or (eq? currentToken 'PLUS_OP) (eq? currentToken 'MINUS_OP))
	(ast
	(alist-cons 'right (let-values (((v t) (getToken)))
	(readNum v t))
	(alist-cons 'left e
	(alist-cons 'op currentToken '()))))
	e))))

	(define (readNum tokenVal currentToken)
	(let ((e '()))
	(if (eq? currentToken 'NUM)
	(alist-cons 'val tokenVal (alist-cons 'op 'NUM e))
	(error "bad expression: NUM expected\n"))))

	;;; コンパイラ
	(define (compileExpr e)
	(list->vector (reverse (Codes e '()))))

	(define (Codes e nCode)
	(case (cdr (assq 'op e))
	((NUM) (cons `((opcode . PUSH)
	(operand ,@(cdr (assq 'val e)))) nCode))
	((PLUS_OP) (cons '((opcode . ADD))
	(Codes (cdr (assq 'right e))
	(Codes (cdr (assq 'left e)) nCode))))
	((MINUS_OP) (cons '((opcode . SUB))
	(Codes (cdr (assq 'right e))
	(Codes (cdr (assq 'left e)) nCode))))))

	;;; コード生成。
	;;; スタックマシンのコードを Scheme になおして出力する。

	(define (codeGen Codes)
	; この辺で、今回のスタックマシンに必要な基本関数を定義して文字列として出力する。
	(display "(define (push n stack)\n
	(cons n stack))\n
	(define (pop stack)\n
	(values (car stack) (cdr stack)))\n
	(define-syntax define-alu\n
	(syntax-rules ()\n
	((_ name sym)\n
	(define (name stack)\n
	(let-values (((b stack) (pop stack)))\n
	(let-values (((a stack) (pop stack)))\n
	(push (sym a b) stack)))))))\n
	(define-alu add +)\n
	(define-alu sub -)\n
	(define (print stack)\n
	(let-values (((a stack) (pop stack)))\n
	(for-each display `(,a \"\n\"))\n
	stack))\n")
	(let ((nCode (vector-length Codes))) ; 入力されたコードの長さ
	;; ここの手続き(proc)はインデントの為で実は必須ではない。
	(letrec ((proc
	(lambda (n)
	(make-string (* 2 n) #\space))))
	;; 関数本体。
	;; Scheme のコードを文字列として組み立てる。
	(let loop ((i 0) (n nCode) (str "'()"))
	(if (= i nCode)
	(display (string-append "(define (main)\n" str ")\n"))
	(case (cdr (assq 'opcode (vector-ref Codes i)))
	((PUSH) (loop (+ i 1) (- n 1)
	(string-append (proc n)
	"(push "
	(number->string
	(cdr
	(assq 'operand
	(vector-ref Codes i))))
	" \n" str ")")))
	((ADD) (loop (+ i 1) (- n 1)
	(string-append (proc n)
	"(add \n"
	str
	")")))
	((SUB) (loop (+ i 1) (- n 1)
	(string-append (proc n)
	"(sub \n"
	str
	")")))
	((PRINT) (loop (+ i 1) (- n 1)
	(string-append (proc n)
	"(print \n"
	str
	")")))))))))

	;;; main プロシージャ
	(define (main)
	(let-values (((v t) (getToken)))
	(let ((e (readExpr v t)))
	(let ((Codes (vector-append (compileExpr e) #(((opcode . PRINT))))))
	(codeGen Codes)))))

view raw compiler.rkt hosted with ❤ by GitHub

ちょっと暫くこの辺のネタで遊んでみますかね。

2015年2月17日火曜日

Schemeでスタックマシンの基礎

Wizardryってゲームが好きです。

まあ、あまりにも有名なゲームなんで知らない人は多分いないと思うんですが、一応ちょっと解説してみますか。
世界で初めて、商用として成功したRPG(ロールプレイングゲーム)ですね。

注: 良く「世界初のRPG」って記述が成されますが、これは嘘です。実は世界初のRPGはPLATOと言うメインフレームのプラットフォームで作られていて、それは1974年頃の事でした。WizardryはそのPLATOで1977年頃に作られたMMORPG(ビックリするかもしれないけど、ネット時代より遥か以前にMMORPGは既に存在していた!)であるOublietteと言うゲームをApple II上で1人でプレイできるように「改良した」もの、って言って良いです。

さて、このWizardryってのは色々なマシンに移植されてるわけですが。ファミコンみたいなゲーム専用機以外でもザーッと挙げてみると、

Apple II
Apple Macintosh
SHARP MZ-2500
SHARP X1/Turbo
富士通 FM-7
富士通 FM-77
NEC PC-8801
NEC PC-9801
MSX-2
Commodore 64
Commodore 128
IBM-PC

と物凄い数の移植なんですね。

これだと物凄い数のプログラマが物凄く苦労して移植したんじゃないか、って思うでしょう。ところが、メインプログラマのロバート・ウッドヘッド氏の話によると、

「殆ど(80%くらい?)ソースコードは同じなんだ。違うのは画像出力とか、機械によって差があるところだけだね。」

との事です。

当時のゲームプログラムだとBASIC、あるいはスピードが欲しい場合は直接アセンブリでコーディングするのが普通だったらしいんですが、Wizardryの設計の優れたところ、と言うのは、Pascalを使った構造化プログラミングで作ったほぼ最初の商用製品だ、と言うトコロでしょう。完全にシナリオデータとゲーム本体のプログラムを分けているらしく、外国語へのポーティングも必要最小限の労力で行えるように設計されているらしく、恐らく凄く綺麗な「教科書的な」プログラミングの塊なんじゃないでしょうか。

ここで使われたPascal処理系をUCSD Pascalと言います。これは仮想マシン上で動くように設計されたPascal処理系の代表格で、まさに当時の"Write Once, Run Anywhere"を実現してたようですね・・・そう、当時はJava的な存在だったわけです。

注: C言語も「マシン間の差異があってもソースの移植性を極力大事にする」意図で設計されていますが、随分と違うアプローチで、元々Pascalは「仮想マシンを前提として動かす」と言うアプローチになってました。しかも、C言語は原則的に16bit機以上が対象で、黎明期の8bitのパーソナルコンピュータ上だと「動かしづらい」プログラミング言語だった模様です。その辺、当時の環境だとPascalの方がメリットが大きかったのでしょう。

さて、そのUCSD Pascal。Wikipediaではこんな記述が成されていますね。

CPUの異なるパーソナルコンピュータ上で動作するために、P-Machineと呼ばれる仮想マシンを使用する。コンパイラはプログラムをそれぞれのCPU用の機械語に翻訳するのではなく、P-Machineの機械語であるP-Codeに翻訳する。そのため、P-Codeの仮想マシンを実装すればどのようなパーソナルコンピュータ上でも実行可能であった。

かっちょいい(笑)!仮想マシンですよ、仮想マシン(笑)。
問題は仮想マシンってのは実装が簡単なんですかねぇ。次のような記述が続きます。

P-Machineは典型的なスタックマシンで、様々な処理を主にスタック上で行うアーキテクチャを持っていた。

スタックマシン・・・何じゃそれ、なんですが(笑)。
Wikipediaのスタックマシンの項目読んでてもイマイチピンと来ない。やっぱ一回実装してみるに限りますね。
元々、CPUの動作とかは全く知らない門外漢なんですが、そろそろその辺勉強しても良い頃かもしれません。
ってなわけで、ネットで検索するとJavaで書かれた「仮想計算機を作ろう」と言うページを見つけたんで、Java書けないんですが(笑)、何とか読み下して、Schemeで簡単なスタックマシンを実装してみたいと思います。

スタックとは何か?

知るか(笑)。

いや、昔勉強した事あった、って言えばあったんですが、「一体何の為にこれやってんのか」ってのがサッパリ分からないんで、すっかり忘れてます(笑)。Lisp系だと何でもリストを使えば済む、ってんであんまマジメに考えてなかったんですよねぇ。改めて勉強です。

仮想スタックマシンを実装するに当たって、スタックというデータ構造について理解している必要がありますから、まずはこれについて、簡単なプログラムを交えながら解説することにします。

はいはい。

スタックはデータ構造の1つで、LIFO（Last In First Out）という性質を持っています。これは、最後に入れたデータを最初に取り出すことができるという意味になります。

何か、んな事言ってたなぁ。

ボール（値）を上からしか出し入れできない、不透明な長い箱をイメージするとよいでしょう。このような箱からボールを取り出すには、最後に入れたボール（値）からしか取り出せないということになります。

値をスタックへ格納する操作はpushと呼ばれ、値をスタックから取り出す操作はpopと呼ばれます。この2つの基本操作でスタックへ格納するデータをコントロールできます。オレンジ矢印が値を積むpushの操作を表し、グレイ矢印が値を取り出すpopの操作を表しています。次に取り出せるデータを参照するためのpeekという操作が提供されることもあります。

スタックにはどのような値がどういう順番で格納されているのかについては隠ぺいされていて、スタックを使用するプログラムからは見えないという点も重要です。

このように、スタックでは単純な操作しかできないのですが、後置記法と組み合わせることにより結構複雑な計算を実現できます。基本動作を理解するために、スタックの使い方と簡単な実装方法について見てみましょう。

なるほど、です。
次へ進んでみましょうか。

スタックを実装してみる

まずは、そのpushとpopを実装してみます。 Schemeだと次のように実装するのが綺麗なんじゃないでしょうか。

	(define (push item stack)
	(cons item stack))

	(define (pop stack)
	(values (car stack) (cdr stack)))

view raw push and pop.rkt hosted with ❤ by GitHub

pushは事実上consですね。ここは良し、とします。
問題はpopですか。通常、恐らく大域変数stackをリストで作っておいて、破壊的変更を行う、ってのがこのテのコーディングの前提になるんでしょうが、それは避けます。あくまで関数型プログラミングの範疇で、破壊的変更しない前提で行きます。
が、そうすると困ったことになるんですね。原則、pushではstackは仮引数として与えてstackに何らかの操作をした結果を返せばいいわけですが、popの場合、「取り出した値を返す」のが大事なのか「操作した後のstackを返す」のが大事なのか分かりません。ってかどっちも大事なんですよね～。
こう言う場合多値を用いて両者とも返しちゃう、ってのが一番Schemeらしいでしょう。そう言う実装方針で上のコードは掻きました。

次に示すような順番でスタックへ値を積んだり、スタックから値を取り出したりしてみます。

ここでは、図2のボール1をItem1、ボール2をItem2のように表すことにします。図2の動作例に従い、Item1、Item2、Item3の値を順にスタックへ積んだ（push）後、スタックから値を取り出します（pop）。このとき、一番上にある値はItem3なので、これが取り出されます。

次に、Item4、Item5の値を順にスタックへ積んでから、3回連続でスタックから値を取り出します。このとき、スタックの上から順に値が取り出されるので、Item5、Item4、Item2の順に出てきます。このタイミングでは、スタックにはItem1しか残っていないということになります。

最後に、ここへItem6を積んで、2回連続でスタックから値を取り出します。すると、Item6、Item1の順で値が取り出されます。

では、ここで書いてあるような動作をテストするプロシージャ、stacktestを実装してみます。こう言う場合、Schemeだとちょっと汚くなる、っつーかSchemeらしい書き方が難しいんですよね。何せ逐次実行が前提の言語じゃないんで、フラットに書くのが難しい。
一方、所詮動作確認なんで、あんま面倒臭い事考えたくないんで、適当にベタ書きしてみます。

	(define (stacktest . stack)
	(let ((stack (push "Item1" stack)))
	(let ((stack (push "Item2" stack)))
	(let ((stack (push "Item3" stack)))
	(let-values (((item stack) (pop stack)))
	(display item) ; Item3
	(newline)
	(let ((stack (push "Item4" stack)))
	(let ((stack (push "Item5" stack)))
	(let-values (((item stack) (pop stack)))
	(display item) ; Item5
	(newline)
	(let-values (((item stack) (pop stack)))
	(display item) ; Item4
	(newline)
	(let-values (((item stack) (pop stack)))
	(display item) ; Item2
	(newline)
	(let ((stack (push "Item6" stack)))
	(let-values (((item stack) (pop stack)))
	(display item) ; Item6
	(newline)
	(let-values (((item stack) (pop stack)))
	(display item) ; Item1
	(newline)
	stack)))))))))))))

view raw stacktest.rkt hosted with ❤ by GitHub

オリジナルのJavaコードに対応させようとすると、大体こんなカンジですかね。Javaなんかは由緒正しい「逐次処理言語」なんで、コードがフラットなんですが、Schemeの場合、特に今回はpopが多値を返す為にこう言うヘンなカンジにならざるを得なかったです。
ポイントはlet-valuesで、popが多値を返し、最初の値(つまり取り出した値)を表示用のプロシージャ、displayに渡して表示させて、残りをstackとして次のプロシージャに渡すようになっています。

	(let-values (((item stack) (pop stack))) ; pop の2つの返り値を item と stack に束縛する
	(display item) ; item を表示
	(newline) ; 改行
	(hoge stack)... ; stack を別のプロシージャへ渡す

view raw let-values sample.rkt hosted with ❤ by GitHub

では動作確認してみましょうか。

	> (stacktest)
	Item3
	Item5
	Item4
	Item2
	Item6
	Item1
	'()
	>

view raw stacktest.rkt hosted with ❤ by GitHub

元ページのJavaコードの実行結果と同じになっていますね。確かにLIFOになっています。

仮想スタックマシンを実装する

すでに何度か説明しましたが、後置記法で表現された式というのは、スタックを使うと、非常に簡単に計算ができてしまいます。そして、このスタックというデータ構造を実現することは、これまでの説明からも分かるように、それほど難しくはありません。

さいでっか。じゃあ、次行きましょうか。

設計

オリジナルだとクラスだフィールドだメソッドだ、って書いてるんですが、Schemeにはんなモン無いんで無視します(笑)。そもそも大域変数を破壊的変更する設計にしないんで、フィールドとか要らんでしょ。

ただ、簡単化の為に次のヤツだけは受けます。

また、演算装置も用意します。これは、2つのパラメータを受け取って演算を行い、その結果を返すメソッドを持つAluクラスとして実装します。ALU（Arithmetic Logic Unit）は四則演算と論理演算を含むのが一般的ですが、ここではSvm1に必要な加算と乗算のみ用意することにします。

そうそう、面倒だから取り敢えず加算と乗算のみやることにしましょう。追加は簡単ですしね。

演算装置

まあ、これは簡単ですね。オリジナルだとメソッドにしてますが、Schemeでは単純に独立したプロシージャとして実装します。ってか実装って程でもねぇんだけどな。

	(define (add a b)
	(+ a b))

	(define (multiply a b)
	(* a b))

view raw alu.rkt hosted with ❤ by GitHub

まんまやん、まんま、そのまんまです。

プログラムを仮想スタックマシンへロード

さて、オリジナルではバイトデータのファイルでやり取りしてるんですが、どうしましょう。そもそもSchemeだとバイトデータの扱いが良く分からないし(そもそも仕様にないと思う)、オリジナルのバイトデータの仕様も良く分かりません。

しょーがないんで、プレーンテキストの読み込みに留めておきます。

そしてそのプレーンテキストへの記述の仕様ですが、

計算式は逆ポーランド記法とする
bipush命令は続くコードにある値をオペランドスタックに積む(push)
iadd命令はオペランドスタックに積まれている値を2つ取り出して(pop)、それぞれの値を加算した結果をオペランドスタックに積む
imul命令はオペランドスタックに積まれている値を2つ取り出して(pop)、乗算した結果をオペランドスタックに積む
print命令はオペランドスタックの一番上に積まれている値を出力する

とします。

具体的には、例えば、1 + 2 * 3の演算命令としては、基本的には逆ポーランド記法なので、1 2 3 * +になるわけですが、テキストファイルへの記述は

bipush 1 bipush 2 bipush 3 imul iadd print

view raw code1.svm hosted with ❤ by GitHub

とします。
何だかインチキなアセンブリ言語みたいですが(笑)、取り敢えずこれを良しとして対象としましょう。構造さえ決まってしまえば、あとでどうにでも改造出来ますしね。

ってなわけでloadプロシージャを決まりきったカタチで実装します。

	(define (load filename)
	(with-input-from-file filename
	(lambda ()
	(let loop ((code '()) (c (read)))
	(if (eof-object? c)
	(reverse code)
	(loop (cons c code) (read)))))))

view raw load.rkt hosted with ❤ by GitHub

ロードしたプログラムを実行

余談ですが、Schemeの最新の仕様書では繰り返し構文が増えています。他の言語ではお馴染みのwhen(while)やunlessが搭載されました。繰り返ししたいけど特に終了時点で返したい値が無い場合重宝しますね。

ってなわけでunlessを使った再帰でプロシージャexecuteを実装します。

	(define (execute code stack)
	(unless (null? code)
	(let-values (((code stack) (executecommand code stack)))
	(execute code stack))))

view raw execute.rkt hosted with ❤ by GitHub

executeはexecutecommandを呼び出し、executecommandは多値を使ってexecuteとの間でcodeとstackをやり取りします。codeはexecutecommandによって「消費」され、計算の進行に従ってstackは(プログラミング用語ではない)状態を変化させていきます。命令を実際に解釈していくのはexecutecommandです。
ではexecutecommandを実装していきます。

命令の判定を実行

commandがbipushの場合は、続くコードにある値をオペランドスタックへ積む（push）する処理を行います。

commandがiaddの場合は、オペランドスタックに積まれている値を2つ取り出して（pop）、それぞれの値を加算した結果をオペランドスタックへ積みます。

commandがimulの場合は、iaddとほぼ同様の処理を行いますが、オペランドスタックへは取り出した値を乗算した結果を積むという点が異なります。

commandがprintの場合は、オペランドスタックの一番上に積まれている値を出力します。

これをこのまま実装すると次のようになります。

	(define (executecommand code operandstack)
	(let ((command (car code)) (code (cdr code)))
	(case command
	((bipush) (values (cdr code) (push (car code) operandstack)))
	((iadd) (let-values (((b operandstack) (pop operandstack)))
	(let-values (((a operandstack) (pop operandstack)))
	(values code (push (add a b) operandstack)))))
	((imul) (let-values (((b operandstack) (pop operandstack)))
	(let-values (((a operandstack) (pop operandstack)))
	(values code (push (multiply a b) operandstack)))))
	((print) (display (peek operandstack))
	(newline)
	(values code operandstack)))))

view raw executecommand.rkt hosted with ❤ by GitHub

先ほど書いた通り、executecommandはexecuteと多値を用いてやり取りします。返り値はcodeとoperandstackの二種類です。

仮想計算機もどきの実行

例として、次の3つのファイルを用意しておきます。

bipush 1 bipush 2 iadd print

view raw code0.svm hosted with ❤ by GitHub

bipush 1 bipush 2 bipush 3 imul iadd print

view raw code1.svm hosted with ❤ by GitHub

bipush 1 bipush 2 iadd bipush 3 imul print

view raw code2.svm hosted with ❤ by GitHub

このプログラムで生成されたSvm1のオブジェクトコードを仮想スタックマシンSvm1で実行します。

では、svm1をでっち上げましょう。

	(define (svm1 filename)
	(execute (load filename) '()))

view raw svm1.rkt hosted with ❤ by GitHub

code0.svmには、「1 + 2」、code1.svmには、「1 + 2 * 3」、code2.svmには、「(1 + 2) * 3」を計算するオブジェクトコードが保存されていますから、実行結果はそれぞれ「3」、「7」、「9」となります。

	> (svm1 "./code0.svm")
	3
	> (svm1 "./code1.svm")
	7
	> (svm1 "./code2.svm")
	9
	>

view raw execute-svm1.rkt hosted with ❤ by GitHub

はい、確かになっていますね。

仮想計算機の実行例のイメージ

最初に、bipushを読み込むと、次の値を読み込んでオペランドスタックへ「1」をpushしています。同様にして、「2」「3」をpushします（図では、省略しています）。
imulを読み込むと、オペランドスタックから値を2つpopして、それらを乗算し、その結果をオペランドスタックへpushします。
iaddを読み込むと、オペランドスタックから値を2つpopして、それらを加算し、その結果をオペランドスタックへpushします。

どうでしょう、スタックを使うと簡単に仮想計算機をソフトウェアで実装することが分かったでしょうか。もちろん、Svm1は仮想計算機というには機能が少な過ぎますが、雰囲気はつかんでいただけたと思います。

まあ、雰囲気はつかめましたね、確かに。

今回のソース

さあて、これ使うと色々な仮想計算機が作れる足がかりになるんでしょうかね。
では今回のソースです。

	#lang racket

	(define (push item stack)
	(cons item stack))

	(define (pop stack)
	(values (car stack) (cdr stack)))

	(define (peek stack)
	(car stack))

	(define (stacktest . stack)
	(let ((stack (push "Item1" stack)))
	(let ((stack (push "Item2" stack)))
	(let ((stack (push "Item3" stack)))
	(let-values (((item stack) (pop stack)))
	(display item) ; Item3
	(newline)
	(let ((stack (push "Item4" stack)))
	(let ((stack (push "Item5" stack)))
	(let-values (((item stack) (pop stack)))
	(display item) ; Item5
	(newline)
	(let-values (((item stack) (pop stack)))
	(display item) ; Item4
	(newline)
	(let-values (((item stack) (pop stack)))
	(display item) ; Item2
	(newline)
	(let ((stack (push "Item6" stack)))
	(let-values (((item stack) (pop stack)))
	(display item) ; Item6
	(newline)
	(let-values (((item stack) (pop stack)))
	(display item) ; Item1
	(newline)
	stack)))))))))))))

	(define (add a b)
	(+ a b))

	(define (multiply a b)
	(* a b))

	(define (load filename)
	(with-input-from-file filename
	(lambda ()
	(let loop ((code '()) (c (read)))
	(if (eof-object? c)
	(reverse code)
	(loop (cons c code) (read)))))))

	(define (execute code stack)
	(unless (null? code)
	(let-values (((code stack) (executecommand code stack)))
	(execute code stack))))

	(define (executecommand code operandstack)
	(let ((command (car code)) (code (cdr code)))
	(case command
	((bipush) (values (cdr code) (push (car code) operandstack)))
	((iadd) (let-values (((b operandstack) (pop operandstack)))
	(let-values (((a operandstack) (pop operandstack)))
	(values code (push (add a b) operandstack)))))
	((imul) (let-values (((b operandstack) (pop operandstack)))
	(let-values (((a operandstack) (pop operandstack)))
	(values code (push (multiply a b) operandstack)))))
	((print) (display (peek operandstack))
	(newline)
	(values code operandstack)))))

	(define (svm1 filename)
	(execute (load filename) '()))

view raw stackmachine.rkt hosted with ❤ by GitHub

登録: 投稿 (Atom)

How To Become A Hacker