ryos36の日記 (Scheme Switch)

 | 

2008-01-06

vim で lisp

10:52

vimlisp に対しても tag が使えることがわかった。[ [が出来るとなおいいが、、、

子供と一緒に common lisp

10:52

小学3年生の子供に lisp を教えることにした。さて、プログラマーとしての英才教育が出来るか?(なんちゃって)

SICP の5章

10:52

goto を実現するための習作

(defun jump-test (lst stack)
  (let ((one (car lst))
        (remain (cdr lst)))
    (format t "do ~a~%" one)
    (cond ((consp one) (cond ((eq (car one) 'goto) (gethash (cadr one) stack))
                             (t remain)))
          (t (setf (gethash one stack) remain)
             remain))))

(setf stack (make-hash-table))
(setf lst '(
            label
            (op something)
            (goto label)))

(setf lst (jump-test lst stack))
(format t "~a~%" stack)
(setf lst (jump-test lst stack))
(setf lst (jump-test lst stack))
(setf lst (jump-test lst stack))
(setf lst (jump-test lst stack))
(setf lst (jump-test lst stack))

一応動くぞ。 basic 位作れそうだな。

make-machine の習作

SICP のソースを見ずに作ったのでめちゃくちゃ。しかも中途半端。あくまで習作。

(defun niy (func) (error "NIY ~a" func))

(defstruct register-machine-instance
  regs
  opes
  controller)

(defun make-machine (regs opes controller)
  (let ((machine (make-register-machine-instance
                   :regs regs
                   :opes opes
                   :controller controller))
        )
    (let* (
           (eval-operand #'(lambda (operand)
                             (let ((s (car operand)))
                               (cond ((eq s 'regs) (gethash (cadr operand) regs)
)
                                     ((eq s 'const) (cadr operand))
                                     (t
                                       (assert (eq s 'op))
                                       (niy "eval-op"))))))

           (assign #'(lambda (regs-name operand)
                       (setf (gethash regs-name regs)
                         (funcall eval-operand operand)))))
      (let ((dispatch #'(lambda (m)
                          (cond ((eq m 'machine) machine)
                                (t nil)))))
        (funcall assign 'a '(const 33))
        (format t "eval ~a~%"
                (funcall eval-operand '(regs a)))
        dispatch))))
;--------------------------------------------------------------------------
(setf regs (make-hash-table))
(setf (gethash 'a regs) 4)
;(push 0 (gethash 'a regs))
(setf machine (make-machine regs nil nil))
(format t "~a~%" machine)
(format t "~a~%" (funcall machine 'machine))
(format t "~a~%" (eval-operand '(const 4)))

一応動いているようだが、、、SICP とは直接関係ない。

ついでに CLOS による習作

19:05

(defclass register-machine-instance()
  (
  regs
  opes
  controller))

(defmethod make-register ((m register-machine-instance) regs)
  (let ((h (make-hash-table)))
    (mapcar #'(lambda (r) (setf (gethash r h) nil)) regs)
    (setf (slot-value m 'regs) h)))

(defmethod assign ((m register-machine-instance) regs-name operand)
  (labels ((eval-operand (operand)
                         (let ((s (car operand)))
                           (cond ((eq s 'regs) (gethash (cadr operand) (slot-val
ue m 'regs)))
                                 ((eq s 'const) (cadr operand))
                                 (t
                                   (assert (eq s 'op))
                                   (niy "eval-op"))))))
    (setf (gethash regs-name (slot-value m 'regs))
          (eval-operand operand))))

(let ((*debug-flag* t)
      (m (make-instance 'register-machine-instance)))
  (do-test-case
    (print (make-register m '(a b c)))
    (print (assign m 'a '(const 312)))
    nil
    ))

書いたはいいがいまいちだな。 defstruct でいいじゃん。 On Lisp の defmethod を斜め読み。なるほど、オブジェクト指向というよりは関数主体なんだな。

継承が必要ないなら(そして、本当に必要なさそうだし)、CLOS の必要性はない。(とおもう) CLOS 自身も信者っている、じゃなくて死んじゃっているみたいだし。でその作者?のSonya E. Keene は dylan に移行したみたいだしね。

いやそもそも私の設計が間違っているぞ、、、やっぱりプログラムは設計(メタファーの構築)が重要だ。

 |