Changeset 9428


Ignore:
Timestamp:
May 9, 2008, 10:11:25 AM (11 years ago)
Author:
gb
Message:

Update package-refs whenever package names are introduced or changed.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711-perf/ccl/level-1/l1-symhash.lisp

    r6196 r9428  
    141141    (let* ((names (pkg.names package)))
    142142      (declare (type cons names))
     143      (dolist (n names)
     144        (let* ((ref (register-package-ref n)))
     145          (setf (package-ref.pkg ref) nil)))
    143146      (rplaca names (new-package-name new-name package))
     147      (let* ((ref (register-package-ref (car names))))
     148        (setf (package-ref.pkg ref) package))
    144149      (rplacd names nil))
    145150    (%add-nicknames new-nicknames package)))
     
    193198                      (make-read-write-lock)
    194199                      nil)))
    195       (use-package use pkg)
    196       (%add-nicknames nicknames pkg)
    197       (with-package-list-write-lock
    198           (push pkg %all-packages%))
    199       pkg))
     200    (let* ((ref (register-package-ref name)))
     201      (setf (package-ref.pkg ref) pkg))
     202    (use-package use pkg)
     203    (%add-nicknames nicknames pkg)
     204    (with-package-list-write-lock
     205        (push pkg %all-packages%))
     206    pkg))
    200207
    201208(defun new-package-name (name &optional package)
     
    254261    (dolist (name nicknames package)
    255262      (let* ((ok-name (new-package-nickname name package)))
    256         (if ok-name (push ok-name (cdr names)))))))
     263        (when ok-name
     264          (let* ((ref (register-package-ref ok-name)))
     265            (setf (package-ref.pkg ref) package)
     266            (push ok-name (cdr names))))))))
    257267
    258268(defun find-symbol (string &optional package)
     
    262272  are NIL."
    263273  (multiple-value-bind (sym flag)
    264                        (%findsym (ensure-simple-string string) (pkg-arg (or package *package*)))
     274      (%findsym (ensure-simple-string string) (pkg-arg (or package *package*)))
    265275    (values sym flag)))
    266276
     277(defun %pkg-ref-find-symbol (string ref)
     278  (multiple-value-bind (sym flag)
     279      (%findsym (ensure-simple-string string)
     280                (or (package-ref.pkg ref)
     281                    (setf (package-ref.pkg ref)
     282                          (%find-pkg (package-ref.name ref)))))
     283    (values sym flag)))
     284   
    267285;;; Somewhat saner interface to %find-symbol
    268286(defun %findsym (string package)
    269287  (%find-symbol string (length string) package))
    270288
    271 (defun intern (str &optional (package *package*))
    272   "Return a symbol in PACKAGE having the specified NAME, creating it
    273   if necessary."
    274   (setq package (pkg-arg package))
     289(eval-when (:compile-toplevel)
     290  (declaim (inline %intern)))
     291
     292(defun %intern (str package)
    275293  (setq str (ensure-simple-string str))
    276294  (with-package-lock (package)
     
    280298       (values symbol where)
    281299       (values (%add-symbol str package internal-offset external-offset) nil)))))
     300
     301
     302(defun intern (str &optional (package *package*))
     303  "Return a symbol in PACKAGE having the specified NAME, creating it
     304  if necessary."
     305  (%intern str (pkg-arg package)))
     306
     307(defun %pkg-ref-intern (str ref)
     308  (%intern str (or (package-ref.pkg ref)
     309                   (setf (package-ref.pkg ref)
     310                         (%find-pkg (package-ref.name ref))))))
    282311
    283312(defun unintern (symbol &optional (package *package*))
     
    613642  (setf (pkg.shadowed package) nil)
    614643  (setq %all-packages% (nremove package %all-packages%))
     644  (dolist (n (pkg.names package))
     645    (let* ((ref (register-package-ref n)))
     646      (setf (package-ref.pkg ref) nil)))
    615647  (setf (pkg.names package) nil)
    616648  (let* ((ivec (car (pkg.itab package)))
     
    691723  (let* ((pkg (find-package name)))
    692724    (if pkg
    693       ; Restarts could offer several ways of fixing this.
     725      ;; Restarts could offer several ways of fixing this.
    694726      (unless (string= (package-name pkg) name)
    695727        (cerror "Redefine ~*~S"
Note: See TracChangeset for help on using the changeset viewer.