Re: simple loop question

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 ...) () ()) ] ))