「基本的な 7 つの関数を実装すれば、LISP は作れる」という話をよく聞きます。僕はこのことに疑問を持っていました。和田先生が、「"Lisp 1.5 Programmer's Manual" の EVAL の定義を読むとよく分る」とおっしゃったので、お借りして読みました。
この本では、EVAL が M 式で書かれており、すんなり頭に入ってきません。そこで、Emacs Lisp で実装してみました。
表記
関数の名前は、Emacs とぶつからないように、全部大文字にします。ただし、読みにくい表記は、読みやすい表記に変えることにしました。
7 つの基本関数
さて、7 つの関数の定義です。
(defalias 'CAR 'car) (defalias 'CDR 'cdr) (defalias 'CONS 'cons) (defalias 'QUOTE 'quote) (defalias 'EQ 'eq) (defalias 'ATOM 'atom) (defalias 'COND 'cond)
注：nil もアトムだそうです。
関数定義
基本関数に加えて、関数定義のための関数が必要です。関数を定義する関数は LABEL という名前になっており、以下のように使うそうです。
(LABEL FOO (LAMBDA (VAR1 VAR2) BODY)
LABEL の定義はこうしました。
(defvar ENV '((t . t))) ;; EVAL の最初の ASSOC が t を返すように (defmacro LABEL (func lamb) `(let ((name (quote ,func))) (fset name ,lamb) (setq ENV (delete (assoc name ENV) ENV)) (setq ENV (cons (cons name ,lamb) ENV)) name))
あとで実装する EVAL は、どうも環境が連想リストで定義されていることを仮定しているようです。そこで、環境をグローバル変数として用意しました。ENV という名前で、連想リストを格納します。本には、ENV なんかでてこないので、あしからず。
一番難しかったのは、ENV の初期値です。これは後述します。
また、関数定義に必要な LAMBDA ですが、試行錯誤の後、大文字にするのは諦めて、Emacs Lisp の組み込み関数である lambda を使うことにしました。
おなじみの関数
基本関数は定義したので、これらをもとに関数を定義して行きます。まず、おなじみの関数から。
(LABEL CADR (lambda (x) (CAR (CDR x)))) ;; SECOND (LABEL CDAR (lambda (x) (CDR (CAR x)))) (LABEL CAAR (lambda (x) (CAR (CAR x)))) (LABEL CADDR (lambda (x) (CAR (CDR (CDR x))))) ;; THIRD (LABEL CADAR (lambda (x) (CAR (CDR (CAR x)))))
lambda を使っているので、Emacs で eval することができます。
(CADR '(0 1 2 3)) ;; => 1
EQUAL と NULL
EVAL の実装に必要な関数を定義します。
(LABEL EQUAL (lambda (x y) (COND ((ATOM x) (COND ((ATOM y) (EQ x y)) (t nil))) ((EQUAL (CAR x) (CAR y)) (EQUAL (CDR x) (CDR y))) (t nil)))) (LABEL NULL (lambda (x) (COND ((EQ x nil) t) (t nil))))
おなじみの関数(2)
また、EVAL には必要ありませんが、基本関数の定義も載っていました。
(LABEL SUBST (lambda (x y z) (COND ((EQUAL y z) x) ((ATOM z) z) (t (CONS (SUBST x y (CAR z)) (SUBST x y (CDR z))))))) (SUBST '(x . a) 'b '((a . b) . c)) ;; => '((a . (x . a)) . c) (LABEL APPEND (lambda (x y) (COND ((NULL x) y) (t (CONS (CAR x) (APPEND (CDR x) y)))))) (LABEL MEMBER (lambda (x y) (COND ((NULL y) nil) ((EQUAL x (CAR y)) t) (t (MEMBER x (CDR y))))))
PAIRLIS と ASSOC
次は EVAL に必要な PAIRLIS です。これは、引数の名前と値のペアを作る関数です。
(LABEL PAIRLIS (lambda (x y a) (COND ((NULL x) a) (t (CONS (CONS (CAR x) (CAR y)) (PAIRLIS (CDR x) (CDR y) a)))))) (PAIRLIS '(a b c) '(u v w) '((d . x) (e . y))) ;; => ((a . u) (b . v) (c . w) (d . x) (e . y))
おなじみの ASSOC も定義します。これは、連想リストで実装した環境に対して名前を検索し、その値を得るのに利用されます。
(LABEL ASSOC (lambda (x a) (COND ((EQUAL (CAAR a) x) (CAR a)) (t (ASSOC x (CDR a))))))
EVAL
さて、いよいよ EVAL です。EVAL は、フォームを処理する関数です。
(LABEL EVAL (lambda (e a) (COND ((ATOM e) (CDR (ASSOC e a))) ;; 引数・関数の検索 ((ATOM (CAR e)) (COND ((EQ (CAR e) 'QUOTE) (CADR e)) ((EQ (CAR e) 'COND) (EVCON (CDR e) a)) (t ;; 関数呼び出し (APPLY (CAR e) (EVLIS (CDR e) a) a)))) (t ;; 関数呼び出し (APPLY (CAR e) (EVLIS (CDR e) a) a)))))
APPLY
関数の処理は、APPLY でやります。
(LABEL APPLY (lambda (fn x a) ;; function arguments alist (COND ((ATOM fn) (COND ((EQ fn 'CAR) (CAAR x)) ((EQ fn 'CDR) (CDAR x)) ((EQ fn 'CONS) (CONS (CAR x) (CADR x))) ((EQ fn 'ATOM) (ATOM (CAR x))) ((EQ fn 'EQ) (EQ (CAR x) (CADR x))) (t (APPLY (EVAL fn a) ;; 関数名から関数本体の検索 x a)))) ((EQ (CAR fn) 'lambda) ;; ここは小文字 (EVAL (CADDR fn) ;; 関数本体 (PAIRLIS ;; 引数の登録 (CADR fn) ;; 引数 x a))) ((EQ (CAR fn) 'LABEL) (APPLY (CADDR fn) ;; lambda x (CONS ;; 関数の登録 (CONS (CADR fn) ;; 関数名 (CADDR fn)) ;; lambda a))))))
このどこを見ても、アトムでａる t を評価すると t が返る部分がありません。そこで、EVAL の最初の ASSOC が t を返すように、環境である ENV の初期値に t を登録しました。
EVCON と ELVIS
COND を処理するのは、EVCON です。
(LABEL EVCON (lambda (c a) (COND ((EVAL (CAAR c) a) ;; 条件 ;; 必ずここにマッチすると仮定しているので ;; (NULL c) をチェックしない (EVAL (CADAR c) a)) (t (EVCON (CDR c) a))))) ;; 再帰
引数は、EVLIS で処理します。
(LABEL EVLIS (lambda (m a) (COND ((NULL m) nil) (t (CONS (EVAL (CAR m) a) (EVLIS (CDR m) a))))))
EVAL を動かしてみる
さて、EVAL が実際に動くか試してみましょう。REPL という再帰関数を定義します。
(LABEL REPL (lambda (lst old new) (COND ((NULL lst) nil) ((EQ (CAR lst) old) (CONS new (REPL (CDR lst) old new))) (t (CONS (CAR lst) (REPL (CDR lst) old new))))))
Emacs で評価するとこんな感じです。
(REPL (QUOTE (a b c d)) (QUOTE c) (QUOTE x)) ;; => (a b x d)
実装した EVAL でも同じ結果となりました！
(EVAL '(REPL (QUOTE (a b c d)) (QUOTE c) (QUOTE x)) ENV) ;; => (a b x d)
