From Newsgroup: comp.lang.lisp

Or if the predicate functions FOO-P and BAR-P are sufficiently
expensive that you don't want to compute more often than absolutely necessary:

(loop for x in things
for foo-p = (foo-p x)
for bar-p = (bar-p x)
when foo-p collect x into foos
when bar-p collect x into bars
when (and foo-p bar-p) collect x into both
finally (return (values foos bars both)))

Gauche Scheme

(let1 things '(2 9 33 -44 0 5 -27 88 6 99 -7)
(Do (odds negs both)
((null? things) @ (values odds negs both))
(let* ((x (pop! things))
(odd (odd? x))
(neg (negative? x)))
(if odd (push! odds x))
(when neg (push! negs x) (if odd (push! both x))))))

(9 33 5 -27 99 -7)
(-44 -27 -7)
(-27 -7)

Given:

(define (reverse~ x) (if (pair? x) (reverse x) x))

(define-syntax Do-aux
(syntax-rules (<> @ values)
[(_ ((a b <>) d ...) (seen ...) z ...)
(Do-aux (d ...) (seen ... (a b b)) z ...) ]
[(_ ((a b c) d ...) (seen ...) z ...)
(Do-aux (d ...) (seen ... (a b c)) z ...) ]
[(_ ((a b) d ...) (seen ...) z ...)
(Do-aux (d ...) (seen ... (a b)) z ...) ]
[(_ ((a) d ...) (seen ...) z ...)
(Do-aux (d ...) (seen ... (a '())) z ...) ]
[(_ (a d ...) (seen ...) z ...)
(Do-aux (d ...) (seen ... (a '())) z ...) ]
[(_ () seen (a b ... @ (values x ...)) z ...)
(Do-aux () seen (a b ... (values (reverse~ x) ...)) z ...) ]
[(_ () seen (a b ... @ xs) z ...)
(Do-aux () seen (a b ... (reverse xs)) z ...) ]
[(_ () seen till body ...)
(do seen till body ...) ]))
(define-syntax Do
(syntax-rules ()
[(_ specs till body ...)
(Do-aux specs () till body ...) ]))
--
[T]he problem is that lispniks are as cultish as any other devout group and basically fall down frothing at the mouth if they see [heterodoxy].
--- Kenny Tilton
The good news is, it's not Lisp that sucks, but Common Lisp. --- Paul Graham --- Synchronet 3.21a-Linux NewsLink 1.2