diff --git a/Makefile b/Makefile index 6a81b0bc5a70c8e5b345ff4a0aff895099f32d10..8a4c5a42cc614099e1e1f035cb200faa37aca007 100644 --- a/Makefile +++ b/Makefile @@ -79,7 +79,7 @@ SCL ?= scl XCL ?= xcl header_lisp := header.lisp -driver_lisp := uiop/package.lisp uiop/common-lisp.lisp uiop/utility.lisp uiop/version.lisp uiop/os.lisp uiop/pathname.lisp uiop/filesystem.lisp uiop/stream.lisp uiop/image.lisp uiop/lisp-build.lisp uiop/launch-program.lisp uiop/run-program.lisp uiop/configuration.lisp uiop/backward-driver.lisp uiop/driver.lisp +driver_lisp := uiop/package.lisp uiop/package-local-nicknames.lisp uiop/common-lisp.lisp uiop/utility.lisp uiop/version.lisp uiop/os.lisp uiop/pathname.lisp uiop/filesystem.lisp uiop/stream.lisp uiop/image.lisp uiop/lisp-build.lisp uiop/launch-program.lisp uiop/run-program.lisp uiop/configuration.lisp uiop/backward-driver.lisp uiop/driver.lisp defsystem_lisp := upgrade.lisp session.lisp component.lisp operation.lisp system.lisp system-registry.lisp action.lisp lisp-action.lisp find-component.lisp forcing.lisp plan.lisp operate.lisp find-system.lisp parse-defsystem.lisp bundle.lisp concatenate-source.lisp package-inferred-system.lisp output-translations.lisp source-registry.lisp backward-internals.lisp backward-interface.lisp interface.lisp user.lisp footer.lisp all_lisp := $(header_lisp) $(driver_lisp) $(defsystem_lisp) diff --git a/make-asdf.bat b/make-asdf.bat index 523fbe71da6ecbcd067f3acc86e43e27737647a3..9c4deab031ba0ac8322b30fc0aea9c0dad609888 100644 --- a/make-asdf.bat +++ b/make-asdf.bat @@ -4,7 +4,7 @@ set here=%~dp0 set header_lisp=header.lisp -set driver_lisp=uiop\package.lisp + uiop\common-lisp.lisp + uiop\utility.lisp + uiop\version.lisp + uiop\os.lisp + uiop\pathname.lisp + uiop\filesystem.lisp + uiop\stream.lisp + uiop\image.lisp + uiop\lisp-build.lisp + uiop\launch-program.lisp + uiop\run-program.lisp + uiop\configuration.lisp + uiop\backward-driver.lisp + uiop\driver.lisp +set driver_lisp=uiop\package.lisp + uiop\package-local-nicknames.lisp + uiop\common-lisp.lisp + uiop\utility.lisp + uiop\version.lisp + uiop\os.lisp + uiop\pathname.lisp + uiop\filesystem.lisp + uiop\stream.lisp + uiop\image.lisp + uiop\lisp-build.lisp + uiop\launch-program.lisp + uiop\run-program.lisp + uiop\configuration.lisp + uiop\backward-driver.lisp + uiop\driver.lisp set defsystem_lisp=upgrade.lisp + session.lisp + component.lisp + operation.lisp + system.lisp + system-registry.lisp + action.lisp + lisp-action.lisp + find-component.lisp + forcing.lisp + plan.lisp + operate.lisp + find-system.lisp + parse-defsystem.lisp + bundle.lisp + concatenate-source.lisp + package-inferred-system.lisp + output-translations.lisp + source-registry.lisp + backward-internals.lisp + backward-interface.lisp + interface.lisp + user.lisp + footer.lisp %~d0 diff --git a/make-asdf.sh b/make-asdf.sh index ec429fd2f01ad9d9ab8dbefb4232bb90773c37ea..7c14f2b5b64a94cf364af2fadc3458ef5b58ab31 100755 --- a/make-asdf.sh +++ b/make-asdf.sh @@ -5,7 +5,7 @@ here="$(dirname $0)" header_lisp="header.lisp" -driver_lisp="uiop/package.lisp uiop/common-lisp.lisp uiop/utility.lisp uiop/version.lisp uiop/os.lisp uiop/pathname.lisp uiop/filesystem.lisp uiop/stream.lisp uiop/image.lisp uiop/lisp-build.lisp uiop/launch-program.lisp uiop/run-program.lisp uiop/configuration.lisp uiop/backward-driver.lisp uiop/driver.lisp" +driver_lisp="uiop/package.lisp uiop/package-local-nicknames.lisp uiop/common-lisp.lisp uiop/utility.lisp uiop/version.lisp uiop/os.lisp uiop/pathname.lisp uiop/filesystem.lisp uiop/stream.lisp uiop/image.lisp uiop/lisp-build.lisp uiop/launch-program.lisp uiop/run-program.lisp uiop/configuration.lisp uiop/backward-driver.lisp uiop/driver.lisp" defsystem_lisp="upgrade.lisp session.lisp component.lisp operation.lisp system.lisp system-registry.lisp action.lisp lisp-action.lisp find-component.lisp forcing.lisp plan.lisp operate.lisp find-system.lisp parse-defsystem.lisp bundle.lisp concatenate-source.lisp package-inferred-system.lisp output-translations.lisp source-registry.lisp backward-internals.lisp backward-interface.lisp interface.lisp user.lisp footer.lisp" all () { diff --git a/test/test-package-local-nicknames.script b/test/test-package-local-nicknames.script index 06700b87abae76825d0b4de5062f20fdb4340abd..8b2d7897e9d919ad60a8bdd92fff31a79c10f6b5 100644 --- a/test/test-package-local-nicknames.script +++ b/test/test-package-local-nicknames.script @@ -38,11 +38,11 @@ (delete-package :package-local-nicknames-test-1)) (when (find-package :package-local-nicknames-test-2) (delete-package :package-local-nicknames-test-2))) - (let ((form1 `(uiop/package:define-package :package-local-nicknames-test-1 (:use) + (let ((form1 `(uiop:define-package :package-local-nicknames-test-1 (:use) (:local-nicknames (:l :cl) (,+nn-name+ ,+pkg-name+))))) (eval form1)) - (let ((form2 `(uiop/package:define-package :package-local-nicknames-test-2 (:use) - (:export "CONS")))) + (let ((form2 `(uiop:define-package :package-local-nicknames-test-2 (:use) + (:export "CONS")))) (eval form2))) (defmacro define-test (name &rest body) @@ -62,7 +62,7 @@ :package-local-nicknames-test-1 :package-local-nicknames-test-2)) (let ((*package* (find-package p))) - (let ((alist (uiop/package:package-local-nicknames :package-local-nicknames-test-1))) + (let ((alist (uiop:package-local-nicknames :package-local-nicknames-test-1))) (assert (equal (cons (case-lisp-string "L") (find-package :cl)) (assoc (case-lisp-string "L") alist :test 'string=))) (assert (equal (cons +nn-sname+ (find-package +pkg-sname+)) @@ -95,29 +95,29 @@ (define-test test-package-local-nicknames-nickname-removal (reset-test-packages) - (assert (= 2 (length (uiop/package:package-local-nicknames :package-local-nicknames-test-1)))) - (assert (uiop/package:remove-package-local-nickname :l :package-local-nicknames-test-1)) - (assert (= 1 (length (uiop/package:package-local-nicknames :package-local-nicknames-test-1)))) + (assert (= 2 (length (uiop:package-local-nicknames :package-local-nicknames-test-1)))) + (assert (uiop:remove-package-local-nickname :l :package-local-nicknames-test-1)) + (assert (= 1 (length (uiop:package-local-nicknames :package-local-nicknames-test-1)))) (let ((*package* (find-package :package-local-nicknames-test-1))) (assert (not (find-package :l))))) (define-test test-package-local-nicknames-nickname-removal-char #+ignore (declare (optimize (debug 3) (speed 0))) (reset-test-packages) - (assert (= 2 (length (uiop/package:package-local-nicknames :package-local-nicknames-test-1)))) - (assert (uiop/package:remove-package-local-nickname (if (eq (readtable-case *readtable*) :preserve) #\l #\L) - :package-local-nicknames-test-1)) - (assert (= 1 (length (uiop/package:package-local-nicknames :package-local-nicknames-test-1)))) + (assert (= 2 (length (uiop:package-local-nicknames :package-local-nicknames-test-1)))) + (assert (uiop:remove-package-local-nickname (if (eq (readtable-case *readtable*) :preserve) #\l #\L) + :package-local-nicknames-test-1)) + (assert (= 1 (length (uiop:package-local-nicknames :package-local-nicknames-test-1)))) (let ((*package* (find-package :package-local-nicknames-test-1))) (assert (not (find-package :l))))) (define-test test-package-local-nicknames-nickname-removal-readd-another-package-equality (reset-test-packages) - (assert (uiop/package:remove-package-local-nickname :l :package-local-nicknames-test-1)) + (assert (uiop:remove-package-local-nickname :l :package-local-nicknames-test-1)) (assert (eq (find-package :package-local-nicknames-test-1) - (uiop/package:add-package-local-nickname :l :package-local-nicknames-test-2 - :package-local-nicknames-test-1))) + (uiop:add-package-local-nickname :l :package-local-nicknames-test-2 + :package-local-nicknames-test-1))) (let ((*package* (find-package :package-local-nicknames-test-1))) (let ((cl (find-package :l)) (sb (find-package +nn-name+))) diff --git a/uiop/driver.lisp b/uiop/driver.lisp index 9b7807d7d57f95467d671003f4072f82d1eca60b..b5033588068c07f9758a0ce98aa99d934fdf54aa 100644 --- a/uiop/driver.lisp +++ b/uiop/driver.lisp @@ -13,7 +13,8 @@ :uiop/package :uiop/utility :uiop/version :uiop/os :uiop/pathname :uiop/filesystem :uiop/stream :uiop/image :uiop/launch-program :uiop/run-program - :uiop/lisp-build :uiop/configuration :uiop/backward-driver)) + :uiop/lisp-build :uiop/configuration :uiop/backward-driver + :uiop/package-local-nicknames)) ;; Provide both lowercase and uppercase, to satisfy more people. (provide "uiop") (provide "UIOP") diff --git a/uiop/package-local-nicknames.lisp b/uiop/package-local-nicknames.lisp new file mode 100644 index 0000000000000000000000000000000000000000..95a12124a3912e417cc25e48f83d96b24f2b6cf7 --- /dev/null +++ b/uiop/package-local-nicknames.lisp @@ -0,0 +1,22 @@ +;;; ------------------------------------------------------------------------- +;;; Export the package-local-nicknames API. This cannot be done from +;;; uiop/package due to different ways implementations handle package variance. + +(uiop/package:define-package :uiop/package-local-nicknames + (:use :common-lisp) + ;; Hack to make sure uiop/package is loaded first (to portably get + ;; :PACKAGE-LOCAL-NICKNAMES onto *FEATURES*) + (:import-from :uiop/package) + #+package-local-nicknames + (:import-from #+allegro #:excl + #+sbcl #:sb-ext + #+(or clasp abcl ecl) #:ext + #+ccl #:ccl + #+lispworks #:hcl + #-(or allegro sbcl clasp abcl ccl lispworks ecl) + (error "Don't know from which package this lisp supplies the local-package-nicknames API.") + #:remove-package-local-nickname #:package-local-nicknames #:add-package-local-nickname) + #+package-local-nicknames + (:export #:add-package-local-nickname #:remove-package-local-nickname #:package-local-nicknames)) + +(in-package :uiop/package-local-nicknames) diff --git a/uiop/package.lisp b/uiop/package.lisp index 61a48a012a51f66eb8a4fdb37e20b143d635c15e..2212f8cbed5aa84f094aba0917245441a6a1368a 100644 --- a/uiop/package.lisp +++ b/uiop/package.lisp @@ -28,15 +28,6 @@ ;; import and export the same exact symbols as for ASDF 2.27. ;; Any other symbol must be import-from'ed and re-export'ed in a different package. (:use :common-lisp) - #+package-local-nicknames - (:import-from #+allegro #:excl - #+sbcl #:sb-ext - #+(or clasp abcl ecl) #:ext - #+ccl #:ccl - #+lispworks #:hcl - #-(or allegro sbcl clasp abcl ccl lispworks ecl) - (error "Don't know from which package this lisp supplies the local-package-nicknames API.") - #:remove-package-local-nickname #:package-local-nicknames #:add-package-local-nickname) (:export #:find-package* #:find-symbol* #:symbol-call #:intern* #:export* #:import* #:shadowing-import* #:shadow* #:make-symbol* #:unintern* @@ -47,11 +38,7 @@ #:ensure-package-unused #:delete-package* #:package-names #:packages-from-names #:fresh-package-name #:rename-package-away #:package-definition-form #:parse-define-package-form - #:ensure-package #:define-package - #+package-local-nicknames #:add-package-local-nickname - #+package-local-nicknames #:remove-package-local-nickname - #+package-local-nicknames #:package-local-nicknames - )) + #:ensure-package #:define-package)) (in-package :uiop/package) @@ -364,6 +351,43 @@ or when loading the package is optional." ,@(when-relevant :intern (and internp (sort-names intern))))))))) +;;; package-local-nicknames +;;; +;;; These symbols cannot be imported to (or exported from) the uiop/package +;;; package, as its definition is frozen forever. So we create our own +;;; functions mirroring the p-l-n API here that just dispatch to the +;;; implementation's own functions. We then create another package (once +;;; UIOP:DEFINE-PACKAGE is in place) that is used to export the API from the +;;; UIOP package. +#+package-local-nicknames +(eval-when (:load-toplevel :compile-toplevel :execute) + #-(or allegro sbcl clasp abcl ecl ccl lispworks) + (error "Don't know from which package this lisp supplies the local-package-nicknames API.") + + (defun add-package-local-nickname (local-nickname actual-package &optional (package-designator *package*)) + (#+allegro excl:add-package-local-nickname + #+sbcl sb-ext:add-package-local-nickname + #+(or clasp abcl ecl) ext:add-package-local-nickname + #+ccl ccl:add-package-local-nickname + #+lispworks hcl:add-package-local-nickname + local-nickname actual-package package-designator)) + + (defun remove-package-local-nickname (old-nickname &optional (package-designator *package*)) + (#+allegro excl:remove-package-local-nickname + #+sbcl sb-ext:remove-package-local-nickname + #+(or clasp abcl ecl) ext:remove-package-local-nickname + #+ccl ccl:remove-package-local-nickname + #+lispworks hcl:remove-package-local-nickname + old-nickname package-designator)) + + (defun package-local-nicknames (package-designator) + (#+allegro excl:package-local-nicknames + #+sbcl sb-ext:package-local-nicknames + #+(or clasp abcl ecl) ext:package-local-nicknames + #+ccl ccl:package-local-nicknames + #+lispworks hcl:package-local-nicknames + package-designator))) + ;;; ensure-package, define-package (eval-when (:load-toplevel :compile-toplevel :execute) (defun ensure-shadowing-import (name to-package from-package shadowed imported) diff --git a/uiop/uiop.asd b/uiop/uiop.asd index 72fffb0d35600cf4223eb2c6cffdec708e90b13e..962f40e006fd0afe474aaed982dd9b102e34a411 100644 --- a/uiop/uiop.asd +++ b/uiop/uiop.asd @@ -30,6 +30,7 @@ you already have a matching UIOP loaded." :components ((:static-file "contrib/debug.lisp") (:file "package") + (:file "package-local-nicknames" :depends-on ("package")) (:file "common-lisp" :depends-on ("package")) (:file "utility" :depends-on ("common-lisp")) (:file "version" :depends-on ("utility")) @@ -43,7 +44,7 @@ you already have a matching UIOP loaded." (:file "run-program" :depends-on ("launch-program" "version")) (:file "configuration" :depends-on ("image")) (:file "backward-driver" :depends-on ("lisp-build" "run-program" "configuration" "version")) - (:file "driver" :depends-on ("backward-driver"))) + (:file "driver" :depends-on ("backward-driver" "package-local-nicknames"))) . #-asdf3 () #+asdf3 (:encoding :utf-8 :around-compile call-without-redefinition-warnings