[SICP] make-machine

dispatch 用マクロ

clos や dlambda をつかわないとなんだか funcall を一杯使ってかっちょ悪いので一発マクロを書く。

; usage:
;       (m-call machine :set-var 3)
(defmacro m-call (machine method &body body)
  `(funcall (funcall ,machine ,method) ,@body))

本題の make-machine と make-new-machine

SICP がプログラムを作るときのテスト＆ランで話が進まないので、また、教科書的にわざと考えるようにしている節が見受けられるのでそれを無視して、書いていく。

(defun make-new-machine ()
  (labels ((allocate-register (reg)
                              (prin1 reg))
           (dispatch (msg)
                     (cond ((eq msg 'allocate-register) #'allocate-register)
                           ((eq msg :plus) #'plus)
                           (t (princ "error!")))))
      #'dispatch))
;
;
(defun make-machine (register-names ops controller-text)
  (let ((machine (make-new-machine)))
    (mapcar #'(lambda (register-name)
                (m-call machine 'allocate-register register-name))
            register-names)))
                ;(funcall (funcall machine 'allocate-register) register-name))

これで次のテストが通る。do-test-case は私が書いたマクロ。あまりきにしなくて良い。

(do-test-case
  t
  (make-machine '(r0 r1 r2) 'ops 'text))

結果は

> clisp test-machine.lisp

R0
R1
R2

これですべてのレジスタをプリントすることが出来た。先は長い。

デバッグ用マクロ

最初できのよくないマクロを書いてしまった。

(defmacro do-test-case0 (&body body)

  `(let ((func #'(lambda () (progn
                              ,@body
                              ))))
     (debug-trace (funcall func))))

このまくろをつかうといっつも

(let ((*debug-flag* nil))
  (do-test-case
    (labels ((fde (ee) (format t "~a~%" ee)))
      (fde (make-lambda '(x) '((+ x 1))))
      (setf f '(lambda (a b) (+ a 1) (+ b 1)))
      (fde (make-procedure (lambda-parameters f) (lambda-body f) '((())))))))

と、いつも fde というなぞの関数と(あとで print に変更)と外側に debug-flag をいれなければならない。いつもならマクロに出来る。

(defmacro do-test-case1 (flag &body body)
  `(let ((*debug-flag* ,flag))
     (let ((func #'(lambda () (progn
                                ,@body
                                ))))
       (debug-trace (funcall func)))))

こうすると、似たような関数が出来てしまった。そこで、以前の関数を do-test-case0 として、もうひとつ do-test-case をラッピングして後方互換をとるようにした。

(defmacro do-test-case0 (&body body)
  (format t "********~%*WARING*, please use new style do-test-case~%********~%~%
")
  `(let ((func #'(lambda () (progn
                              ,@body
                              ))))
     (debug-trace (funcall func))))

(defmacro do-test-case1 (flag &body body)
  `(let ((*debug-flag* ,flag))
     (let ((func #'(lambda () (progn
                                ,@body
                                ))))
       (debug-trace (funcall func)))))

(defmacro do-test-case (&body body)
  (let ((flag (car body)))
    (cond ((null flag) `(do-test-case1 ,@body))
          ((eq t flag) `(do-test-case1 ,@body))
          (t `(do-test-case0 ,@body)))))

いいか悪いか知らんが、複雑なマクロを書いて、以前のプログラムも動くし（動いたときにワーニングがでる）、新しいスタイルもうまく動く。うわ〜いいのか？
心の中で、すごい！！というのと、複雑すぎる！！がないまぜ。まぁそれが lisp だ。