Peter Seibel wrote:

> that didn't just throw away those valuse. Here' a version that uses
> lexical variables, as requested. However it suffers from only allowing
> a finite number of named bags. There may be some clever way to work
> around that without walking the code. Or you could just live with it,
> the same way we live with other limits such as the number of arguments
> we can pass to a function.
>
> (defmacro bag (&body body)
> (let ((bag (gensym))
> (namedbags (loop repeat 10 collect (gensym))))
> `(let ((,bag ())
> ,@(loop for bag in namedbags collect `(,bag ())))
> (flet ((find-bag (name)
> (cond
> (name
> (loop for bag in ',namedbags
> for bagname = (get bag 'bag-name)
> when (eql name bagname) return bag
> when (not bagname) do
> (setf (get bag 'bag-name) name) and
> return bag
> finally (error "Out of bags")))
> (t ',bag))))
> (macrolet ((containing (item &optional name)
> `(push ,item ,(find-bag name)))
> (the-bag (name)
> (find-bag name)))
> ,@body)
> ,bag))))
>
> This lets you write stuff like:
>
> CL-USER> (bag
> (dotimes (i 10)
> (if (evenp i)
> (containing i evens)
> (containing i odds)))
> (containing (the-bag evens))
> (containing (the-bag odds)))
> ((9 7 5 3 1) (8 6 4 2 0))

Gauche Scheme

(let@ ('() odds evens)
(dotimes (i 10)
(if (odd? i) (push! odds i) (push! evens i)))
(list evens odds))

((8 6 4 2 0) (9 7 5 3 1))

Given:

(define-syntax let@-aux
(syntax-rules ()
[(let@-aux ('() var ...) (pairs ...) stuff)
(let@-aux () (pairs ... (var '()) ...) stuff)]
[(let@-aux (var val more ...) (pairs ...) stuff)
(let@-aux (more ...) (pairs ... (var val)) stuff)]
[(let@-aux (var) pairs stuff)
(let@-aux (var '()) pairs stuff)]
[(let@-aux () ((var val) ...) (stuff ...))
(let* ((var val) ...) stuff ...)]))
(define-syntax let@
(syntax-rules ()
[(let@ things stuff ...)
(let@-aux things () (stuff ...))]))

Another way.

(lope
collectors (evens odds)
upto i 0 9
((if (odd? i) odds evens) i))

'(0 2 4 6 8)
'(1 3 5 7 9)