/[gcl]/gcl/lsp/packlib.lsp
ViewVC logotype

Diff of /gcl/lsp/packlib.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1.1.1 by wfs, Mon Dec 6 22:44:07 1999 UTC revision 1.2 by camm, Tue Oct 15 14:51:51 2002 UTC
# Line 58  Line 58 
58    
59  (defmacro do-symbols ((var &optional (package '*package*) (result-form nil))  (defmacro do-symbols ((var &optional (package '*package*) (result-form nil))
60                        . body)                        . body)
61    (let ((p (gensym)) (i (gensym)) (l (gensym))    (let ((p (gensym)) (i (gensym)) (l (gensym)) (q (gensym))
62          (loop (gensym)) (x (gensym))(y (gensym)) (break (gensym)) declaration)          (loop (gensym)) (x (gensym))(y (gensym)) (break (gensym)) declaration)
63      (multiple-value-setq (declaration body) (find-declarations body))      (multiple-value-setq (declaration body) (find-declarations body))
64      `(let ((,p (coerce-to-package ,package)) ,var ,l)      `(let ((,p (coerce-to-package ,package)) ,var ,l )
65         ,@declaration         ,@declaration
66         (multiple-value-bind (,y ,x)         (dolist (,q (cons ,p (package-use-list ,p)) (progn (setq ,var nil) ,result-form))
67              (package-size ,p)                 (multiple-value-bind
68              (declare (fixnum ,x ,y))                  (,y ,x) (package-size ,q)
69         (dotimes (,i (+ ,x ,y) (progn (setq ,var nil) ,result-form))                  (declare (fixnum ,x ,y))
70           (setq ,l (if (< ,i ,x)                  (if (not (eq ,p ,q)) (setq ,x 0))
71                        (si:package-internal ,p ,i)                  (dotimes (,i (+ ,x ,y))
72                        (si:package-external ,p (- ,i ,x))))                           (setq ,l (if (< ,i ,x)
73         ,loop                                        (si:package-internal ,q ,i)
74           (when (null ,l) (go ,break))                                      (si:package-external ,q (- ,i ,x))))
75           (setq ,var (car ,l))                           ,loop
76           ,@body                           (when (null ,l) (go ,break))
77           (setq ,l (cdr ,l))                           (setq ,var (car ,l))
78           (go ,loop)                           (if (or (eq ,q ,p)
79         ,break)))))                                   (eq :inherited (car (last (multiple-value-list
80                                                                (find-symbol (symbol-name ,var) ,p))))))
81                                 (progn ,@body))
82                             (setq ,l (cdr ,l))
83                             (go ,loop)
84                             ,break))))))
85                
86    
87  (defmacro do-external-symbols  (defmacro do-external-symbols

Legend:
Removed from v.1.1.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26