[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
orthogonal.
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))))