Re: Another code review perhaps?

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