计算机程序的构造和解释(SICP) 第5章 习题解析 Part1

这次回顾第五章第一部分习题。

学习资料：

https://ocw.mit.edu/courses/electrical-engineering-and-computer-science/6-001-structure-and-interpretation-of-computer-programs-spring-2005/index.htm

https://github.com/DeathKing/Learning-SICP

https://mitpress.mit.edu/sites/default/files/sicp/index.html

https://www.bilibili.com/video/BV1Xx41117tr?from=search&seid=14983483066585274454

参考资料：

https://sicp.readthedocs.io/en/latest

http://community.schemewiki.org/?SICP-Solutions

http://community.schemewiki.org/?sicp

https://liujiacai.net/blog/2016/02/22/recursion-without-name/

https://mvanier.livejournal.com/2897.html

https://github.com/jiacai2050/sicp

https://liujiacai.net/

5.1(p346)

略过作图。

5.2(p348)

代码：

(controller
    (assign (reg product) (const 1))
    (assign (reg counter) (const 1))
    test-b
        (test (op >) (reg counter) (reg n))
        (branch (label factorial-done))
        (assign product (op *) (reg counter) (reg product))
        (assign counter (op +) (reg counter) (const 1))
    factorial-done)

5.3(p349)

代码：

(controller
    (assign (reg guess) (const 1))
    test-b
        (test (op good-engough?) guess)
        (branch (label sqrt-iter-done))
        (assign guess (op improve) (reg guess))
        (go-to (label test-b))
    sqrt-iter-done)

(controller
    (assign (reg guess) (const 1))
    test-b
    good-enough
        (assign t1 (op square) (reg guess))
        (assign t2 (op -) (reg t1) (reg x))
        (assign t3 (op abs) (reg t2))
        (test (op <) (reg t3) (const 0.001))
        (branch (label sqrt-iter-done))
    improve
        (assign t4 (op /) (reg x) (reg guess))
        (assign guess (op average) (reg guess) (reg t4))
    impore-done
        (go-to (label test-b))
    sqrt-iter-done)

5.4(p357)

代码：

; a
(controller
    (assign continue (label expt-done))
    expt-loop
        (test (op =) (reg n) (const 0))
        (branch (label base-case))
        (save continue)
        (save n)
        (assign n (op -) (reg n) (const 1))
        (assign continue (label after-exp))
        (goto (label expt-loop))
    after-exp
        (restore n)
        (restore continue)
        (assign val (op *) (reg b) (reg val))
        (goto (reg continue))
    base-case
        (assign val (const 1))
        (goto (reg continue))
    expt-done)

; b
(controller
    (assign (reg product) (const 1))
    (assign counter (reg n))
    test-b
        (test (op =) (reg counter) (const 0))
        (branch (label expt-done))
        (assign counter (op -) (reg counter) (const 1))
        (assign product (op *) (reg product) (reg b))
        (goto (label test-b))
    expt-done)

5.5(p358)

例子：

(fib 2)

调用过程：

continue		n		val
fib-done		2		None
afterfib-n-1	1	 	None
afterfib-n-1	1	 	1
afterfib-n-2	0	 	1
afterfib-n-2	0	 	0
fib-done		0		1

5.6(p358)

参考资料：

http://community.schemewiki.org/?sicp-ex-5.6

可以删除afterfib-n-1中如下语句：

(restore continue)
(save continue)

5.7(p360)

代码：

(load "ch5-regsim.scm")

