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

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

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

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

処理系の概要

実行例は次の通り．PHP 7.4.10のREPLにて確認．

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

"McCarthy's Original Lisp"の詳細についてはまとめ記事を参照．ダイナミックスコープということもあり，実行例では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
先の記事よりそのまま抜粋．空リストは内部ではNULLを設定．
S式入力：s_read
新規に作成．字句解析部s_lexは()および'の識別でひとつの文字列を配列化．空白要素はarray_filterによって除去されるが，連想配列としての添字対応は変わらないので，array_valuesで添字振り直し．抽象構文木生成部s_synは括弧ネスト・ドット対・クォート記号対応とし，リスト処理関数でコンスセルによる構文木を生成．それらをまとめたS式入力関数s_readを定義．
評価器：s_eval＋ユーティリティ関数
"McCarthy's Original Lisp"をベースにs_eval関数およびユーティリティ関数を作成．
REP (no Loop)：s_rep
s_read→s_eval→s_stringをまとめたs_repを定義．

備考

更新履歴

2020-09-21：初版公開