簡易LISP処理系の実装例（Prolog版）

【他言語版へのリンク記事】簡易LISP処理系の実装例【各言語版まとめ】

この記事は，下記拙作記事のProlog版（SWI Prolog）を抜粋・修正したものを利用した，簡易LISP処理系（"McCarthy's Original Lisp"）の実装例をまとめたものです．

• 『括弧文字列』簡易パーサ実装例まとめ
• リスト処理関数（cons,car,cdr,eq,atom）実装例まとめ（LISPと全く同じコンスセル操作が可能であるため実装不要）

最低限の機能をもったLISP処理系の実装の場合，本体である評価器（eval）実装はとても簡単であり，むしろ，字句・構文解析を行うS式入出力（やリスト処理実装）の方が開発言語ごとの手間が多く，それが敷居になっている人向けにまとめています．

処理系の概要

実行例は次の通り．SWI Prolog 8.0.2にて確認．

$ swipl -s jmclisp.swi
;（起動時のメッセージは省略）
?- s_rep().
|: (car (cdr '(10 20 30)))
|:
20
true.

?- s_rep().
|: ((lambda (x) (car (cdr x))) '(abc def ghi))
|:
def
true.

?- s_rep().
|: ((lambda (f x y) (f x (f y '()))) 'cons '10 '20)
|:
(10 20)
true.

?- s_rep().
|: ((lambda (f x y) (f x (f y '())))
|: '(lambda (x y) (cons x (cons y '())))
|: '10 '20)
|:
(10 (20 ()))
true.

?- s_rep().
|: ((lambda (assoc k v) (assoc k v))
|: '(lambda (k v)
|:    (cond ((eq v '()) nil)
|:          ((eq (car (car v)) k)
|:           (car v))
|:          ('t (assoc k (cdr v)))))
|: 'Orange
|: '((Apple . 120) (Orange . 210) (Lemon . 180)))
|:
(Orange . 210)
true.

実装内容は次の通り．

• "McCarthy's Original Lisp"をベースにした評価器
• 数字を含むアトムは全てシンボルとし，変数の値とする場合はquote（'）を使用
• 構文としてquoteの他，condとlambdaが使用可能
• 組込関数：atom eq cons car cdr（内部でPrologのリスト操作をそのまま適用）
• 真偽値はt（真）およびnil（偽）＝空リスト＝[]
• エラーチェックなし，モジュール化なし，ガーベジコレクションなし

"McCarthy's Original Lisp"の詳細についてはまとめ記事を参照．ダイナミックスコープということもあり，実行例ではlambda式をletrec（Scheme）やlabels（Common Lisp）などの代わりに使用しています．

#実装例

##ソースコード一式

jmclisp.swi

%
% JMC Lisp: defined in McCarthy's 1960 paper,
% with S-expression input/output
%


% S-expression input: s_read

s_lchp(C) :- member(C, ['(', ')', '\'']), !.
s_lwa(CS, WS0, WS1) :- atomics_to_string(CS, T), append(WS0, [T], WS1).
s_lex0('\n', [], WS, WS).
s_lex0('\n', CS, WS, SL) :- s_lwa(CS, WS, SL).
s_lex0(' ',  [], WS, SL) :- get_char(C), s_lex0(C, [], WS, SL).
s_lex0(' ',  CS, WS, SL) :- s_lwa(CS, WS, WS1),
                            get_char(C), s_lex0(C, [], WS1, SL).
s_lex0(C,    [], WS, SL) :- s_lchp(C),
                            s_lwa([C], WS, WS1),
                            get_char(N), s_lex0(N, [], WS1, SL).
s_lex0(C,    CS, WS, SL) :- s_lchp(C),
                            s_lwa(CS, WS, WS1),
                            s_lwa([C], WS1, WS2),
                            get_char(N), s_lex0(N, [], WS2, SL).
s_lex0(C,    CS, WS, SL) :- append(CS, [C], CS1),
                            get_char(C1), s_lex0(C1, CS1, WS, SL).
s_lex1(SL) :- get_char(C), s_lex0(C, [], [], SL), !.

s_lexS([], R, R).
s_lexS(L, LS, R) :- append(LS, L, R1), s_lex1(L1), s_lexS(L1, R1, R).
s_lex(R) :- s_lex1(L), s_lexS(L, [], R), !.

s_syn0(["("|L], R, [R|L]).
s_syn0(["."|L], [R1|_], SL) :- s_syn(L, [A|D]), s_syn0(D, [A|R1], SL).
s_syn0(S, R, SL) :- s_syn(S, [A|D]), s_syn0(D, [A|R], SL).

s_quote(X, [], [X]).
s_quote(X, ["'"|S], [["quote"|[X]]|S]).
s_quote(X, S, [X|S]) :- !.

s_syn([X|L], SL) :- X == ")", s_syn0(L, [], [R|S]), s_quote(R, S, SL).
s_syn([R|S], SL) :- s_quote(R, S, SL).

s_read(R) :- s_lex(X), reverse(X, S), s_syn(S, [R|_]), !.


% S-expression output: s_display

s_strcons([S|[]]) :- s_display(S).
s_strcons([S|SD]) :- string(SD), s_display(S), write(" . "), write(SD).
s_strcons([S|SD]) :- s_display(S), write(" "), s_strcons(SD), !.

s_display([])    :- write("()").
s_display(true)  :- write("t").
s_display(false) :- write("nil").
s_display(S)     :- string(S), write(S).
s_display(S)     :- write("("), s_strcons(S), write(")"), !.


% JMC Lisp evaluator: s_eval

s_pair([], [], []).
s_pair(X, Y, []) :- string(X); string(Y).
s_pair([X1|X], [Y1|Y], [[X1|[Y1]]|R]) :- s_pair(X, Y, R), !.

s_assoc(X, [[X|[R|_]]|_], R).
s_assoc(X, [_|Y], R) :- s_assoc(X, Y, R), !.

s_eq(S, S, "t") :- string(S).
s_eq([], [], "t").
s_eq(_, _, "nil") :- !.
s_atom(X, "t") :- string(X).
s_atom([], "t").
s_atom(_, "nil") :- !.

s_eval0(["quote"|[E|_]], _, E).
s_eval0(["atom" |[E|_]], A, R) :- s_eval(E, A, R1), s_atom(R1, R).
s_eval0(["eq"   |[E1|[E2|_]]], A, R) :- s_eval(E1, A, R1), s_eval(E2, A, R2),
                                        s_eq(R1, R2, R).
s_eval0(["car"  |[E|_]], A, R) :- s_eval(E, A, [R|_]).
s_eval0(["cdr"  |[E|_]], A, R) :- s_eval(E, A, [_|R]).
s_eval0(["cons" |[E1|[E2|_]]], A, [R1|R2]) :- s_eval(E1, A, R1), s_eval(E2, A, R2).
s_eval0(["cond" |E], A, R) :- evcon(E, A, R), !.
s_eval0([E1|E], A, R) :- s_assoc(E1, A, R1), s_eval([R1|E], A, R), !.

s_eval("t",   _, true) :- !.
s_eval("nil", _, false) :- !.
s_eval(E, A, R) :- s_atom(E, "t"), s_assoc(E, A, R).
s_eval([E1|E], A, R) :- s_atom(E1, "t"), s_eval0([E1|E], A, R), !.
s_eval([["lambda"|[E1|[E2|_]]]|E3], A, R) :-
  evlis(E3, A, R1), s_pair(E1, R1, R2), append(R2, A, R3), s_eval(E2, R3, R), !.
s_eval(_, _, _) :- writeln("Error"), !.

evcon([[C1|[C2|_]]|_], A, R) :- s_eval(C1, A, R1), R1 == "t", s_eval(C2, A, R), !.
evcon([_|C], A, R) :- evcon(C, A, R), !.

evlis([], _, []).
evlis([M1|M], A, [R1|R2]) :- s_eval(M1, A, R1), evlis(M, A, R2), !.


% REP (no Loop): s_rep

s_rep() :- s_read(E), s_eval(E, [], R), s_display(R), !.

##解説

• S式入力：s_read
  先の記事から，字句解析部を( )および'の識別に変更し，更に，複数行入力対応とするため，空行が入力されるまで文字列リストを連結するよう修正．抽象構文木生成部はドット対とクォート記号対応としつつ，コンスセル構造による構文木を生成するよう変更．それらをまとめたS式入力関数s_readを定義．

• S式出力：s_display
  新規に作成．内部では[]である空リストは()を，真偽値は（念のため）t nilを出力するよう設定．

• 評価器：s_eval＋ユーティリティ関数
  "McCarthy's Original Lisp"をベースにs_eval関数およびユーティリティ関数を作成．なお，分岐処理や戻り値相当はパターンマッチングによって実装していることもあり，eqやatomは真偽値として（Prolog自身のtrue falseではなく）t nilを引数マッチングさせると共に，condの条件式の評価結果がtの時に対応する処理を実行するようevconにて定義．

• REP (no Loop)：s_rep
s_read→s_eval→s_displayをまとめたs_repを定義．

#備考

##記事に関する補足

• 動的型付きの上にLISPと全く同じコンスセル操作ができるので，他のプログラミング言語と比べて移植がとてつもなく楽だったのだけれども，記述コードの様相も根本的に異なるというかなんというか．HaskellやR言語でも似たような形で実装できるかなと思っていたのだけれど，(cdr '(a))相当でエラーにならず普通に空リストを返す言語ってPrologくらいなんだなあとあらためて．(cons 'a '())＝(a)相当が普通にできる言語，の間違い．むしろなぜPrologができるのかっていう．

##更新履歴

• 2020-10-07：初版公開