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

SICP scheme

検証を、と言いつつ次の問題に着手してしまう。

問題 5.13

試験を考えてみたら、既存の試験とほぼ同様なソレがでっち上がった。

(use gauche.test)

(add-load-path ".")
(load "ch5-regsim")

(test-start "5.13")

(test-section "assign")
(let ((m (make-machine (list (list 'rem remainder) (list '= =))
                       '(test-b
                         (test (op =) (reg b) (const 0))
                         (branch (label gcd-done))
                         (assign t (op rem) (reg a) (reg b))
                         (assign a (reg b))
                         (assign b (reg t))
                         (goto (label test-b))
                         gcd-done))))

  (test* "register a exist" '*unassigned* (get-register-contents m 'a))
  (test* "register b exist" '*unassigned* (get-register-contents m 'b))
  (test* "register t exist" '*unassigned* (get-register-contents m 't))

  (set-register-contents! m 'a 206)
  (set-register-contents! m 'b 40)
  (test* "a" 206 (get-register-contents m 'a))
  (test* "b" 40 (get-register-contents m 'b))

  (start m)
  
  (test* "a" 2 (get-register-contents m 'a))
  )

(test-end)

これは既存な試験の修正が必要だなぁ。ってこれ、machine に lookup-register ってメセジ送信した時に machine 側で失敗したら allocate すりゃ良いだけの話??

      (define (lookup-register name)
        (let ((val (assoc name register-table)))
          (if val
              (cadr val)
	      (set! register-table
		    (cons (list name (make-register name))
			  register-table)))))

こりゃ無いかなぁ。って val 戻せてないし。

      (define (lookup-register name)
        (let ((val (assoc name register-table)))
          (if val 
	      (cadr val)
	      (let ((val (make-register name)))
		(set! register-table
		      (cons (list name val)
			    register-table))
		(cadr val)))))

こうか。なんか微妙。

追記

む。間違えてた。上記の試験をしてみたら

*** ERROR: pair required, but got #<closure (make-register dispatch)>

と叱られる。よく見ると else なブロックの val はリストじゃないじゃん。正しくは以下でしょうか。

      (define (lookup-register name)
        (let ((val (assoc name register-table)))
          (if val
              (cadr val)
	      (let ((val (make-register name)))
		(set! register-table
		      (cons (list name val)
			    register-table))
		val))))

一応これで上記の試験にはパスしておりますが ...

さらに追記

既存な試験にも手を入れてみました。

  • allocate-register の削除
  • undefined register な試験の削除

削除しちゃって良いのだろうか、と言いつつ全部コメントアウト。試験にもパスしていますが、こんなに簡単に終了しちゃって良いのだろうか。