Commit 95f4085f authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.26.65: Much progress on define-package. Basically working, except with using packages.

parent 056f33a9
...@@ -3,6 +3,15 @@ ...@@ -3,6 +3,15 @@
* Split ASDF in parts * Split ASDF in parts
** Have it pass test-lisp ** Have it pass test-lisp
** Have it pass test-upgrade ** Have it pass test-upgrade
** Get package upgrade right
** The unconditional ensure-package-unused breaks test-encodings.script,
since asdf severs itself from its client package hosting the
defsystem form during defsystem-depends-on.
** Solution 1: emulate hook on the *upgraded-p* solution, either using
explicit flag, explicit version numbers or implicit version information
(e.g. source-code or sxhash thereof, also accounting for dependency
package information).
** Solution 2: Just "do the right thing" with exported symbols.
* Make load-op a generic operation that selects the proper strategy * Make load-op a generic operation that selects the proper strategy
for each system, module or file, according to component properties and user-configuration: for each system, module or file, according to component properties and user-configuration:
compile the lisp file then load the fasl (load-compiled-op), compile the lisp file then load the fasl (load-compiled-op),
......
;;;; ------------------------------------------------------------------------- ;;;; -------------------------------------------------------------------------
;;;; Actions ;;;; Actions
(defpackage :asdf/action (asdf/package:define-package :asdf/action
(:recycle :asdf/action :asdf)
(:use :common-lisp :asdf/implementation :asdf/utility :asdf/pathname :asdf/os (:use :common-lisp :asdf/implementation :asdf/utility :asdf/pathname :asdf/os
:asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/operation) :asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/operation)
#+gcl<2.7 (:shadowing-import-from :asdf/implementation #:type-of) #+gcl<2.7 (:shadowing-import-from :asdf/implementation #:type-of)
......
...@@ -14,7 +14,7 @@ ...@@ -14,7 +14,7 @@
:licence "MIT" :licence "MIT"
:description "Another System Definition Facility" :description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems." :long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.26.64" ;; to be automatically updated by bin/bump-revision :version "2.26.65" ;; to be automatically updated by bin/bump-revision
:depends-on () :depends-on ()
:components :components
((:file "asdf"))) ((:file "asdf")))
......
;;;; ------------------------------------------------------------------------- ;;;; -------------------------------------------------------------------------
;;; Backward-compatible interfaces ;;; Backward-compatible interfaces
(defpackage :asdf/backward-interface (asdf/package:define-package :asdf/backward-interface
(:recycle :asdf/backward-interface :asdf)
(:use :common-lisp :asdf/implementation :asdf/utility :asdf/pathname :asdf/os (:use :common-lisp :asdf/implementation :asdf/utility :asdf/pathname :asdf/os
:asdf/component :asdf/system :asdf/operation :asdf/action :asdf/component :asdf/system :asdf/operation :asdf/action
:asdf/lisp-build :asdf/operate :asdf/output-translations) :asdf/lisp-build :asdf/operate :asdf/output-translations)
...@@ -15,7 +16,6 @@ ...@@ -15,7 +16,6 @@
#:operation-on-warnings #:operation-on-warnings
#:run-shell-command #:run-shell-command
#:system-definition-pathname)) #:system-definition-pathname))
(in-package :asdf/backward-interface) (in-package :asdf/backward-interface)
(defvar *asdf-verbose* nil) ; worked around by cl-protobufs. It was a mistake to introduce it. mea culpa -fare (defvar *asdf-verbose* nil) ; worked around by cl-protobufs. It was a mistake to introduce it. mea culpa -fare
......
;;;; ------------------------------------------------------------------------- ;;;; -------------------------------------------------------------------------
;;; Internal hacks for backward-compatibility ;;; Internal hacks for backward-compatibility
(defpackage :asdf/backward-internals (asdf/package:define-package :asdf/backward-internals
(:recycle :asdf/backward-internals :asdf)
(:use :common-lisp :asdf/implementation :asdf/utility :asdf/pathname (:use :common-lisp :asdf/implementation :asdf/utility :asdf/pathname
:asdf/system :asdf/component :asdf/find-system :asdf/action) :asdf/system :asdf/component :asdf/find-system :asdf/action)
(:export ;; for internal use (:export ;; for internal use
......
;;;; ------------------------------------------------------------------------- ;;;; -------------------------------------------------------------------------
;;;; ASDF-Bundle ;;;; ASDF-Bundle
(defpackage :asdf/bundle (asdf/package:define-package :asdf/bundle
(:recycle :asdf/bundle :asdf)
(:use :common-lisp :asdf/utility :asdf/pathname :asdf/os :asdf/lisp-build (:use :common-lisp :asdf/utility :asdf/pathname :asdf/os :asdf/lisp-build
:asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/operation :asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/operation
:asdf/action :asdf/lisp-action :asdf/plan :asdf/operate) :asdf/action :asdf/lisp-action :asdf/plan :asdf/operate)
......
;;;; ------------------------------------------------------------------------- ;;;; -------------------------------------------------------------------------
;;;; Components ;;;; Components
(defpackage :asdf/component (asdf/package:define-package :asdf/component
(:recycle :asdf/component :asdf)
(:use :common-lisp :asdf/implementation :asdf/utility :asdf/pathname :asdf/upgrade) (:use :common-lisp :asdf/implementation :asdf/utility :asdf/pathname :asdf/upgrade)
(:export (:export
#:component #:component-find-path #:component #:component-find-path
...@@ -19,8 +20,7 @@ ...@@ -19,8 +20,7 @@
#:component-external-format #:component-encoding #:component-external-format #:component-encoding
#:detect-encoding #:*encoding-detection-hook* #:always-default-encoding #:detect-encoding #:*encoding-detection-hook* #:always-default-encoding
#:encoding-external-format #:*encoding-external-format-hook* #:default-encoding-external-format #:encoding-external-format #:*encoding-external-format-hook* #:default-encoding-external-format
#:*default-encoding* #:*utf-8-external-format* #:*default-encoding* #:*utf-8-external-format*))
))
(in-package :asdf/component) (in-package :asdf/component)
(defgeneric* component-name (component) (defgeneric* component-name (component)
......
;;;; ------------------------------------------------------------------------- ;;;; -------------------------------------------------------------------------
;;;; Concatenate-source ;;;; Concatenate-source
(defpackage :asdf/concatenate-source (asdf/package:define-package :asdf/concatenate-source
(:recycle :asdf/concatenate-source :asdf)
(:use :common-lisp :asdf/utility :asdf/os (:use :common-lisp :asdf/utility :asdf/os
:asdf/component :asdf/operation :asdf/system :asdf/find-system :asdf/defsystem :asdf/component :asdf/operation :asdf/system :asdf/find-system :asdf/defsystem
:asdf/action :asdf/lisp-action :asdf/bundle) :asdf/action :asdf/lisp-action :asdf/bundle)
......
;;;; --------------------------------------------------------------------------- ;;;; ---------------------------------------------------------------------------
;;;; Generic support for configuration files ;;;; Generic support for configuration files
(defpackage :asdf/configuration (asdf/package:define-package :asdf/configuration
(:recycle :asdf/configuration :asdf)
(:use :common-lisp :asdf/utility :asdf/pathname :asdf/os) (:use :common-lisp :asdf/utility :asdf/pathname :asdf/os)
(:export (:export
#:get-folder-path #:get-folder-path
...@@ -13,8 +14,7 @@ ...@@ -13,8 +14,7 @@
#:report-invalid-form #:invalid-configuration #:*ignored-configuration-form* #:report-invalid-form #:invalid-configuration #:*ignored-configuration-form*
#:*clear-configuration-hook* #:clear-configuration #:*clear-configuration-hook* #:clear-configuration
#:resolve-location #:location-designator-p #:location-function-p #:*here-directory* #:resolve-location #:location-designator-p #:location-function-p #:*here-directory*
#:resolve-relative-location-component #:resolve-absolute-location-component #:resolve-relative-location-component #:resolve-absolute-location-component))
))
(in-package :asdf/configuration) (in-package :asdf/configuration)
(define-condition invalid-configuration () (define-condition invalid-configuration ()
......
;;;; ------------------------------------------------------------------------- ;;;; -------------------------------------------------------------------------
;;;; Defsystem ;;;; Defsystem
(defpackage :asdf/defsystem (asdf/package:define-package :asdf/defsystem
(:recycle :asdf/defsystem :asdf)
(:use :common-lisp :asdf/utility :asdf/pathname (:use :common-lisp :asdf/utility :asdf/pathname
:asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/component :asdf/system :asdf/find-system :asdf/find-component
:asdf/lisp-action :asdf/operate :asdf/lisp-action :asdf/operate
...@@ -9,8 +10,7 @@ ...@@ -9,8 +10,7 @@
#+gcl<2.7 (:shadowing-import-from :asdf/implementation #:type-of) #+gcl<2.7 (:shadowing-import-from :asdf/implementation #:type-of)
(:export (:export
#:defsystem #:do-defsystem #:parse-component-form #:defsystem #:do-defsystem #:parse-component-form
#:*default-component-class* #:*default-component-class*))
))
(in-package :asdf/defsystem) (in-package :asdf/defsystem)
;;; Pathname ;;; Pathname
......
;;;; ------------------------------------------------------------------------- ;;;; -------------------------------------------------------------------------
;;;; Finding components ;;;; Finding components
(defpackage :asdf/find-component (asdf/package:define-package :asdf/find-component
(:recycle :asdf/find-component :asdf)
(:use :common-lisp :asdf/utility :asdf/os (:use :common-lisp :asdf/utility :asdf/os
:asdf/component :asdf/system :asdf/find-system) :asdf/component :asdf/system :asdf/find-system)
(:export (:export
...@@ -12,9 +13,7 @@ ...@@ -12,9 +13,7 @@
#:missing-component #:missing-component-of-version #:retry #:missing-component #:missing-component-of-version #:retry
#:missing-dependency #:missing-dependency-of-version #:missing-dependency #:missing-dependency-of-version
#:missing-requires #:missing-parent #:missing-requires #:missing-parent
#:missing-required-by #:missing-version #:missing-required-by #:missing-version))
))
(in-package :asdf/find-component) (in-package :asdf/find-component)
;;;; Missing component conditions ;;;; Missing component conditions
......
;;;; ------------------------------------------------------------------------- ;;;; -------------------------------------------------------------------------
;;;; Finding systems ;;;; Finding systems
(defpackage :asdf/find-system (asdf/package:define-package :asdf/find-system
(:recycle :asdf/find-system :asdf)
(:use :common-lisp :asdf/implementation :asdf/utility :asdf/upgrade :asdf/pathname :asdf/os (:use :common-lisp :asdf/implementation :asdf/utility :asdf/upgrade :asdf/pathname :asdf/os
:asdf/component :asdf/system) :asdf/component :asdf/system)
(:export (:export
......
;;;; ----------------------------------------------------------------------- ;;;; -----------------------------------------------------------------------
;;;; ASDF Footer: last words and cleanup ;;;; ASDF Footer: last words and cleanup
(defpackage :asdf/footer (asdf/package:define-package :asdf/footer
(:recycle :asdf/footer :asdf)
(:use :common-lisp (:use :common-lisp
:asdf/package :asdf/implementation :asdf/package :asdf/implementation
:asdf/utility :asdf/pathname :asdf/os :asdf/lisp-build :asdf/utility :asdf/pathname :asdf/os :asdf/lisp-build
......
...@@ -53,5 +53,5 @@ ...@@ -53,5 +53,5 @@
(:file "bundle" :depends-on ("lisp-action")) (:file "bundle" :depends-on ("lisp-action"))
(:file "concatenate-source" :depends-on ("lisp-action")) (:file "concatenate-source" :depends-on ("lisp-action"))
(:file "backward-interface" :depends-on ("lisp-action")))) (:file "backward-interface" :depends-on ("lisp-action"))))
(:file "user") (:file "interface")
(:file "footer" :depends-on ("interface")))) (:file "footer" :depends-on ("interface"))))
;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*- ;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
;;; This is ASDF 2.26.64: Another System Definition Facility. ;;; This is ASDF 2.26.65: Another System Definition Facility.
;;; ;;;
;;; Feedback, bug reports, and patches are all welcome: ;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>. ;;; please mail to <asdf-devel@common-lisp.net>.
......
;;;; ------------------------------------------------------------------------- ;;;; -------------------------------------------------------------------------
;;;; Handle ASDF portability to multiple implementations ;;;; Handle ASDF portability to multiple implementations
(defpackage :asdf/implementation (asdf/package:define-package :asdf/implementation
(:use :common-lisp :asdf/package) (:use :common-lisp :asdf/package)
(:recycle :asdf/implementation :asdf)
#+cormanlisp #+cormanlisp
(:export (:export
#:logical-pathname #:translate-logical-pathname #:logical-pathname #:translate-logical-pathname
......
;;;; --------------------------------------------------------------------------- ;;;; ---------------------------------------------------------------------------
;;;; Handle ASDF package upgrade, including implementation-dependent magic. ;;;; Handle ASDF package upgrade, including implementation-dependent magic.
(defpackage :asdf/interface (asdf/package:define-package :asdf/interface
(:recycle :asdf/interface :asdf)
(:nicknames :asdf) (:nicknames :asdf)
(:use :common-lisp (:use :common-lisp
:asdf/package :asdf/implementation :asdf/utility :asdf/pathname :asdf/os :asdf/upgrade :asdf/package :asdf/implementation :asdf/utility :asdf/pathname :asdf/os :asdf/upgrade
...@@ -127,7 +128,6 @@ ...@@ -127,7 +128,6 @@
#:system-source-registry #:system-source-registry
#:user-source-registry-directory #:user-source-registry-directory
#:system-source-registry-directory)) #:system-source-registry-directory))
(in-package :asdf/interface) (in-package :asdf/interface)
(with-upgrade (:when (fboundp 'make-sub-operation)) (with-upgrade (:when (fboundp 'make-sub-operation))
......
;;;; ------------------------------------------------------------------------- ;;;; -------------------------------------------------------------------------
;;;; Actions to build Common Lisp software ;;;; Actions to build Common Lisp software
(defpackage :asdf/lisp-action (asdf/package:define-package :asdf/lisp-action
(:recycle :asdf/lisp-action :asdf)
(:use :common-lisp :asdf/utility :asdf/lisp-build (:use :common-lisp :asdf/utility :asdf/lisp-build
:asdf/component :asdf/system :asdf/find-component :asdf/operation :asdf/action) :asdf/component :asdf/system :asdf/find-component :asdf/operation :asdf/action)
(:export (:export
......
;;;; ------------------------------------------------------------------------- ;;;; -------------------------------------------------------------------------
;;;; Support to build (compile and load) Lisp files ;;;; Support to build (compile and load) Lisp files
(defpackage :asdf/lisp-build (asdf/package:define-package :asdf/lisp-build
(:recycle :asdf/lisp-build :asdf)
(:use :common-lisp :asdf/utility :asdf/pathname :asdf/os) (:use :common-lisp :asdf/utility :asdf/pathname :asdf/os)
(:export (:export
#:*compile-file-warnings-behaviour* #:*compile-file-failure-behaviour* #:*compile-file-warnings-behaviour* #:*compile-file-failure-behaviour*
......
;;;; ------------------------------------------------------------------------- ;;;; -------------------------------------------------------------------------
;;;; Invoking Operations ;;;; Invoking Operations
(defpackage :asdf/operate
(asdf/package:define-package :asdf/operate
(:recycle :asdf/operate :asdf)
(:use :common-lisp :asdf/implementation :asdf/utility :asdf/upgrade (:use :common-lisp :asdf/implementation :asdf/utility :asdf/upgrade
:asdf/component :asdf/system :asdf/operation :asdf/action :asdf/component :asdf/system :asdf/operation :asdf/action
:asdf/lisp-build :asdf/lisp-action #:asdf/plan :asdf/lisp-build :asdf/lisp-action #:asdf/plan
......
;;;; ------------------------------------------------------------------------- ;;;; -------------------------------------------------------------------------
;;;; Operations ;;;; Operations
(defpackage :asdf/operation (asdf/package:define-package :asdf/operation
(:recycle :asdf/operation :asdf)
(:use :common-lisp :asdf/utility :asdf/upgrade) (:use :common-lisp :asdf/utility :asdf/upgrade)
(:export (:export
#:operation #:operation
#:operation-original-initargs ;; backward-compatibility only. DO NOT USE. #:operation-original-initargs ;; backward-compatibility only. DO NOT USE.
#:make-operation #:make-operation
#:find-operation)) #:find-operation))
(in-package :asdf/operation) (in-package :asdf/operation)
;;; Operation Classes ;;; Operation Classes
......
;;;; --------------------------------------------------------------------------- ;;;; ---------------------------------------------------------------------------
;;;; Access to the Operating System ;;;; Access to the Operating System
(defpackage :asdf/os
(asdf/package:define-package :asdf/os
(:recycle :asdf/os :asdf)
(:use :cl :asdf/package :asdf/implementation :asdf/utility :asdf/pathname) (:use :cl :asdf/package :asdf/implementation :asdf/utility :asdf/pathname)
(:export (:export
#:featurep #:os-unix-p #:os-windows-p ;; features #:featurep #:os-unix-p #:os-windows-p ;; features
......
;;;; --------------------------------------------------------------------------- ;;;; ---------------------------------------------------------------------------
;;;; asdf-output-translations ;;;; asdf-output-translations
(defpackage :asdf/output-translations (asdf/package:define-package :asdf/output-translations
(:recycle :asdf/output-translations :asdf)
(:use :common-lisp :asdf/utility :asdf/pathname :asdf/os :asdf/configuration :asdf/action) (:use :common-lisp :asdf/utility :asdf/pathname :asdf/os :asdf/configuration :asdf/action)
(:export (:export
#:invalid-output-translation #:invalid-output-translation
......
...@@ -13,60 +13,104 @@ ...@@ -13,60 +13,104 @@
(defpackage :asdf/package (defpackage :asdf/package
(:use :common-lisp) (:use :common-lisp)
(:export (:export
#:find-symbol* #:present-symbol-p #:present-symbols #:find-package* #:package-name* #:find-symbol* #:intern* #:unintern*
#:intern* #:remove-symbol #:unlink-package #:ensure-package #:unlink-package #:ensure-package #:define-package #:package-data))
#:define-package))
(in-package :asdf/package) (in-package :asdf/package)
(declaim (optimize (speed 0) (safety 3) (debug 3)))
(defmacro DBG (tag &rest exprs)
"simple debug statement macro:
outputs a tag plus a list of variable and their values, returns the last value"
;"if not in debugging mode, just compute and return last value"
#-DBGXXX (declare (ignore tag)) #-DBGXXX (car (last exprs)) #+DBGXXX
(let ((res (gensym))(f (gensym)))
`(let (,res (*print-readably* nil))
(flet ((,f (fmt &rest args) (apply #'format *error-output* fmt args)))
(fresh-line *standard-output*) (fresh-line *trace-output*) (fresh-line *error-output*)
(,f "~&~A~%" ,tag)
,@(mapcan
#'(lambda (x)
`((,f "~& ~S => " ',x)
(,f "~{~S~^ ~}~%" (setf ,res (multiple-value-list ,x)))))
exprs)
(apply 'values ,res)))))
;;;; General purpose package utilities ;;;; General purpose package utilities
(eval-when (:load-toplevel :compile-toplevel :execute) (eval-when (:load-toplevel :compile-toplevel :execute)
(defun find-symbol* (name package-name &optional (error t)) (defun find-package* (package-designator &optional (error t))
(let ((package (find-package package-designator)))
(cond
(package package)
(error (error "No package named ~S" (string package-designator)))
(t nil))))
(defun package-name* (package-designator &optional (error t))
(let ((package (find-package* package-designator error)))
(when package (package-name package))))
(defun find-symbol* (name package-designator &optional (error t))
"Find a symbol in a package of given string'ified NAME; "Find a symbol in a package of given string'ified NAME;
unless CL:FIND-SYMBOL, work well with 'modern' case sensitive syntax unless CL:FIND-SYMBOL, work well with 'modern' case sensitive syntax
by letting you supply a symbol or keyword for the name; by letting you supply a symbol or keyword for the name;
also works well when the package is not present. also works well when the package is not present.
If optional ERROR argument is NIL, return NIL instead of an error If optional ERROR argument is NIL, return NIL instead of an error
when the symbol is not found." when the symbol is not found."
(let ((package (find-package package-name))) (block nil
(if package (let ((package (find-package* package-designator error)))
(let ((symbol (find-symbol (string name) package))) (when package
(or symbol (multiple-value-bind (symbol status) (find-symbol (string name) package)
(when error (cond
(error "There is no symbol ~A in package ~A" name package-name)))) (status (return (values symbol status)))
(when error (error (error "There is no symbol ~S in package ~S" name (package-name package))))))
(error "There is no package ~A" package-name))))) (values nil nil))))
(defun intern* (name package) (defun intern* (name package-designator &optional (error t))
(intern (string name) package)) (intern (string name) (package-name* package-designator error)))
(defun remove-symbol (symbol package) (defun unintern* (name package-designator &optional (error t))
(let ((sym (find-symbol* symbol package nil))) (block nil
(when sym (let ((package (find-package* package-designator error)))
#-cormanlisp (unexport sym package) (when package
(unintern sym package) (multiple-value-bind (symbol status) (find-symbol* name package error)
sym))) (cond
(defun present-symbol-p (symbol package) (status (unintern symbol package)
(member (nth-value 1 (find-symbol* symbol package nil)) '(:internal :external))) (return (values symbol status)))
(defun present-symbols (package) (error (error "symbol ~A not present in package ~A"
;; #-genera (loop :for s :being :the :present-symbols :in package :collect s) #+genera (string symbol) (package-name package))))))
(let (l) (do-symbols (s package) (when (present-symbol-p s package) (push s l))) (reverse l)))) (values nil nil))))
(defun package-data (package-designator &optional (error t))
(let ((package (find-package* package-designator error)))
(when package
(labels ((string-sort (strings)
(sort strings #'string<))
(sort-packages (packages)
(string-sort (mapcar #'package-name packages))))
(loop :with internal :with external :with inherited
:for sym :being :the :symbols :in package
:for status = (nth-value 1 (find-symbol* sym package)) :do
(ecase status
(:internal (push sym internal))
(:external (push sym external))
(:inherited (push sym inherited)))
:finally
(return
`(:name ,(package-name package)
:nicknames ,(package-nicknames package)
:internal ,(string-sort internal)
:external ,(string-sort external)
:inherited ,(string-sort inherited)
:shadowing ,(string-sort (package-shadowing-symbols package))
:use ,(sort-packages (package-use-list package))
:used-by ,(sort-packages (package-used-by-list package))))))))))
(eval-when (:load-toplevel :compile-toplevel :execute) (eval-when (:load-toplevel :compile-toplevel :execute)
(defun soft-upgrade-p (upgrade) (defun soft-upgrade-p (upgrade)
(ecase upgrade ((:soft nil) t) (:hard nil))) (ecase upgrade ((:soft nil) t) (:hard nil)))
(defun check-packages-exist (package-names)
(remove-duplicates
(loop :for n :in package-names
:for p = (find-package n)
:when p :collect p :else :do (error "Package ~A does not exist" n))
:from-end t))
(defun ensure-package-unused (package) (defun ensure-package-unused (package)
(loop :for p :in (package-used-by-list package) :do (loop :for p :in (package-used-by-list package) :do
(unuse-package package p))) (unuse-package package p)))
(defun ensure-package-deleted (package) ;; &key upgrade (defun ensure-package-deleted (package) ;; &key upgrade
(let ((p (find-package package))) (let ((p (find-package package)))
(when p (when p
;;(unless (soft-upgrade-p upgrade) (ensure-package-unintern p (present-symbols u)))
(ensure-package-unused p) (ensure-package-unused p)
(delete-package package)))) (delete-package package))))
(defun ensure-package-fmakunbound (package symbols) (defun ensure-package-fmakunbound (package symbols)
...@@ -77,20 +121,10 @@ when the symbol is not found." ...@@ -77,20 +121,10 @@ when the symbol is not found."
(loop :for name :in symbols (loop :for name :in symbols
:for sym = (find-symbol* name package nil) :for sym = (find-symbol* name package nil)
:when sym :do #-gcl (fmakunbound `(setf ,sym)))) :when sym :do #-gcl (fmakunbound `(setf ,sym))))
(defun ensure-package-unintern (package unintern &key table (users (list-all-packages)))
(loop :for u :in unintern
:for name = (string u)
:for removed = (remove-symbol name package) :do
(when removed
(loop :for p :in users :do
(when (eq removed (find-symbol name p))
(unintern removed p)))))))
(eval-when (:load-toplevel :compile-toplevel :execute)
(defun recycle-symbol (name recycle) (defun recycle-symbol (name recycle)
(loop :for r :in recycle (loop :for r :in recycle
:for s = (find-symbol* name r nil) :for s = (find-symbol* name r nil)
:when s :do (values s r))) :when s :do (return (values s r))))
(defun ensure-package (name &key (defun ensure-package (name &key
upgrade upgrade
nicknames documentation use nicknames documentation use
...@@ -99,7 +133,6 @@ when the symbol is not found." ...@@ -99,7 +133,6 @@ when the symbol is not found."
recycle mix reexport recycle mix reexport
unintern fmakunbound fmakunbound-setf) unintern fmakunbound fmakunbound-setf)
(let* ((nicknames (mapcar #'string nicknames)) (let* ((nicknames (mapcar #'string nicknames))
(use (check-packages-exist use))
(shadow (mapcar #'string shadow)) (shadow (mapcar #'string shadow))
(shadowing-import-from (loop :for sif :in shadowing-import-from (shadowing-import-from (loop :for sif :in shadowing-import-from
:collect (mapcar #'string sif))) :collect (mapcar #'string sif)))
...@@ -107,24 +140,31 @@ when the symbol is not found." ...@@ -107,24 +140,31 @@ when the symbol is not found."
:collect (mapcar #'string if))) :collect (mapcar #'string if)))
(export (mapcar #'string export)) (export (mapcar #'string export))
(recycle (remove nil (mapcar #'find-package recycle))) (recycle (remove nil (mapcar #'find-package recycle)))
(mix (check-packages-exist mix))