- (with-packages ()
- (let ((package (if (packagep package-designator)
- package-designator
- (find-package package-designator))))
- (cond ((not package)
- ;; This continuable error is required by ANSI.
- (cerror
- "Return ~S."
- (make-condition
- 'simple-package-error
- :package package-designator
- :format-control "There is no package named ~S."
- :format-arguments (list package-designator))
- nil))
- ((not (package-name package)) ; already deleted
- nil)
- (t
- (with-single-package-locked-error
- (:package package "deleting package ~A" package)
- (let ((use-list (package-used-by-list package)))
- (when use-list
- ;; This continuable error is specified by ANSI.
- (cerror
- "Remove dependency in other packages."
- (make-condition
- 'simple-package-error
- :package package
- :format-control
- "~@<Package ~S is used by package~P:~2I~_~S~@:>"
- :format-arguments (list (package-name package)
- (length use-list)
- (mapcar #'package-name use-list))))
- (dolist (p use-list)
- (unuse-package package p))))
- (dolist (used (package-use-list package))
- (unuse-package used package))
- (do-symbols (sym package)
- (unintern sym package))
- (remhash (package-name package) *package-names*)
- (dolist (nick (package-nicknames package))
- (remhash nick *package-names*))
- (setf (package-%name package) nil
- ;; Setting PACKAGE-%NAME to NIL is required in order to
- ;; make PACKAGE-NAME return NIL for a deleted package as
- ;; ANSI requires. Setting the other slots to NIL
- ;; and blowing away the PACKAGE-HASHTABLES is just done
- ;; for tidiness and to help the GC.
- (package-%nicknames package) nil
- (package-%use-list package) nil
- (package-tables package) nil
- (package-%shadowing-symbols package) nil
- (package-internal-symbols package)
- (make-or-remake-package-hashtable 0)
- (package-external-symbols package)
- (make-or-remake-package-hashtable 0))
- t))))))
+ (tagbody :restart
+ (let ((package (find-package package-designator)))
+ (cond ((not package)
+ ;; This continuable error is required by ANSI.
+ (cerror
+ "Return ~S."
+ (make-condition
+ 'simple-package-error
+ :package package-designator
+ :format-control "There is no package named ~S."
+ :format-arguments (list package-designator))
+ (return-from delete-package nil)))
+ ((not (package-name package)) ; already deleted
+ (return-from delete-package nil))
+ (t
+ (with-single-package-locked-error
+ (:package package "deleting package ~A" package)
+ (let ((use-list (package-used-by-list package)))
+ (when use-list
+ ;; This continuable error is specified by ANSI.
+ (cerror
+ "Remove dependency in other packages."
+ (make-condition
+ 'simple-package-error
+ :package package
+ :format-control
+ "~@<Package ~S is used by package~P:~2I~_~S~@:>"
+ :format-arguments (list (package-name package)
+ (length use-list)
+ (mapcar #'package-name use-list))))
+ (dolist (p use-list)
+ (unuse-package package p))))
+ (with-package-graph ()
+ ;; Check for races, restart if necessary.
+ (let ((package2 (find-package package-designator)))
+ (when (or (neq package package2) (package-used-by-list package2))
+ (go :restart)))
+ (dolist (used (package-use-list package))
+ (unuse-package used package))
+ (do-symbols (sym package)
+ (unintern sym package))
+ (with-package-names (names)
+ (remhash (package-name package) names)
+ (dolist (nick (package-nicknames package))
+ (remhash nick names))
+ (setf (package-%name package) nil
+ ;; Setting PACKAGE-%NAME to NIL is required in order to
+ ;; make PACKAGE-NAME return NIL for a deleted package as
+ ;; ANSI requires. Setting the other slots to NIL
+ ;; and blowing away the PACKAGE-HASHTABLES is just done
+ ;; for tidiness and to help the GC.
+ (package-%nicknames package) nil))
+ (setf (package-%use-list package) nil
+ (package-tables package) nil
+ (package-%shadowing-symbols package) nil
+ (package-internal-symbols package)
+ (make-or-remake-package-hashtable 0)
+ (package-external-symbols package)
+ (make-or-remake-package-hashtable 0)))
+ (return-from delete-package t)))))))