Path: news.eternal-september.org!eternal-september.org!.POSTED!not-for-mail
From: "B. Pym" <Nobody447095@here-nor-there.org>
Newsgroups: comp.lang.lisp
Subject: Re: simple loop question
Date: Wed, 25 Jun 2025 12:02:11 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 151
Message-ID: <103gofl$2ojq2$1@dont-email.me>
References: <103f589$29347$1@dont-email.me>
Injection-Date: Wed, 25 Jun 2025 14:02:11 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="ccbff3a8fa3d1a7129f43ab6084d87c5";
	logging-data="2903874"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX195pyAVUPCMFeH/S66FdCrI"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:osl1/mAg64gkWyk3N1VGw/C7YaQ=

B. Pym wrote:

> Lars Brinkhoff wrote:
> 
> > > use LOOP to collect random integers into a list until the sum of that
> > > list exceeds a constant (say 50).
> > 
> > (loop for x = (random 10) collect x sum x into y until (> y 50))
> 
> Gauche Scheme
> 
> (use srfi-27 :only (random-integer))
> (define random random-integer)
> 
> Gauche lacks do*.  We'll define a version that
> has an extra feature that works well for this
> problem.
> 
> (do* ((x 0 (random 10))
>       ((y z) (0 ()) (+ cons)))
>   ((> y 50) z))
> 
> Here's the line that uses the extra feature:
> 
>       ((y z) (0 ()) (+ cons)))
> 
> The two variables y and z are intialized to the
> values 0 and '(), respectively.
> For the next pass through the loop, each
> variable is updated by a "kons" and the
> variable in the line above this special line.
> So this is equivalent to:
> 
>   (y 0 (+ x y))
>   (z () (cons x z))
> 
> Using this feature, the do* solution is shorter than
> the LOOP solution.
> 
> (loop for x = (random 10) collect x sum x into y until (> y 50))
> (do* ((x 0 (random 10)) ((y z) (0 ()) (+ cons))) ((> y 50) z))
> 
> Removing unnecessary spaces:
> 
> (loop for x =(random 10)collect x sum x into y until(> y 50))
> (do*((x 0(random 10))((y z)(0())(+ cons)))((> y 50)z))
> 
> Note that the order of the numbers in the list returned by do*
> is reversed with respect to the order in which they were produced.
> 
> (define-syntax do*-aux
>   (syntax-rules ()
>     [(do*-aux (specs ...
>                 (v0 stuff ...)
>                 ((v ...) (init ...) (kons ...)))
>               till
>               body
>               (lets ...)
>               (sets ...))
>      (do*-aux (specs ... (v0 stuff ...))
>               till
>               body
>               ((v init) ... lets ...)
>               ((set! v (kons v0 v)) ... sets ...)) ]
>     [(do*-aux (specs ... (v init update))
>               till
>               body
>               (lets ...)
>               (sets ...))
>      (do*-aux (specs ...)
>               till
>               body
>               ((v init) lets ...)
>               ((set! v update) sets ...)) ]
>     [(do*-aux (specs ... (v init)) till body (lets ...) sets)
>      (do*-aux (specs ...) till body ((v init) lets ...) sets) ]
>     [(do*-aux () () more ...)
>      (do*-aux () (#f) more ...) ]
>     [(do*-aux () (till result ...) (body ...) (lets ...) (sets ...))
>      (let* (lets ...)
>        (let go ()
>          (if till
>            (begin result ...)
>            (begin
>              body ...
>              sets ...
>              (go))))) ] ))
> 
> (define-syntax do*
>   (syntax-rules ()
>     [ (do* specs till body ...)
>       (do*-aux specs till (body ...) () ()) ] ))

Shorter yet.


(do* ((x 0 (random 10))
      ((y z) 0 () (+ cons)))
  ((> y 50) z))

(do* ((x 0 (random 10)) ((y z) 0 () (+ cons))) ((> y 50) z))



(define-syntax do*-aux
  (syntax-rules ()

    [(do*-aux (specs ...
                (v0 stuff ...)
                ((v ...) init ... (kons ...)))
              till
              body
              (lets ...)
              (sets ...))
     (do*-aux (specs ... (v0 stuff ...))
              till
              body
              ((v init) ... lets ...)
              ((set! v (kons v0 v)) ... sets ...)) ]

    [(do*-aux (specs ... (v init update))
              till
              body
              (lets ...)
              (sets ...))
     (do*-aux (specs ...)
              till
              body
              ((v init) lets ...)
              ((set! v update) sets ...)) ]
    [(do*-aux (specs ... (v init)) till body (lets ...) sets)
     (do*-aux (specs ...) till body ((v init) lets ...) sets) ]
    [(do*-aux () () more ...)
     (do*-aux () (#f) more ...) ]
    [(do*-aux () (till result ...) (body ...) (lets ...) (sets ...))
     (let* (lets ...)
       (let go ()
         (if till
           (begin result ...)
           (begin
             body ...
             sets ...
             (go))))) ] ))


(define-syntax do*
  (syntax-rules ()
    [ (do* specs till body ...)
      (do*-aux specs till (body ...) () ()) ] ))