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 な試験も今一つ微妙。