この記事は，下記拙作記事の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）などの代わりに使用しています．

実装例

ソースコード一式

jmclisp.r

#
# 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：初版公開

簡易LISP処理系の実装例（R言語版）

処理系の概要

実装例

ソースコード一式

解説

備考

記事に関する補足

更新履歴