SICP演習問題5.14

(define (fact-print-stack n)
  (define fact-machine
  (make-machine
   '(n val continue)
   (list (list '= =) (list '- -) (list '* *))
   '(fact
       (assign continue (label fact-done))
     fact-loop
       (test (op =) (reg n) (const 1))
       (branch (label base-case))
       (save continue)
       (save n)
       (assign n (op -) (reg n) (const 1))
       (assign continue (label after-fact))
       (goto (label fact-loop))
     after-fact
       (restore n)
       (restore continue)
       (assign val (op *) (reg n) (reg val))
       (goto (reg continue))
     base-case
       (assign val (const 1))
       (goto (reg continue))
     fact-done)))
  (newline)
  (let loop ((count 1))
    (if (> count n)
        'done
        (begin
          ((fact-machine 'stack) 'initialize)
          (set-register-contents! fact-machine 'n count)
          (start fact-machine)
          (format #t "fact(~2d):~8d\n" count (get-register-contents fact-machine 'val))
          (print-stack fact-machine)
          (loop (+ count 1))))))
(fact-print-stack 10)

結果

gosh>
fact( 1):       1
(total-pushes = 0 maximum-depth = 0)
fact( 2):       2
(total-pushes = 2 maximum-depth = 2)
fact( 3):       6
(total-pushes = 4 maximum-depth = 4)
fact( 4):      24
(total-pushes = 6 maximum-depth = 6)
fact( 5):     120
(total-pushes = 8 maximum-depth = 8)
fact( 6):     720
(total-pushes = 10 maximum-depth = 10)
fact( 7):    5040
(total-pushes = 12 maximum-depth = 12)
fact( 8):   40320
(total-pushes = 14 maximum-depth = 14)
fact( 9):  362880
(total-pushes = 16 maximum-depth = 16)
fact(10): 3628800
(total-pushes = 18 maximum-depth = 18)
done

|