[movitz-cvs] CVS movitz
ffjeld
ffjeld at common-lisp.net
Fri Apr 28 21:19:06 UTC 2006
Update of /project/movitz/cvsroot/movitz
In directory clnet:/tmp/cvs-serv15447
Modified Files:
image.lisp
Log Message:
Implement package-nicknames.
--- /project/movitz/cvsroot/movitz/image.lisp 2006/04/10 11:48:20 1.105
+++ /project/movitz/cvsroot/movitz/image.lisp 2006/04/28 21:19:06 1.106
@@ -9,7 +9,7 @@
;;;; Created at: Sun Oct 22 00:22:43 2000
;;;; Distribution: See the accompanying file COPYING.
;;;;
-;;;; $Id: image.lisp,v 1.105 2006/04/10 11:48:20 ffjeld Exp $
+;;;; $Id: image.lisp,v 1.106 2006/04/28 21:19:06 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -1117,7 +1117,7 @@
(pushnew :constant-variable (movitz-symbol-flags symbol))
(setf (movitz-symbol-value symbol)
(movitz-read (translate-program (symbol-value (translate-program name :muerte.cl :cl))
- :cl :muerte.cl))))
+ :cl :muerte.cl))))
symbol)))
(defun make-packages-hash (&optional (*image* *image*))
@@ -1143,16 +1143,20 @@
lisp-package context)
(setf (gethash lisp-package lisp-to-movitz-package)
(or (gethash package-name packages-hash nil)
- (let ((p (funcall 'muerte::make-package-object
- :name package-name
- :shadowing-symbols-list (package-shadowing-symbols lisp-package)
- :external-symbols (make-hash-table :test #'equal)
- :internal-symbols (make-hash-table :test #'equal)
- :use-list (mapcar #'(lambda (up)
- (ensure-package (movitz-package-name (package-name up))
- up context))
- (package-use-list lisp-package)))))
+ (let* ((nicks (mapcar #'movitz-package-name (package-nicknames lisp-package)))
+ (p (funcall 'muerte::make-package-object
+ :name package-name
+ :shadowing-symbols-list (package-shadowing-symbols lisp-package)
+ :external-symbols (make-hash-table :test #'equal)
+ :internal-symbols (make-hash-table :test #'equal)
+ :nicknames nicks
+ :use-list (mapcar #'(lambda (up)
+ (ensure-package (movitz-package-name (package-name up))
+ up context))
+ (package-use-list lisp-package)))))
(setf (gethash package-name packages-hash) p)
+ (dolist (nick nicks)
+ (setf (gethash nick packages-hash) p))
p)))))
(let ((movitz-cl-package (ensure-package (symbol-name :common-lisp)
(find-package :muerte.common-lisp))))
More information about the Movitz-cvs
mailing list