Implement till 5.4

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")