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

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

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

* [『括弧文字列』簡易パーサ実装例まとめ](https://qiita.com/ytaki0801/items/b8d7d4c778fe98966ce5)
* [リスト処理関数（cons,car,cdr,eq,atom）実装例まとめ](https://qiita.com/ytaki0801/items/a11c8143c5c63a406c7f)

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

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

```rust:main.rs
fn main() {
  println!("{}", s_rep("(car (cdr '(10 20 30)))"));

  println!("{}", s_rep("((lambda (x) (car (cdr x))) '(abc def ghi))"));

  println!("{}", s_rep("((lambda (func x y) (func x (func y '()))) \
                        'cons '10 '20)"));

  println!("{}", s_rep("((lambda (func x y) (func x (func y '()))) \
                        '(lambda (x y) (cons x (cons y '())))      \
                        '10 '20)"));

  println!("{}", s_rep("((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)))"));
}
```
```rust
$ cargo run
    Finished dev [unoptimized + debuginfo] target(s) in 0.03s
     Running `target/debug/jmclisp_rs`
20
def
(10 20)
(10 (20 ()))
(Orange . 210)
```

実装内容は次の通り．

* ["McCarthy's Original Lisp"](http://paulgraham.com/lispcode.html)をベースにした評価器
* 数字を含むアトムは全てシンボルとし，変数の値とする場合は`quote`（`'`）を使用
* 構文として`quote`の他，`cond`と`lambda`が使用可能
* 組込関数：`atom` `eq` `cons` `car` `cdr`（内部でコンスセルを作成）
* 真偽値は`t`（真）および`nil`（偽）＝空リスト
* エラーチェックなし，モジュール化なし，ガーベジコレクションなし

"McCarthy's Original Lisp"の詳細については[まとめ記事](https://qiita.com/ytaki0801/items/dcb0fe48cbeab30ac40d)を参照．ダイナミックスコープということもあり，実行例ではlambda式を`letrec`（Scheme）や`labels`（Common Lisp）などの代わりに使用しています．

#実装例

##ソースコード一式

```rust:main.rs
//
// JMC Lisp: defined in McCarthy's 1960 paper,
// with S-expression input/output and basic list processing
//

use std::fmt;


// basic list processing: cons, uncons(car, cdr), eq, atom
// and S-expreesion output

#[derive(Clone)]
enum CELL { ATOM(String), PAIR(CONS), }

#[derive(Clone)]
struct CONS { x: Box<CELL>, y: Box<CELL>, }

#[allow(dead_code)]
impl fmt::Display for CONS {
  fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
    match &(*self.y) {
      CELL::ATOM(s) => {
        if s == "nil" {
          write!(f, "{}", self.x)
        } else {
          write!(f, "{} . {}", self.x, self.y)
        }
      },
      CELL::PAIR(s) => { write!(f, "{} {}", self.x, s) },
    }
  }
}

#[allow(dead_code)]
impl fmt::Display for CELL {
  fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
    match self {
      CELL::ATOM(s)  => {
        if s == "nil" {
          write!(f, "()")
        } else {
          write!(f, "{}", s)
        }
      },
      CELL::PAIR(ss) => write!(f, "({})", ss),
    }
  }
}

#[allow(dead_code)]
impl CELL {
  fn strg(c: &str) -> CELL { CELL::ATOM(String::from(c)) }
  fn cons(a: CELL, d: CELL) -> CELL {
    CELL::PAIR( CONS { x: Box::new(a), y: Box::new(d), })
  }
  fn uncons(s: CELL) -> (CELL, CELL) {
    match s {
      CELL::PAIR(CONS { x, y }) => {
        (::std::mem::replace(&mut *Box::leak(x), CELL::strg("nil")),
         ::std::mem::replace(&mut *Box::leak(y), CELL::strg("nil")))
      },
      CELL::ATOM(s) => (CELL::ATOM(s), CELL::strg("nil")),
    }
  }
  fn atom(s: &CELL) -> bool {
    match &s {
      CELL::PAIR(CONS { x: _, y: _ }) => false,
      CELL::ATOM(_) => true,
    }
  }
}

#[allow(dead_code)]
impl PartialEq for CONS {
  fn eq(&self, _: &Self) -> bool { false }
}

#[allow(dead_code)]
impl PartialEq for CELL {
  fn eq(&self, other: &Self) -> bool {
    match self {
      CELL::ATOM(s1) => {
        match other {
          CELL::ATOM(s2) => { s1 == s2 },
                       _ => false,
        }
      }, _ => false,
    }
  }
}


// S-expression input: s_read

fn s_lex(s: &str) -> Vec<String> {
  let r: String = s.replace("(", " ( ")
                   .replace(")", " ) ")
                   .replace("'", " ' ");
  r.split_whitespace()
   .map(|x| x.to_string())
   .collect()
}

fn s_quote(x: CELL, mut s: Vec<String>)
  -> (CELL, Vec<String>) {
  if !s.is_empty() && s[s.len() - 1] == "'" {
    s.pop();
    (CELL::cons(CELL::strg("quote"),
     CELL::cons(x, CELL::strg("nil"))), s)
  } else {
    (x, s)
  }
}

fn s_syn0(r: CELL, mut s: Vec<String>)
  -> (CELL, Vec<String>) {
  let mut t = s.split_off(s.len() - 1);
  if t[0] == "(" {
    (r, s)
  } else if t[0] == "." {
    let (rr, rs) = s_syn(s);
    let (ca, _) = CELL::uncons(r);
    s_syn0(CELL::cons(rr, ca), rs)
  } else {
    s.append(&mut t);
    let (rr, rs) = s_syn(s);
    let c = CELL::cons(rr, r);
    s_syn0(c, rs)
  }
}

fn s_syn(mut s: Vec<String>)
  -> (CELL, Vec<String>) {
  let t = s.split_off(s.len() - 1);
  if t[0] == ")" {
    let (r, ss) = s_syn0(CELL::strg("nil"), s);
    s_quote(r, ss)
  } else {
    s_quote(CELL::strg(&t[0]), s)
  }
}

fn s_read(s: &str) -> CELL {
  let (rs, _) = s_syn(s_lex(s)); rs
}


// JMC Lisp evaluator: s_eval

fn eqev(s1: CELL, s2: CELL) -> CELL {
  if s1 == s2 {
    CELL::strg("t")
  } else {
    CELL::strg("nil")
  }
}

fn atomev(s: CELL) -> CELL {
  if CELL::atom(&s) {
    CELL::strg("t")
  } else {
    CELL::strg("nil")
  }
}

fn s_null(x: &CELL) -> bool {
  x == &CELL::strg("nil")
}

fn s_append(x: CELL, y: CELL) -> CELL {
  if s_null(&x) {
    y
  } else {
    let (a, d) = CELL::uncons(x);
    CELL::cons(a, s_append(d, y))
  }
}

fn s_list(x: CELL, y: CELL) -> CELL {
  CELL::cons(x, CELL::cons(y, CELL::strg("nil")))
}

fn s_pair(x: CELL, y: CELL) -> CELL {
  if s_null(&x) || s_null(&y) {
    CELL::strg("nil")
  } else if !(CELL::atom(&x)) && !(CELL::atom(&y)) {
    let (xa, xd) = CELL::uncons(x);
    let (ya, yd) = CELL::uncons(y);
    CELL::cons(s_list(xa, ya), s_pair(xd, yd))
  } else {
    CELL::strg("nil")
  }
}

fn s_assoc(x: CELL, y: CELL) -> CELL {
  let (ya, yd) = CELL::uncons(y);
  let (yaa, yad) = CELL::uncons(ya);
  let (yada, _) = CELL::uncons(yad);
  if yaa == x {
    yada
  } else {
    s_assoc(x, yd)
  }
}

fn s_eval(e: CELL, a: CELL) -> CELL {
  if CELL::atom(&e) {
    s_assoc(e, a)
  } else {
    let (ea, ed) = CELL::uncons(e);
    if CELL::atom(&ea) {
      if ea == CELL::strg("quote") {
        let (eda, _) = CELL::uncons(ed);
        eda
      } else if ea == CELL::strg("atom") {
        let (eda, _) = CELL::uncons(ed);
        let t = a.clone();
        atomev(s_eval(eda, t))
      } else if ea == CELL::strg("eq") {
        let (eda, edd) = CELL::uncons(ed);
        let (edda,  _) = CELL::uncons(edd);
        let t1 = a.clone();
        let t2 = a.clone();
        eqev(s_eval(eda, t1), s_eval(edda, t2))
      } else if ea == CELL::strg("car") {
        let t = a.clone();
        let (eda, _) = CELL::uncons(ed);
        let (ra,  _) = CELL::uncons(s_eval(eda, t));
        ra
      } else if ea == CELL::strg("cdr") {
        let t = a.clone();
        let (eda, _) = CELL::uncons(ed);
        let (_,  rd) = CELL::uncons(s_eval(eda, t));
        rd
      } else if ea == CELL::strg("cons") {
        let (eda, edd) = CELL::uncons(ed);
        let (edda,  _) = CELL::uncons(edd);
        let t1 = a.clone();
        let t2 = a.clone();
        CELL::cons(s_eval(eda, t1), s_eval(edda, t2))
      } else if ea == CELL::strg("cond") {
        evcon(ed, a)
      } else {
        let t1 = a.clone();
        let t2 = a.clone();
        s_eval(CELL::cons(s_assoc(ea, t1), ed), t2)
      }
    } else {
      let (eaa, ead) = CELL::uncons(ea);
      if eaa == CELL::strg("lambda") {
        let (eada, eadd) = CELL::uncons(ead);
        let (eadda,   _) = CELL::uncons(eadd);
        let t1 = a.clone();
        let t2 = a.clone();
        s_eval(eadda, s_append(s_pair(eada, evlis(ed, t1)), t2))
      } else {
        CELL::strg("nil")
      }
    }
  }
}

fn evcon(c: CELL, a: CELL) -> CELL {
  let t1 = a.clone();
  let t2 = a.clone();
  let (ca,   cd) = CELL::uncons(c);
  let (caa, cad) = CELL::uncons(ca);
  let (cada,  _) = CELL::uncons(cad);
  if s_eval(caa, t1) == CELL::strg("t") {
    s_eval(cada, t2)
  } else {
    evcon(cd, t2)
  }
}

fn evlis(m: CELL, a: CELL) -> CELL {
  if m == CELL::strg("nil") {
    CELL::strg("nil")
  } else {
    let t1 = a.clone();
    let t2 = a.clone();
    let (ma, md) = CELL::uncons(m);
    CELL::cons(s_eval(ma, t1), evlis(md, t2))
  }
}


// REP (no Loop): s_rep

fn s_rep(s: &str) -> CELL {
  s_eval(s_read(s), CELL::strg("nil"))
}


fn main() {
  println!("{}", s_rep("(car (cdr '(10 20 30)))"));

  println!("{}", s_rep("((lambda (x) (car (cdr x))) '(abc def ghi))"));

  println!("{}", s_rep("((lambda (func x y) (func x (func y '()))) \
                        'cons '10 '20)"));

  println!("{}", s_rep("((lambda (func x y) (func x (func y '()))) \
                        '(lambda (x y) (cons x (cons y '())))      \
                        '10 '20)"));

  println!("{}", s_rep("((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) (Lemmon . 180)))"));
}
```

##解説

* リスト処理：`cons` `uncons`(`car`，`cdr`相当) `eq` `atom`，および，S式出力
[先の記事](https://qiita.com/ytaki0801/items/a11c8143c5c63a406c7f)よりそのまま抜粋．Rust版については，S式入出力の[元記事](https://qiita.com/ytaki0801/items/b8d7d4c778fe98966ce5)でも抜粋・修正の上で使用しています．

* S式字句解析：`s_lex`，S式抽象構文木生成：`s_syn`，S式入力：`s_read`
 [先の記事](https://qiita.com/ytaki0801/items/b8d7d4c778fe98966ce5)から，字句解析部を`()`および`'`の識別に変更．抽象構文木生成部については，元記事でもリスト処理関数でコンスセルによる構文木を生成しており，そこに，ドット対とクォート記号に対応するための記述を追加．`s_lex`→`s_syn`をまとめた`s_read`を定義．

* 評価器：`s_eval`＋ユーティリティ関数
["McCarthy's Original Lisp"](http://paulgraham.com/lispcode.html)をベースに`s_eval`関数およびユーティリティ関数を作成．リスト処理部同様，基本的にはムーブセマンティクスで実装しているが，関数適用時の引数評価のための並行参照その他に対応するため，環境変数`a`のみ`CELL` `CONS`の`Clone`トレイトによるコピーセマンティクスにて処理．

* REP (no Loop)：`s_rep`
`s_read`→`s_eval`をまとめた`s_rep`を定義．

#備考

##記事に関する補足
* ほとんどをムーブセマンティクスで実装したこともあって，ガーベジコレクションなしでも問題ないかな？ダメかな．

##更新履歴
* 2020-09-29：初版公開