Serendip

Web Studio

問題5.12

計算機を作る際に解析器 analyzer を実装する。

(define (make-new-machine)
  (let ((pc (make-register 'pc))
        (flag (make-register 'flag))
        (stack (make-stack))
        (analyzer (make-analyzer)) ;; 解析器を追加する
        (the-instruction-sequence '()))
  ;; 省略
                    ((eq? message 'operations) the-ops)
                    ((eq? message 'analyzer) analyzer) ;; メッセージ処理に解析器分を追加する
                    (else (error "Unknown request -- MACHINE" message))))
            dispatch)))

解析器

(define (make-analyzer)
  (let ((analyze-list '((assign) (test) (branch) (goto) (save) (restore) (perform))))
       (define (add-analyzer inst label)
         (let ((analyzer (assoc label analyze-list)))
              (if analyzer
                  (if (not (member inst analyzer))
                      (set-cdr! analyzer (cons inst (cdr analyzer)))))))
       (define (print-analyzer)
         (print analyze-list))
       (define (dispatch message)
         (cond ((eq? message 'add) add-analyzer)
               ((eq? message 'print) print-analyzer)
               (else (error "Unknown request -- ANALYZER" message))))
       dispatch))

(define (print-analyzed-result machine)
  (((machine 'analyzer) 'print)))

(define (add-analyzer inst machine label)
  (((machine 'analyzer) 'add) inst label))

命令の実行手続きを生成する際に解析を行うように処理を追加する。

(define (make-execution-procedure inst labels machine
                                  pc flag stack ops)
  (cond ((eq? (car inst) 'assign)
         (add-analyzer inst machine 'assign)
         (make-assign inst machine labels ops pc))
        ((eq? (car inst) 'test)
         (add-analyzer inst machine 'test)
         (make-test inst machine labels ops flag pc))
        ((eq? (car inst) 'branch)
         (add-analyzer inst machine 'branch)
         (make-branch inst machine labels flag pc))
        ((eq? (car inst) 'goto)
         (add-analyzer inst machine 'goto)
         (make-goto inst machine labels pc))
        ((eq? (car inst) 'save)
         (add-analyzer inst machine 'save)
         (make-save inst machine stack pc))
        ((eq? (car inst) 'restore)
         (add-analyzer inst machine 'restore)
         (make-restore inst machine stack pc))
        ((eq? (car inst) 'perform)
         (add-analyzer inst machine 'perform)
         (make-perform inst machine labels ops pc))
        (else (error "Unknown instruction type -- ASSEMBLE"
                     inst))))

図5.12(p305)の Fibonacci 計算機でテストしてみる。

(define fib-machine
  (make-machine
    '(continue val n)
    (list (list '< <) (list '- -) (list '+ +))
    '(start
       (assign continue (label fib-done))
  fib-loop
    (test (op <) (reg n) (const 2))
    (branch (label immediate-answer))
    (save continue)
    (assign continue (label afterfib-n-1))
    (save n)
    (assign n (op -) (reg n) (const 1))
    (goto (label fib-loop))
  afterfib-n-1
    (restore n)
    (restore continue)
    (assign n (op -) (reg n) (const 2))
    (save continue)
    (assign continue (label afterfib-n-2))
    (save val)
    (goto (label fib-loop))
  afterfib-n-2
    (assign n (reg val))
    (restore val)
    (restore continue)
    (assign val (op +) (reg val) (reg n))
    (goto (reg continue))
  immediate-answer
    (assign val (reg n))
    (goto (reg continue))
  fib-done)))

(print-analyzed-result fib-machine) ;; 解析結果を表示する

実行結果

gosh> ((assign (assign val (reg n)) (assign val (op +) (reg val) (reg n)) (assign n (reg val)) (assign continue (label afterfib-n-2)) (assign n (op -) (reg n) (const 2)) (assign n (op -) (reg n) (const 1)) (assign continue (label afterfib-n-1)) (assign continue (label fib-done))) (test (test (op <) (reg n) (const 2))) (branch (branch (label immediate-answer))) (goto (goto (reg continue)) (goto (label fib-loop))) (save (save val) (save n) (save continue)) (restore (restore val) (restore continue) (restore n)) (perform))

計算機プログラムの構造と解釈

posted with amazlet at 08.11.07

ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 6542

Amazon.co.jp で詳細を見る