> (defun my-test ()
> (loop for number = (1+ (random 6))
> as sum = number then (+ sum number)
> until (= number 1)
> do (format t "~&~D thrown. Sum: ~D" number sum)
> finally (format t "~&One thrown.")))

Gauche Scheme

(use srfi-1) ;; unfold
(use srfi-27) ;; random-integer

(define (my-test)
(fold
(^(n sum) (print n " thrown. Sum: " (inc! sum n)) sum)
0
(cdr (unfold zero? ($ + 1 $) (^_ (random-integer 6)) -1)))
(print "One thrown."))

gosh> (my-test)
2 thrown. Sum: 2
2 thrown. Sum: 4
6 thrown. Sum: 10
One thrown.

gosh> (my-test)
One thrown.

Explanation of "unfold":

Function: unfold end-test key gen-next-seed seed :optional tail-gen

(unfold zero? (lambda(n) (+ 800 n)) (lambda(n) (- n 1)) 7)
===>
(807 806 805 804 803 802 801)

(unfold zero? (lambda(n) (+ 800 n)) (lambda(n) (- n 1)) 7
(lambda(n) (list "The number" n "ended the unfolding.")))
===>
(807 806 805 804 803 802 801 "The number" 0 "ended the unfolding.")

B. Pym wrote:

> > (defun my-test ()
> > (loop for number = (1+ (random 6))
> > as sum = number then (+ sum number)
> > until (= number 1)
> > do (format t "~&~D thrown. Sum: ~D" number sum)
> > finally (format t "~&One thrown.")))
>
> Gauche Scheme
>
> (use srfi-1) ;; unfold
> (use srfi-27) ;; random-integer
>
> (define (my-test)
> (fold
> (^(n sum) (print n " thrown. Sum: " (inc! sum n)) sum)
> 0
> (cdr (unfold zero? ($ + 1 $) (^_ (random-integer 6)) -1)))
> (print "One thrown."))
>
>
> gosh> (my-test)
> 2 thrown. Sum: 2
> 2 thrown. Sum: 4
> 6 thrown. Sum: 10
> One thrown.
>
> gosh> (my-test)
> One thrown.
>
>
> Explanation of "unfold":
>
> Function: unfold end-test key gen-next-seed seed :optional tail-gen
>
> (unfold zero? (lambda(n) (+ 800 n)) (lambda(n) (- n 1)) 7)
> ===>
> (807 806 805 804 803 802 801)
>
> (unfold zero? (lambda(n) (+ 800 n)) (lambda(n) (- n 1)) 7
> (lambda(n) (list "The number" n "ended the unfolding.")))
> ===>
> (807 806 805 804 803 802 801 "The number" 0 "ended the unfolding.")

Using "do" is a bit tricky, but the result is shorter.

