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)))