Re: [Gcl-devel] Lisp programming style advice

[Paul F. Dietz]

Camm Maguire wrote:
> Greetings!  Thanks, as always, Paul.
>
> Here is what I'm committing now.  I've implemented everything save the
> flet suggestion.  I cannot seem to get the ,name recognized as a valid
> defined function in the (return ) calls when using flet.
>
> =============================================================================
> (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))
>        (macrolet ((,name () 
> 		     '(block ,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))))


Whoa!  I just noticed -- the macro expansion for ,name include a form whose
car is ,name.

That will cause the compiler to blow up at macroexpansion time.

The tests in ansi-tests have been eval-ing the test forms, which avoids
this problem (the interpreter macroexpands only on demand).

The problem you were having with FLET is that the functions defined in a FLET
are not visible in their own bodies.  If you want them to be recursive, you
need to use LABELS.  That's the appropriate solution here (or enclose the
entire thing in a tagbody and jump back at the tail recursion.)

        Paul