SICP問題5.21

大昔にやった覚えのあるcount-leaves手続きをレジスタ計算機で作る問題。
まだレジスタ計算機がしっくりきていない状態で間を空けてしまったので
ドツボりました。
正直今だにあってるんだかどうなんだか自信がもてない状態だったりします。

再帰的count-leavesはfibonacci-machineと同じようになればいい、と気づくのに時間を要しました。忘れすぎですね。

(define count-leaves-machine-1
  (make-machine
    '(continue tree ret old-ret tmp)
    (list (list 'print print) (list 'read read) (list '+ +) (list 'car car)
          (list 'cdr cdr) (list 'not not) (list 'null? null?) (list 'pair? pair?))
    '(
      count-start
        (perfome (op initial-instruction-count))
        (perfome (op initialize-stack))
        (assign tree (op read))
        (assign continue (label count-done))
        (assign ret (const 0))
        (assign old-ret (const 0))
      count-loop
        (test (op null?) (reg tree))
        (branch (label zero-case))
        (assign tmp (op pair?) (reg tree))
        (test (op not) (reg tmp))
        (branch (label one-case))
        (save continue)
        (save tree)
        (assign continue (label after-count-1))
        (assign tree (op car) (reg tree))
        (goto (label count-loop))
      after-count-1
        (restore tree)
        (save ret)
        (assign tree (op cdr) (reg tree))
        (assign continue (label after-count-2))
        (goto (label count-loop))
      after-count-2
        (assign old-ret (reg ret))
        (restore ret)
        (restore continue)
        (assign ret (op +) (reg ret) (reg old-ret))
        (goto (reg continue))
      zero-case
        (assign ret (const 0))
        (goto (reg continue))
      one-case
        (assign ret (const 1))
        (goto (reg continue))
      count-done
        (perfome (op print) (reg ret))
        (perfome (op print-stack-statistics))
        (perfome (op print-instruction-count)))))

notは正直どうしたらいいのかわからなかったので、いったんtmpという名のレジスタにpair?の結果を格納しておき、そのレジスタに対してnot演算させてます。

カウンタを陽にもつ再帰的count-leaves

(define count-leaves-machine-2
  (make-machine
    '(continue tree count tmp)
    (list (list 'print print) (list 'read read) (list '+ +) (list 'car car)
          (list 'cdr cdr) (list 'not not) (list 'null? null?) (list 'pair? pair?))
    '(
      count-start
        (perfome (op initial-instruction-count))
        (perfome (op initialize-stack))
        (assign tree (op read))
        (assign continue (label count-done))
        (assign count (const 0))
      count-loop
        (test (op null?) (reg tree))
        (branch (label count-zero))
        (assign tmp (op pair?) (reg tree))
        (test (op not) (reg tmp))
        (branch (label count-plus))
        (save continue)
        (save tree)
        (assign continue (label after-count))
        (assign tree (op car) (reg tree))
        (goto (label count-loop))
      after-count
        (restore tree)
        (restore continue)
        (assign tree (op cdr) (reg tree))
        (goto (label count-loop))
      count-plus
        (assign count (op +) (reg count) (const 1))
      count-zero   
        (goto (reg continue))
      count-done
        (perfome (op print) (reg count))
        (perfome (op print-stack-statistics))
        (perfome (op print-instruction-count)))))

こっちのほうが若干すっきりしてるような気がします。