From Newsgroup: comp.lang.lisp

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) ;; random-integer
(define random random-integer)

"!" is similar to "do".

(! (a cons r r (random 10) <> s + r) (> s 50))

Given:

(define-syntax !-aux
(syntax-rules (<> @ @@ + - : cons append :meld
cdr :in :across :along
:on :by :pop-or-nothing
:if :if-else ! :also? :also :to :repeat
:till :always
:let := )
[(_ specs seen lets @)
(!-aux specs seen lets #f @) ]
[(_ (:let id val z ...) seen (lets ...) stuff ...)
(!-aux (z ...) seen (lets ... (id val)) stuff ...) ]
[(_ (:= id val z ...) stuff ...)
(!-aux (:let id #f dummy #f (set! id val) z ...) stuff ...) ]
;;
[(_ (:also? bool op x z ...) (seen ... (v i update)) stuff ...)
(!-aux (z ...)
(seen ... (v i (if bool (op x update) update)))
stuff ...) ]
[(_ (:also op x z ...) stuff ...)
(!-aux (:also? #t op x z ...) stuff ...) ]
;;
[(_ ((:pop-or-nothing x xs nil) z ...) stuff ...)
(!-aux (x (if (pair? xs)(pop! xs) nil) <> z ...) stuff ...) ]
;;
;;
[(_ (:always expr z ...) seen lets bool)
(!-aux (ok #t expr
:till (not ok)
z ...)
seen lets bool ok
) ]
[(_ (:always expr z ...) stuff ...)
(!-aux " * * * Bad usage of :always in !") ]
[(_ (:till expr z ...) seen lets #f stuff ...)
(!-aux (z ...) seen lets expr stuff ...) ]
[(_ (:till expr z ...) seen lets bool stuff ...)
(!-aux (z ...) seen lets (or expr bool) stuff ...) ]
;;
[(_ (:if bool z ...) (seen ... (v i u)) stuff ...)
(!-aux (z ...)
(seen ... (v i (if bool u v))) stuff ...) ]
;;
[(_ (:if-else bool z ...) (seen ... (a b c)(d e f)) stuff ...)
(!-aux (:let yes #f z ...)
(seen ... (a b (begin (set! yes bool) (if yes c a)))
(d e (if (not yes) f d))) stuff ...) ]
;;
[(_ ((a b ...) :on lst :by kdr z ...) stuff ...)
(!-aux (:let xs lst
:let ys #f
exhausted (null? xs) <>
dummy (begin (set! ys xs)
(when (pair? xs) (set! xs (kdr xs)))) <>
(:pop-or-nothing a ys #f)
(:pop-or-nothing b ys #f) ...
:till exhausted
z ...) stuff ...) ]
[(_ ((a b ...) :on lst z ...) stuff ...)
(!-aux ((a b ...) :on lst :by cdr z ...) stuff ...) ]
;;
[(_ (x :in lst z ...) stuff ...)
(!-aux (:let xs lst
x (if (pair? xs)(pop! xs) !-aux) <>
:till (eq? x !-aux)
z ...) stuff ...) ]
;;
[(_ (x :across vec z ...) stuff ...)
(!-aux (:let v vec :let i 0
x (if (< i (vector-length v))
(begin0 (vector-ref v i) (inc! i))
!-aux) <>
:till (eq? x !-aux)
z ...) stuff ...) ]
[(_ (ch :along str z ...) stuff ...)
(!-aux (:let s str :let i 0
ch (and (< i (string-length s))
(begin0 (string-ref s i) (inc! i))) <>
:till (not ch)
z ...)
stuff ...) ]
[(_ (a b <> z ...) stuff ...)
(!-aux (a b b z ...) stuff ...) ]
;;
[(_ (a b + z ...) stuff ...)
(!-aux (a b (+ 1 a) z ...) stuff ...) ]
[(_ (a + n z ...) stuff ...)
(!-aux (a 0 (+ n a) z ...) stuff ...) ]
[(_ (a b - z ...) stuff ...)
(!-aux (a b (- a 1) z ...) stuff ...) ]
[(_ (n lo inc :to hi z ...) stuff ...)
(!-aux (:let step inc :let high hi
n lo (+ n step)
:till (> n high)
z ...) stuff ...) ]
[(_ (n lo :to hi z ...) stuff ...)
(!-aux (n lo 1 :to hi z ...) stuff ...) ]
[(_ (:repeat n z ...) stuff ...)
(!-aux (m 1 :to n z ...) stuff ...) ]
;;
[(_ (v init : kons u z ...) stuff ...)
(!-aux (v init (kons u v) z ...) stuff ...) ]
;;
[(_ (a cons b z ...) stuff ...)
(!-aux (a '() : cons b z ...) stuff ...) ]
[(_ (a append b z ...) stuff ...)
(!-aux (a '() : append (reverse b) z ...) stuff ...) ]
[(_ (a :meld b z ...) stuff ...)
(!-aux (a '()
(if (pair? b) (append (reverse b) a)
(cons b a))
z ...) stuff ...) ]
;;
[(_ (a b cdr z ...) stuff ...)
(!-aux (a b (cdr a) z ...) stuff ...) ]
[(_ (a b c z ...) (seen ...) stuff ...)
(!-aux (z ...) (seen ... (a b c)) stuff ...) ]
[(_ (a b) (seen ...) stuff ...)
(!-aux () (seen ... (a b)) stuff ...) ]
[(_ (a) (seen ...) stuff ...)
(!-aux () (seen ... (a '())) stuff ...) ]
;; Default action is print first variable.
[(_ () ((a b c) z ...) lets bool !)
(!-aux () ((a b c) z ...) lets bool ! print a) ]
;; (!-aux () ((a b c) z ...) lets bool ! begin (print a)(sys-sleep 1)) ]
[(_ () seen lets bool ! action ...)
(!-aux () seen lets bool #t (action ...)) ]
;; If result not specified, pick one.
[(_ () ((a b c) z ...) lets bool)
(!-aux () ((a b c) z ...) lets bool
(if (pair? a) (reverse a) a)) ]
[(_ () ((a b c) z ...) lets bool @)
(!-aux () ((a b c) z ...) lets bool (reverse a)) ]
[(_ () seen lets bool @ result stuff ...)
(!-aux () seen lets bool (reverse result) stuff ...) ]
;;
[(_ () seen lets bool @@ (what x ...) stuff ...)
(!-aux () seen lets bool (what (reverse x) ...) stuff ...) ]
[(_ () seen lets bool (what @ x z ...) stuff ...)
(!-aux () seen lets bool (what (reverse x) z ...) stuff ...) ]
[(_ () seen lets bool (what x @ y z ...) stuff ...)
(!-aux () seen lets bool (what x (reverse y) z ...) stuff ...) ]
;;
[(_ () ((a b c) z ...) lets 0 stuff ...)
(!-aux () ((a b c) z ...) lets (= 0 a) stuff ...) ]
[(_ () seen lets bool result stuff ...)
(let lets (do seen (bool result) stuff ...)) ]
))
(define-syntax !
(syntax-rules ()
[(_ specs bool stuff ...)
(!-aux specs () () bool stuff ...) ]
[(_ specs) (! specs #f) ]
))


--- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.lisp

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 ...) () ()) ] ))
--- Synchronet 3.21d-Linux NewsLink 1.2

From Newsgroup: comp.lang.lisp

On 2025-06-24, B. Pym <Nobody447095@here-nor-there.org> 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.

You don't seem to understand that if you use this do* only once for your one-liner, it's not shorter? Everything you wrote yourself not coming
from the language contributes to the size of your solution.

Your definition is 41 nonblank lines of code, so your one liner is now actually a 42 liner.

The macro has to be used 41 times to amortize that down to one line of definition overhead per use, so that all 41 one-liners that use it are effectively two-liners, carrying 100% overhead.

Say, if you think it's okay to write a 41 line definition that somehow doesn't count toward the size of your one-liner, why wouldn't you just make that definition a function, which then lets your one liner be something like this?

(r 10 50)

You could even hard code the parameters into the definition so
it's just (r); who says that the definition must be flexibly parametrized?

A Scheme wth symbol macros (standard CL feature) could get it down
to one symbol then.

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

The difference is negligible.

You don't seem to get that "collect x sum x into y until (> y 50)" is
easy for non-experts to understand. Maybe you have autism or something,
so you have no idea how neurotypicals process information.

You have three variables in your solution; x, y and z. Aren't you always criticizing the use of comprehension constructs that use variables, instead of point-free map/reduce type stuff?

Removing unnecessary spaces:

Removing spaces in a big decrement in the readability of the do*
code, yet places it at only a 7 character advantage.

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

That could matter! Sometimes pseudo-random behavior is called upon to be reproducible, and so you can't just replace code that lists random
numbers with code that does that in reverse order. You may have to
adjust test cases and possibly other things.
--
TXR Programming Language: http://nongnu.org/txr
Cygnal: Cygwin Native Application Library: http://kylheku.com/cygnal
Mastodon: @Kazinator@mstdn.ca
--- Synchronet 3.21d-Linux NewsLink 1.2

From Newsgroup: comp.lang.lisp

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


--- Synchronet 3.21d-Linux NewsLink 1.2

From Newsgroup: comp.lang.lisp

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

If we are allowed to set up a couple of collectors, the
solution is tiny. Comparing it to the LOOP version:


(until (> (s (c (random 10))) 50)) (c)
(loop for x = (random 10) collect x sum x into y until (> y 50))


Here's the code:

(use srfi-27) ;; random-integer
(define random random-integer)

(let ((c (mlistbag)) (s (mbag 0 +)))
(until (> (s (c (random 10))) 50))
(c))

===>
(8 1 9 8 1 9 9 2 6)


Given:

(define (mbag init func :optional (pass-through #f))
(let ((val init) (func func) (pass-through pass-through))
(lambda args
(if (null? args)
val
(begin
(set! val
;; A "kons" may have been supplied.
((if (null? (cdr args)) func (cadr args))
(car args) val))
(if pass-through
(car args)
val))))))
(define (mlistbag :optional (pass-through #t))
(let ((bag (mbag '() cons pass-through)))
(lambda args
(if (null? args)
(reverse (bag))
(apply bag args)))))


--- Synchronet 3.21d-Linux NewsLink 1.2