[lnkForumImage]
TotalShareware - Download Free Software

Confronta i prezzi di migliaia di prodotti.
Asp Forum
 Home | Login | Register | Search 


 

Forums >

comp.lang.lisp

Re: macro flow from inside to outside

William James

8/22/2015 10:29:00 AM

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:

(define (make-bag)
(let ((bag '()))
(case-lambda
(() (reverse bag))
((x) (set! bag (cons x bag)) x))))

(let ((evens (make-bag)) (odds (make-bag)))
(dotimes (i 10)
((if (even? i) evens odds) i))
(list (evens) (odds)))

((0 2 4 6 8) (1 3 5 7 9))

--
[W]e had enough employees who made more than 85 to fill all the openings. The
highest score that any of the blacks scored on the test was 11. The lowest
score that any black made on the test was 4. All four of those blacks went
into skilled-trades training.
https://archive.org/download/TheOldmanArchives/oldman29-...