sicp-ex-5.3



<< Previous exercise (5.2) | Index | Next exercise (5.4) >>


meteorgan

  
  
 (define sqrt-machine 
   (make-machine 
    '(x guess temp) 
    (list (list '- -) (list '< <) (list '/ /) (list '+ +) (list '* *) (list '> >)) 
    '((assign guess (const 1.0)) 
     test-g 
     (assign temp (op *) (reg guess) (reg guess)) 
     (assign temp (op -) (reg temp) (reg x)) 
     (test (op >) (reg temp) (const 0)) 
     (branch (label iter)) 
     (assign temp (op -) (const 0) (reg temp)) 
     iter 
     (test (op <) (reg temp) (const 0.001)) 
     (branch (label sqrt-done)) 
     (assign temp (op /) (reg x) (reg guess)) 
     (assign temp (op +) (reg temp) (reg guess)) 
     (assign guess (op /) (reg temp) (const 2)) 
     (goto (label test-g)) 
     sqrt-done))) 
 (set-register-contents! sqrt-machine 'x 2) 
 (start sqrt-machine) 
  
 (get-register-contents sqrt-machine 'guess) 
 =>1.4142156862745097 
  
  
 ;; 1. assuming that good-enough? and improve are primtives 
  
 (controller 
  (assign x (op read)) 
  (assign guess (const 1.0)) 
  
  test-good 
  (test (op good-enough?) (reg guess) (reg x)) 
  (branch (label done)) 
  (assign t (op improve) (reg guess) (reg x)) 
  (assign guess (reg t)) 
  (goto test-good) 
  done 
  
  (perform (op print) (reg guess)) 
  ) 
  
 ;; 2. inline improve 
  
 (controller 
  (assign x (op read)) 
  (assign guess (const 1.0)) 
  
  test-good 
  (test (op good-enough?) (reg guess) (reg x)) 
  (branch (label done)) 
  
  ;; improve procedure 
  (assign div (op /) (reg x) (reg guess)) 
  (assign avg (op average) (reg guess) (reg div)) 
  
  (assign t (reg avg)) 
  (assign guess (reg t)) 
  (goto test-good) 
  done 
  
  (perform (op print) (reg guess)) 
  ) 
  
 ;; 2a inline average 
 (controller 
  (assign x (op read)) 
  (assign guess (const 1.0)) 
  
  test-good 
  (test (op good-enough?) (reg guess) (reg x)) 
  (branch (label done)) 
  
  ;; improve procedure 
  (assign div (op /) (reg x) (reg guess)) 
  
  ;; average procedure 
  (assign sum (op +) (reg guess) (reg div)) 
  (assign avg (op /) (reg sum) (const 2)) 
  
  (assign t (reg avg)) 
  (assign guess (reg t)) 
  (goto test-good) 
  done 
  
  (perform (op print) (reg guess)) 
  ) 
  
 3. inline good-enough? 
 (controller 
  (assign x (op read)) 
  (assign guess (const 1.0)) 
  
  test-good 
   
  ;; good-enough? procedure 
  (assign square (op *) (reg guess) (reg guess)) 
  (assign diff (op -) (reg square) (reg x)) 
  (test (op <) (reg diff) (const 0)) 
  (branch test-abs-neg) 
  test-abs-pos 
  (assign abs (reg diff)) 
  test-abs-neg 
  (assign abs (op *) (reg diff) (const -1)) 
  (test (op <) (reg abs) (const 0.001)) 
  
  (branch (label done)) 
  
  ;; improve procedure 
  (assign div (op /) (reg x) (reg guess)) 
  ;; average procedure 
  (assign sum (op +) (reg guess) (reg div)) 
  (assign avg (op /) (reg sum) (const 2)) 
  
  (assign t (reg avg)) 
  (assign guess (reg t)) 
  (goto test-good) 
  done 
  
  (perform (op print) (reg guess)) 
  )