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

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

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

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

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


# 処理系の概要
実行例は次の通り．PHP 7.4.10のREPLにて確認．

```php
$ php -a
Interactive shell

php > include "jmclisp.php";
php > echo s_rep("(car (cdr '(10 20 30)))");
20
php > echo s_rep("((lambda (x) (car (cdr x))) '(abc def ghi))");
def
php > echo s_rep("((lambda (f x y) (f x (f y '()))) 'cons '10 '20)");
(10 20)
php > echo s_rep("((lambda (f x y) (f x (f y '())))
php "              '(lambda (x y) (cons x (cons y '())))
php "              '10 '20)");
(10 (20 ()))
php > echo s_rep("((lambda (assoc k v) (assoc k v))
php "             '(lambda (k v)
php "                (cond ((eq v '()) nil)
php "                      ((eq (car (car v)) k)
php "                       (car v))
php "                      ('t (assoc k (cdr v)))))
php "             'Orange
php "             '((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`（偽）＝空リスト＝`NULL`
* エラーチェックなし，モジュール化なし，ガーベジコレクションなし

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


#実装例

##ソースコード一式

```jmclisp.php
<?php
#
# 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

function cons($x, $y) { return [$x, $y]; }
function car($s) { return $s[0]; }
function cdr($s) { return $s[1]; }
function eq($s1, $s2) { return $s1 === $s2; }
function atom($s) {
  return is_string($s) || is_bool($s) || is_null($s);
}


# S-expression output: s_string

function s_strcons($s)
{
  $sa_r = s_string(car($s));
  $sd = cdr($s);
  if (eq($sd, NULL)) {
    return $sa_r;
  } elseif (atom($sd)) {
    return $sa_r . " . " . $sd;
  } else {
    return $sa_r . " " . s_strcons($sd);
  }
}

function s_string($s)
{
  if     (eq($s, NULL))  { return "()";  }
  elseif (eq($s, true))  { return "t";   }
  elseif (eq($s, false)) { return "nil"; }
  elseif (atom($s)) {
    return $s;
  } else {
    return "(" . s_strcons($s) . ")";
  }
}


# S-expression input: s_read

function s_lex($s)
{
  return
    array_values(
      array_filter(
        explode(" ",
          str_replace([ "(" , ")" , "'" ,"\n"],
                      [" ( "," ) "," ' ", "" ],
                      $s))));
}

function s_syn_q($x, &$s)
{
  if (count($s) != 0 && end($s) == "'") {
    array_pop($s);
    return cons("quote", cons($x, NULL));
  } else {
    return $x;
  }
}

function s_syn(&$s)
{
  $t = array_pop($s);
  if ($t == ")") {
    $r = NULL;
    while (end($s) != "(") {
      if (end($s) == ".") {
        array_pop($s);
        $r = cons(s_syn($s), car($r));
      } else {
        $r = cons(s_syn($s), $r);
      }
    }
    array_pop($s);
    return s_syn_q($r, $s);
  } else {
    return s_syn_q($t, $s);
  }
}

function s_read($s) { return s_syn(s_lex($s)); }


# JMC Lisp evaluator: s_eval

function caar($x) { return car(car($x)); }
function cadr($x) { return car(cdr($x)); }
function cadar($x) { return car(cdr(car($x))); }
function caddr($x) { return car(cdr(cdr($x))); }
function caddar($x) { return car(cdr(cdr(car($x)))); }

function s_null($x) { return eq($x, NULL); }

function s_append($x, $y)
{
  if (s_null($x)) { return $y; }
  else { return cons(car($x), s_append(cdr($x), $y)); }
}

function s_list($x, $y) { return cons($x, cons($y, NULL)); }

function s_pair($x, $y)
{
  if (s_null($x) && s_null($y)) { return NULL; }
  elseif (!atom($x) && !atom($y)) {
    return cons(s_list(car($x), car($y)),
                s_pair(cdr($x), cdr($y)));
  }
}

function s_assoc($x, $y)
{
  if (eq(caar($y), $x)) {
    return cadar($y);
  } else {
    return 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))) {
        if     (eq(car($e), "quote")) { return cadr($e); }
        elseif (eq(car($e), "atom"))  { return atom(s_eval(cadr($e), $a)); }
        elseif (eq(car($e), "eq"))    { return eq(  s_eval(cadr($e), $a),
                                                    s_eval(caddr($e), $a)); }
        elseif (eq(car($e), "car"))   { return car( s_eval(cadr($e), $a)); }
        elseif (eq(car($e), "cdr"))   { return cdr( s_eval(cadr($e), $a)); }
        elseif (eq(car($e), "cons"))  { return cons(s_eval(cadr($e), $a),
                                                    s_eval(caddr($e), $a)); }
        elseif (eq(car($e), "cond"))  { return evcon(cdr($e), $a); }
        else { 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));
    } else { print("Error"); }
}

function evcon($c, $a)
{
    if (s_eval(caar($c), $a)) { return s_eval(cadar($c), $a); }
    else { return evcon(cdr($c), $a); }
}

function evlis($m, $a)
{
    if (s_null($m)) { return NULL; }
    else { return cons(s_eval(car($m), $a), evlis(cdr($m), $a)); }
}


# REP (no Loop): s_rep
function s_rep($e) { return s_string(s_eval(s_read($e), "()")); }
```


##解説

* リスト処理：`cons` `car` `cdr` `eq` `atom`，S式出力：`s_string`
[先の記事](https://qiita.com/ytaki0801/items/a11c8143c5c63a406c7f)よりそのまま抜粋．空リストは内部では`NULL`を設定．

* S式入力：`s_read`
新規に作成．字句解析部`s_lex`は`()`および`'`の識別でひとつの文字列を配列化．空白要素は`array_filter`によって除去されるが，連想配列としての添字対応は変わらないので，`array_values`で添字振り直し．抽象構文木生成部`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`を定義．


#備考

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