; iter
(define expt-machine-iter
    (make-machine
        '(product counter b n)
        (list (list '= =) 
              (list '- -)
              (list '* *))
        '((assign product (const 1))
          (assign counter (reg n))
          test-b
          (test (op =) (reg counter) (const 0))
          (branch (label expt-done))
          (assign counter (op -) (reg counter) (const 1))
          (assign product (op *) (reg product) (reg b))
          (goto (label test-b))
          expt-done)))

(set-register-contents! expt-machine-iter 'b 2)

(set-register-contents! expt-machine-iter 'n 10)

(start expt-machine-iter)

(get-register-contents expt-machine-iter 'product)

(set-register-contents! expt-machine-iter 'b 3)

(set-register-contents! expt-machine-iter 'n 5)

(start expt-machine-iter)

(get-register-contents expt-machine-iter 'product)

; rec
(define expt-machine-rec
    (make-machine
        '(b n continue val)
        (list (list '= =) 
              (list '- -)
              (list '* *))
        '((assign continue (label expt-done))
          expt-loop
            (test (op =) (reg n) (const 0))
            (branch (label base-case))
            (save continue)
            (save n)
            (assign n (op -) (reg n) (const 1))
            (assign continue (label after-exp))
            (goto (label expt-loop))
          after-exp
            (restore n)
            (restore continue)
            (assign val (op *) (reg b) (reg val))
            (goto (reg continue))
          base-case
            (assign val (const 1))
            (goto (reg continue))
          expt-done)))

(set-register-contents! expt-machine-rec 'b 2)

(set-register-contents! expt-machine-rec 'n 10)

(start expt-machine-rec)

(get-register-contents expt-machine-rec 'val)

(set-register-contents! expt-machine-rec 'b 3)

(set-register-contents! expt-machine-rec 'n 5)

(start expt-machine-rec)

(get-register-contents expt-machine-rec 'val)

实验结果：

1 ]=> (set-register-contents! expt-machine-iter 'b 2)
;Value: done

1 ]=> (set-register-contents! expt-machine-iter 'n 10)
;Value: done

1 ]=> (start expt-machine-iter)
;Value: done

1 ]=> (get-register-contents expt-machine-iter 'product)
;Value: 1024

1 ]=> (set-register-contents! expt-machine-iter 'b 3)
;Value: done

1 ]=> (set-register-contents! expt-machine-iter 'n 5)
;Value: done

1 ]=> (start expt-machine-iter)
;Value: done

1 ]=> (get-register-contents expt-machine-iter 'product)
;Value: 243

1 ]=> (set-register-contents! expt-machine-rec 'b 2)
;Value: done

1 ]=> (set-register-contents! expt-machine-rec 'n 10)
;Value: done

1 ]=> (start expt-machine-rec)
;Value: done

1 ]=> (get-register-contents expt-machine-rec 'val)
;Value: 1024

1 ]=> (set-register-contents! expt-machine-rec 'b 3)
;Value: done

1 ]=> (set-register-contents! expt-machine-rec 'n 5)
;Value: done

1 ]=> (start expt-machine-rec)
;Value: done

1 ]=> (get-register-contents expt-machine-rec 'val)
;Value: 243

5.8(p366)

ch5-regsim.scm新增规则：

; 5.8 add start
(define (extract-labels text receive)
  (if (null? text)
      (receive '() '())
      (extract-labels (cdr text)
       (lambda (insts labels)
         (let ((next-inst (car text)))
           (if (symbol? next-inst)
               ; add
               (if (exist-label? next-inst labels)
                (error "Multiply defined label -- ASSEMBLE" next-inst)
                (receive insts
                        (cons (make-label-entry next-inst
                                                insts)
                              labels)))
               (receive (cons (make-instruction next-inst)
                              insts)
                        labels)))))))

(define (exist-label? label labels)
  (cond ((null? labels) #f)
        ((equal? label (caar labels)) 
          #t)
        (else (exist-label? label (cdr labels)))))
; 5.8 add end

测试代码：

(load "ch5-regsim.scm")

(define test-machine
    (make-machine
        '(a)
        (list)
        '(start
            (goto (label here))
          here
            (assign a (const 3))
            (goto (label there))
          here
            (assign a (const 4))
            (goto (label there))
          there)))

(start test-machine)

(get-register-contents test-machine 'a)

实验结果：

;Multiply defined label -- ASSEMBLE here
;To continue, call RESTART with an option number:
; (RESTART 1) => Return to read-eval-print level 1.