LoginSignup
1
2

More than 3 years have passed since last update.

@ytaki0801(Yozo TAKIZAWA)

簡易LISP処理系の実装例（C++17版）

Last updated at Posted at 2020-10-11

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

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

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

処理系の概要

実行例は次の通り．GCC 8.3.0（--std=c++17）にて確認．

$ c++ jmclisp.cpp --std=c++17
$ ./a.out
(car (cdr '(10 20 30)))

20
$ ./a.out
((lambda (x) (car (cdr x))) '(abc def ghi))

def
$ ./a.out
((lambda (f x y) (f x (f y '()))) 'cons '10 '20)

(10 20)
$ ./a.out
((lambda (f x y) (f x (f y '())))
 '(lambda (x y) (cons x (cons y '())))
 '10 '20)

(10 (20 ()))
$ ./a.out
((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.cpp
//
// JMC Lisp: defined in McCarthy's 1960 paper,
// with S-expression input/output and basic list processing
//

#include <iostream>
#include <string>
#include <functional>
#include <variant>

using namespace std;


// basic list processing: cons, car, cdr, eq, atom

struct CELL;

struct CONS {
  vector<CELL> pair;
  CONS() : pair(2) { }
};

struct CELL { variant<string, CONS> node; };

CELL cons(CELL x, CELL y)
{
  CONS c; c.pair[0] = x; c.pair[1] = y;
  CELL s; s.node = c;
  return s;
}

CELL car(CELL x) { return get<1>(x.node).pair[0]; }
CELL cdr(CELL x) { return get<1>(x.node).pair[1]; }
bool atom(CELL s) { return s.node.index() == 0; }

bool eq(CELL x, CELL y) {
  if (atom(x) && atom(y))
    return get<0>(x.node) == get<0>(y.node);
  else
    return false;
}

string c2s(CELL s) { return get<0>(s.node); }
CELL s2c(string s) { CELL r; r.node = s; return r; }
CELL nil(void) { return s2c("nil"); }


// S-expression output: s_display

void s_display(CELL s);

void s_strcons(CELL s) {
  s_display(car(s));
  CELL sd = cdr(s);
  if (eq(sd, nil())) { cout << ""; }
  else if (atom(sd)) {
    cout << " . " << c2s(sd);
  } else { cout << " "; s_strcons(sd); }
}

void s_display(CELL s) {
  if (eq(s, nil())) { cout << "()"; }
  else if (atom(s)) { cout << c2s(s); }
  else {
    cout << "("; s_strcons(s); cout << ")";
  }
}


// S-expression input: s_read

bool s_lc(char c)
{
  return c == '(' || c == ')' || c == '\'';
}

vector<string> s_lex(string s)
{
  vector<string> r;
  string t;

  for (char c: s) {
    if (c == ' ' && t != "") {
      r.push_back(t); t = "";
    } else if (s_lc(c) && t != "") {
      r.push_back(t); t = "";
      r.push_back(string(1, c));
    } else if (s_lc(c)) {
      r.push_back(string(1, c));
    } else {
      if (c != ' ') t.push_back(c);
    }
  }
  if (t != "") r.push_back(t);

  return r;
}

CELL s_quo(CELL x, vector<string> s, int *pos)
{
  if (*pos != -1 && s[*pos] == "'") {
    *pos = *pos - 1;
    return cons(s2c("quote"), cons(x, nil()));
  } else {
    return x;
  }
}

CELL s_syn(vector<string> s, int *pos)
{
  string t = s[*pos];
  *pos = *pos - 1;
  if (t == ")") {
    CELL r = nil();
    while(s[*pos] != "(") {
      if (s[*pos] == ".") {
        *pos = *pos - 1;
        r = cons(s_syn(s, pos), car(r));
      } else {
        r = cons(s_syn(s, pos), r);
      }
    }
    *pos = *pos - 1;
    return s_quo(r, s, pos);
  } else {
    return s_quo(s2c(t), s, pos);
  }
}

CELL s_read(string s)
{
  vector<string> rl;
  rl = s_lex(s);
  int pos = rl.size() - 1;
  return s_syn(rl, &pos);
}


// JMC Lisp evaluator: s_eval

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

bool s_null(CELL x) { return eq(x, nil()); }

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

CELL s_list(CELL x, CELL y)
{
  return cons(x, cons(y, nil()));
}

CELL s_pair(CELL x, CELL y)
{
  if (s_null(x) && s_null(y)) { return nil(); }
  else if (!atom(x) && !atom(y)) {
    return cons(s_list(car(x), car(y)),
                s_pair(cdr(x), cdr(y)));
  } else { return nil(); }
}

CELL s_assoc(CELL x, CELL y)
{
  if (eq(caar(y), x)) { return cadar(y); }
  else { return s_assoc(x, cdr(y)); }
}

CELL s_atom(CELL s)
{
  if (atom(s))
    return s2c("t");
  else
    return nil();
}
CELL s_eq(CELL s1, CELL s2)
{
  if (eq(s1, s2))
    return s2c("t");
  else
    return nil();
}

CELL evcon(CELL c, CELL a);
CELL evlis(CELL m, CELL a);
CELL s_eval(CELL e, CELL a)
{
  if      (eq(e, s2c("t"))) { return s2c("t"); }
  else if (eq(e, nil()))   { return nil(); }
  else if (atom(e)) { return s_assoc(e, a); }
  else if (atom(car(e))) {
    if        (eq(car(e), s2c("quote"))) {
      return cadr(e);
    } else if (eq(car(e), s2c("atom")))  {
      return s_atom(s_eval(cadr(e), a));
    } else if (eq(car(e), s2c("eq"))) {
      return s_eq(s_eval(cadr(e), a),
                  s_eval(caddr(e), a));
    } else if (eq(car(e), s2c("car"))) {
      return car( s_eval(cadr(e), a));
    } else if (eq(car(e), s2c("cdr"))) {
      return cdr( s_eval(cadr(e), a));
    } else if (eq(car(e), s2c("cons"))) {
      return cons(s_eval(cadr(e), a),
                  s_eval(caddr(e), a));
    } else if (eq(car(e), s2c("cond"))) {
      return evcon(cdr(e), a);
    } else {
      return s_eval(cons(s_assoc(car(e), a), cdr(e)), a);
    }
  } else if (eq(caar(e), s2c("lambda"))) {
    return s_eval(caddar(e),
                  s_append(s_pair(cadar(e), evlis(cdr(e), a)),
                           a));
  } else {
    cout << "Error" << endl;
    return nil();
  }
}

CELL evcon(CELL c, CELL a)
{
  if (eq(s_eval(caar(c), a), s2c("t"))) {
    return s_eval(cadar(c), a);
  } else { return evcon(cdr(c), a); }
}

CELL evlis(CELL m, CELL a)
{
  if (s_null(m)) { return nil(); }
  else { return cons(s_eval(car(m), a), evlis(cdr(m), a)); }
}


// REP (no Loop): s_rep
void s_rep(string s)
{
  return s_display(s_eval(s_read(s), nil()));
}


int main(void)
{
  string s = "", i;

  do {
    i = "";
    getline(cin, i);
    s = s + i;
  } while (i != "");

  s_rep(s); cout << endl;

  return (0);
}

解説

  • リスト処理：cons car cdr eq atom，S式出力：s_display
    先の記事よりそのまま抜粋．variantおよびvectorを用いて，文字列とコンスセルの双方を参照可能な相互再帰構造体を構成して実装．

  • S式入力：s_read
    新規に作成．字句解析部s_lexは()および'の識別でひとつの文字列を配列化，抽象構文木生成部s_synは括弧ネスト・ドット対・クォート記号対応とし，リスト処理関数で構文木を生成．

  • 評価器：s_eval＋ユーティリティ関数
    "McCarthy's Original Lisp"をベースにs_eval関数およびユーティリティ関数を作成．

  • REP (no Loop)：s_rep
    s_read→s_eval→s_displayをまとめたs_repを定義．また，main関数で空行を入力するまで複数行を入力してひとつの文字列とし，s_repに渡すよう記述．

備考

記事に関する補足

  • C++でも17なのは，解説にあるように，コンスセル実装にvariantとvectorを用いる必要があったため．つまり，17未満の場合は…C言語実装版を参照（手抜き）．

更新履歴

  • 2020-10-11：初版公開
1
2
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
Sign upLogin
1
2