SICP 問題 5.21

schemeで書いた手続きのレジスタマシンを実装する．

;;; a
;;; 再帰的count-leaves
(define (count-leaves tree)
  (cond ((null? tree) 0)
        ((not (pair? tree)) 1)
        (else (+ (count-leaves (car tree))
                 (coutn-leaves (cdr tree))))))

(define recur-count-leaves-machine
  (make-machine
   '(tree val continue)
   (list (list 'null? null?) (list 'car car) (list 'cdr cdr) (list '+ +)
         (list 'pair? pair?))
   '(start
       (assign continue (label count-leaves-done))
     car-loop
       (test (op null?) (reg tree))
       (branch (label null))
       (test (op pair?) (reg tree))
       (branch (label pair))
       (assign val (const 1))
       (goto (reg continue))
     pair
       (save continue)
       (assign continue (label aftercount-car))
       (save tree)
       (assign tree (op car) (reg tree))
       (goto (label car-loop))
     aftercount-car
       (restore tree)
       (assign tree (op cdr) (reg tree))
       (assign continue (label aftercount-cdr))
       (save val)
       (goto (label car-loop))
     aftercount-cdr
       ;; valの値を一時的にtreeに入れて，後に計算する．goto先はaftercount-carなので
       ;; そこでtreeはrestoreされる．
       (restore tree)
       (restore continue)
       (assign val (op +) (reg val) (reg tree))
       (goto (reg continue))
     null
       (assign val (const 0))
       (goto (reg continue))
     count-leaves-done)))

test

gosh> (set-register-contents! recur-count-leaves-machine 'tree '(1 2 3 4))
done
gosh> (start recur-count-leaves-machine)
done
gosh> (get-register-contents recur-count-leaves-machine 'val)
4
gosh> recur-count-leaves-machine
gosh> (set-register-contents! recur-count-leaves-machine 'tree '(1 2 (a b) 3 4))
done
gosh> (start recur-count-leaves-machine)
done
gosh> (get-register-contents recur-count-leaves-machine 'val)
6

;;; b
;;; カウンタを陽に持つ再帰的count-leaves
(define (count-leaves tree)
  (define (count-iter tree n)
    (cond ((null? tree) n)
          ((not (pair? tree)) (+ n 1))
          (else (count-iter (cdr tree)
                            (count-iter (car tree) n)))))
  (count-iter tree 0))

(define count-n-leaves
  (make-machine
   '(tree continue n)
   (list (list 'null? null?) (list 'car car) (list 'cdr cdr) (list '+ +)
         (list 'pair? pair?))
   '(start
       (assign continue (label count-leaves-done))
       (assign n (const 0))
     car-loop
       (test (op null?) (reg tree))
       (branch (label null))
       (test (op pair?) (reg tree))
       (branch (label pair))
       (assign n (op +) (reg n) (const 1))
       (goto (reg continue))
     pair
       (save continue)
       (assign continue (label aftercount-car))
       (save tree)
       (assign tree (op car) (reg tree))
       (goto (label car-loop))
     aftercount-car
       (restore tree)
       (assign tree (op cdr) (reg tree))
       (assign continue (label aftercount-cdr))
       (goto (label car-loop))
     aftercount-cdr
       (restore continue)
       (goto (reg continue))
     ;; branchは(reg continue)が出来ないので，一度ここに飛ばしてからcontinueに飛ぶ
     null
      (goto (reg continue))
     count-leaves-done)))

test

gosh> (set-register-contents! count-n-leaves 'tree '(1 2 (a b) 3 4))
done
gosh> (start count-n-leaves)
done
gosh> (get-register-contents count-n-leaves 'n)
6