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

【他言語版へのリンク記事】[簡易LISP処理系の実装例【各言語版まとめ】](https://qiita.com/ytaki0801/items/dcb0fe48cbeab30ac40d)

この記事は，下記拙作記事のR言語版を抜粋・修正したものを利用した，簡易LISP処理系（["McCarthy's Original Lisp"](http://paulgraham.com/lispcode.html)）の実装例をまとめたものです．

* [『括弧文字列』簡易パーサ実装例まとめ](https://qiita.com/ytaki0801/items/b8d7d4c778fe98966ce5)
* [リスト処理関数（cons,car,cdr,eq,atom）実装例まとめ](https://qiita.com/ytaki0801/items/a11c8143c5c63a406c7f)

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


# 処理系の概要
実行例は次の通り．R 3.5.2にて確認．

```lisp
> 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"](http://paulgraham.com/lispcode.html)をベースにした評価器
* 数字を含むアトムは全てシンボルとし，変数の値とする場合は`quote`（`'`）を使用
* 構文として`quote`の他，`cond`と`lambda`が使用可能
* 組込関数：`atom` `eq` `cons` `car` `cdr`（内部でコンスセルを作成）
* 真偽値は`t`（真）および`nil`（偽）＝空リスト＝`NULL`
* エラーチェックなし，モジュール化なし，ガーベジコレクションなし

"McCarthy's Original Lisp"の詳細については[まとめ記事](https://qiita.com/ytaki0801/items/dcb0fe48cbeab30ac40d)を参照．ダイナミックスコープということもあり，実行例では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`
[先の記事](https://qiita.com/ytaki0801/items/a11c8143c5c63a406c7f)より，ほぼそのまま抜粋．

* S式入力：`s_read`
[先の記事](https://qiita.com/ytaki0801/items/b8d7d4c778fe98966ce5)から，字句解析部を`(` `)`および`'`の識別に変更，抽象構文木生成部をドット対とクォート記号対応としつつ，リスト処理関数でコンスセルによる構文木を生成するよう変更，それらをまとめたS式入力関数`s_read`を定義．

* 評価器：`s_eval`＋ユーティリティ関数
["McCarthy's Original Lisp"](http://paulgraham.com/lispcode.html)をベースに`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：初版公開