Go to Qiita Advent Calendar 2024 Top
LoginSignup
1
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

@ytaki0801(Yozo TAKIZAWA)

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

Last updated at Posted at 2020-12-10

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

この記事は，Clojureによる二種類の原初LISP評価器（"McCarthy's Original Lisp"）の実装をまとめたものです．

コンスセル未対応版

ClojureはS式入出力を扱うプログラミング言語のため，LISP評価器の実装自体は容易ですが，他のLISP系言語と異なりリスト構造はコンスセルに基づくものではなく，ドット対表現も利用できません．この版では，リスト構造を基本データ構造としつつ，『原初LISP評価器の機能に相当するClojureの機能のみで原初LISP評価器を定義』しています．具体的には次の通りです．

  • 実装は' seq? = cons first rest cond defnを使用
  • 機能はquote atom eq cons car cdr cond lambdaを提供

S式入力はClojureのreadをそのまま使用しており，'についてもquoteに自動的に変換されることを想定しています．実行例（1.10.0）は次の通り**（最後の例で(car (cdr (assoc k v)))としていることに注意）**．

$ clojure
Clojure 1.10.0
user=> (load-file "jmclisp.clojure")
#'user/eval_
user=> (eval_ (read) '())
(car (cdr '(10 20 30)))
20
user=> (eval_ (read) '())
((lambda (x) (car (cdr x))) '(abc def ghi))
def
user=> (eval_ (read) '())
((lambda (f x y) (f x (f y '()))) 'cons '10 '20)
(10 20)
user=> (eval_ (read) '())
((lambda (f x y) (f x (f y '())))
 '(lambda (x y) (cons x (cons y '())))
 '10 '20)
(10 (20 ()))
user=> (eval_ (read) '())
((lambda (assoc k v) (car (cdr (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)))
210

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

ソースコード一式は次の通り．

jmclisp.clojure
; The Lisp defined in McCarthy's 1960 paper, implemented by Clojure
; derived from jmc.lisp in http://paulgraham.com/lispcode.html
; Assumes only quote, seq?, =, cons, first, rest, cond and defn

(defn car_ [x] (first x))
(defn cdr_ [x] (rest x))
(defn caar_ [x] (car_ (car_ x)))
(defn cadr_ [x] (car_ (cdr_ x)))
(defn cadar_ [x] (car_ (cdr_ (car_ x))))
(defn caddr_ [x] (car_ (cdr_ (cdr_ x))))
(defn caddar_ [x] (car_ (cdr_ (cdr_ (car_ x)))))

(defn null_ [x] (= x '()))

(defn and_ [x y] (cond x (cond y true :else false) :else false))

(defn not_ [x] (cond x false :else true))

(defn atom_ [x] (not_ (seq? x)))

(defn append_ [x y]
  (cond (null_ x) y
        :else (cons (car_ x) (append_ (cdr_ x) y))))

(defn list_ [x y] (cons x (cons y '())))

(defn 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)))))

(defn assoc_ [x y]
  (cond (null_ y) false
        (= (caar_ y) x) (cadar_ y)
        :else (assoc_ x (cdr_ y))))

(declare eval_)

(defn evcon_ [c a]
  (cond (eval_ (caar_ c) a) (eval_ (cadar_ c) a)
        :else (evcon_ (cdr_ c) a)))

(defn evlis_ [m a]
  (cond (null_ m) '()
        :else (cons (eval_  (car_ m) a)
                    (evlis_ (cdr_ m) a))))

(defn eval_ [e a]
  (cond (atom_ e) (assoc_ e a)
        (atom_ (car_ e))
          (cond (= (car_ e) 'quote) (cadr_ e)
                (= (car_ e) 'atom)  (atom_ (eval_ (cadr_  e) a))
                (= (car_ e) 'eq)    (=     (eval_ (cadr_  e) a)
                                           (eval_ (caddr_ e) a))
                (= (car_ e) 'car)   (car_  (eval_ (cadr_  e) a))
                (= (car_ e) 'cdr)   (cdr_  (eval_ (cadr_  e) a))
                (= (car_ e) 'cons)  (cons  (eval_ (cadr_  e) a)
                                           (eval_ (caddr_ e) a))
                (= (car_ e) 'cond)  (evcon_ (cdr_ e) a)
                :else (eval_ (cons (assoc_ (car_ e) a) (cdr_ e))
                             a))
        (= (caar_ e) 'lambda)
          (eval_ (caddar_ e)
                 (append_ (pair_ (cadar_ e) (evlis_ (cdr_ e) a))
                          a))))

コンスセル対応版

ふたつの要素をもつリスト構造をコンスセルとした基本操作関数の実装と，その実装に併せたS式入出力を定義した版です．実行例（1.10.0）は次の通り**（最後の例で(cdr (assoc k v))としていることに注意）**．

$ clojure
Clojure 1.10.0
user=> (load-file "jmclisp2.clojure")
#'user/s_rep
user=> (s_rep)
(car (cdr '(10 20 30)))
20
user=> (s_rep)
((lambda (x) (car (cdr x))) '(abc def ghi))
def
user=> (s_rep)
((lambda (f x y) (f x (f y '()))) 'cons '10 '20)
(10 20)
user=> (s_rep)
((lambda (f x y) (f x (f y '())))
 '(lambda (x y) (cons x (cons y '())))
 '10 '20)
(10 (20 ()))
user=> (s_rep)
((lambda (assoc k v) (cdr (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)))
210

ソースコード一式は次の通り．

jmclisp2.clojure
;
; JMC Lisp: defined in McCarthy's 1960 paper,
; with S-expression input/output and conscell processing
;


; basic conscell processing: cons_, car_, cdr_, eq_, atom_
(defn cons_ [x y] (list x y))
(defn car_ [x] (first x))
(defn cdr_ [x] (second x))
(defn eq_ [s1 s2] (= s1 s2))
(defn atom_ [x] (not (seq? x)))


; S-expression with dotted pairs output: s_output
(declare s_output)
(defn s_strcons [s]
  (let [sa_r (s_output (car_ s)) sd (cdr_ s)]
    (cond (eq_ sd nil) (cons sa_r nil)
          (atom_ sd) (cons sa_r (cons '. (cons sd nil)))
          :else (cons sa_r (s_strcons sd)))))
(defn s_output [s]
  (cond (eq_ s nil) '()
        (eq_ s true) 't
        (eq_ s false) 'nil
        (atom_ s) s
        :else (s_strcons s)))


; S-expression with conscell lists input: s_input
(defn s_syn [s]
  (cond (atom_ s) s
        (= s '()) nil
        (= (rest s) '()) (cons_ (s_syn (first s)) nil)
        (= (second s) '.) (cons_ (s_syn (first s))
                                 (s_syn (first (rest (rest s)))))
        :else (cons (s_syn (first s))
                    (cons_ (s_syn (rest s)) nil))))
(defn s_input [] (s_syn (read)))


; JMC Lisp evaluator: eval_

(defn caar_ [x] (car_ (car_ x)))
(defn cadr_ [x] (car_ (cdr_ x)))
(defn cadar_ [x] (car_ (cdr_ (car_ x))))
(defn caddr_ [x] (car_ (cdr_ (cdr_ x))))
(defn caddar_ [x] (car_ (cdr_ (cdr_ (car_ x)))))

(defn null_ [x] (eq_ x nil))

(defn and_ [x y] (cond x (cond y true :else false) :else false))

(defn not_ [x] (cond x false :else true))

(defn append_ [x y]
  (cond (null_ x) y
        :else (cons_ (car_ x) (append_ (cdr_ x) y))))

(defn list_ [x y] (cons_ x (cons_ y nil)))

(defn pair_ [x y]
  (cond (and_ (null_ x) (null_ y))
        nil
        (and_ (not_ (atom_ x)) (not_ (atom_ y)))
        (cons_ (list_ (car_ x) (car_ y))
              (pair_ (cdr_ x) (cdr_ y)))))

(defn assoc_ [x y]
  (cond (null_ y) false
        (eq_ (caar_ y) x) (cadar_ y)
        :else (assoc_ x (cdr_ y))))

(declare eval_)

(defn evcon_ [c a]
  (cond (eval_ (caar_ c) a) (eval_ (cadar_ c) a)
        :else (evcon_ (cdr_ c) a)))

(defn evlis_ [m a]
  (cond (null_ m) nil
        :else (cons_ (eval_  (car_ m) a)
                     (evlis_ (cdr_ m) a))))

(defn eval_ [e a]
  (cond (atom_ e) (assoc_ e a)
        (atom_ (car_ e))
          (cond (eq_ (car_ e) 'quote) (cadr_ e)
                (eq_ (car_ e) 'atom)  (atom_ (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))))

; REP (no Loop): s_rep
(defn s_rep [] (s_output (eval_ (s_input) nil)))

備考

更新履歴

  • 2020-12-16：コンスセル対応版を追加
  • 2020-12-10：初版公開（コンスセル未対応版）
1
0
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
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?