239 lines
6.8 KiB
Scheme
239 lines
6.8 KiB
Scheme
(load "util.scm")
|
|
(load "misc/sicp-regsim.scm")
|
|
|
|
(display "\nex-5.1 draw-factorial\n")
|
|
|
|
; See misc directory for drawing.
|
|
|
|
(display "[answered]\n")
|
|
|
|
(display "\nex-5.2 design-factorial\n")
|
|
|
|
(define factorial-machine
|
|
(make-machine
|
|
'(counter product n)
|
|
(list (list '> >) (list '* *) (list '+ +))
|
|
'(controller
|
|
(assign product (const 1))
|
|
(assign counter (const 1))
|
|
test-counter
|
|
(test (op >) (reg counter) (reg n))
|
|
(branch (label factorial-done))
|
|
(assign product (op *) (reg product) (reg counter))
|
|
(assign counter (op +) (reg counter) (const 1))
|
|
(goto (label test-counter))
|
|
factorial-done)))
|
|
|
|
(set-register-contents! factorial-machine 'n 6)
|
|
(start factorial-machine)
|
|
(assert (get-register-contents factorial-machine 'product) 720)
|
|
|
|
(display "\nex-5.3 - sqrt-newton\n")
|
|
|
|
(define (good-enough? guess n)
|
|
(< (abs (- (* guess guess) n)) 0.01))
|
|
|
|
(define (improve guess n)
|
|
(average guess (/ n guess)))
|
|
|
|
(define (average a b)
|
|
(/ (+ a b) 2))
|
|
|
|
(define (sqrt-newton n)
|
|
(define (iter guess)
|
|
(if (good-enough? guess n)
|
|
guess
|
|
(iter (improve guess n))))
|
|
(iter 1.))
|
|
|
|
(define sqrt-machine
|
|
(make-machine
|
|
'(guess n)
|
|
(list (list 'good-enough? good-enough?)
|
|
(list 'improve improve))
|
|
'(controller
|
|
(assign guess (const 1.))
|
|
iter
|
|
(test (op good-enough?) (reg guess) (reg n))
|
|
(branch (label sqrt-done))
|
|
(assign guess (op improve) (reg guess) (reg n))
|
|
(goto (label iter))
|
|
sqrt-done)))
|
|
|
|
(set-register-contents! sqrt-machine 'n 2)
|
|
(start sqrt-machine)
|
|
(assert (get-register-contents sqrt-machine 'guess) (sqrt-newton 2))
|
|
|
|
(define sqrt-machine
|
|
(make-machine
|
|
'(guess n div_n_guess guess_error)
|
|
(list (list '>= >=)
|
|
(list '< <)
|
|
(list 'abs abs)
|
|
(list '- -)
|
|
(list '* *)
|
|
(list '/ /)
|
|
(list '+ +))
|
|
'(controller
|
|
(assign guess (const 1.))
|
|
iter
|
|
; good-enough?
|
|
(assign guess_error (op *) (reg guess) (reg guess))
|
|
(assign guess_error (op -) (reg guess_error) (reg n))
|
|
(test (op >=) (reg guess_error) (const 0))
|
|
(branch (label guess_error_positive))
|
|
(assign guess_error (op *) (reg guess_error) (const -1))
|
|
guess_error_positive
|
|
(test (op <) (reg guess_error) (const 0.01))
|
|
(branch (label sqrt-done))
|
|
; improve
|
|
(assign div_n_guess (op /) (reg n) (reg guess))
|
|
(assign guess (op +) (reg guess) (reg div_n_guess))
|
|
(assign guess (op /) (reg guess) (const 2))
|
|
(goto (label iter))
|
|
sqrt-done)))
|
|
|
|
(set-register-contents! sqrt-machine 'n 2)
|
|
(start sqrt-machine)
|
|
(assert (get-register-contents sqrt-machine 'guess) (sqrt-newton 2))
|
|
|
|
(display "\nex-5.4 - expt\n")
|
|
|
|
(define (expt-rec b n)
|
|
(if (= n 0)
|
|
1
|
|
(* b (expt b (- n 1)))))
|
|
|
|
(define expt-rec-machine
|
|
(make-machine
|
|
'(b n val continue)
|
|
(list (list '* *) (list '- -) (list '= =))
|
|
'(controller
|
|
(assign continue (label expt-done))
|
|
expt-loop
|
|
(test (op =) (reg n) (const 0))
|
|
(branch (label base-case))
|
|
(save continue)
|
|
(assign n (op -) (reg n) (const 1))
|
|
(assign continue (label after-expt))
|
|
(goto (label expt-loop))
|
|
after-expt
|
|
(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-rec-machine 'b 3)
|
|
(set-register-contents! expt-rec-machine 'n 4)
|
|
(start expt-rec-machine)
|
|
(assert (get-register-contents expt-rec-machine 'val)
|
|
(expt-rec 3 4))
|
|
|
|
(define (expt-iter b n)
|
|
(define (expt-iter counter product)
|
|
(if (= counter 0)
|
|
product
|
|
(expt-iter (- counter 1) (* b product))))
|
|
(expt-iter n 1))
|
|
|
|
(define expt-iter-machine
|
|
(make-machine
|
|
'(b n counter product continue)
|
|
(list (list '* *) (list '- -) (list '= =))
|
|
'(controller
|
|
(assign counter (reg n))
|
|
(assign product (const 1))
|
|
expt-loop
|
|
(test (op =) (reg counter) (const 0))
|
|
(branch (label expt-done))
|
|
(assign counter (op -) (reg counter) (const 1))
|
|
(assign product (op *) (reg b) (reg product))
|
|
(goto (label expt-loop))
|
|
expt-done)))
|
|
|
|
(set-register-contents! expt-iter-machine 'b 3)
|
|
(set-register-contents! expt-iter-machine 'n 4)
|
|
(start expt-iter-machine)
|
|
(assert (get-register-contents expt-iter-machine 'product)
|
|
(expt-iter 3 4))
|
|
|
|
(display "\nex-5.5 - hand-simulate-fib\n")
|
|
(display "[answered]\n")
|
|
|
|
; begin
|
|
; n = 2 ; val = ? ; continue = fib-done
|
|
; stack = []
|
|
|
|
; fib-loop
|
|
; n = 1 ; val = ? ; continue = afterfib-n-1
|
|
; stack = [2, fib-done]
|
|
|
|
; fib-loop
|
|
; immediate-answer
|
|
; n = 1 ; val = 1 ; continue = afterfib-n-1
|
|
; stack = [2, fib-done]
|
|
|
|
; afterfib-n-1
|
|
; n = 0 ; val = 1 ; continue = afterfib-n-2
|
|
; stack = [1, fib-done]
|
|
|
|
; fib-loop
|
|
; n = 0 ; val = 0 ; continue = afterfib-n-2
|
|
; stack = [1, fib-done]
|
|
|
|
; afterfib-n-2
|
|
; n = 0 ; val = 1 ; continue = fib-done
|
|
; stack = []
|
|
|
|
; fib-done
|
|
; val = 1
|
|
|
|
(display "\nex-5.6 - slightly-improved-fib\n")
|
|
|
|
(define fib-machine
|
|
(make-machine
|
|
'(n val continue)
|
|
(list (list '< <) (list '- -) (list '= +) (list '+ +))
|
|
'(controller
|
|
(assign continue (label fib-done))
|
|
fib-loop
|
|
(test (op <) (reg n) (const 2))
|
|
(branch (label immediate-answer))
|
|
;; set up to compute Fib(n - 1)
|
|
(save continue)
|
|
(assign continue (label afterfib-n-1))
|
|
(save n) ; save old value of n
|
|
(assign n (op -) (reg n) (const 1)); clobber n to n - 1
|
|
(goto (label fib-loop)) ; perform recursive call
|
|
afterfib-n-1 ; upon return, val contains Fib(n - 1)
|
|
(restore n)
|
|
;(restore continue)
|
|
;; set up to compute Fib(n - 2)
|
|
(assign n (op -) (reg n) (const 2))
|
|
;(save continue)
|
|
(assign continue (label afterfib-n-2))
|
|
(save val) ; save Fib(n - 1)
|
|
(goto (label fib-loop))
|
|
afterfib-n-2 ; upon return, val contains Fib(n - 2)
|
|
(assign n (reg val)) ; n now contains Fib(n - 2)
|
|
(restore val) ; val now contains Fib(n - 1)
|
|
(assign val ; Fib(n - 1) + Fib(n - 2)
|
|
(op +) (reg val) (reg n))
|
|
(restore continue)
|
|
(goto (reg continue)) ; return to caller, answer is in val
|
|
immediate-answer
|
|
(assign val (reg n)) ; base case: Fib(n) = n
|
|
(goto (reg continue))
|
|
fib-done)))
|
|
|
|
(set-register-contents! fib-machine 'n 8)
|
|
(start fib-machine)
|
|
(assert (get-register-contents fib-machine 'val) 21)
|
|
|
|
; restore and save of continue in afterfib-n-1 is not needed
|
|
(display "[answered]\n")
|
|
|