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

let : let* :: do : do*

first a minor issue:
Both list-tail and list-ref specify that the first argument should be
a list.  But in neither case does the argument need to be non-circular.
DO* is defined in common-lisp and is related to DO as LET* is related
to LET.  Its inclusion in scheme would make the function set more

My main reason for recommending that DO* be included in the Scheme
language is that mathematical algorithms are usually expressed in
pseudo-Algol which translates to the constructs LET* and DO*.  A LET*
in the body of a DO does not do the job because only the variables in
the outer DO are available for the test clause.

I am writing a symbolic mathematics system in Revised^3.99 Scheme.
The code is more than 4000 lines long.  I find that squeezing the
loops into DO (without DO*) is difficult and leads to contorted
arrangements for the <init> and <test> clauses to make them look ahead.

Here is my code for computing the subdeterminant Psuedo Remainder
Sequence of two polynomials.

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

;;; Pseudo Remainder Sequence
(define (univ_prs u v)
  (let ((var (car u))
	(g 1)
	(h 1)
        (delta 1))
    (do ((r (univ_prem u v) (univ_prem u v)))
	((eqv? 0 (univ_degree r var))
	 (if (eqv? 0 r) v r))
      (set! delta (- (univ_degree u var) (univ_degree v var)))
      (set! u v)
      (set! v (poly_/ r (poly_* g (poly_^ h delta))))
      (set! g (car (last-pair u)))
      (set! h (cond ((one? delta) g)
		    ((zero? delta) h)
		    (else (poly_/ (poly_^ g delta)
				  (poly_^ h (+ -1 delta)))))))))

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