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

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

処理系の概要

実行例は次の通り．rustc 1.34.2にて確認．

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)))"));
}

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

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

実装例

ソースコード一式

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式出力
先の記事よりそのまま抜粋．Rust版については，S式入出力の元記事でも抜粋・修正の上で使用しています．
S式字句解析：s_lex，S式抽象構文木生成：s_syn，S式入力：s_read
先の記事から，字句解析部を()および'の識別に変更．抽象構文木生成部については，元記事でもリスト処理関数でコンスセルによる構文木を生成しており，そこに，ドット対とクォート記号に対応するための記述を追加．s_lex→s_synをまとめたs_readを定義．
評価器：s_eval＋ユーティリティ関数
"McCarthy's Original Lisp"をベースにs_eval関数およびユーティリティ関数を作成．リスト処理部同様，基本的にはムーブセマンティクスで実装しているが，関数適用時の引数評価のための並行参照その他に対応するため，環境変数aのみCELL CONSのCloneトレイトによるコピーセマンティクスにて処理．
REP (no Loop)：s_rep
s_read→s_evalをまとめたs_repを定義．

備考

記事に関する補足

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

更新履歴

2020-09-29：初版公開

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

処理系の概要

実装例

ソースコード一式

解説

備考

記事に関する補足

更新履歴