言語処理系とは: 補題

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

	#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と格闘、です。

言語処理系とは

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

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

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

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

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

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

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

はい、左様でやんすね。

 言語処理系の基本構成

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

1. 字句解析(lexical analysis): 文字列を言語の要素（トークン、token）の列に分解する。
2. 構文解析(syntax analysis): token列を意味を反映した構造に変換。こ の構造は、しばしば、木構造で表現されるので、抽象構文木（abstract syntax tree）と呼ばれる。ここまでの言語を認識する部分を言語のparserと 呼ぶ。
3. 意味解析(semantics analysis): 構文木の意味を解析する。インタプリ ターでは、ここで意味を解析し、それに対応した動作を行う。コンパイラでは、 この段階で内部的なコード、中間コードに変換する。
4. 最適化(code optimization): 中間コードを変形して、効率のよいプログ ラムに変換する。
5. コード生成(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が収まっていきます。

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

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

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

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

1. 数字のASTつまり、opがNUMであれば、その値を返す。
2. 演算式であれば、左辺を評価した値と右辺を評価した値を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には要らないですね。シンボルとリストで凌ぎましょう。

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

1. 式が数字であれば、その数字をpushするコードを出す。
2. 式が演算であれば、左辺と右辺をコンパイルし、それぞれの結果をスタッ クにつむコードを出す。その後、演算子に対応したスタックマシンのコードを 出す。
3. 式のコンパイルしたら、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で出力します(爆)。
ちなみに、最初は、オリジナルのコードに従って書いてたんですが、上手く動いたのをきっかけにしてもうちょっと欲が出てきたんですね。
元のコードにはいくつかちょっと特徴があります。

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

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

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

と言う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

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

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

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

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

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