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

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

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

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

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


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

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

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

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

(10 20)
$ perl jmclisp.pl
((lambda (f x y) (f x (f y '())))
 '(lambda (x y) (cons x (cons y '())))
 '10 '20)

(10 (20 ()))
$ perl jmclisp.pl
((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.pl
#
# 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

sub cons { [$_[0], $_[1]]; }
sub car { my $r = $_[0]; $$r[0]; }
sub cdr { my $r = $_[0]; $$r[1]; }
sub atom { !(ref $_[0]); }
sub eq_ {
  if (atom($_[0]) && atom($_[0])) {
    $_[0] eq $_[1];
  } else { 0; }
}


# S-expression output: s_string

sub s_strcons {
  my $sa_r = s_string(car($_[0]));
  my $sd = cdr($_[0]);
  if (eq_($sd, "nil")) {
    $sa_r;
  } elsif (atom($sd)) {
    $sa_r . " . " .  $sd;
  } else {
    $sa_r . " " . s_strcons($sd);
  }
}

sub s_string {
  if (eq_($_[0], "nil")) {
    "()";
  } elsif (atom($_[0])) {
    $_[0];
  } else {
    "(" . s_strcons($_[0]) . ")";
  }
}


# S-expression input: s_read

sub s_lex {
  my $t = $_[0];
  $t =~ s/\(/ ( /g;
  $t =~ s/\)/ ) /g;
  $t =~ s/\'/ ' /g;
  my @r = split(/ +/, $t);
  @r;
}

sub s_quote {
  if ($#rl != -1 && @rl[$#rl] eq "'") {
    pop(@rl);
    cons("quote", cons($_[0], "nil"));
  } else {
    $_[0];
  }
}

sub s_syn {
  my $t = pop(@rl);
  if ($t eq ")") {
    my $r = "nil";
    while (@rl[$#rl] ne "(") {
      if (@rl[$#rl] eq ".") {
        pop(@rl);
        $r = cons(s_syn(), car($r));
      } else {
        $r = cons(s_syn(), $r);
      }
    }
    pop(@rl);
    s_quote($r);
  } else {
    s_quote($t);
  }
}

sub s_read { @rl = s_lex($_[0]); s_syn(); }


# JMC Lisp evaluator: s_eval

sub caar { car(car($_[0])); }
sub cadr { car(cdr($_[0])); }
sub cadar { car(cdr(car($_[0]))); }
sub caddr { car(cdr(cdr($_[0]))); }
sub caddar { car(cdr(cdr(car($_[0])))); }

sub s_null { eq_($_[0], "nil"); }

sub s_append {
  if (s_null($_[0])) { $_[1]; }
  else { cons(car($_[0]), s_append(cdr($_[0]), $_[1])); }
}

sub s_list { cons($_[0], cons($_[1], "nil")); }

sub s_pair {
  if (s_null($_[0]) && s_null($_[1])) { "nil"; }
  elsif (!atom($_[0]) && !atom($_[1])) {
    cons(s_list(car($_[0]), car($_[1])),
         s_pair(cdr($_[0]), cdr($_[1])));
  }
}

sub s_assoc {
  if (eq_(caar($_[1]), $_[0])) { cadar($_[1]); }
  else { s_assoc($_[0], cdr($_[1])); }
}

sub s_eval {
  if    (eq_($_[0], "t"))   { 1; }
  elsif (eq_($_[0], "nil")) { 0; }
  elsif (atom($_[0])) { s_assoc($_[0], $_[1]); }
  elsif (atom(car($_[0]))) {
    if    (eq_(car($_[0]), "quote")) { cadr($_[0]); }
    elsif (eq_(car($_[0]), "atom"))  { atom(s_eval( cadr($_[0]), $_[1])); }
    elsif (eq_(car($_[0]), "eq"))    { eq_( s_eval( cadr($_[0]), $_[1]),
                                            s_eval(caddr($_[0]), $_[1])); }
    elsif (eq_(car($_[0]), "car"))   { car( s_eval( cadr($_[0]), $_[1])); }
    elsif (eq_(car($_[0]), "cdr"))   { cdr( s_eval( cadr($_[0]), $_[1])); }
    elsif (eq_(car($_[0]), "cons"))  { cons(s_eval( cadr($_[0]), $_[1]),
                                            s_eval(caddr($_[0]), $_[1])); }
    elsif (eq_(car($_[0]), "cond"))  { evcon(cdr($_[0]), $_[1]); }
    else { s_eval(cons(s_assoc(car($_[0]), $_[1]), cdr($_[0])), $_[1]); }
  } elsif (eq_(caar($_[0]), "lambda")) {
    s_eval(caddar($_[0]),
           s_append(s_pair(cadar($_[0]), evlis(cdr($_[0]), $_[1])), $_[1]));
  } else { print("Error"); }
}

sub evcon {
  if (s_eval(caar($_[0]), $_[1])) { s_eval(cadar($_[0]), $_[1]); }
  else { evcon(cdr($_[0]), $_[1]); }
}

sub evlis {
  if (s_null($_[0])) { "nil"; }
  else { cons(s_eval(car($_[0]), $_[1]), evlis(cdr($_[0]), $_[1])); }
}

# REP (no Loop): s_rep
sub s_rep { s_string(s_eval(s_read($_[0]), s_read("()"))); }


do {
  $sline = "";
  $sline = <STDIN>;
  chomp($sline);
  $slines = $slines . $sline;
} while ($sline ne "");

print s_string(s_rep($slines)), "\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`に渡して評価を実行．


#備考

##記事に関する補足
* [Raku](https://raku.guide/ja/)はどうしようかなあ…．

##更新履歴
* 2020-10-12：初版公開