リスト遊び 6-4 より抽象的に

前回
リスト遊び 6-3 連想リスト と funcall - by shigemk2

;; 英語風に動詞を前に置いてみたくなる
(add 1 (mul 2 3))

というわけで、動詞を前に置いても計算できるlispを完成させる。

(defun assq (key alist)
  (cond
   ((null alist) nil)
   ;; 先頭のドット対を調べ、ドット対のCARが指すデータがkeyと同一なら、その先頭のドット対を返す
   ((eq key (car (car alist))) (car alist))
    (t (assq key (cdr alist)))))
assq

;; より抽象的に、リストの要素を順番に取り出す関数を作成する
(defun 1st (exp) (car exp))
(defun 2nd (exp) (car (cdr exp)))
(defun 3rd (exp) (car (cdr (cdr exp))))

;; 「二項演算式 二項演算子 二項演算式」の形を取る二項演算式のための連想リストを作成する
(setq order-func1 '((OP . 2nd) (ARG1 . 1st) (ARG2 . 3rd)))

;; 上記の連想リストを検索して、キーに合致するドット対から関数を取り出す関数order-funcを作成する
(defun order-func (sym odr-db)
  (cdr (assq sym odr-db)))

;; order-funcを利用すると、以前のop、arg1、arg2は以下のように実装できる。
(defun op (exp order-db)
  (funcall (order-func 'OP order-db) exp))
op
(defun arg1 (exp order-db)
  (funcall (order-func 'ARG1 order-db) exp))
arg1
(defun arg2 (exp order-db)
  (funcall (order-func 'ARG2 order-db) exp))
arg2
(setq op-func1 '((+ . +) (- . -) (* . *)))
((+ . +) (- . -) (* . *))
(setq op-func2 '((add . +) (sub . -) (mul . *)))
((add . +) (sub . -) (mul . *))

;; 演算子からそれに対応する関数名を取り出すプログラム
(defun op-func (sym op-db)
  (cdr (assq sym op-db)))
op-func

(defun calc (exp op-db odr-db)
  (cond
   ((atom exp) exp)
   (t (funcall
       (op-func (op exp odr-db) op-db)
       (calc (arg1 exp odr-db) op-db odr-db)
       (calc (arg2 exp odr-db) op-db odr-db)))))
calc
(calc '(1 + (2 * 3)) op-func1 order-func1)
7
(setq order-func2 '((OP . 1st) (ARG1 . 2nd) (ARG2 . 3rd)))
((OP . 1st) (ARG1 . 2nd) (ARG2 . 3rd))

(calc '(add 1 (mul 2 3)) op-func2 order-func2)
7

• 共通部分は補助関数を使って抽象化する
• 呼び出される関数だけが異なる場合は、呼び出す関数を実行時に決定する方法を用いて抽象化する

リスト遊び―Emacsで学ぶLispの世界 (ASCII SOFTWARE SCIENCE Language)