[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

do is horrible

   ;;; This algorithm taken from:
   ;;; Knuth, D. E.,
   ;;; The Art Of Computer Programming, Vol. 2: Seminumerical Algorithms,
   ;;; Addison Wesley, Reading, MA 1969.

   ;Here would be the code with DO*
   (define (univ_prs u v)
     (do* ((var (car u))
	   (delta 0 (- (univ_degree u var) (univ_degree v var)))
	   (u u v)
	   (v v (poly_/ r (poly_* g (poly_^ h delta))))
	   (g 0 (car (last-pair u)))
	   (h 0 (cond ((one? delta) g)
		      ((zero? delta) h)
		      (else (poly_/ (poly_^ g delta)
				    (poly_^ h (+ -1 delta))))))
	   (r (univ_prem u v) (univ_prem u v)))
	  ((eqv? 0 (univ_degree r var))
	   (if (eqv? 0 r) v r))))

I hate do and do*. I find the Yale loop macro much easier to read and write,
and port it to all the lisps and Scheme's I program. It has the advantages
- Multiple termination conditions
  You can have clauses like:
    (do ...)
    (until (prime? i))
    (do ...)
    (next (i (+ 1 (* i i))))
    (while (< i j))
    (do ...)

  So you can specify two different exit points and exit conditions for the
  loop. do* does not allow these sort of Knuth-loops.

- Sequential update semantics
  This is the feature you wanted in do*.

- Readable, lispy syntax
  As opposed to, say, the baroque MIT loop macro.

- Useful iteration clauses for common iterators:
  integer sequences: (incr j in 0 to 100)
  vectors:	     (for elt in-vector v)
  lists:	     (for x in l)
  ...and so on. The set of loop clauses is extensible.

- Update by name, instead of by position
  Writing tail-recursive loops with 7 iteration variables sucks.

Here's your procedure using the loop macro:

(define (univ_prs u v)
  (loop (initial (var (car u))  (g 1)  (h 1)  (delta 1))
	(bind (r (univ_prem u v)))
	(until (eqv? 0 r))
	(next (delta (- (univ_degree u var) (univ_degree v var)))
	      (u v)
      	      (v (poly_/ r (poly_* g (poly_^ h delta))))
	      (g (car (last-pair u)))
	      (h (cond ((one? delta) g)
		       ((zero? delta) h)
		       (else (poly_/ (poly_^ g delta)
		       		     (poly_^ h (+ -1 delta)))))))
	(result (if (eqv? 0 r) v r))))