From Newsgroup: comp.lang.lisp

Peter Seibel wrote:

This is my solution to Ex. 5 on p. 97 of Paul Graham's "ANSI Common
Lisp"

<QUOTE>
Define iterative and recursive versions of a function that takes an
object x and a vector v, and returns a list of all the objects that immediately precede x in v.

(precedes #\a "abracadabra")

(#\c #\d #\r)
</QUOTE>

(defun precedes (object vector)
(do ((length (length vector))
(results nil)
(idx 1 (1+ idx)))
((= idx length) results)
(when (eql object (aref vector idx))
(pushnew (aref vector (1- idx)) results))))

I don't think that's really any better. Maybe LOOP:

(defun precedes (object vector)
(loop with results = nil
for idx from 1 below (length vector)
when (eql object (aref vector idx))
do (pushnew (aref vector (1- idx)) results)
finally (return results)))

Gauche Scheme

(use gauche.sequence)

(define (precedes obj seq)
(do_ ((i 1 :below (size-of seq))
(r '()))
(#f @ r)
(when (eqv? obj (ref seq i))
(let1 prev (ref seq (- i 1))
(or (member prev r) (push! r prev))))))


(precedes #\a "abracadabra")

===>
(#\r #\c #\d)

Given:

(define-syntax do_-aux
(syntax-rules ( <> @ :in :collect-if :collect :below :to : )
[ (do_-aux ((x what <>) more ...) (seen ...) stuff ...)
(do_-aux (more ...) (seen ... (x what what)) stuff ...) ]
[ (do_-aux ((x a :below b) more ...) seen lets (bool z ...) stuff ...)
(do_-aux ((top b)
(x a (+ x 1)) more ...) seen lets
((or (>= x top) bool) z ...) stuff ...) ]
[ (do_-aux ((x a :to b) more ...) stuff ...)
(do_-aux ((x a :below (+ 1 b)) more ...) stuff ...) ]
[ (do_-aux ((x :in seq) more ...) seen (lets ...) (bool z ...) stuff ...)
(do_-aux ((x (and (pair? the-list) (car the-list)) <>) more ...)
seen
(lets ... (the-list seq))
((or (null? the-list) (begin (pop! the-list) #f) bool) z ...)
stuff ...) ]
[ (do_-aux ((accum :collect-if bool x) more ...) stuff ...)
(do_-aux ((accum '()
(if bool (cons x accum) accum)) more ...) stuff ...) ]
[ (do_-aux ((accum :collect x) more ...) stuff ...)
(do_-aux ((accum :collect-if #t x) more ...) stuff ...) ]
[ (do_-aux (: v init update more ...) (seen ...) stuff ...)
(do_-aux (: more ...) (seen ... (v init update)) stuff ...) ]
[ (do_-aux (:) stuff ...)
(do_-aux () stuff ...) ]
[ (do_-aux (spec more ...) (seen ...) stuff ...)
(do_-aux (more ...) (seen ... spec) stuff ...) ]
[ (do_-aux () seen lets (bool y ... @ result) stuff ...)
(do_-aux () seen lets (bool y ... (reverse result)) stuff ...) ]
[ (do_-aux () seen (lets ...) more ...)
(let (lets ...)
(do seen more ...))
] ))
(define-syntax do_
(syntax-rules ()
[ (do_ specs () more ...)
(do_ specs (#f) more ...) ]
[ (do_ specs more ...)
(do_-aux specs () () more ...) ] ))
--- Synchronet 3.21a-Linux NewsLink 1.2