Solution of SICP Exercise 5.15

Think it is good to provide two types of access to the information.
One is to add some trace operations directly in the machine instructions, e.g.
(perform (op print-program-counter), which has the merit that
we can get the information even if the machine never stops.
(which means we have no chance to get the information form outside the machine)

Another is provide an interface in the underlying machine model itself, e.g.
(factorial-machine 'print-program-counter).
This is useful when we want a compact set of instructions without trace commands in it
and we are sure have chance to access the machine from outside.

觉得应该像5.14那样提供两种界面，一种是直接将追踪信息写在指令中。比如，
 (perform (op print-program-counter)
好处是即使程序不停也依然可以看到想要的信息
另外一种是通过底层的机器模型提供所需信息。比如，
(factorial-machine 'print-program-counter)
好处是可以将指令简介化，不在处理中加入和处理无关的追踪信息的输出。

２種類のインターフェースを提供したほうが良いと思う。
一つは、コマンドの中に直接トレース情報出力のコマンド追加。
例えば、 (perform (op print-program-counter)
これによって、停止しない処理でも必要な情報取れる。
もう一つは、下層のマシーンモデルにトレース情報取得のインターフェース追加。
例えば、(factorial-machine 'print-program-counter)
これによって、処理に余計なトレース情報出力コマンド入れず、処理に専念するプログラムができる。

(define (make-new-machine)
  (let ((pc (make-register 'pc))
        (flag (make-register 'flag))
        (stack (make-stack))
        (the-instruction-sequence '())
 (counter 0))

    (define (initialize-program-counter)
      (set! counter 0))

    (define (print-program-counter)
      (newline)
      (display (list 'program-counter= counter)))
    (let ((the-ops
           (list (list 'initialize-stack
                       (lambda () (stack 'initialize)))
                 (list 'print-stack-statistics
                       (lambda () (stack 'print-statistics)))
   (list 'initialize-program-counter
         (lambda ()
    (initialize-program-counter)))
   (list 'print-program-counter
         (lambda ()
    (print-program-counter)))))          (register-table
           (list (list 'pc pc) (list 'flag flag))))
      (define (allocate-register name)
        (if (assoc name register-table)
            (error "Multiply defined register: " name)
            (set! register-table
                  (cons (list name (make-register name))
                        register-table)))
        'register-allocated)
      (define (lookup-register name)
        (let ((val (assoc name register-table)))
          (if val
              (cadr val)
              (error "Unknown register:" name))))
      (define (execute)
        (let ((insts (get-contents pc)))
          (if (null? insts)
              'done
              (begin
                ((instruction-execution-proc (car insts)))
  (set! counter (+ counter 1))
                (execute)))))


      (define (dispatch message)
        (cond ((eq? message 'start)
               (set-contents! pc the-instruction-sequence)
               (execute))
              ((eq? message 'install-instruction-sequence)
               (lambda (seq) (set! the-instruction-sequence seq)))
              ((eq? message 'allocate-register) allocate-register)
              ((eq? message 'get-register) lookup-register)
              ((eq? message 'install-operations)
               (lambda (ops) (set! the-ops (append the-ops ops))))
              ((eq? message 'stack) stack)
              ((eq? message 'operations) the-ops)
       ((eq? message 'print-program-counter)
        (print-program-counter))
       ((eq? message 'initialize-program-counter)
        (initialize-program-counter))              (else (error "Unknown request -- MACHINE" message))))
      dispatch)))

Solution of SICP Exercise 5.14

Below is the solution of Exercise 5.14.
Found some solutions on the web try to get
the trace information using something like
((factorial-machine 'stack) print-statistics)
instead of modifying instructions set of the factorial machine,
which is not the intent of this exercise.

下面是练习5.14的解决方案。
我注意到有些网上的方案直接访问STACK的print-statistics函数。
((factorial-machine 'stack) print-statistics)
显然这不是本练习的目的。

練習問題5.14の回答は下記の通りになります。
直接スタックのprint-statistics関数を使用し、
情報を取得することも可能ですが、本練習の目的ではないと思います。

(define fm
  (make-machine
  '(n val continue)
  (list (list '= =) (list '- -) (list '* *) (list 'read read) (list 'output write))
  '(controller
    (assign n (op read))
    (perform (op initialize-stack))
    (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
    (perform (op output) (reg val))
    (perform (op print-stack-statistics))
    (goto (label controller)))))