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

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

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

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

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

処理系の概要

実行例は次の通り．Perl 5.28.1にて確認．

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

"McCarthy's Original Lisp"の詳細についてはまとめ記事を参照．ダイナミックスコープということもあり，実行例では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
  先の記事よりそのまま抜粋．無名多次元配列にてコンスセルを実装．

• S式入力：s_read
  新規に作成．字句解析部s_lexは()および'の識別でひとつの文字列を配列化．抽象構文木生成部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を定義．空行が入力されるまでの複数行入力を結合した文字列をs_repに渡して評価を実行．

#備考

##記事に関する補足

• Rakuはどうしようかなあ…．

##更新履歴

• 2020-10-12：初版公開