Path: ...!weretis.net!feeder8.news.weretis.net!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: "B. Pym" <Nobody447095@here-nor-there.org>
Newsgroups: comp.lang.lisp,comp.lang.scheme
Subject: Re: macro flow from inside to outside
Date: Wed, 11 Sep 2024 05:04:55 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 78
Message-ID: <vbr8dj$3emd5$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Wed, 11 Sep 2024 07:04:55 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="3be87affaab0b87468eb137bb3ffc6ef";
	logging-data="3627429"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX1/KcmUa8wV2f+x/isUy/XE4"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:8VSFv/3QYSwIHFguEQBOlauIqoQ=
Bytes: 3455

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)