SICP 問題 5.45

コンパイルした階乗計算，積極制御評価器の階乗計算，特殊目的計算機のプッシュ数，最大スタック深さを調べて比較する．

まずはコンパイルしたものから

gosh> (compile-and-go
       '(define (factorial n)
          (if (= n 1)
              1
              (* (factorial (- n 1)) n))))

(total-pushes = 0 maximum-depth = 0)
;;; EC-Eval value:
ok


;;; EC-Eval input:
(factorial 1)

(total-pushes = 5 maximum-depth = 3)
;;; EC-Eval value:
1

;;; EC-Eval input:
(factorial 2)

(total-pushes = 7 maximum-depth = 3)
;;; EC-Eval value:
2

;;; EC-Eval input:
(factorial 3)

(total-pushes = 9 maximum-depth = 4)
;;; EC-Eval value:
6

;;; EC-Eval input:
(factorial 4)

(total-pushes = 11 maximum-depth = 6)
;;; EC-Eval value:
24

;;; EC-Eval input:
(factorial 5)

(total-pushes = 13 maximum-depth = 8)
;;; EC-Eval value:
120

;;; EC-Eval input:
(factorial 6)

(total-pushes = 15 maximum-depth = 10)
;;; EC-Eval value:
720

;;; EC-Eval input:
(factorial 7)

(total-pushes = 17 maximum-depth = 12)
;;; EC-Eval value:
5040

;;; EC-Eval input:
(factorial 8)

(total-pushes = 19 maximum-depth = 14)
;;; EC-Eval value:
40320

;;; EC-Eval input:
(factorial 9)

(total-pushes = 21 maximum-depth = 16)
;;; EC-Eval value:
362880

;;; EC-Eval input:
(factorial 10)

(total-pushes = 23 maximum-depth = 18)
;;; EC-Eval value:
3628800

プッシュ数は2n+3
最大スタック深さは2n-2
　
次に積極制御評価器で計測する．

;;; EC-Eval input:
(define (ec-factorial n)
  (if (= n 1)
      1
      (* (ec-factorial (- n 1)) n)))

(total-pushes = 3 maximum-depth = 3)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(ec-factorial 1)

(total-pushes = 16 maximum-depth = 8)
;;; EC-Eval value:
1

;;; EC-Eval input:
(ec-factorial 2)

(total-pushes = 48 maximum-depth = 13)
;;; EC-Eval value:
2

;;; EC-Eval input:
(ec-factorial 3)

(total-pushes = 80 maximum-depth = 18)
;;; EC-Eval value:
6

;;; EC-Eval input:
(ec-factorial 4)

(total-pushes = 112 maximum-depth = 23)
;;; EC-Eval value:
24

;;; EC-Eval input:
(ec-factorial 5)

(total-pushes = 144 maximum-depth = 28)
;;; EC-Eval value:
120

;;; EC-Eval input:
(ec-factorial 6)

(total-pushes = 176 maximum-depth = 33)
;;; EC-Eval value:
720

;;; EC-Eval input:
(ec-factorial 7)

(total-pushes = 208 maximum-depth = 38)
;;; EC-Eval value:
5040

;;; EC-Eval input:
(ec-factorial 8)

(total-pushes = 240 maximum-depth = 43)
;;; EC-Eval value:
40320

;;; EC-Eval input:
(ec-factorial 9)

(total-pushes = 272 maximum-depth = 48)
;;; EC-Eval value:
362880

;;; EC-Eval input:
(ec-factorial 10)

(total-pushes = 304 maximum-depth = 53)
;;; EC-Eval value:
3628800

プッシュ数は32n-16
最大スタック深さは5n+3
　
最後に階乗計算のための特殊計算機で計測する．

