【他言語版へのリンク記事】簡易LISP処理系の実装例【各言語版まとめ】

この記事は，下記拙作記事のJulia版を抜粋・修正したものを利用した，簡易LISP処理系（"McCarthy's Original Lisp"）の実装例をまとめたものです．

~~『括弧文字列』簡易パーサ実装例まとめ~~
（Julia版はS式入出力を先行作成しました）
リスト処理関数（cons,car,cdr,eq,atom）実装例まとめ

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

処理系の概要

実行例は次の通り．Julia 1.0.3にて確認．

$ julia
               _
   _       _ _(_)_     |  Documentation: https://docs.julialang.org
  (_)     | (_) (_)    |
   _ _   _| |_  __ _   |  Type "?" for help, "]?" for Pkg help.
  | | | | | | |/ _` |  |
  | | |_| | | | (_| |  |  Version 1.0.3
 _/ |\__'_|_|_|\__'_|  |  Raspbian ⛬  julia/1.0.3+dfsg-4+rpi1
|__/                   |

julia> include("./jmclisp.jl")
s_readlines (generic function with 1 method)

julia> s_rep(s_readlines())
(car (cdr '(10 20 30)))

"20"

julia> s_rep(s_readlines())
((lambda (x) (car (cdr x))) '(abc def ghi))

"def"

julia> s_rep(s_readlines())
((lambda (f x y) (f x (f y '()))) 'cons '10 '20)

"(10 20)"

julia> s_rep(s_readlines())
((lambda (f x y) (f x (f y '())))
 '(lambda (x y) (cons x (cons y '())))
 '10 '20)

"(10 (20 ()))"

julia> 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)))

"(Orange . 210)"

実装内容は次の通り．

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

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

#実装例

##ソースコード一式

jmclisp.jl

#
# 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

cons(x, y) = (x, y)
car(s) = s[1]
cdr(s) = s[2]
eq(s1, s2) = s1 == s2
atom(s) =
  isa(s, String) || isa(s, SubString) || isa(s, Nothing) || isa(s, Bool)


# S-expression input: s_read

function s_lex(s)
  for p = "()'"
    s = replace(s, p => " " * p * " ")
  end
  return split(s)
end

function s_syn(s)
  t = pop!(s)
  if t == ")"
    r = nothing
    while s[end] != "("
      if s[end] == "."
        pop!(s)
        r = cons(s_syn(s), car(r))
      else
        r = cons(s_syn(s), r)
      end
    end
    pop!(s)
    if length(s) != 0 && s[end] == "'"
      pop!(s)
      return cons("quote", cons(r, nothing))
    else
      return r
    end
  else
    if length(s) != 0 && s[end] == "'"
      pop!(s)
      return cons("quote", cons(t, nothing))
    else
      return t
    end
  end
end

s_read(s) = s_syn(s_lex(s))


# S-expression output: s_string

function s_strcons(s)
  sa_r = s_string(car(s))
  sd = cdr(s)
  eq(sd, nothing) && return sa_r
  atom(sd)        && return sa_r * " . " * sd
                     return sa_r *  " "  * s_strcons(sd)
end

function s_string(s)
  eq(s, nothing) && return "()"
  eq(s, true)    && return "t"
  eq(s, false)   && return "nil"
  atom(s)        && return s
                    return "(" * s_strcons(s) * ")"
end


# JMC Lisp evaluator: s_eval

caar(x) = car(car(x))
cadr(x) = car(cdr(x))
cadar(x) = car(cdr(car(x)))
caddr(x) = car(cdr(cdr(x)))
caddar(x) = car(cdr(cdr(car(x))))

s_null(x) = eq(x, nothing)

s_append(x, y) =
  s_null(x) ? y : cons(car(x), s_append(cdr(x), y))

s_list(x, y) = cons(x, cons(y, nothing))

s_pair(x, y) =
  s_null(x) && s_null(y) ? nothing :
  !atom(x)  && !atom(y)  ?
    cons(s_list(car(x), car(y)),
         s_pair(cdr(x), cdr(y))) :
  nil

s_assoc(x, y) =
  eq(caar(y), x) ? cadar(y) : 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))
        eq(car(e), "quote") && return cadr(e)
        eq(car(e), "atom")  && return atom(s_eval(cadr(e), a))
        eq(car(e), "eq")    && return eq(  s_eval(cadr(e), a),
                                           s_eval(caddr(e), a))
        eq(car(e), "car")   && return car( s_eval(cadr(e), a))
        eq(car(e), "cdr")   && return cdr( s_eval(cadr(e), a))
        eq(car(e), "cons")  && return cons(s_eval(cadr(e), a),
                                           s_eval(caddr(e), a))
        eq(car(e), "cond")  && return evcon(cdr(e), a)
        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))
    print("Error")
    end
end

evcon(c, a) =
  s_eval(caar(c), a) == "t" || s_eval(caar(c), a) ?
  s_eval(cadar(c), a) : evcon(cdr(c), a)

evlis(m, a) =
  s_null(m) ? nothing :
  cons(s_eval(car(m), a), evlis(cdr(m), a))


# REP (no Loop): s_rep
s_rep(e) = s_string(s_eval(s_read(e), "()"))

function s_readlines()
  r = ""
  i = readline()
  while i != ""
    r = r * i
    i = readline()
  end
  return r
end

##解説

リスト処理：cons car cdr eq atom
先の記事より，ほぼそのまま抜粋．
S式入力：s_read
新規に作成．字句解析部s_lexは()および'の識別でひとつの文字列を配列化，抽象構文木生成部s_synは括弧ネスト・ドット対・クォート記号対応とし，リスト処理関数でコンスセルによる構文木を生成．それらをまとめたS式入力関数s_readを定義．
S式出力：s_string
新規に作成．内部ではnothingである空リストは()を，真偽値はt nilを出力するよう設定．
評価器：s_eval＋ユーティリティ関数
"McCarthy's Original Lisp"をベースにs_eval関数およびユーティリティ関数を作成．
REP (no Loop)：s_rep
s_read→s_eval→s_stringをまとめたs_repを定義．また，そのままでは二重引用符で囲んだ（LISP記述としての）文字列を複数行に分けて入力・記述することができないため，空行を入力するまで行単位の文字列入力を行い，結合して返す関数s_readlinesを併せて定義．

#備考

##記事に関する補足

評価器のみで約60行／1800バイトほど．全体で約160行／3400バイトほどなので半々だろうか．~~ただ，多くの関数をラムダ式代入形式にして相応に字数を減らしているという話が．~~→判断分岐の多くを&&表現に書き直して更に削減．
Juliaでは，文字列連結が（+ではなく）*，NULL相当がnothing，ということを今回の実装で初めて知った…．

##更新履歴

2020-09-21：ソースコードの判断分岐の多くを&&表現に書き直し（Twitter返信より）
2020-09-20：初版公開