Re: [Gcl-devel] Lisp programming style advice

[Camm Maguire]

Greetings, and thanks again!  I've just committed a version using
labels.

=============================================================================
(defmacro with-package-iterator ((name plist &rest symbol-types) . body)
  (let ((p (gensym)) (i (gensym)) (l (gensym)) (q (gensym)) (dum (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 (cons t (if (atom ,plist) (list ,plist) ,plist))) (,q nil) (,l 
nil)
           (,i -1) (,x 0) (,y 0))
       (labels ((,name () 
                       (when (null (setq ,l (cdr ,l)))
                         (when (eql (incf ,i) (+ ,x ,y))
                           (when (null (setq ,q (cdr ,q))) 
                             (when (null (setq ,p (cdr ,p)))
                               (return-from ,name nil))
                             (rplaca ,p (coerce-to-package (car ,p)))
                             (setq ,q (list 
                                       (si::coerce-to-package (car ,p))))
                             (when (member :inherited (list ,@symbol-types))
                               (rplacd ,q (package-use-list (car ,q)))))
                           (multiple-value-setq (,y ,x) (si::package-size (car 
,q)))
                           (when (or (not (member :internal (list 
,@symbol-types)))
                                     (not (eq (car ,p) (car ,q))))
                             (setq ,x 0))
                           (when (and (not (member :external (list 
,@symbol-types)))
                                      (eq (car ,p) (car ,q)))
                             (setq ,y 0))
                           (when (zerop (+ ,x ,y)) 
                             (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)))))
                       (when (null ,l)
                         (return-from ,name (,name)))
                       (multiple-value-setq (,dum ,access) 
                                            (find-symbol 
                                             (symbol-name (car ,l)) (car ,p)))
                       (when (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