gosh> (define fact  ;; 二回目以降の初期化は省略
        (make-machine
         (list (list '* *)
               (list '= =)
               (list '- -))
         '(controller
           (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 print-stack-statistics)))))
fact
gosh> (set-register-contents! fact 'n 1)
done
gosh> (start fact)

(total-pushes = 0 maximum-depth = 0)done
gosh> (get-register-contents fact 'val)
1
gosh> (set-register-contents! fact 'n 2)
done
gosh> (start fact)

(total-pushes = 2 maximum-depth = 2)done
gosh> (get-register-contents fact 'val)
2
gosh> (set-register-contents! fact 'n 3)
done
gosh> (start fact)

(total-pushes = 4 maximum-depth = 4)done
gosh> (get-register-contents fact 'val)
6
gosh> (set-register-contents! fact 'n 4)
done
gosh> (start fact)

(total-pushes = 6 maximum-depth = 6)done
gosh> (get-register-contents fact 'val)
24
gosh> (set-register-contents! fact 'n 5)
done
gosh> (start fact)

(total-pushes = 8 maximum-depth = 8)done
gosh> (get-register-contents fact 'val)
120
gosh> (set-register-contents! fact 'n 6)
done
gosh> (start fact)

(total-pushes = 10 maximum-depth = 10)done
gosh> (get-register-contents fact 'val)
720
gosh> (set-register-contents! fact 'n 7)
done
gosh> (start fact)

(total-pushes = 12 maximum-depth = 12)done
gosh> (get-register-contents fact 'val)
5040
gosh> (set-register-contents! fact 'n 8)
done
gosh> (start fact)

(total-pushes = 14 maximum-depth = 14)done
gosh> (get-register-contents fact 'val)
40320
gosh> (set-register-contents! fact 'n 9)
done
gosh> (start fact)

(total-pushes = 16 maximum-depth = 16)done
gosh> (get-register-contents fact 'val)
362880
gosh> (set-register-contents! fact 'n 10)
done
gosh> (start fact)

(total-pushes = 18 maximum-depth = 18)done
gosh> (get-register-contents fact 'val)
3628800

プッシュ数が2n-2 最大スタック深さが2n-2．

比べると，積極制御評価器は
total: 32n-16
max: 5n+3
　
翻訳系は
total: 2n+3
max: 2n-2
　
階乗計算機は
total: 2n-2
max: 2n-2
　
本来はここで翻訳系と階乗計算機のほうがはるかに優れていることを確認するはずが
ここまでの問題で最適化したため，ほとんど性能差がなくなっている．
比率を出すと積極制御評価器とは
totalが1:16
maxは2:5の性能差になる．

ここで本当に翻訳系が2nで収まっているのか確認のためにコンパイルした命令列を出力させる．
saveしているところを確認する．

gosh> (compile
       '(define (factorial n)
          (if (= n 1)
              1
              (* (factorial (- n 1)) n)))
       'val 'next '())
      ((env)
       (val)
       ((assign val (op make-compiled-procedure) (label entry1) (reg env))
        (goto (label after-lambda2))
        entry1
        (assign env (op compiled-procedure-env) (reg proc))
        (assign env (op extend-environment) (const (n)) (reg argl) (reg env))
        (assign arg1 (op lexical-address-lookup) (const (0 0)) (reg env))
        (assign arg2 (const 1))
        (assign val (op =) (reg arg1) (reg arg2))
        (test (op false?) (reg val))
        (branch (label false-branch4))
        true-branch3
        (assign val (const 1))
        (goto (reg continue))
        false-branch4
        (save continue)  ;; false-branchのcontinue
        (save env)          ;; false-branchのenv
        (assign proc (op get-global-environment))
        (assign proc (op lookup-variable-value) (const factorial) (reg proc))
        (assign arg1 (op lexical-address-lookup) (const (0 0)) (reg env))
        (assign arg2 (const 1))
        (assign val (op -) (reg arg1) (reg arg2))
        (assign argl (op list) (reg val))
        (test (op primitive-procedure?) (reg proc))
        (branch (label primitive-branch6))
        compiled-branch7
        (assign continue (label proc-return9))
        (assign val (op compiled-procedure-entry) (reg proc))
        (goto (reg val))
        proc-return9
        (assign arg1 (reg val))
        (goto (label after-call8))
        primitive-branch6
        (assign arg1 (op apply-primitive-procedure) (reg proc) (reg argl))
        after-call8
        (restore env)
        (assign arg2 (op lexical-address-lookup) (const (0 0)) (reg env))
        (assign val (op *) (reg arg1) (reg arg2))
        (restore continue)
        (goto (reg continue))
        after-if5
        after-lambda2
        (perform (op define-variable!) (const factorial) (reg val) (reg env))
        (assign val (const ok))))

false-branchでcontinueとenvをsaveしているだけなので最大スタック深さが2n-2なのは確かなようだ．
プッシュ数が2n+3なのは(factorial 1)でも5回プッシュされてるところを見ると，
引数を適用する段階でされているのでこれ以上は無理だろう．
factorialは基本計算しか使っていないので，open-code最適化がかなり効いてるためのこれだけ性能がよくなってると思われる．