"jmc.lisp"とは，John McCarthy氏の原初のLISPインタプリタ記述を，Paul Graham氏がCommon Lispで実装したものです．概要は次の通り．

実装はquote atom eq cons car cdr cond defunを使用
機能はquote atom eq cons car cdr cond lambda labelを提供

jmc.lispをGNU Emacs（今回に限ってはEmacs Lispと同じ構文・基本関数で書かれているため）で実行した例は次の通り．

*** Welcome to IELM ***  Type (describe-mode) for help.
ELISP> (load "~/tmp/jmc.lisp")
t
ELISP> (eval. '((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)

ダイナミックスコープということもあり，実行例ではlambda式をletrec（Scheme）やlabels（Common Lisp）などの代わりに使用しています（つまり，labelはなくても良い）．

jmc.scm

これを，Schemeで書き直してみたというのがこの記事の主旨です．

実装はquote pair? eq? cons car cdr cond/else define #t #fを使用
機能はquote pair? eq? cons car cdr cond/else lambda #t #fを提供

(define (atom. x)
  (and. (not. (null. x)) (not. (pair? x))))

(define (null. x)
  (eq? x '()))

(define (and. x y)
  (cond (x (cond (y #t) (else #f)))
        (else #f)))

(define (not. x)
  (cond (x #f)
        (else #t)))

(define (append. x y)
  (cond ((null. x) y)
        (else (cons (car x) (append. (cdr x) y)))))

(define (list. x y)
  (cons x (cons y '())))

(define (pair. x y)
  (cond ((and. (null. x) (null. y)) '())
        ((and. (not. (atom. x)) (not. (atom. y)))
         (cons (list. (car x) (car y))
               (pair. (cdr x) (cdr y))))))

(define (assoc. x y)
  (cond ((eq? (caar y) x) (cadar y))
        (else (assoc. x (cdr y)))))

(define (eval. e a)
  (cond
    ((eq? e '#t) #t)
    ((eq? e '#f) #f)
    ((eq? e 'else) #t)
    ((atom. e) (assoc. e a))
    ((atom. (car e))
     (cond
       ((eq? (car e) 'quote) (cadr e))
       ((eq? (car e) 'pair?) (pair?  (eval. (cadr e) a)))
       ((eq? (car e) 'eq?)   (eq?    (eval. (cadr e) a)
                                     (eval. (caddr e) a)))
       ((eq? (car e) 'car)   (car    (eval. (cadr e) a)))
       ((eq? (car e) 'cdr)   (cdr    (eval. (cadr e) a)))
       ((eq? (car e) 'cons)  (cons   (eval. (cadr e) a)
                                     (eval. (caddr e) a)))
       ((eq? (car e) 'cond)  (evcon. (cdr e) a))
       (else (eval. (cons (assoc. (car e) a) (cdr e)) a))))
    ((eq? (caar e) 'lambda)
     (eval. (caddar e)
            (append. (pair. (cadar e) (evlis. (cdr e) a))
                     a)))))

(define (evcon. c a)
  (cond ((eval. (caar c) a)
         (eval. (cadar c) a))
        (else (evcon. (cdr c) a))))

(define (evlis. m a)
  (cond ((null. m) '())
        (else (cons (eval. (car m) a)
                    (evlis. (cdr m) a)))))

GNU Guile 3.0を用いた実行例は次の通り．

$ guile
（起動時の表示はカット．プロンプトは"guile>"のみ）
guile> (load "./jmclisp.scm")
guile> (eval. '((lambda (assoc k v) (assoc k v))
...             '(lambda (k v)
...                (cond ((eq? v '()) #f)
...                      ((eq? (car (car v)) k)
...                       (car v))
...                      (else (assoc k (cdr v)))))
...             'Orange
...             '((Apple . 120) (Orange . 210) (Lemon . 180)))
...            '())
$1 = (Orange . 210)

備考

記事に関する補足

cadrとかも使ってるのは御容赦を．jmc.lispでも未定義で使ってたりするし．
jmc.scmで更にjmc.scmを記述できるはずだけど…~~実行が面倒そう．~~→元の"jmc.lisp"でやってみました．
初期のLISP（≒jmc.lisp）がダイナミックスコープなのはバグ，というのは，開発者が意図していなかったという意味で，僕もそう思う（苦笑）．ラムダ式ならレキシカルスコープじゃないと辻褄が合わないし，なにより，必要ないはずのlabelが定義されていたあたりなんといいますか．まあ，おかげでこうして，超手軽に再帰処理を定義・実行できる処理系を，いろんなプログラミング言語でこれまた超手軽に定義・実行できるのだけれども．

更新履歴

2020-09-14：備考欄に『jmc.lispでjmc.lispを実行してみた』記事について追記
2020-09-11：備考欄にダイナミックスコープに関する補足を追加
2020-09-08：初版公開

jmc.lispをjmc.scmに書き直してみた

jmc.scm

備考

記事に関する補足

更新履歴