gcl-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [Gcl-devel] Problem in WITH-PACKAGE-ITERATOR


From: Camm Maguire
Subject: Re: [Gcl-devel] Problem in WITH-PACKAGE-ITERATOR
Date: 21 Jan 2003 11:43:09 -0500

Thanks Peter!  This looks good to me, and its now committed.

Take care,

Peter Wood <address@hidden> writes:

> Hi
> On Sat, Jan 18, 2003 at 05:54:07PM -0600, Paul F. Dietz wrote:
> > >(compile nil '(lambda () (with-package-iterator (x "CL" (:external)) (x))))
>                                                            ^^   ??  ^^
> > Compiling gazonk0.lsp.
> > ; (DEFUN COMPILER::CMP-ANON ...) is being compiled.
> > ;; Warning: Type declaration was found for not bound variable #:G2648.
> > ;; Warning: Type declaration was found for not bound variable #:G2647.
> > ;; The variable #:G2646 is undefined.
> > ;; The compiler will assume this variable is a global.
> > ;; The variable #:G2649 is undefined.
> > ;; The compiler will assume this variable is a global.
> > End of Pass 1.
> > End of Pass 2.
> > OPTIMIZE levels: Safety=1 (No runtime error checking), Space=0, Speed=3
> > Finished compiling gazonk0.lsp.
> > Loading gazonk0.o
> > start address -T 0x8d85fe0 Finished loading gazonk0.o
> > #<compiled-function COMPILER::CMP-ANON>
> > 
> > >
> > 
> > 
> > Those variables should not be global.
> 
> (BTW && OT: I have noticed that the compiler's 'messages' are not
> always accurate.  Apart from that, I think :external in the test above
> should not be in a list (?!))
> 
> The following changes fix the problem:
> 
> 1) Move the form '(declare (fixnum ,x ,y))' to just after the
> backquoted let form's variable list in the with-package-iterator macro.
> 
> 2) Initialize ,access and ,dum to nil by also giving them default
> bindings in the macro's backquoted let form.
> 
> Now it looks like this (/lsp/with-package-iterator.lsp):
> 
> (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)
>       (si::universal-error-handler :simple-program-error nil nil nil "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) (,dum nil) (,access nil)) ;;CHANGED
>       (declare (fixnum ,x ,y)) ;;CHANGED
>       (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))))
>       ;;CHANGED
>       ,@declaration
>       ,@body))))
> 
> When I rerun your test with this fixed macro I get:
> 
> > (compile nil '(lambda () (with-package-iterator (x "CL" :external) (x))))
> 
> Compiling gazonk0.lsp.
> End of Pass 1.  
> 
> ;; Note: Tail-recursive call of X was replaced by iteration.
> ;; Note: Tail-recursive call of X was replaced by iteration.
> ;; Note: Tail-recursive call of X was replaced by iteration.
> End of Pass 2.  
> OPTIMIZE levels: Safety=2, Space=3, Speed=0
> Finished compiling gazonk0.lsp.
> Loading gazonk0.o
> start address -T 0x8ccd000 Finished loading gazonk0.o
> #<compiled-function 089f11cc>
> 
> >
> 
> Disclaimer: I haven't tried it compiled yet.
> 
> Regards,
> Peter
> 
> 
> _______________________________________________
> Gcl-devel mailing list
> address@hidden
> http://mail.gnu.org/mailman/listinfo/gcl-devel
> 
> 

-- 
Camm Maguire                                            address@hidden
==========================================================================
"The earth is but one country, and mankind its citizens."  --  Baha'u'llah




reply via email to

[Prev in Thread] Current Thread [Next in Thread]