【他言語版へのリンク記事】簡易LISP処理系の実装例【各言語版まとめ】
この記事は,下記拙作記事のPHP版を抜粋・修正したものを利用した,簡易LISP処理系("McCarthy's Original Lisp")の実装例をまとめたものです.
-
『括弧文字列』簡易パーサ実装例まとめ
(PHP版はS式入出力を先行作成しました) - リスト処理関数(cons,car,cdr,eq,atom)実装例まとめ
最低限の機能をもったLISP処理系の実装の場合,本体である評価器(eval)実装はとても簡単であり,むしろ,字句・構文解析を行うS式入出力やリスト処理実装の方が開発言語ごとの手間が多く,それが敷居になっている人向けにまとめています.
処理系の概要
実行例は次の通り.PHP 7.4.10のREPLにて確認.
$ php -a
Interactive shell
php > include "jmclisp.php";
php > echo s_rep("(car (cdr '(10 20 30)))");
20
php > echo s_rep("((lambda (x) (car (cdr x))) '(abc def ghi))");
def
php > echo s_rep("((lambda (f x y) (f x (f y '()))) 'cons '10 '20)");
(10 20)
php > echo s_rep("((lambda (f x y) (f x (f y '())))
php " '(lambda (x y) (cons x (cons y '())))
php " '10 '20)");
(10 (20 ()))
php > echo s_rep("((lambda (assoc k v) (assoc k v))
php " '(lambda (k v)
php " (cond ((eq v '()) nil)
php " ((eq (car (car v)) k)
php " (car v))
php " ('t (assoc k (cdr v)))))
php " 'Orange
php " '((Apple . 120) (Orange . 210) (Lemon . 180)))");
(Orange . 210)
実装内容は次の通り.
- "McCarthy's Original Lisp"をベースにした評価器
- 数字を含むアトムは全てシンボルとし,変数の値とする場合は
quote
('
)を使用 - 構文として
quote
の他,cond
とlambda
が使用可能 - 組込関数:
atom
eq
cons
car
cdr
(内部でコンスセルを作成) - 真偽値は
t
(真)およびnil
(偽)=空リスト=NULL
- エラーチェックなし,モジュール化なし,ガーベジコレクションなし
"McCarthy's Original Lisp"の詳細についてはまとめ記事を参照.ダイナミックスコープということもあり,実行例ではlambda式をletrec
(Scheme)やlabels
(Common Lisp)などの代わりに使用しています.
#実装例
##ソースコード一式
<?php
#
# JMC Lisp: defined in McCarthy's 1960 paper,
# with S-expression input/output and basic list processing
#
# basic list processing: cons, car, cdr, eq, atom
function cons($x, $y) { return [$x, $y]; }
function car($s) { return $s[0]; }
function cdr($s) { return $s[1]; }
function eq($s1, $s2) { return $s1 === $s2; }
function atom($s) {
return is_string($s) || is_bool($s) || is_null($s);
}
# S-expression output: s_string
function s_strcons($s)
{
$sa_r = s_string(car($s));
$sd = cdr($s);
if (eq($sd, NULL)) {
return $sa_r;
} elseif (atom($sd)) {
return $sa_r . " . " . $sd;
} else {
return $sa_r . " " . s_strcons($sd);
}
}
function s_string($s)
{
if (eq($s, NULL)) { return "()"; }
elseif (eq($s, true)) { return "t"; }
elseif (eq($s, false)) { return "nil"; }
elseif (atom($s)) {
return $s;
} else {
return "(" . s_strcons($s) . ")";
}
}
# S-expression input: s_read
function s_lex($s)
{
return
array_values(
array_filter(
explode(" ",
str_replace([ "(" , ")" , "'" ,"\n"],
[" ( "," ) "," ' ", "" ],
$s))));
}
function s_syn_q($x, &$s)
{
if (count($s) != 0 && end($s) == "'") {
array_pop($s);
return cons("quote", cons($x, NULL));
} else {
return $x;
}
}
function s_syn(&$s)
{
$t = array_pop($s);
if ($t == ")") {
$r = NULL;
while (end($s) != "(") {
if (end($s) == ".") {
array_pop($s);
$r = cons(s_syn($s), car($r));
} else {
$r = cons(s_syn($s), $r);
}
}
array_pop($s);
return s_syn_q($r, $s);
} else {
return s_syn_q($t, $s);
}
}
function s_read($s) { return s_syn(s_lex($s)); }
# JMC Lisp evaluator: s_eval
function caar($x) { return car(car($x)); }
function cadr($x) { return car(cdr($x)); }
function cadar($x) { return car(cdr(car($x))); }
function caddr($x) { return car(cdr(cdr($x))); }
function caddar($x) { return car(cdr(cdr(car($x)))); }
function s_null($x) { return eq($x, NULL); }
function s_append($x, $y)
{
if (s_null($x)) { return $y; }
else { return cons(car($x), s_append(cdr($x), $y)); }
}
function s_list($x, $y) { return cons($x, cons($y, NULL)); }
function s_pair($x, $y)
{
if (s_null($x) && s_null($y)) { return NULL; }
elseif (!atom($x) && !atom($y)) {
return cons(s_list(car($x), car($y)),
s_pair(cdr($x), cdr($y)));
}
}
function s_assoc($x, $y)
{
if (eq(caar($y), $x)) {
return cadar($y);
} else {
return s_assoc($x, cdr($y));
}
}
function s_eval($e, $a)
{
if (eq($e, "t")) { return true; }
elseif (eq($e, "nil")) { return false; }
elseif (atom($e)) { return s_assoc($e, $a); }
elseif (atom(car($e))) {
if (eq(car($e), "quote")) { return cadr($e); }
elseif (eq(car($e), "atom")) { return atom(s_eval(cadr($e), $a)); }
elseif (eq(car($e), "eq")) { return eq( s_eval(cadr($e), $a),
s_eval(caddr($e), $a)); }
elseif (eq(car($e), "car")) { return car( s_eval(cadr($e), $a)); }
elseif (eq(car($e), "cdr")) { return cdr( s_eval(cadr($e), $a)); }
elseif (eq(car($e), "cons")) { return cons(s_eval(cadr($e), $a),
s_eval(caddr($e), $a)); }
elseif (eq(car($e), "cond")) { return evcon(cdr($e), $a); }
else { return s_eval(cons(s_assoc(car($e), $a), cdr($e)), $a); }
}
elseif (eq(caar($e), "lambda")) {
return s_eval(caddar($e),
s_append(s_pair(cadar($e), evlis(cdr($e), $a)), $a));
} else { print("Error"); }
}
function evcon($c, $a)
{
if (s_eval(caar($c), $a)) { return s_eval(cadar($c), $a); }
else { return evcon(cdr($c), $a); }
}
function evlis($m, $a)
{
if (s_null($m)) { return NULL; }
else { return cons(s_eval(car($m), $a), evlis(cdr($m), $a)); }
}
# REP (no Loop): s_rep
function s_rep($e) { return s_string(s_eval(s_read($e), "()")); }
##解説
-
リスト処理:
cons
car
cdr
eq
atom
,S式出力:s_string
先の記事よりそのまま抜粋.空リストは内部ではNULL
を設定. -
S式入力:
s_read
新規に作成.字句解析部s_lex
は()
および'
の識別でひとつの文字列を配列化.空白要素はarray_filter
によって除去されるが,連想配列としての添字対応は変わらないので,array_values
で添字振り直し.抽象構文木生成部s_syn
は括弧ネスト・ドット対・クォート記号対応とし,リスト処理関数でコンスセルによる構文木を生成.それらをまとめたS式入力関数s_read
を定義. -
評価器:
s_eval
+ユーティリティ関数
"McCarthy's Original Lisp"をベースにs_eval
関数およびユーティリティ関数を作成. -
REP (no Loop):
s_rep
s_read
→s_eval
→s_string
をまとめたs_rep
を定義.
#備考
##更新履歴
- 2020-09-21:初版公開