[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Gcl-devel] Lisp programming style advice
From: |
Camm Maguire |
Subject: |
[Gcl-devel] Lisp programming style advice |
Date: |
26 Oct 2002 13:13:55 -0400 |
Greetings! In the course of addressing some of the ansi issues
revealed by Paul's tests, I'm finding myself writing ever more
sophisticated (for me) lisp code for GCL with a still partial
understanding of the language. I'd like to take a moment to solicit
the opinions of the list on the with-package-iterator macro I
committed recently. This works (apparently), and was designed to
emulate the behavior of do-symbols (packlib.lsp). But its not
particularly elegant, and I worry about the non-tail recursive calls
from a performance point of view. In general, I'm concerning myself
with correctness first and deferring performance considerations to a
much later stage, but if I can learn some tricks along the way, we'll
save work down the road, I'd imagine.
Take care,
(defmacro with-package-iterator ((name plist &rest symbol-types) . body)
(let ((p (gensym)) (i (gensym)) (l (gensym)) (q (gensym))
(x (gensym))(y (gensym)) (access (gensym)) declaration)
(multiple-value-setq (declaration body) (si::find-declarations body))
(if (null symbol-types)
(specific-error :too-few-arguments "Symbol type specifiers must be
supplied"))
`(let ((,p nil) (,q nil) (,l nil)
(,i -1) (,x 0) (,y 0))
(macrolet ((,name ()
'(block ,name
(setq ,l (cdr ,l))
(if (null ,l)
(progn
(setq ,i (1+ ,i))
(if (eql ,i (+ ,x ,y))
(progn
(setq ,q (cdr ,q))
(if (null ,q)
(progn
(if (null ,p)
(setq ,p (if (atom ,plist)
(list ,plist)
,plist))
(setq ,p (cdr ,p)))
(if (null ,p)
(return-from ,name nil))
(rplaca ,p (coerce-to-package
(car ,p)))
(setq ,q (list
(si::coerce-to-package
(car ,p))))
(if (member :inherited (list
,@symbol-types))
(rplacd ,q (package-use-list
(car ,q))))))
(setq ,x (multiple-value-list
(si::package-size (car ,q))))
(setq ,y (first ,x))
(setq ,x (second ,x))
(if (or (not (member :internal (list
,@symbol-types)))
(not (eq (car ,p) (car ,q))))
(setq ,x 0))
(if (and (not (member :external (list
,@symbol-types)))
(eq (car ,p) (car ,q)))
(setq ,y 0))
(if (zerop (+ ,x ,y))
(progn (setq ,i -1)
(return-from ,name (,name)))
(setq ,i 0))))
(setq ,l (if (< ,i ,x)
(si::package-internal (car ,q)
,i)
(si::package-external (car ,q) (-
,i ,x))))))
(if (null ,l) (return-from ,name (,name)))
(setq ,access (second
(multiple-value-list
(find-symbol
(symbol-name (car ,l)) (car ,p)))))
(if (and (not (eq ,access :inherited))
(not (eq (car ,p) (car ,q))))
(return-from ,name (,name)))
(values 't (car ,l) ,access (car ,p)))))
(declare (fixnum ,x ,y))
,@declaration
,@body))))
--
Camm Maguire address@hidden
==========================================================================
"The earth is but one country, and mankind its citizens." -- Baha'u'llah
- [Gcl-devel] Lisp programming style advice,
Camm Maguire <=