SICP 読み (255) 5.2 レジスタ計算機での計算

SICP scheme

問題 5.8 と 5.9 も本体に取り込んでおく事に。

問題 5.8

extract-labels 以下は UT も書いとらん。とりあえず以下の試験を追加。

(test-section "extract-labels (5.8)")
(let ((m (make-new-machine))
      (l '(start
	   (goto (label here))
	   here
	   (assign a (const 3))
	   (goto (label there))
	   here
	   (assign a (const 4))
	   (goto (label there))
	   there)))
  (for-each (lambda (register-name)
	      ((m 'allocate-register) register-name))
	    '(a))
  (test* "assemble error" *test-error* (assemble l m)))

問題 5.9

こちらも微妙な試験を追加。

(test-section "make-operation-exp (5.9)")
(let ((m (make-new-machine)))
  ((m 'install-operations) (list (list 'rem remainder) (list '+ +)))
  (test* "use only reg & const" *test-error*
	 (make-operation-exp '((ope +) (label gcd-done) (const 2))
			     m
			     '((gcd-done . ()))
			     (m 'operations))))

一応試験にはパスしている模様。これらを基に 5.11 な検討を。

問題 5.11 の a.

これは本体への盛り込みは不要。試験を以下に。

(test-section "fib")
(let ((m (make-machine
	  '(n continue val)
	  (list (list '< <) (list '- -) (list '+ +))
	  '(controller
	    (assign continue (label fib-done))
	    fib-loop
	    (test (op <) (reg n) (const 2))
	    (branch (label immediate-answer))
	    ;; set up to compute Fib(n - 1)
	    (save continue)
	    (assign continue (label afterfib-n-1))
	    (save n)
	    (assign n (op -) (reg n) (const 1))
	    (goto (label fib-loop))
	    afterfib-n-1
	    (restore n)

	    ;; set up to compute Fib(n - 2)
	    (assign n (op -) (reg n) (const 2))

	    (assign continue (label afterfib-n-2))
	    (save val)
	    (goto (label fib-loop))
	    afterfib-n-2
	    (assign n (reg val))
	    (restore val)
	    (restore continue)
	    (assign val
		    (op +) (reg val) (reg n)) 
	    (goto (reg continue))
	    immediate-answer
	    (assign val (reg n))
	    (goto (reg continue))
	    fib-done))))

  (set-register-contents! m 'n 0)
  (start m)
  (test* "(fib 0)" 0 (get-register-contents m 'val))

  (set-register-contents! m 'n 1)
  (start m)
  (test* "(fib 1)" 1 (get-register-contents m 'val))

  (set-register-contents! m 'n 2)
  (start m)
  (test* "(fib 2)" 1 (get-register-contents m 'val))

  (set-register-contents! m 'n 3)
  (start m)
  (test* "(fib 3)" 2 (get-register-contents m 'val))

  (set-register-contents! m 'n 4)
  (start m)
  (test* "(fib 4)" 3 (get-register-contents m 'val))

  (set-register-contents! m 'n 5)
  (start m)
  (test* "(fib 5)" 5 (get-register-contents m 'val))

  (set-register-contents! m 'n 6)
  (start m)
  (test* "(fib 6)" 8 (get-register-contents m 'val))

  (set-register-contents! m 'n 7)
  (start m)
  (test* "(fib 7)" 13 (get-register-contents m 'val))
  )

今から昼メシくって、だらだらしながら b. 以降を検討な日曜日。