Looping constructs (was: Comparison: Beta - Lisp)

[Robert L.]

Simon Brooke wrote:

> Cambridge LisP has the beautiful construct
>
> (loop
> forms
> (until <condition> value)
> forms
> (while <condition> value)
> forms)
>
> where there can be an arbitrary number of forms, including an
> arbitrary number of _until_ forms and an arbitrary number of _while_
> forms in any order. The construct loops evaluating each of the forms
> in turn until it comes to an _until_ form whose condition evaluates to
> true, when it returns the value element of that form or nil if there
> was none; or until it comes to a _while_ form whose condition
> evaluates to false, in which case it returns the value element of that
> form or nil if there was none.
>
> In use it's exceedingly clear and flexible. I think this is
> implemented as a (pretty cunning) macro which expands into a _prog_
> wrapped around a _cond_; it might be worth spending a quiet winter's
> evening reinventing it (unless someone posts the code to this
> newsgroup).

(define-syntax cam-aux
(syntax-rules (while until)
[(_ (until bool x ...) more ... go (form ...))
(begin form ... (if bool (begin #f x ...)
(cam-aux more ... go ())))]
[(_ (while bool x ...) y ... go z)
(cam-aux (until (not bool) x ...) y ... go z)]
[(_ x more ... go (form ...)) (cam-aux more ... go (form ... x))]
[(_ go (form ...)) (begin form ... (go))]))

(define-syntax cam-loop
(syntax-rules ()
[(_ stuff ...)
(let go () (cam-aux stuff ... go ()))]))


(define (test)
(let ((x 24))
(cam-loop
(printf "~a " x)
(while (> (random 9) 0) " Low random number. ")
(display "-- ")
(set! x (quotient x 2))
(until (odd? x) " Hit an odd number."))))

> (test)
24 -- 12 -- 6 -- " Hit an odd number."
> (test)
24 -- 12 -- 6 -- " Hit an odd number."
> (test)
24 " Low random number. "

In Forth?

--
Europe is not going to be the monolithic societies that they once were in the
last century.... They are now going into a multicultural mode. Jews will be
resented because of our leading role. --- Barbara Spectre
http://archive.org/details/nolies