SICP 読み (247) 5.2 レジスタ計算機での計算
調子悪い。知恵熱かなぁ。熱っぽい感じ。
make-assign な試験から再開してますが微妙。とりあえずエントリ投入してみる。
やっぱ知恵熱かも。pc なソレでハマった。以下の試験、let の中で pc に微妙なソレをセットしてますが、不適切な場所で初期化していたようです。
最初は以下のような形でしたが、試験にパスしない。というか、make-assign が戻す手続き自体が_pair が欲しいが () かよ_という文句を言って異常終了。知恵熱状態なのでワケワカ、なナニでした。(とほほ
("(assign <register-name> (op <operation-name>) <input1> ... <inputn>)" (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 '+ +))) (set-contents! ((m 'get-register) 'pc) '(() (gcd-done ()))) ;; (assign b (op rem) (reg a) (label gcd-done)) ?? (let ((ope (make-assign '(assign a (op +) (reg t) (reg b)) m '() (m 'operations) ((m 'get-register) 'pc)))) (set-contents! ((m 'get-register) 't) 3) (set-contents! ((m 'get-register) 'b) 2) (assert-equal 3 (get-contents ((m 'get-register) 't))) (assert-equal 2 (get-contents ((m 'get-register) 'b))) (assert-equal '*unassigned* (get-contents ((m 'get-register) 'a))) (ope) (assert-equal 5 (get-contents ((m 'get-register) 'a))) ) (let ((ope (make-assign '(assign a (op rem) (reg a) (const 2)) m '() (m 'operations) ((m 'get-register) 'pc)))) (set-contents! ((m 'get-register) 'a) 3) (ope) (assert-equal 1 (get-contents ((m 'get-register) 'a))) ) (let ((ope (make-assign '(assign a (op +) (const 1) (const 2) (const 3)) m '() (m 'operations) ((m 'get-register) 'pc)))) (ope) (assert-equal 6 (get-contents ((m 'get-register) 'a))) ) (assert-error (lambda () (make-assign '(assign d (op =) (reg a) (reg b)) m '() (m 'operations) ((m 'get-register) 'pc)))) (assert-error (lambda () (make-assign '(assign b (op *) (reg a) (reg b)) m '() (m 'operations) ((m 'get-register) 'pc)))) (assert-error (lambda () (make-assign '(assign b (op rem) (reg d) (reg b)) m '() (m 'operations) ((m 'get-register) 'pc)))) (assert-error (lambda () (make-assign '(assign b (op rem) (reg a) (reg d)) m '() (m 'operations) ((m 'get-register) 'pc)))) ) )
分かりにくいですが、pc をセットしてるのは一箇所だけ。let を抜けたらリセットされる、という手前勝手な理解でどハマリ。
以下に make-assign 関連の試験を貼っておきますが、確認不足である可能性は非常に高いと言わざるを得ません (とほほほ
("make-assign" ("(assign <register-name> (reg <register-name>))" (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 '= =))) (set-contents! ((m 'get-register) 'a) 1) (assert-equal 1 (get-contents ((m 'get-register) 'a))) (let ((ope (make-assign '(assign b (reg a)) m '() (m 'operations) ((m 'get-register) 'pc)))) (set-contents! ((m 'get-register) 'pc) '(() (gcd-done ()))) (ope) (assert-equal 1 (get-contents ((m 'get-register) 'b))) ) (assert-error (lambda () (make-assign '(assign c (reg a)) m '() (m 'operations) ((m 'get-register) 'pc)))) (assert-error (lambda () (make-assign '(assign b (reg c)) m '() (m 'operations) ((m 'get-register) 'pc)))) ) ) ("(assign <register-name> (const <constant-value>))" (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-assign '(assign c (const 1)) m '() (m 'operations) ((m 'get-register) 'pc)))) (let ((ope (make-assign '(assign b (const 1)) m '() (m 'operations) ((m 'get-register) 'pc)))) (set-contents! ((m 'get-register) 'pc) '(() (gcd-done ()))) (ope) (assert-equal 1 (get-contents ((m 'get-register) 'b))) ) ) ) ("(assign <register-name> (label <label-name>))" (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 ((ope (make-assign '(assign b (label gcd-done)) m '((gcd-done . ())) (m 'operations) ((m 'get-register) 'pc)))) (set-contents! ((m 'get-register) 'pc) '(() (gcd-done ()))) (ope) (assert-equal '() (get-contents ((m 'get-register) 'b))) (assert-error (lambda () (make-assign '(assign d (label gcd-done)) m '((gcd-done . ())) (m 'operations) ((m 'get-register) 'pc)))) ) (assert-error (lambda () (make-assign '(assign b (label x)) m '() (m 'operations) ((m 'get-register) 'pc)))) ) ) ("(assign <register-name> (op <operation-name>) <input1> ... <inputn>)" (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 '+ +))) ;; (assign b (op rem) (reg a) (label gcd-done)) ?? (let ((ope (make-assign '(assign a (op +) (reg t) (reg b)) m '() (m 'operations) ((m 'get-register) 'pc)))) (set-contents! ((m 'get-register) 'pc) '(() (gcd-done ()))) (set-contents! ((m 'get-register) 't) 3) (set-contents! ((m 'get-register) 'b) 2) (assert-equal 3 (get-contents ((m 'get-register) 't))) (assert-equal 2 (get-contents ((m 'get-register) 'b))) (assert-equal '*unassigned* (get-contents ((m 'get-register) 'a))) (ope) (assert-equal 5 (get-contents ((m 'get-register) 'a))) ) (let ((ope (make-assign '(assign a (op rem) (reg a) (const 2)) m '() (m 'operations) ((m 'get-register) 'pc)))) (set-contents! ((m 'get-register) 'pc) '(() (gcd-done ()))) (set-contents! ((m 'get-register) 'a) 3) (ope) (assert-equal 1 (get-contents ((m 'get-register) 'a))) ) (let ((ope (make-assign '(assign a (op +) (const 1) (const 2) (const 3)) m '() (m 'operations) ((m 'get-register) 'pc)))) (set-contents! ((m 'get-register) 'pc) '(() (gcd-done ()))) (ope) (assert-equal 6 (get-contents ((m 'get-register) 'a))) ) (assert-error (lambda () (make-assign '(assign d (op =) (reg a) (reg b)) m '() (m 'operations) ((m 'get-register) 'pc)))) (assert-error (lambda () (make-assign '(assign b (op *) (reg a) (reg b)) m '() (m 'operations) ((m 'get-register) 'pc)))) (assert-error (lambda () (make-assign '(assign b (op rem) (reg d) (reg b)) m '() (m 'operations) ((m 'get-register) 'pc)))) (assert-error (lambda () (make-assign '(assign b (op rem) (reg a) (reg d)) m '() (m 'operations) ((m 'get-register) 'pc)))) ) ) )
明日も厄日だったらヘコむなぁ。
UT 完了の先は随分向こうな上に、練習問題のハードルがでーじ高そげ。