SICP 読み (248) 5.2 レジスタ計算機での計算
昨晩は酔ってたのもあるけど悪夢を見ているようでした。今日も負けずに試験を書く。
make-test
一応 assign は OK ってコトで次は test の模様。
(define (make-test inst machine labels operations flag pc) (let ((condition (test-condition inst))) (if (operation-exp? condition) (let ((condition-proc (make-operation-exp condition machine labels operations))) (lambda () (set-contents! flag (condition-proc)) (advance-pc pc))) (error "Bad TEST instruction -- ASSEMBLE" inst))))
flag には #t か #f が、という事で test な構文は
(test (op
) ... )
限定な模様。試験はざくっと以下。
("make-test" ("true" (let ((m (make-new-machine))) (for-each (lambda (register-name) ((m 'allocate-register) register-name)) '(a b t)) ((m 'install-operations) (list (list 'rem remainder) (list '= =))) (let ((thunk (make-test '(test (op =) (const 1) (const 1)) m '() (m 'operations) ((m 'get-register) 'flag) ((m 'get-register) 'pc)))) (set-contents! ((m 'get-register) 'pc) '(() (gcd-done ()))) (thunk) (assert-true (get-contents ((m 'get-register) 'flag))) ) ) ) ("false" (let ((m (make-new-machine))) (for-each (lambda (register-name) ((m 'allocate-register) register-name)) '(a b t)) ((m 'install-operations) (list (list 'rem remainder) (list '= =))) (let ((thunk (make-test '(test (op =) (const 2) (const 1)) m '() (m 'operations) ((m 'get-register) 'flag) ((m 'get-register) 'pc)))) (set-contents! ((m 'get-register) 'pc) '(() (gcd-done ()))) (thunk) (assert-false (get-contents ((m 'get-register) 'flag))) ) ) ) ("error" (let ((m (make-new-machine))) (for-each (lambda (register-name) ((m 'allocate-register) register-name)) '(a b t)) ((m 'install-operations) (list (list 'rem remainder) (list '= =))) (assert-error (lambda (make-test '(test (reg a)) m '() (m 'operations) ((m 'get-register) 'flag) ((m 'get-register) 'pc)))) ) ) )
昨晩の失敗はテストケースを分けなかった事と見て、分けてみたんですが微妙。試験的にも微妙さ満点ですが、op な式の試験は make-operation-exp の範疇という事でスルー。でもmake-operation-exp な試験も今一つ微妙。