diff --git a/ex-5_01-xx.scm b/ex-5_01-xx.scm index 8aed871..ea010a8 100644 --- a/ex-5_01-xx.scm +++ b/ex-5_01-xx.scm @@ -30,21 +30,135 @@ (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 (improve guess) - (average guess (/ n guess))) - (define (average a b) - (/ (+ a b) 2)) - (define (good-enough? guess) - (< (abs (- (* guess guess) n)) 0.01)) (define (iter guess) - (if (good-enough? guess) + (if (good-enough? guess n) guess - (iter (average 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))) -(display (sqrt-newton 2)) +(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)) ; val now contains n(n - 1)! + (goto (reg continue)) ; return to caller + base-case + (assign val (const 1)) ; base case: 1! = 1 + (goto (reg continue)) ; return to caller + 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 "\nex-5.4\n")