λ5.3節

問題 5.20  問題 5.21  問題 5.22 

問題 5.20

問題 5.21
;a
(define count-leaves
  (make-machine
    '(continue tree val)
    (list (list 'null? null?) (list 'pair? pair?) (list '+ +)
          (list 'car car) (list 'cdr cdr))
    '((assign continue (label done))
count-leaves
      (test (op null?) (reg tree))
      (branch (label null))
      (test (op pair?) (reg tree))
      (branch (label pair))
      (assign val (const 1))
      (goto (reg continue))
null
      (assign val (const 0))
      (goto (reg continue))
pair
      (save continue)
      (assign continue (label after-1))
      (save tree)
      (assign tree (op car) (reg tree))
      (goto (label count-leaves))
after-1
      (restore tree)
      (assign tree (op cdr) (reg tree))
      (assign continue (label after-2))
      (save val)
      (goto (label count-leaves))
after-2
      (assign tree (reg val))
      (restore val)
      (assign val (op +) (reg val) (reg tree))
      (restore continue)
      (goto (reg continue))
done)))

;b 
(define count-leaves
  (make-machine
    '(continue tree n val)
    (list (list 'null? null?) (list 'pair? pair?) (list '+ +)
          (list 'car car) (list 'cdr cdr))
    '((assign n (const 0))
      (assign continue (label done))
count-iter
      (test (op null?) (reg tree))
      (branch (label null))
      (test (op pair?) (reg tree))
      (branch (label pair))
      (assign val (op +) (reg n) (const 1))
      (goto (reg continue))
pair 
      (save continue)      
      (save tree)
      (assign tree (op car) (reg tree))
      (assign continue (label after1))
      (goto (label count-iter))
after1
      (assign n (reg val))
      (restore tree)
      (assign tree (op cdr) (reg tree))
      (assign continue (label after2))
      (goto (label count-iter))
after2
      (restore continue)
      (goto (reg continue))
null
      (assign val (reg n))
      (goto (reg continue))
done)))
問題 5.22
;a
(define append-machine
 (make-machine
 '(continue x y val)
 (list (list 'null? null?) (list 'car car) (list 'cdr cdr)
       (list 'cons cons))
 '((assign continue (label done))
append
   (test (op null?) (reg x))
   (branch (label null))
   (save continue)
   (save x)
   (assign x (op cdr) (reg x))
   (assign continue (label after-append))
   (goto (label append))
after-append
   (restore x)
   (assign x (op car) (reg x))
   (assign val (op cons) (reg x) (reg val))
   (restore continue)
   (goto (reg continue))
null
   (assign val (reg y))
   (goto (reg continue))
done)))

;b
(define append!-machine
 (make-machine
 '(x y z)
 (list (list 'null? null?) (list 'cdr cdr) (list 'set-cdr! set-cdr!))
 '((save x)
loop
   (assign z (op cdr) (reg x))
   (test (op null?) (reg z))
   (branch (label null))
   (assign x (op cdr) (reg x))
   (goto (label loop))
null
   (perform (op set-cdr!) (reg x) (reg y))
   (restore x))))