(define (my-test)
(do ((n #f (+ 1 (random-integer 6)))
(sum 0))
((eqv? 1 n) (print "One thrown."))
(if n (print n " thrown. Sum: " (inc! sum n)))))

B. Pym wrote:

> B. Pym wrote:
>
> > > (defun my-test ()
> > > (loop for number = (1+ (random 6))
> > > as sum = number then (+ sum number)
> > > until (= number 1)
> > > do (format t "~&~D thrown. Sum: ~D" number sum)
> > > finally (format t "~&One thrown.")))
> >
> > Gauche Scheme
> >
> > (use srfi-1) ;; unfold
> > (use srfi-27) ;; random-integer
> >
> > (define (my-test)
> > (fold
> > (^(n sum) (print n " thrown. Sum: " (inc! sum n)) sum)
> > 0
> > (cdr (unfold zero? ($ + 1 $) (^_ (random-integer 6)) -1)))
> > (print "One thrown."))
> >
> >
> > gosh> (my-test)
> > 2 thrown. Sum: 2
> > 2 thrown. Sum: 4
> > 6 thrown. Sum: 10
> > One thrown.
> >
> > gosh> (my-test)
> > One thrown.
> >
> >
> > Explanation of "unfold":
> >
> > Function: unfold end-test key gen-next-seed seed :optional tail-gen
> >
> > (unfold zero? (lambda(n) (+ 800 n)) (lambda(n) (- n 1)) 7)
> > ===>
> > (807 806 805 804 803 802 801)
> >
> > (unfold zero? (lambda(n) (+ 800 n)) (lambda(n) (- n 1)) 7
> > (lambda(n) (list "The number" n "ended the unfolding.")))
> > ===>
> > (807 806 805 804 803 802 801 "The number" 0 "ended the unfolding.")
>
> Using "do" is a bit tricky, but the result is shorter.
>
> (define (my-test)
> (do ((n #f (+ 1 (random-integer 6)))
> (sum 0))
> ((eqv? 1 n) (print "One thrown."))
> (if n (print n " thrown. Sum: " (inc! sum n)))))

It seems to me that "do*" is more appropriate for this,
but this version is 2 characters longer!

(define (my-test)
(do* ((n #f (+ 1 (random-integer 6)))
(sum 0 (+ n sum)))
((eqv? 1 n) (print "One thrown."))
(if n (print n " thrown. Sum: " sum))))

I don't know why Common Lisp has "do*", but Gauche, Racket,
and Chicken Scheme don't.

Here's a version that I cobbled together. (A macro guru
may give us a better one.) "do" is to "do*" as "let" is
to "let*".

(define-syntax do*-aux
(syntax-rules ()
[(do* (inits ...) ((var update) ...) (test expr ...) stuff ...)
(let* (inits ...)
(if test
(begin expr ...)
(begin
(begin stuff ...)
(let loop ()
(begin (set! var update) ...)
(if test
(begin expr ...)
(begin stuff ...
(loop)))))))]))

(define-syntax do*
(syntax-rules (!!!)
[(do* !!! (inits ...) (updates ...)
((var init update) more ...) until body ...)
(do* !!! (inits ... (var init)) (updates ... (var update))
(more ...) until body ...)]
[(do* !!! (inits ...) (updates ...)
((var init) more ...) until body ...)
(do* !!! (inits ... (var init)) (updates ... )
(more ...) until body ...)]
[(do* !!! inits updates () until body ...)
(do*-aux inits updates until body ...)]
[(do* inits-updates until stuff ...)
(do* !!! () () inits-updates until stuff ...)]))

(do* ((x 0 (+ 1 x))
(y 922))
((= 9 x) (print 'ok))
(print x " " y))

0 922
1 922
2 922
3 922
4 922
5 922
6 922
7 922
8 922
ok

B. Pym wrote:

> B. Pym wrote:
>
> > B. Pym wrote:
> >
> > > > (defun my-test ()
> > > > (loop for number = (1+ (random 6))
> > > > as sum = number then (+ sum number)
> > > > until (= number 1)
> > > > do (format t "~&~D thrown. Sum: ~D" number sum)
> > > > finally (format t "~&One thrown.")))
> > >
> > > Gauche Scheme
> > >
> > > (use srfi-1) ;; unfold
> > > (use srfi-27) ;; random-integer
> > >
> > > (define (my-test)
> > > (fold
> > > (^(n sum) (print n " thrown. Sum: " (inc! sum n)) sum)
> > > 0
> > > (cdr (unfold zero? ($ + 1 $) (^_ (random-integer 6)) -1)))
> > > (print "One thrown."))
> > >
> > >
> > > gosh> (my-test)
> > > 2 thrown. Sum: 2
> > > 2 thrown. Sum: 4
> > > 6 thrown. Sum: 10
> > > One thrown.
> > >
> > > gosh> (my-test)
> > > One thrown.
> > >
> > >
> > > Explanation of "unfold":
> > >
> > > Function: unfold end-test key gen-next-seed seed :optional tail-gen
> > >
> > > (unfold zero? (lambda(n) (+ 800 n)) (lambda(n) (- n 1)) 7)
> > > ===>
> > > (807 806 805 804 803 802 801)
> > >
> > > (unfold zero? (lambda(n) (+ 800 n)) (lambda(n) (- n 1)) 7
> > > (lambda(n) (list "The number" n "ended the unfolding.")))
> > > ===>
> > > (807 806 805 804 803 802 801 "The number" 0 "ended the unfolding.")
> >
> > Using "do" is a bit tricky, but the result is shorter.
> >
> > (define (my-test)
> > (do ((n #f (+ 1 (random-integer 6)))
> > (sum 0))
> > ((eqv? 1 n) (print "One thrown."))
> > (if n (print n " thrown. Sum: " (inc! sum n)))))
>
> It seems to me that "do*" is more appropriate for this,
> but this version is 2 characters longer!
>
> (define (my-test)
> (do* ((n #f (+ 1 (random-integer 6)))
> (sum 0 (+ n sum)))
> ((eqv? 1 n) (print "One thrown."))
> (if n (print n " thrown. Sum: " sum))))
>
> I don't know why Common Lisp has "do*", but Gauche, Racket,
> and Chicken Scheme don't.
>
> Here's a version that I cobbled together. (A macro guru
> may give us a better one.) "do" is to "do*" as "let" is
> to "let*".
>
> (define-syntax do*-aux
> (syntax-rules ()
> [(do* (inits ...) ((var update) ...) (test expr ...) stuff ...)
> (let* (inits ...)
> (if test
> (begin expr ...)
> (begin
> (begin stuff ...)
> (let loop ()
> (begin (set! var update) ...)
> (if test
> (begin expr ...)
> (begin stuff ...
> (loop)))))))]))
>
> (define-syntax do*
> (syntax-rules (!!!)
> [(do* !!! (inits ...) (updates ...)
> ((var init update) more ...) until body ...)
> (do* !!! (inits ... (var init)) (updates ... (var update))
> (more ...) until body ...)]
> [(do* !!! (inits ...) (updates ...)
> ((var init) more ...) until body ...)
> (do* !!! (inits ... (var init)) (updates ... )
> (more ...) until body ...)]
> [(do* !!! inits updates () until body ...)
> (do*-aux inits updates until body ...)]
> [(do* inits-updates until stuff ...)
> (do* !!! () () inits-updates until stuff ...)]))
>
> (do* ((x 0 (+ 1 x))
> (y 922))
> ((= 9 x) (print 'ok))
> (print x " " y))
>
> 0 922
> 1 922
> 2 922
> 3 922
> 4 922
> 5 922
> 6 922
> 7 922
> 8 922
> ok
>

Another way:

(define (my-test)
(let1 r (cut + 1 (random-integer 6))
(do* ((n (r) (r))
(sum n (+ n sum)))
((eqv? 1 n) (print "One thrown."))
(print n " thrown. Sum: " sum))))

B. Pym wrote:

> B. Pym wrote:
>
> > B. Pym wrote:
> >
> > > B. Pym wrote:
> > >
> > > > > (defun my-test ()
> > > > > (loop for number = (1+ (random 6))
> > > > > as sum = number then (+ sum number)
> > > > > until (= number 1)
> > > > > do (format t "~&~D thrown. Sum: ~D" number sum)
> > > > > finally (format t "~&One thrown.")))
> > > >
> > > > Gauche Scheme
> > > >
> > > > (use srfi-1) ;; unfold
> > > > (use srfi-27) ;; random-integer
> > > >
> > > > (define (my-test)
> > > > (fold
> > > > (^(n sum) (print n " thrown. Sum: " (inc! sum n)) sum)
> > > > 0
> > > > (cdr (unfold zero? ($ + 1 $) (^_ (random-integer 6)) -1)))
> > > > (print "One thrown."))
> > > >
> > > >
> > > > gosh> (my-test)
> > > > 2 thrown. Sum: 2
> > > > 2 thrown. Sum: 4
> > > > 6 thrown. Sum: 10
> > > > One thrown.
> > > >
> > > > gosh> (my-test)
> > > > One thrown.
> > > >
> > > >
> > > > Explanation of "unfold":
> > > >
> > > > Function: unfold end-test key gen-next-seed seed :optional tail-gen
> > > >
> > > > (unfold zero? (lambda(n) (+ 800 n)) (lambda(n) (- n 1)) 7)
> > > > ===>
> > > > (807 806 805 804 803 802 801)
> > > >
> > > > (unfold zero? (lambda(n) (+ 800 n)) (lambda(n) (- n 1)) 7
> > > > (lambda(n) (list "The number" n "ended the unfolding.")))
> > > > ===>
> > > > (807 806 805 804 803 802 801 "The number" 0 "ended the unfolding.")
> > >
> > > Using "do" is a bit tricky, but the result is shorter.
> > >
> > > (define (my-test)
> > > (do ((n #f (+ 1 (random-integer 6)))
> > > (sum 0))
> > > ((eqv? 1 n) (print "One thrown."))
> > > (if n (print n " thrown. Sum: " (inc! sum n)))))
> >
> > It seems to me that "do*" is more appropriate for this,
> > but this version is 2 characters longer!
> >
> > (define (my-test)
> > (do* ((n #f (+ 1 (random-integer 6)))
> > (sum 0 (+ n sum)))
> > ((eqv? 1 n) (print "One thrown."))
> > (if n (print n " thrown. Sum: " sum))))
> >
> > I don't know why Common Lisp has "do*", but Gauche, Racket,
> > and Chicken Scheme don't.
> >
> > Here's a version that I cobbled together. (A macro guru
> > may give us a better one.) "do" is to "do*" as "let" is
> > to "let*".
> >
> > (define-syntax do*-aux
> > (syntax-rules ()
> > [(do* (inits ...) ((var update) ...) (test expr ...) stuff ...)
> > (let* (inits ...)
> > (if test
> > (begin expr ...)
> > (begin
> > (begin stuff ...)
> > (let loop ()
> > (begin (set! var update) ...)
> > (if test
> > (begin expr ...)
> > (begin stuff ...
> > (loop)))))))]))
> >
> > (define-syntax do*
> > (syntax-rules (!!!)
> > [(do* !!! (inits ...) (updates ...)
> > ((var init update) more ...) until body ...)
> > (do* !!! (inits ... (var init)) (updates ... (var update))
> > (more ...) until body ...)]
> > [(do* !!! (inits ...) (updates ...)
> > ((var init) more ...) until body ...)
> > (do* !!! (inits ... (var init)) (updates ... )
> > (more ...) until body ...)]
> > [(do* !!! inits updates () until body ...)
> > (do*-aux inits updates until body ...)]
> > [(do* inits-updates until stuff ...)
> > (do* !!! () () inits-updates until stuff ...)]))
> >
> > (do* ((x 0 (+ 1 x))
> > (y 922))
> > ((= 9 x) (print 'ok))
> > (print x " " y))
> >
> > 0 922
> > 1 922
> > 2 922
> > 3 922
> > 4 922
> > 5 922
> > 6 922
> > 7 922
> > 8 922
> > ok
> >
>
> Another way:
>
> (define (my-test)
> (let1 r (cut + 1 (random-integer 6))
> (do* ((n (r) (r))
> (sum n (+ n sum)))
> ((eqv? 1 n) (print "One thrown."))
> (print n " thrown. Sum: " sum))))

Use ":for" when the same expression is to be assigned
to the variable every time.

(define-syntax do@-aux
(syntax-rules ()
[(do* (inits ...) ((var update) ...) (test expr ...) stuff ...)
(let* (inits ...)
(if test
(begin expr ...)
(begin
(begin stuff ...)
(let loop ()
(begin (set! var update) ...)
(if test
(begin expr ...)
(begin stuff ...
(loop)))))))]))

(define-syntax do@
(syntax-rules (:for !!!)
[(do@ !!! (inits ...) (updates ...)
((:for var expr) more ...) until body ...)
(do@ !!! (inits ... (var expr)) (updates ... (var expr))
(more ...) until body ...)]
[(do@ !!! (inits ...) (updates ...)
((var init update) more ...) until body ...)
(do@ !!! (inits ... (var init)) (updates ... (var update))
(more ...) until body ...)]
[(do@ !!! (inits ...) (updates ...)
((var init) more ...) until body ...)
(do@ !!! (inits ... (var init)) (updates ... )
(more ...) until body ...)]
[(do@ !!! inits updates () until body ...)
(do@-aux inits updates until body ...)]
[(do@ inits-updates until stuff ...)
(do@ !!! () () inits-updates until stuff ...)]))

(define (my-test)
(do@ ((:for n (+ 1 (random-integer 6)))
(sum n (+ n sum)))
((= 1 n) (print "One thrown."))
(print n " thrown. Sum: " sum)))