[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [Gcl-devel] Problem in WITH-PACKAGE-ITERATOR
From: |
Peter Wood |
Subject: |
Re: [Gcl-devel] Problem in WITH-PACKAGE-ITERATOR |
Date: |
Sun, 19 Jan 2003 08:25:13 +0100 |
User-agent: |
Mutt/1.4i |
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