【他言語版へのリンク記事】簡易LISP処理系の実装例【各言語版まとめ】
この記事は,下記拙作記事のR言語版を抜粋・修正したものを利用した,簡易LISP処理系("McCarthy's Original Lisp")の実装例をまとめたものです.
最低限の機能をもったLISP処理系の実装の場合,本体である評価器(eval)実装はとても簡単であり,むしろ,字句・構文解析を行うS式入出力やリスト処理実装の方が開発言語ごとの手間が多く,それが敷居になっている人向けにまとめています.
処理系の概要
実行例は次の通り.R 3.5.2にて確認.
> source("jmclisp.r")
> s_rep(s_readlines())
(car (cdr '(10 20 30)))
[1] "20"
> s_rep(s_readlines())
((lambda (x) (car (cdr x))) '(abc def ghi))
[1] "def"
> s_rep(s_readlines())
((lambda (f x y) (f x (f y '()))) 'cons '10 '20)
[1] "(10 20)"
> s_rep(s_readlines())
((lambda (f x y) (f x (f y '())))
'(lambda (x y) (cons x (cons y '())))
'10 '20)
[1] "(10 (20 ()))"
> s_rep(s_readlines())
((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)))
[1] "(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)などの代わりに使用しています.
#実装例
##ソースコード一式
#
# 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
# with S-expreesion output: s_string
cons <- function(x, y) { list(x, y) }
car <- function(s) { s[[1]] }
cdr <- function(s) { s[[2]] }
eq <- function(s1, s2) {
if (is.null(s1) && is.null(s2)) { TRUE }
else if (is.character(s1) && is.character(s2)) { s1 == s2 }
else if (is.logical(s1) && is.logical(s2)) { s1 == s2 }
else { FALSE }
}
atom <- function(s) { is.character(s) || is.null(s) || is.logical(s) }
s_strcons <- function(s) {
sa_r = s_string(car(s))
sd = cdr(s)
if (eq(sd, NULL)) {
sa_r
} else if (atom(sd)) {
paste(sa_r, " . ", sd, sep="")
} else {
paste(sa_r, " ", s_strcons(sd), sep="")
}
}
s_string <- function(s) {
if (eq(s, NULL)) {
"()"
} else if (atom(s)) {
s
} else {
paste("(", s_strcons(s), ")", sep="")
}
}
# S-expression input: s_read
s_lex <- function(p) {
for (d in c("\\(", "\\)", "'")) {
p = gsub(d, paste(" ", d, " ", sep=""), p)
}
strsplit(p, " +")
rp = strsplit(p, " +")
rp[[1]][-which(rp[[1]] %in% "")]
}
s_quote <- function(x, s) {
if (length(s) != 0 && s[1] == "'") {
list(cons("quote", cons(x, NULL)), s[-1])
} else {
list(x, s)
}
}
s_syn0 <- function(s, r) {
if (s[1] == '(') {
list(r, s[-1])
} else if (s[1] == '.') {
rr <- s_syn(s[-1])
s_syn0(rr[[2]], cons(rr[[1]], car(r)))
} else {
rr <- s_syn(s)
s_syn0(rr[[2]], cons(rr[[1]], r))
}
}
s_syn <- function(s) {
if (s[1] == ')') {
r = s_syn0(s[-1], NULL)
s_quote(r[[1]], r[[2]])
} else {
s_quote(s[1], s[-1])
}
}
s_read <- function(s) { s_syn(rev(s_lex(s)))[[1]] }
# JMC Lisp evaluator: s_eval
caar <- function(x) { car(car(x)) }
cadr <- function(x) { car(cdr(x)) }
cadar <- function(x) { car(cdr(car(x))) }
caddr <- function(x) { car(cdr(cdr(x))) }
caddar <- function(x) { car(cdr(cdr(car(x)))) }
s_null <- function(x) { eq(x, NULL) }
s_append <- function(x, y) {
if (s_null(x)) {
y
} else {
cons(car(x), s_append(cdr(x), y))
}
}
s_list <- function(x, y) { cons(x, cons(y, NULL)) }
s_pair <- function(x, y) {
if (s_null(x) && s_null(y)) {
NULL
} else if (!atom(x) && !atom(y)) {
cons(s_list(car(x), car(y)), s_pair(cdr(x), cdr(y)))
} else {
NULL
}
}
s_assoc <- function(x, y) {
if (eq(caar(y), x)) {
cadar(y)
} else {
s_assoc(x, cdr(y))
}
}
s_eval <- function(e, a) {
if (eq(e, "t")) {
"t"
} else if (eq(e, "nil")) {
"nil"
} else if (atom(e)) {
s_assoc(e, a)
} else if (atom(car(e))) {
if (eq(car(e), "quote")) {
cadr(e)
} else if (eq(car(e), "atom")) {
if (atom(s_eval(cadr(e), a))) { "t" } else { "nil" }
} else if (eq(car(e), "eq")) {
if (eq(s_eval(cadr(e), a), s_eval(caddr(e), a))) { "t" } else { "nil" }
} else if (eq(car(e), "car")) {
car(s_eval(cadr(e), a))
} else if (eq(car(e), "cdr")) {
cdr(s_eval(cadr(e), a))
} else if (eq(car(e), "cons")) {
cons(s_eval(cadr(e), a), s_eval(caddr(e), a))
} else if (eq(car(e), "cond")) {
evcon(cdr(e), a)
} else {
s_eval(cons(s_assoc(car(e), a), cdr(e)), a)
}
} else if (eq(caar(e), "lambda")) {
s_eval(caddar(e),
s_append(s_pair(cadar(e), evlis(cdr(e), a)), a))
} else {
print("Error")
NULL
}
}
evcon <- function(c, a) {
if (s_eval(caar(c), a) == "t") {
s_eval(cadar(c), a)
} else {
evcon(cdr(c), a)
}
}
evlis <- function(m, a) {
if (s_null(m)) {
NULL
} else {
cons(s_eval(car(m), a), evlis(cdr(m), a))
}
}
# REP (no Loop): s_rep
s_rep <- function(e) { s_string(s_eval(s_read(e), s_read("()"))) }
s_readlines <- function() {
r = ""
i = readline()
while (i != "") {
r = paste(r, i, sep="")
i = readline()
}
r
}
##解説
-
リスト処理:
cons
car
cdr
eq
atom
,S式出力:s_string
先の記事より,ほぼそのまま抜粋. -
S式入力:
s_read
先の記事から,字句解析部を(
)
および'
の識別に変更,抽象構文木生成部をドット対とクォート記号対応としつつ,リスト処理関数でコンスセルによる構文木を生成するよう変更,それらをまとめたS式入力関数s_read
を定義. -
評価器:
s_eval
+ユーティリティ関数
"McCarthy's Original Lisp"をベースにs_eval
関数およびユーティリティ関数を作成.なお,FALSE
以外のオブジェクトを真として扱わない言語仕様であるため,eq
やatom
は真偽値としてt
かnil
を返すようにすると共に,cond
の条件式の評価結果がt
の時に対応する処理を実行するようevcon
にて定義. -
REP (no Loop):
s_rep
s_read
→s_eval
→s_string
をまとめたs_rep
を定義.また,そのままでは二重引用符で囲んだ(LISP記述としての)文字列を複数行に分けて入力・記述することができないため,空行を入力するまで行単位の文字列入力を行い,結合して返す関数s_readlines
を併せて定義.
#備考
##記事に関する補足
- R言語はコンスセルに基づくデータ構造を持っているのだけれども,リスト同士の要素結合が直接的にはできなかったりベクトル変換すると平坦化されたりするため活かせなかったという….
##更新履歴
- 2020-10-04:初版公開