Path: news.eternal-september.org!eternal-september.org!.POSTED!not-for-mail
From: "B. Pym" <Nobody447095@here-nor-there.org>
Newsgroups: comp.lang.lisp,comp.lang.scheme
Subject: Re: Another code review perhaps?
Date: Wed, 9 Jul 2025 21:18:40 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 91
Message-ID: <104mmbe$e9fs$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Wed, 09 Jul 2025 23:18:40 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="c8a0164b694a706b233ebc3175231f20";
	logging-data="468476"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX19YLhwvEWs1+S6qxhTCfyNv"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:r0ONsMnJjrbRlGYdRoLmoJ5hUGA=

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