0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

簡易LISP処理系の実装例(PHP版)

Last updated at Posted at 2020-09-21

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

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

最低限の機能をもった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の他,condlambdaが使用可能
  • 組込関数: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_reads_evals_stringをまとめたs_repを定義.

#備考

##更新履歴

  • 2020-09-21:初版公開
0
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?