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

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

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

* [リスト処理関数（cons,car,cdr,eq,atom）実装例まとめ](https://qiita.com/ytaki0801/items/a11c8143c5c63a406c7f)
* ~~[『括弧文字列』簡易パーサ実装例まとめ](https://qiita.com/ytaki0801/items/b8d7d4c778fe98966ce5)~~
（Lua版はS式入力を先行作成しました）

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


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

```lisp
$ lua jmclisp.lua
(car (cdr '(10 20 30)))

20
$ lua jmclisp.lua
((lambda (x) (car (cdr x))) '(abc def ghi))

def
$ lua jmclisp.lua
((lambda (f x y) (f x (f y '())))
 '(lambda (x y) (cons x (cons y '())))
 '10 '20)

(10 (20 ()))
$ lua jmclisp.lua
((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)
```

実装内容は次の通り．

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

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


#実装例

##ソースコード一式

```jmclisp.lua
--
-- JMC Lisp: defined in McCarthy's 1960 paper,
-- with S-expression input/output and conscell processing
--


-- basic conscell processing: cons, car, cdr, eq, atom
function cons(x, y) return { x, y } end
function car(s) return s[1] end
function cdr(s) return s[2] end
function eq(s1, s2) return s1 == s2 end
function atom(s)
  return type(s) == "string"
      or type(s) == "nil"
      or type(s) == "boolean"
end


-- S-expression output: s_string

function s_strcons(s)
  sa_r = s_string(car(s))
  sd = cdr(s)
  if eq(sd, nil) then
    return sa_r
  elseif atom(sd) then
    return sa_r.." . "..sd
  else
    return sa_r.." "..s_strcons(sd)
  end
end

function s_string(s)
  if     eq(s, nil)   then return "()"
  elseif eq(s, true)  then return "t"
  elseif eq(s, false) then return "nil"
  elseif atom(s)      then return  s
  else return "("..s_strcons(s)..")"
  end
end


-- S-expression input: s_read

function s_lex(s)
  s, n = string.gsub(s, "(%()", " %1 ");
  s, n = string.gsub(s, "(%))", " %1 ");
  s, n = string.gsub(s, "(%')", " %1 ");
  r = { }
  for w in string.gmatch(s, "[^ ]+") do
    table.insert(r, w);
  end
  return r
end

function s_quote(x, s)
  if #s ~= 0 and s[#s] == "'" then
    table.remove(s, #s)
    return cons("quote", cons(x, nil))
  end
    return x
end

function s_syn(s)
  local t = table.remove(s, #s)
  if t == ")" then
    local r = nil
    while s[#s] ~= "(" do
      if s[#s] == "." then
        table.remove(s, #s)
        r = cons(s_syn(s), car(r))
      else
        r = cons(s_syn(s), r)
      end
    end
    table.remove(s, #s)
    return s_quote(r, s)
  else
    return s_quote(t, s)
  end
end

function s_read(s) return s_syn(s_lex(s)) end


-- JMC Lisp evaluator: s_eval

function caar(x) return car(car(x)) end
function cadr(x) return car(cdr(x)) end
function cadar(x) return car(cdr(car(x))) end
function caddr(x) return car(cdr(cdr(x))) end
function caddar(x) return car(cdr(cdr(car(x)))) end

function s_null(x) return eq(x, nil) end

function s_append(x, y)
  if s_null(x) then
    return y
  else
    return cons(car(x), s_append(cdr(x), y))
  end
end

function s_list(x, y) return cons(x, cons(y, nil)) end

function s_pair(x, y)
  if s_null(x) or s_null(y) then
    return nil
  elseif not(atom(x)) and not(atom(y)) then
    return cons(s_list(car(x), car(y)),
                s_pair(cdr(x), cdr(y)))
  else
    return nil
  end
end

function s_assoc(x, y)
  if s_null(y) then
    return nil
  elseif eq(caar(y), x) then
    return cadar(y)
  else
    return s_assoc(x, cdr(y))
  end
end

function evcon(c, a)
  if s_eval(caar(c), a) then
    return s_eval(cadar(c), a)
  else
    return evcon(cdr(c), a)
  end
end

function evlis(m, a)
  if s_null(m) then
    return nil
  else
    return cons(s_eval(car(m), a), evlis(cdr(m), a))
  end
end

function s_eval(e, a)
  if     eq(e, "t")   then return true
  elseif eq(e, "nil") then return false
  elseif atom(e) then return s_assoc(e, a)
  elseif atom(car(e)) then
    if     eq(car(e), "quote") then return cadr(e)
    elseif eq(car(e), "atom")  then return atom(s_eval(cadr(e), a))
    elseif eq(car(e), "eq")    then return eq(  s_eval(cadr(e), a),
                                                s_eval(caddr(e), a))
    elseif eq(car(e), "car")   then return car( s_eval(cadr(e), a))
    elseif eq(car(e), "cdr")   then return cdr( s_eval(cadr(e), a))
    elseif eq(car(e), "cons")  then return cons(s_eval(cadr(e), a),
                                                s_eval(caddr(e), a))
    elseif eq(car(e), "cond")  then return evcon(cdr(e), a)
    else return s_eval(cons(s_assoc(car(e), a), cdr(e)), a)
    end
  elseif eq(caar(e), "lambda") then
    return s_eval(caddar(e),
                  s_append(s_pair(cadar(e), evlis(cdr(e), a)), a))
  else print ("Error")
  end
end


-- REP (no Loop): s_rep

function s_rep(e) return s_string(s_eval(s_read(e), nil)) end

s = ""
i = io.read()
while i ~= "" do
  s = s..i
  i = io.read()
end
io.write(s_rep(s), "\n")
```


##解説

* リスト処理：`cons` `car` `cdr` `eq` `atom`，S式出力：`s_string`
[先の記事](https://qiita.com/ytaki0801/items/a11c8143c5c63a406c7f)よりそのまま抜粋．多次元配列にてコンスセルを実装．

* S式入力：`s_read`
新規に作成．字句解析部`s_lex`は`()`および`'`の識別でひとつの文字列を配列化．抽象構文木生成部`s_syn`は括弧ネスト・ドット対・クォート記号対応とし，リスト処理関数でコンスセルによる構文木を生成．それらをまとめたS式入力関数`s_read`を定義．

* 評価器：`s_eval`＋ユーティリティ関数
["McCarthy's Original Lisp"](http://paulgraham.com/lispcode.html)をベースに`s_eval`関数およびユーティリティ関数を作成．

* REP (no Loop)：`s_rep`
`s_read`→`s_eval`→`s_string`をまとめた`s_rep`を定義．空行が入力されるまで文字列結合した複数行入力を`s_rep`に渡して評価を実行．


#備考

##更新履歴
* 2020-11-09：初版公開