筆者の別記事『簡易LISP処理系の実装例【各言語版まとめ】』の姉妹版です．今回は，S式入力処理を中心としたまとめ記事となっています．
ここで言う『省略S式』とは，丸括弧と空白区切り（と文字列としてのシンボル）のみの，要素に配列自身を扱うことが可能な再帰的配列構造です．二分木構造が基本のS式にとってはあくまで省略記法なのですが，実際には，LISPコードの多くがこれで表現されています．Scheme風に表現した例は次のようになるでしょうか．
((lambda (x) (cons x (cons x (quote ())))) (quote a))
他のプログラミング言語における[,]による配列構造とほぼ同じですが，S式の空白区切りは連続空白も対象としていることと，シンボルにおける値と名前（変数）の区別は構文で行われるため，値としてのシンボルを引用符で区別しないことが大きな違いです．なお，上記の表現を[,]で表現した例が次の記述です．もし，Pythonのリスト型による省略S式構文木生成パーサが実装されたならば，上記のS式はこのようなリスト型データ構造が出力されることになります．
[["lambda", ["x"], ["cons", "x", ["cons", ["quote", []]]]], ["quote", "a"]]
S式パーサというなら，あえてペア構造（コンスセル）を内部で構成し，ドット記法を含む二分木構造に対応するべきですが，省略記法だけでもゼロから作るとなると割と大変で，小さなLISP処理系本体よりも複雑になります．実際のところ，S式パーサ実装のためには，抽象構文木を生成するためのデータ構造生成機能が必須で，プログラムコードとデータ構造の表現が共にS式であるLISPにとっては，基本中の基本の機能（cons, car, cdr）です．
すなわち，省略形式であってもS式パーサを実装できれば，LISP処理系のほとんどが作成できたといっても過言ではない…ということを示すため，本記事ではパーサ実装例と共に，利用例として純LISPインタプリタ（ダイナミックスコープ版）を付けています．S式を制する者はLISPを制する（大袈裟）．
実装例
Scheme（参照実装）
今回のパーサは，1文字を読み込みながら字句解析を行い1トークンを返すget-tokenと，1トークンを読み込みながら構文解析を行い抽象構文木を返すsreadのふたつの機能に大きく分かれています．
get-tokenは，状況に応じて1文字先読みを行いながら，トークンとしての丸括弧や連続した文字列を認識して返します．たとえば，『読み込んだ文字が空白の時は，それまでの文字列をトークンとして返す前に連続した空白を読み飛ばし，次に呼び出された時は，読み飛ばした後の最初の1文字からトークン認識を始める』といったことが行われます．このため，先読みしたかどうか，先読みした1文字は何かを格納する大域変数が用意されています．
;;;; One token input function with look-ahead caching
(define *lh* #f)
(define (get-token)
(define (put-c1 x) (set! *lh* x))
(define (null-c1) (set! *lh* #f))
(define (get-c1) (if *lh* (let ((lh *lh*)) (null-c1) lh) (read-char)))
(define (tstring t) (list->string (reverse t)))
(define (skip-spaces)
(do ((c (get-c1) (get-c1)))
((not (member c (string->list " \n\r"))) (put-c1 c))))
(let loop ((c (get-c1)) (t '()))
(cond ((member c (string->list " \n\r"))
(if (null? t) (begin (skip-spaces) (loop (get-c1) t)) (tstring t)))
((member c (string->list "()"))
(if (null? t) (string c) (begin (put-c1 c) (tstring t))))
(else (loop (get-c1) (cons c t))))))
sreadは，今回は再帰的な配列構造を対象としていることから，トークン列を走査しながら，丸括弧対応に応じて（Schemeの場合はコンスセル構造を作るconsによって）再帰的な配列構造を構文木として生成します．
;;;; Simple S-expression parser
(define (sread)
(define (slist)
(let loop ((t (get-token)))
(cond ((equal? t ")") '())
((equal? t "(")
(let ((h (loop (get-token))))
(cons h (loop (get-token)))))
(else (cons t (loop (get-token)))))))
(let ((t (get-token)))
(if (equal? t "(") (slist) t)))
以下が，おまけの（？）純LISP仕様インタプリタです．John McCarthy氏の原初のLISPインタプリタ記述に沿ってPaul Graham氏がCommon Lispで実装した"McCarthy's Original Lisp"（jmc.lisp）を，Schemeの標準関数を用いながら書き直したものです．
;;;;
;;;; A Pure LISP interpreter by using the above parser
;;;;
;;;; Simple S-expression output function
(define (swrite s)
(define (ls x)
(swrite (car x))
(if (not (null? (cdr x))) (begin (display " ") (ls (cdr x)))))
(if (string? s) (display s) (begin (display "(") (ls s) (display ")"))))
;;;; "ev" to avoid same name of Scheme eval
(define (ev s e)
(if (pair? s)
(if (pair? (car s))
(ev (caddar s)
(append (map cons (cadar s) (map (lambda (x) (ev x e)) (cdr s)))
e))
(cond ((equal? (car s) "quote") (cadr s))
((equal? (car s) "atom") (not (pair? (ev (cadr s) e))))
((equal? (car s) "car") (car (ev (cadr s) e)))
((equal? (car s) "cdr") (cdr (ev (cadr s) e)))
((equal? (car s) "eq")
(equal? (ev (cadr s) e) (ev (caddr s) e)))
((equal? (car s) "cons")
(cons (ev (cadr s) e) (ev (caddr s) e)))
((equal? (car s) "if")
(if (ev (cadr s) e) (ev (caddr s) e) (ev (cadddr s) e)))
(else (ev (cons (cdr (assoc (car s) e)) (cdr s)) e))))
(cdr (assoc s e))))
;;;; REPL without global environment
(display "S> ")
(do ((s (sread) (sread))) ((equal? s '("exit")))
(swrite (ev s '())) (newline) (display "S> "))
ひとつのS式しか評価しませんが，ラムダ式がダイナミックスコープを採用しており（バグだったという話がありますが），ラムダ式の引数に適用した別のラムダ式が自分自身を引数変数で呼び出すことができるため，再帰処理が可能となっています．次の実行例は，冒頭のラムダ式の例，リスト結合，属性リストによる検索を行っています．
$ chibi-scheme -m chibi sparser-with-plisp.scm
S> ((lambda (x) (cons x (cons x (quote ())))) (quote a))
(a a)
S> ((lambda (append)
(append (quote (a b c)) (quote (x y z))))
(quote (lambda (x y)
(if (eq x (quote ())) y
(cons (car x) (append (cdr x) y))))))
(a b c x y z)
S> ((lambda (plist k v)
(plist (quote O) (quote (A 120 O 210 L 180))))
(quote (lambda (k v)
(if (eq v (quote ())) (quote ())
(if (eq (car v) k) (car (cdr v))
(plist k (cdr (cdr v))))))))
210
S> (exit)
$
Python 3
Scheme版をほぼそのまま書き直したものです．注意点としては，1文字のみ読み込みにinput()は使えず，sys.stdin.read(1)を用いる必要があることです．また，先読みに用いる大域変数へのアクセスのためのglobal宣言が必要なことも割と盲点です．
# One token input function with look-ahead caching
from sys import stdin
LH = False
def get_token():
def put_c1(x): global LH; LH = x
def null_c1(): global LH; LH = False
def get_c1():
if not LH:
try: return stdin.read(1)
except EOFError: pass
else: lh = LH; null_c1(); return lh
def tstring(t): return ''.join(t)
def skip_spaces():
c = get_c1();
while c in ' \n\r\x1a': c = get_c1()
put_c1(c)
c = get_c1(); t = []
while True:
if c in ' \n\r\x1a':
if not t: skip_spaces(); c = get_c1()
else: return tstring(t)
elif c in '()':
if not t: return c
else: put_c1(c); return tstring(t)
else: t = t + [c]; c = get_c1()
LISP系の(cons x y)に相当するリスト型処理としては[x] + yがあり，コンスセル構造には対応できないものの，今回の省略S式に限っては，そのまま書き直すだけで実装可能です．
# Simple S-experssion parser
def sread():
def slist():
t = get_token()
if t == ')': return []
elif t == '(': h = slist(); return [h] + slist()
else: return [t] + slist();
t = get_token()
return slist() if t == '(' else t
LISPインタプリタでは（Python処理系自身がそうであるように）変数束縛機構に辞書型を用いています．要素結合などで簡潔な表記方法があるため手軽です．引数の連続評価も，リスト内包表記でまとめて行えます．注意点として，デフォルト設定のprintではバッファリングが行われているため，S式として認識され次第表示させたい今回の場合ではうまくいかないことから，flush=Trueオプションが必要となります．
#
# A Pure LISP interpreter by using the above parser
#
# Simple S-expression output function
def display(x): print(x, end='', flush=True)
def swrite(s):
def ls(x):
swrite(x[0])
if len(x) > 1: display(' '); ls(x[1:])
if isinstance(s, str): display(s)
elif not s: display('()')
else: display('('); ls(s); display(')')
# "ev" to avoid same name of Python eval
def ev(s, e):
if isinstance(s, str): return e[s]
elif isinstance(s[0], str):
if s[0] == 'quote': return s[1]
elif s[0] == 'atom': return isinstance(ev(s[1], e), str)
elif s[0] == 'car': return ev(s[1], e)[0]
elif s[0] == 'cdr': return ev(s[1], e)[1:]
elif s[0] == 'eq': return ev(s[1], e) == ev(s[2], e)
elif s[0] == 'cons': return [ev(s[1], e)] + ev(s[2], e)
elif s[0] == 'if': return ev(s[2], e) if ev(s[1], e) else ev(s[3], e)
else: return ev([e[s[0]]] + s[1:], e)
else: return ev(s[0][2],
{**e, **dict(zip(s[0][1], [ev(x, e) for x in s[1:]]))})
# REPL without global environment
display('S> '); s = sread()
while s != ['exit']:
swrite(ev(s, {})); print(); display('S> '); s = sread()
$ python3 sparser-with-plisp.py
S> ((lambda (x) (cons x (cons x (quote ())))) (quote a))
(a a)
S> ((lambda (append)
(append (quote (a b c)) (quote (x y z))))
(quote (lambda (x y)
(if (eq x (quote ())) y
(cons (car x) (append (cdr x) y))))))
(a b c x y z)
S> ((lambda (plist k v)
(plist (quote O) (quote (A 120 O 210 L 180))))
(quote (lambda (k v)
(if (eq v (quote ())) (quote ())
(if (eq (car v) k) (car (cdr v))
(plist k (cdr (cdr v))))))))
210
S> (exit)
$
C言語
C言語は（当然ながら）動的な配列／リスト構造を標準では持っていませんので，抽象構文木を生成するS式パーサのためにも，consに相当するところから実装しなければなりません．この場合，内部データ構造も定義・実装することとなり，本格的な処理系実装のためには，ガーベジコレクションを含むメモリ管理機能を充実させる必要があります．
今回は純LISPインタプリタが利用例ということで，staticに大域宣言した配列を組み合わせてコンスセル構造をお手軽に構成しています．ノード配列node，ペア構造配列cell，文字列配列symbで構成され，ノードのそれぞれには，ペア構造配列の添字番号（そのまま正の値）か文字列配列の添字番号（負の値に変換）が入ることとしています．併せて，文字列配列symに文字列を格納したり取り出したりする関数も作成します．
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
// static memory allocation for conscells and symbols
typedef int16_t node_t;
#define SMAX 16
node_t node[1024]; node_t nnum = 1;
node_t cell[256][2]; node_t cnum = 1;
char symb[768][SMAX]; node_t snum = 1;
// each node includes positive index number for conscells
// or negative index number for symbols
#define NIL 0
node_t cons(node_t a, node_t d) {
cell[cnum][0] = a; cell[cnum][1] = d; node[nnum] = cnum;
cnum++; nnum++; return nnum - 1;
}
node_t ssym(char *str) {
strcpy(symb[snum], str); node[nnum] = -snum;
snum++; nnum++; return nnum - 1;
}
const char *gsym(node_t s) { return symb[-node[s]]; }
このため，たとえば(a (b) c)という記述は，通常の配列構造やコンスセル構造であれば
のようになるところ，今回の実装例では
と，コンスセル（ペアの箱）も文字列も必ずノード（点線の箱）を経由するようにしています．かなり無駄に見えますし実際無駄なのですが，それを避けるためには構造体やポインタで管理することとなり，割と面倒です．次は，リスト処理のための基本アクセス関数の実装です．単純な配列操作のみとなっていることがわかります．
// basic list processing functions
#define T (NIL == NIL)
node_t car(node_t s) { return cell[node[s]][0]; }
node_t cdr(node_t s) { return cell[node[s]][1]; }
node_t null(node_t s) { return s == NIL; }
node_t atom(node_t s) { return null(s) || node[s] < 0; }
node_t eq(node_t a, node_t b) {
if (null(a) && null(b)) return T;
else if (!null(a) && !null(b) && atom(a) && atom(b))
return !strcmp(gsym(a), gsym(b));
else return NIL;
}
ここまで揃えばパーサが作れます．実際には，構築した構文木を確認するためS式出力も必要ですが，いずれにしても，参照実装のSchemeやPython版からのほぼ書き直しで作れるのは確かです．ただし，トークン解析で更にもうひとつ，認識途中経過を格納する大域文字配列を設けています．
// One token input function with look-ahead caching
char LH = 0;
char TOKEN[SMAX]; node_t tnum = 0;
void put_c1(node_t x) { LH = x; }
void null_c1(void) { LH = 0; }
char get_c1(void) {
if (LH) { char lh = LH; null_c1(); return lh; }
else return getc(stdin);
}
node_t tstring() {
TOKEN[tnum] = NIL; node_t r = ssym(TOKEN);
tnum = 0; return r;
}
void skip_spaces() {
char c = get_c1();
while (c == ' ' || c == 10 || c == 13 || c == 26) c = get_c1();
put_c1(c);
}
node_t get_token() {
char c;
while (1) {
c = get_c1();
if (c == ' ' || c == 10 || c == 13 || c == 26) {
if (tnum == 0) skip_spaces();
else return tstring();
} else if (c == '(' || c == ')') {
if (tnum == 0) { TOKEN[tnum++] = c; return tstring(); }
else { put_c1(c); return tstring(); }
} else TOKEN[tnum++] = c;
}
}
// Simple S-expression parser
node_t slist(void) {
node_t t = get_token();
if (eq(t, ssym(")"))) return NIL;
else if (eq(t, ssym("("))) {
node_t h = slist(); return cons(h, slist());
} else return cons(t, slist());
}
node_t sread(void) {
node_t t = get_token();
return eq(t, ssym("(")) ? slist() : t;
}
以下のLISPインタプリタも，Scheme版やPython版のほぼ書き直しとなります．なお，変数束縛機構には，動作確認の実行例で登場している属性リストを用いています．plisが属性リスト構築，propが実行例と同じ構成の検索関数です．appendは属性リストの合成，mapは引数の連続評価（いわゆるevlis）を行うための定義です．
//
// A Pure LISP interpreter by using the above parser
//
// Simple S-expression output function
void swrite(node_t s) {
if (atom(s)) { if (null(s)) printf("()"); printf("%s", gsym(s)); }
else {
printf("("); swrite(car(s));
if (!atom(cdr(s)))
for (node_t n = cdr(s); !null(n); n = cdr(n)) {
printf(" "); swrite(car(n));
}
printf(")");
}
}
// utility functions
node_t append(node_t a, node_t b) {
if (null(a)) return b;
else return cons(car(a), append(cdr(a), b));
}
node_t plis(node_t a, node_t b) {
if (null(a) || null(b)) return NIL;
else return cons(car(a), cons(car(b), plis(cdr(a), cdr(b))));
}
node_t prop(node_t k, node_t p) {
if (null(p)) return NIL;
else if (eq(car(p), k)) return car(cdr(p));
else return prop(k, cdr(cdr(p)));
}
node_t map(node_t (*f)(node_t, node_t), node_t s, node_t e) {
if (null(s)) return NIL;
return cons(f(car(s), e), map(f, cdr(s), e));
}
// eval function
node_t ev(node_t s, node_t e) {
if (atom(s)) return prop(s, e);
else if (atom(car(s))) {
if (eq(car(s), ssym("quote"))) return car(cdr(s));
else if (eq(car(s), ssym("atom"))) return atom(ev(car(cdr(s)), e));
else if (eq(car(s), ssym("car"))) return car(ev(car(cdr(s)), e));
else if (eq(car(s), ssym("cdr"))) return cdr(ev(car(cdr(s)), e));
else if (eq(car(s), ssym("eq")))
return eq(ev(car(cdr(s)), e), ev(car(cdr(cdr(s))), e));
else if (eq(car(s), ssym("cons")))
return cons(ev(car(cdr(s)), e), ev(car(cdr(cdr(s))), e));
else if (eq(car(s), ssym("if")))
if (ev(car(cdr(s)), e)) return ev(car(cdr(cdr(s))), e);
else return ev(car(cdr(cdr(cdr(s)))), e);
else if (eq(car(s), ssym("exit"))) exit(0);
else return ev(cons(prop(car(s), e), cdr(s)), e);
} else {
return ev(car(cdr(cdr(car(s)))),
append(plis(car(cdr(car(s))), map(ev, cdr(s), e)), e));
}
}
// REPL without global environment
int main(void) {
printf("S> "); node_t s = sread();
while (1) {
swrite(ev(s, NIL)); printf("\n");
nnum = cnum = snum = 1;
printf("S> "); s = sread();
}
return 0;
}
動作確認も他言語版とほぼ同じです．
$ cc -o sparser-with-plisp sparser-with-plisp.c
$ ./sparser-with-plisp
S> ((lambda (x) (cons x (cons x (quote ())))) (quote a))
(a a)
S> ((lambda (append)
(append (quote (a b c)) (quote (x y z))))
(quote (lambda (x y)
(if (eq x (quote ())) y
(cons (car x) (append (cdr x) y))))))
(a b c x y z)
S> ((lambda (plist k v)
(plist (quote O) (quote (A 120 O 210 L 180))))
(quote (lambda (k v)
(if (eq v (quote ())) (quote ())
(if (eq (car v) k) (car (cdr v))
(plist k (cdr (cdr v))))))))
210
S> (exit)
$
備考
更新履歴
- 2022-05-13：字句解析における括弧処理を簡略化
- 2022-02-21：字句解析における空白等スキップ時の一部不具合を修正
- 2022-02-09：各種解説を追加
- 2022-02-09：C言語版追加
- 2022-02-09：初版公開（Scheme，Python 3）