Commit c609093c authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

package-system: support for quick-build style defpackage-based dependencies.

This is quick-build compatible and fixes lp#1230368.

To use package-system, just have foo.asd containing
	(defsystem foo :class package-system)
at the top of your quick-build hierarchy $FOODIR
for packages whose name start with "FOO/"
and ASDF will thereafter look for system "foo/bar/baz" in $FOODIR/bar/baz.lisp.

Such a file will implicitly have its own system defined;
its dependencies are computed by scanning the file,
extracting its first defpackage form,
and using the packages it uses or imports from
as a as a specification of what systems it depends on.

You can register packages as belonging to a system with
	(asdf:register-system-packages my-system '(package1 package2))
Using or importing from a package registered to a given system
will generate a dependency to the registered system.
Using or importing from a packages registered to the constant symbol T
will not generate any dependency.
Using or importing from a packages that is not registered will generate
a dependency on a system the name of which is the package name downcased.
All packages that exist at the time ASDF is initially loaded
are registered to constant symbol T.

Also, for convenience, introduce :use-reexport and :mix-reexport in
uiop/package.lisp (of course, no one can rely on it until it's mainstream,
but better late than never).

To use this style in a way compatible with older versions of ASDF 3,
you may use the asdf-package-system extension.
See lisp-interface-library for a system that uses this style this way.

Push :asdf-package-system to *features*
parent ba8308da
...@@ -45,7 +45,7 @@ XCL ?= xcl ...@@ -45,7 +45,7 @@ XCL ?= xcl
header_lisp := header.lisp header_lisp := header.lisp
driver_lisp := uiop/package.lisp uiop/common-lisp.lisp uiop/utility.lisp uiop/os.lisp uiop/pathname.lisp uiop/filesystem.lisp uiop/stream.lisp uiop/image.lisp uiop/run-program.lisp uiop/lisp-build.lisp uiop/configuration.lisp uiop/backward-driver.lisp uiop/driver.lisp driver_lisp := uiop/package.lisp uiop/common-lisp.lisp uiop/utility.lisp uiop/os.lisp uiop/pathname.lisp uiop/filesystem.lisp uiop/stream.lisp uiop/image.lisp uiop/run-program.lisp uiop/lisp-build.lisp uiop/configuration.lisp uiop/backward-driver.lisp uiop/driver.lisp
defsystem_lisp := upgrade.lisp component.lisp system.lisp cache.lisp find-system.lisp find-component.lisp operation.lisp action.lisp lisp-action.lisp plan.lisp operate.lisp backward-internals.lisp defsystem.lisp bundle.lisp concatenate-source.lisp output-translations.lisp backward-interface.lisp source-registry.lisp interface.lisp user.lisp footer.lisp defsystem_lisp := upgrade.lisp component.lisp system.lisp cache.lisp find-system.lisp find-component.lisp operation.lisp action.lisp lisp-action.lisp plan.lisp operate.lisp output-translations.lisp source-registry.lisp backward-internals.lisp parse-defsystem.lisp bundle.lisp concatenate-source.lisp backward-interface.lisp package-system.lisp interface.lisp user.lisp footer.lisp
all_lisp := $(header_lisp) $(driver_lisp) $(defsystem_lisp) all_lisp := $(header_lisp) $(driver_lisp) $(defsystem_lisp)
# Making ASDF itself should be our first, default, target: # Making ASDF itself should be our first, default, target:
......
...@@ -10,7 +10,7 @@ ...@@ -10,7 +10,7 @@
(in-package :asdf) (in-package :asdf)
#+asdf3 #+asdf3
(defsystem :asdf/header (defsystem :asdf/prelude
;; Note that it's polite to sort the defsystem forms in dependency order, ;; Note that it's polite to sort the defsystem forms in dependency order,
;; and compulsory to sort them in defsystem-depends-on order. ;; and compulsory to sort them in defsystem-depends-on order.
:version (:read-file-form "version.lisp-expr") :version (:read-file-form "version.lisp-expr")
...@@ -39,8 +39,8 @@ ...@@ -39,8 +39,8 @@
:version (:read-file-form "version.lisp-expr") :version (:read-file-form "version.lisp-expr")
:build-operation monolithic-concatenate-source-op :build-operation monolithic-concatenate-source-op
:build-pathname "build/asdf" ;; our target :build-pathname "build/asdf" ;; our target
:around-compile call-without-redefinition-warnings ;; we need be the same as asdf-driver :around-compile call-without-redefinition-warnings ;; we need be the same as uiop
:depends-on (:asdf/header :asdf/driver) :depends-on (:asdf/prelude :asdf/driver)
:encoding :utf-8 :encoding :utf-8
:components :components
((:file "upgrade") ((:file "upgrade")
...@@ -57,26 +57,28 @@ ...@@ -57,26 +57,28 @@
(:file "output-translations" :depends-on ("operate")) (:file "output-translations" :depends-on ("operate"))
(:file "source-registry" :depends-on ("find-system")) (:file "source-registry" :depends-on ("find-system"))
(:file "backward-internals" :depends-on ("lisp-action" "operate")) (:file "backward-internals" :depends-on ("lisp-action" "operate"))
(:file "defsystem" :depends-on ("backward-internals" "cache")) (:file "parse-defsystem" :depends-on ("backward-internals" "cache"))
(:file "bundle" :depends-on ("lisp-action")) (:file "bundle" :depends-on ("lisp-action"))
(:file "concatenate-source" :depends-on ("bundle")) (:file "concatenate-source" :depends-on ("bundle"))
(:file "backward-interface" :depends-on ("operate" "output-translations")) (:file "backward-interface" :depends-on ("operate" "output-translations"))
(:file "package-system" :depends-on ("system" "find-system" "parse-defsystem"))
(:file "interface" :depends-on (:file "interface" :depends-on
("defsystem" "concatenate-source" ("parse-defsystem" "concatenate-source"
"backward-interface" "backward-internals" "backward-interface" "backward-internals"
"output-translations" "source-registry")) "output-translations" "source-registry" "package-system"))
(:file "user" :depends-on ("interface")) (:file "user" :depends-on ("interface"))
(:file "footer" :depends-on ("user")))) (:file "footer" :depends-on ("user"))))
(defsystem :asdf (defsystem :asdf
:author ("Daniel Barlow") :author ("Daniel Barlow")
:maintainer ("Francois-Rene Rideau") :maintainer ("Robert Goldman")
: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 "3.1.0" ;; to be automatically updated by make bump-version :version "3.1.0" ;; to be automatically updated by make bump-version
:depends-on () :depends-on ()
#+asdf3 :encoding #+asdf3 :utf-8 #+asdf3 :encoding #+asdf3 :utf-8
:class #.(if (find-class 'package-system nil) 'package-system 'system)
;; For most purposes, asdf itself specially counts as a builtin system. ;; For most purposes, asdf itself specially counts as a builtin system.
;; If you want to link it or do something forbidden to builtin systems, ;; If you want to link it or do something forbidden to builtin systems,
;; specify separate dependencies on UIOP (aka asdf-driver) and asdf/defsystem. ;; specify separate dependencies on UIOP (aka asdf-driver) and asdf/defsystem.
......
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
(:recycle :asdf/concatenate-source :asdf) (:recycle :asdf/concatenate-source :asdf)
(:use :uiop/common-lisp :uiop :asdf/upgrade (:use :uiop/common-lisp :uiop :asdf/upgrade
:asdf/component :asdf/operation :asdf/component :asdf/operation
:asdf/system :asdf/find-system :asdf/defsystem :asdf/system :asdf/find-system
:asdf/action :asdf/lisp-action :asdf/bundle) :asdf/action :asdf/lisp-action :asdf/bundle)
(:export (:export
#:concatenate-source-op #:concatenate-source-op
......
...@@ -783,6 +783,7 @@ software. ...@@ -783,6 +783,7 @@ software.
* A more involved example:: * A more involved example::
* The defsystem grammar:: * The defsystem grammar::
* Other code in .asd files:: * Other code in .asd files::
* The package-system extension::
@end menu @end menu
@node The defsystem form, A more involved example, Defining systems with defsystem, Defining systems with defsystem @node The defsystem form, A more involved example, Defining systems with defsystem, Defining systems with defsystem
...@@ -1351,7 +1352,7 @@ Its semantics was limited in purpose and dubious to explain, ...@@ -1351,7 +1352,7 @@ Its semantics was limited in purpose and dubious to explain,
and its implementation was breaking a hole into the ASDF object model. and its implementation was breaking a hole into the ASDF object model.
Please use the @code{if-feature} option instead. Please use the @code{if-feature} option instead.
@node Other code in .asd files, , The defsystem grammar, Defining systems with defsystem @node Other code in .asd files, The package-system extension, The defsystem grammar, Defining systems with defsystem
@section Other code in .asd files @section Other code in .asd files
Files containing @code{defsystem} forms Files containing @code{defsystem} forms
...@@ -1379,6 +1380,75 @@ of output from ASDF operations. ...@@ -1379,6 +1380,75 @@ of output from ASDF operations.
@end itemize @end itemize
@node The package-system extension, , Other code in .asd files, Defining systems with defsystem
@section The package-system extension
Starting with ASDF 3.0.3,
ASDF supports a one-package-per-file style of programming,
whereby each file is its own system,
and dependencies are deduced from the @code{defpackage} form.
In this style, packages referring to a same-named system (downcased);
and if a system is defined with @code{:class package-system},
then system names that start with that name
(using the slash @code{/} separator)
refer to files under the filesystem hierarchy where the system is defined.
For instance, if system @code{my-lib} is defined in
@file{/foo/bar/my-lib/my-lib.asd}, then system @code{my-lib/src/utility}
will be found in file @file{/foo/bar/my-lib/src/utility.lisp}.
This style was made popular by @code{faslpath} and @code{quick-build} before,
and at the cost of a stricter package discipline,
seems to make for more maintainable code.
It is used by ASDF itself (starting with ASDF 3) and by @code{lisp-interface-library}.
To use this style, choose a toplevel system name, e.g. @code{my-lib},
and create a file @file{my-lib.asd}
with the @code{:class :package-system} option in its @code{defsystem}.
For instance:
@example
#-asdf (error "my-lib requires ASDF 3")
(defsystem my-lib
:class :package-system
:defsystem-depends-on (:asdf-package-system)
:depends-on (:my-lib/src/all)
:in-order-to ((test-op (load-op :my-lib/test/all)))
:perform (test-op (o c) (symbol-call :my-lib/test/all :test-suite)))
(register-system-packages :closer-mop
'(:c2mop :closer-common-lisp :c2cl :closer-common-lisp-user :c2cl-user))
@end example
In the code above, the
@code{:defsystem-depends-on (:asdf-package-system)} is
for compatibility with older versions of ASDF 3 (ASDF 2 not supported),
and requires the @code{asdf-package-system} library to be present
(it is implicitly provided by ASDF starting with ASDF 3.0.3).
The function @code{register-system-packages} has to be called to register
packages used or provided by your system and its components
where the name of the system that provides the package
is not the downcase of the package name.
File @file{my-lib/src/utility.lisp} might start with:
@example
(defpackage :my-lib/src/utility
(:use :closer-common-lisp :my-lib/src/macros :my-lib/src/variables)
(:import-from :cl-ppcre #:register-groups-bind)
(:export #:foo #:bar))
@end example
And from the @code{:use} and @code{:import-from} clauses,
ASDF could tell that you depend on systems @code{closer-mop} (registered above),
@code{cl-ppcre} (package and system names match), and
@code{my-lib/src/macros} and @code{my-lib/src/variables}
(package and system names match, and they will be looked up hierarchically).
The form @code{uiop:define-package} is supported as well as @code{defpackage},
and has many options that prove useful in this context,
such as @code{:use-reexport} and @code{:mix-reexport}
that allow for ``inheritance'' of symbols being exported.
@node The object model of ASDF, Controlling where ASDF searches for systems, Defining systems with defsystem, Top @node The object model of ASDF, Controlling where ASDF searches for systems, Defining systems with defsystem, Top
@comment node-name, next, previous, up @comment node-name, next, previous, up
@chapter The object model of ASDF @chapter The object model of ASDF
......
...@@ -303,7 +303,8 @@ Peter Graves <gnooth@gmail.com> (XCL). ...@@ -303,7 +303,8 @@ Peter Graves <gnooth@gmail.com> (XCL).
that also determines dependencies, in the style of that also determines dependencies, in the style of
<a href="https://bugs.launchpad.net/asdf/+bug/1230368"><tt>quick-build</tt></a> or <a href="https://bugs.launchpad.net/asdf/+bug/1230368"><tt>quick-build</tt></a> or
<a href="http://www.cliki.net/faslpath"><tt>faslpath</tt></a> <a href="http://www.cliki.net/faslpath"><tt>faslpath</tt></a>
(hopefully to be merged into a future ASDF 3.0.4 or 3.1 release.</li> (this functionality is built into recent ASDF releases,
but this package exists for backward compatibility with earlier versions of ASDF 3).
</ul> </ul>
<p>Former extensions, now superseded, include:</p> <p>Former extensions, now superseded, include:</p>
<ul> <ul>
......
...@@ -244,10 +244,8 @@ Going forward, we recommend new users should be using the source-registry. ...@@ -244,10 +244,8 @@ Going forward, we recommend new users should be using the source-registry.
(defun register-preloaded-system (system-name &rest keys) (defun register-preloaded-system (system-name &rest keys)
(setf (gethash (coerce-name system-name) *preloaded-systems*) keys)) (setf (gethash (coerce-name system-name) *preloaded-systems*) keys))
(register-preloaded-system "asdf" :version *asdf-version*) (dolist (s '("asdf" "uiop" "asdf-driver" "asdf-defsystem" "asdf-package-system"))
(register-preloaded-system "uiop" :version *asdf-version*) (register-preloaded-system s :version *asdf-version*))
(register-preloaded-system "asdf-driver" :version *asdf-version*)
(register-preloaded-system "asdf-defsystem" :version *asdf-version*)
(defmethod find-system ((name null) &optional (error-p t)) (defmethod find-system ((name null) &optional (error-p t))
(declare (ignorable name)) (declare (ignorable name))
......
...@@ -3,11 +3,7 @@ ...@@ -3,11 +3,7 @@
(asdf/package:define-package :asdf/footer (asdf/package:define-package :asdf/footer
(:recycle :asdf/footer :asdf) (:recycle :asdf/footer :asdf)
(:use :uiop/common-lisp :uiop :asdf/upgrade (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/operate :asdf/bundle))
:asdf/find-system :asdf/find-component :asdf/operation :asdf/action :asdf/lisp-action
:asdf/operate :asdf/bundle :asdf/concatenate-source
:asdf/output-translations :asdf/source-registry
:asdf/backward-internals :asdf/defsystem :asdf/backward-interface))
(in-package :asdf/footer) (in-package :asdf/footer)
;;;; Hook ASDF into the implementation's REQUIRE and other entry points. ;;;; Hook ASDF into the implementation's REQUIRE and other entry points.
...@@ -54,7 +50,7 @@ ...@@ -54,7 +50,7 @@
(when (boundp 'excl:*warn-on-nested-reader-conditionals*) (when (boundp 'excl:*warn-on-nested-reader-conditionals*)
(setf excl:*warn-on-nested-reader-conditionals* asdf/common-lisp::*acl-warn-save*)) (setf excl:*warn-on-nested-reader-conditionals* asdf/common-lisp::*acl-warn-save*))
(dolist (f '(:asdf :asdf2 :asdf3)) (pushnew f *features*)) (dolist (f '(:asdf :asdf2 :asdf3 :asdf-package-system)) (pushnew f *features*))
(provide "asdf") (provide "ASDF") ;; do it both ways to satisfy more people. (provide "asdf") (provide "ASDF") ;; do it both ways to satisfy more people.
...@@ -63,4 +59,3 @@ ...@@ -63,4 +59,3 @@
(when *load-verbose* (when *load-verbose*
(asdf-message ";; ASDF, version ~a~%" (asdf-version))) (asdf-message ";; ASDF, version ~a~%" (asdf-version)))
...@@ -14,8 +14,8 @@ ...@@ -14,8 +14,8 @@
:asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/component :asdf/system :asdf/find-system :asdf/find-component
:asdf/operation :asdf/action :asdf/lisp-action :asdf/operation :asdf/action :asdf/lisp-action
:asdf/output-translations :asdf/source-registry :asdf/output-translations :asdf/source-registry
:asdf/plan :asdf/operate :asdf/defsystem :asdf/bundle :asdf/concatenate-source :asdf/plan :asdf/operate :asdf/parse-defsystem :asdf/bundle :asdf/concatenate-source
:asdf/backward-internals :asdf/backward-interface) :asdf/backward-internals :asdf/backward-interface :asdf/package-system)
;; TODO: automatically generate interface with reexport? ;; TODO: automatically generate interface with reexport?
(:export (:export
#:defsystem #:find-system #:locate-system #:coerce-name #:defsystem #:find-system #:locate-system #:coerce-name
...@@ -57,8 +57,9 @@ ...@@ -57,8 +57,9 @@
#:file-component #:source-file #:c-source-file #:java-source-file #:file-component #:source-file #:c-source-file #:java-source-file
#:cl-source-file #:cl-source-file.cl #:cl-source-file.lsp #:cl-source-file #:cl-source-file.cl #:cl-source-file.lsp
#:static-file #:doc-file #:html-file #:static-file #:doc-file #:html-file
#:file-type #:file-type #:source-file-type
#:source-file-type
#:package-system #:register-system-packages
#:component-children ; component accessors #:component-children ; component accessors
#:component-children-by-name #:component-children-by-name
......
;;;; -------------------------------------------------------------------------
;;;; Package systems in the style of quick-build or faslpath
(uiop:define-package :asdf/package-system
(:recycle :asdf/package-system :asdf)
(:use :uiop/common-lisp :uiop
:asdf/defsystem ;; Using the old name of :asdf/parse-defsystem for compatibility
:asdf/upgrade :asdf/component :asdf/system :asdf/find-system :asdf/lisp-action)
(:export
#:package-system #:register-system-packages #:sysdef-package-system-search
#:*defpackage-forms* #:*package-systems*))
(in-package :asdf/package-system)
(with-upgradability ()
(defparameter *defpackage-forms* '(cl:defpackage uiop:define-package))
(defun initial-package-systems-table ()
(let ((h (make-hash-table :test 'equal)))
(dolist (p (list-all-packages))
(dolist (n (package-names p))
(setf (gethash n h) t)))
h))
(defvar *package-systems* (initial-package-systems-table))
(defclass package-system (system)
())
(defun defpackage-form-p (form)
(and (consp form)
(member (car form) *defpackage-forms*)))
(defun stream-defpackage-form (stream)
(loop :for form = (read stream)
:when (defpackage-form-p form)
:return form))
(defun file-defpackage-form (file)
(with-input-file (f file)
(stream-defpackage-form f)))
(defun package-dependencies (defpackage-form)
(assert (defpackage-form-p defpackage-form))
(remove-duplicates
(while-collecting (dep)
(loop* :for (option . arguments) :in (cddr defpackage-form) :do
(ecase option
((:use :mix :reexport :use-reexport :mix-reexport)
(dolist (p arguments) (dep (string p))))
((:import-from :shadowing-import-from)
(dep (string (first arguments))))
((:nicknames :documentation :shadow :export :intern :unintern :recycle)))))
:from-end t :test 'equal))
(defun package-designator-name (package)
(etypecase package
(package (package-name package))
(string package)
(symbol (string package))))
(defun register-system-packages (system packages)
(let ((name (or (eq system t) (coerce-name system))))
(dolist (p (ensure-list packages))
(setf (gethash (package-designator-name p) *package-systems*) name))))
(defun package-name-system (package-name)
(check-type package-name string)
(if-let ((system-name (gethash package-name *package-systems*)))
system-name
(string-downcase package-name)))
(defun package-system-file-dependencies (file)
(let* ((defpackage-form (file-defpackage-form file))
(package-dependencies (package-dependencies defpackage-form)))
(remove t (mapcar 'package-name-system package-dependencies))))
(defun same-package-system-p (system name directory subpath dependencies)
(and (eq (type-of system) 'package-system)
(equal (component-name system) name)
(pathname-equal directory (component-pathname system))
(equal dependencies (component-sideway-dependencies system))
(let ((children (component-children system)))
(and (length=n-p children 1)
(let ((child (first children)))
(and (eq (type-of child) 'cl-source-file)
(equal (component-name child) "lisp")
(and (slot-boundp child 'relative-pathname)
(equal (slot-value child 'relative-pathname) subpath))))))))
(defun sysdef-package-system-search (system)
(let ((primary (primary-system-name system)))
(unless (equal primary system)
(let ((top (find-system primary nil)))
(when (typep top 'package-system)
(if-let (dir (system-source-directory top))
(let* ((sub (subseq system (1+ (length primary))))
(f (probe-file* (subpathname dir sub :type "lisp")
:truename *resolve-symlinks*)))
(when (file-pathname-p f)
(let ((dependencies (package-system-file-dependencies f))
(previous (cdr (system-registered-p system))))
(if (same-package-system-p previous system dir sub dependencies)
previous
(eval `(defsystem ,system
:class package-system
:source-file nil
:pathname ,dir
:depends-on ,dependencies
:components ((cl-source-file "lisp" :pathname ,sub)))))))))))))))
(with-upgradability ()
(pushnew 'sysdef-package-system-search *system-definition-search-functions*))
;;;; ------------------------------------------------------------------------- ;;;; -------------------------------------------------------------------------
;;;; Defsystem ;;;; Defsystem
(asdf/package:define-package :asdf/defsystem (asdf/package:define-package :asdf/parse-defsystem
(:recycle :asdf/defsystem :asdf) (:recycle :asdf/parse-defsystem :asdf/defsystem :asdf)
(:use :uiop/common-lisp :uiop :asdf/upgrade (:nicknames :asdf/defsystem) ;; previous name, to be compatible with, in case anyone cares
(:use :uiop/common-lisp :asdf/driver :asdf/upgrade
:asdf/component :asdf/system :asdf/cache :asdf/component :asdf/system :asdf/cache
:asdf/find-system :asdf/find-component :asdf/lisp-action :asdf/operate :asdf/find-system :asdf/find-component :asdf/lisp-action :asdf/operate
:asdf/backward-internals) :asdf/backward-internals)
...@@ -13,7 +14,7 @@ ...@@ -13,7 +14,7 @@
#:determine-system-directory #:parse-component-form #:determine-system-directory #:parse-component-form
#:non-toplevel-system #:non-system-system #:non-toplevel-system #:non-system-system
#:sysdef-error-component #:check-component-input)) #:sysdef-error-component #:check-component-input))
(in-package :asdf/defsystem) (in-package :asdf/parse-defsystem)
;;; Pathname ;;; Pathname
(with-upgradability () (with-upgradability ()
......
...@@ -3,15 +3,12 @@ ...@@ -3,15 +3,12 @@
(uiop/package:define-package :uiop/driver (uiop/package:define-package :uiop/driver
(:nicknames :uiop :asdf/driver :asdf-driver :asdf-utils) (:nicknames :uiop :asdf/driver :asdf-driver :asdf-utils)
(:use :uiop/common-lisp :uiop/package :uiop/utility (:use :uiop/common-lisp)
:uiop/os :uiop/pathname :uiop/stream :uiop/filesystem :uiop/image ;; NB: not reexporting uiop/common-lisp
:uiop/run-program :uiop/lisp-build
:uiop/configuration :uiop/backward-driver)
(:reexport
;; NB: excluding uiop/common-lisp
;; which include all of CL with compatibility modifications on select platforms, ;; which include all of CL with compatibility modifications on select platforms,
;; that could cause potential conflicts for packages that would :use (cl uiop) ;; that could cause potential conflicts for packages that would :use (cl uiop)
;; or :use (closer-common-lisp uiop), etc. ;; or :use (closer-common-lisp uiop), etc.
(:use-reexport
:uiop/package :uiop/utility :uiop/package :uiop/utility
:uiop/os :uiop/pathname :uiop/stream :uiop/filesystem :uiop/image :uiop/os :uiop/pathname :uiop/stream :uiop/filesystem :uiop/image
:uiop/run-program :uiop/lisp-build :uiop/run-program :uiop/lisp-build
......
...@@ -680,22 +680,26 @@ or when loading the package is optional." ...@@ -680,22 +680,26 @@ or when loading the package is optional."
:with documentation = nil :with documentation = nil
:for (kw . args) :in clauses :for (kw . args) :in clauses
:when (eq kw :nicknames) :append args :into nicknames :else :when (eq kw :nicknames) :append args :into nicknames :else
:when (eq kw :documentation) :when (eq kw :documentation)
:do (cond :do (cond
(documentation (error "define-package: can't define documentation twice")) (documentation (error "define-package: can't define documentation twice"))
((or (atom args) (cdr args)) (error "define-package: bad documentation")) ((or (atom args) (cdr args)) (error "define-package: bad documentation"))
(t (setf documentation (car args)))) :else (t (setf documentation (car args)))) :else
:when (eq kw :use) :append args :into use :and :do (setf use-p t) :else :when (eq kw :use) :append args :into use :and :do (setf use-p t) :else
:when (eq kw :shadow) :append args :into shadow :else :when (eq kw :shadow) :append args :into shadow :else
:when (eq kw :shadowing-import-from) :collect args :into shadowing-import-from :else :when (eq kw :shadowing-import-from) :collect args :into shadowing-import-from :else
:when (eq kw :import-from) :collect args :into import-from :else :when (eq kw :import-from) :collect args :into import-from :else
:when (eq kw :export) :append args :into export :else :when (eq kw :export) :append args :into export :else
:when (eq kw :intern) :append args :into intern :else :when (eq kw :intern) :append args :into intern :else
:when (eq kw :recycle) :append args :into recycle :and :do (setf recycle-p t) :else :when (eq kw :recycle) :append args :into recycle :and :do (setf recycle-p t) :else
:when (eq kw :mix) :append args :into mix :else :when (eq kw :mix) :append args :into mix :else
:when (eq kw :reexport) :append args :into reexport :else :when (eq kw :reexport) :append args :into reexport :else
:when (eq kw :unintern) :append args :into unintern :else :when (eq kw :use-reexport) :append args :into use :and :append args :into reexport
:do (error "unrecognized define-package keyword ~S" kw) :and :do (setf use-p t) :else
:when (eq kw :mix-reexport) :append args :into mix :and :append args :into reexport
:and :do (setf use-p t) :else
:when (eq kw :unintern) :append args :into unintern :else
:do (error "unrecognized define-package keyword ~S" kw)
:finally (return `(,package :finally (return `(,package
:nicknames ,nicknames :documentation ,documentation :nicknames ,nicknames :documentation ,documentation
:use ,(if use-p use '(:common-lisp)) :use ,(if use-p use '(:common-lisp))
......
...@@ -817,30 +817,38 @@ unless IGNORE-ERROR-STATUS is specified. ...@@ -817,30 +817,38 @@ unless IGNORE-ERROR-STATUS is specified.
If OUTPUT is a pathname, a string designating a pathname, or NIL designating the null device, If OUTPUT is a pathname, a string designating a pathname, or NIL designating the null device,
the file at that path is used as output. the file at that path is used as output.
If it's :INTERACTIVE, output is inherited from the current process. If it's :INTERACTIVE, output is inherited from the current process;
beware that this may be different from your *STANDARD-OUTPUT*,
and under SLIME will be on your *inferior-lisp* buffer.
If it's T, output goes to your current *STANDARD-OUTPUT* stream.
Otherwise, OUTPUT should be a value that is a suitable first argument to Otherwise, OUTPUT should be a value that is a suitable first argument to
SLURP-INPUT-STREAM (qv.), or a list of such a value and keyword arguments. SLURP-INPUT-STREAM (qv.), or a list of such a value and keyword arguments.
In this case, RUN-PROGRAM will create a temporary stream for the program output. In this case, RUN-PROGRAM will create a temporary stream for the program output;
The program output, in that stream, will be processed by a call to SLURP-INPUT-STREAM, the program output, in that stream, will be processed by a call to SLURP-INPUT-STREAM,
using OUTPUT as the first argument (or the first element of OUTPUT, and the rest as keywords). using OUTPUT as the first argument (or the first element of OUTPUT, and the rest as keywords).
T designates the *STANDARD-OUTPUT* to be provided to SLURP-INPUT-STREAM.
The primary value resulting from that call (or NIL if no call was needed) The primary value resulting from that call (or NIL if no call was needed)
will be the first value returned by RUN-PROGRAM. will be the first value returned by RUN-PROGRAM.
E.g., using :OUTPUT :STRING will have it return the entire output stream as a string. E.g., using :OUTPUT :STRING will have it return the entire output stream as a string.
And using :OUTPUT '(:STRING :STRIPPED T) will have it return the same string
stripped of any ending newline.
ERROR-OUTPUT is similar to OUTPUT, except that the resulting value is returned ERROR-OUTPUT is similar to OUTPUT, except that the resulting value is returned
as the second value of RUN-PROGRAM. T designates the *ERROR-OUTPUT*. as the second value of RUN-PROGRAM. T designates the *ERROR-OUTPUT*.
Also :OUTPUT means redirecting the error output to the output stream, and NIL is returned. Also :OUTPUT means redirecting the error output to the output stream,
in which case NIL is returned.
INPUT is similar to OUTPUT, except that VOMIT-OUTPUT-STREAM is used, INPUT is similar to OUTPUT, except that VOMIT-OUTPUT-STREAM is used,
no value is returned, and T designates the *STANDARD-INPUT*. no value is returned, and T designates the *STANDARD-INPUT*.
Use ELEMENT-TYPE and EXTERNAL-FORMAT to specify how streams are created. Use ELEMENT-TYPE and EXTERNAL-FORMAT are passed on
to your Lisp implementation, when applicable, for creation of the output stream.
One and only one of the stream slurping or vomiting may or may not happen One and only one of the stream slurping or vomiting may or may not happen
in parallel in parallel with the subprocess, depending on options and implementation. in parallel in parallel with the subprocess,
Other streams are completely produced or consumed before or after the subprocess is spawned, depending on options and implementation,
using temporary files. and with priority being given to output processing.
Other streams are completely produced or consumed
before or after the subprocess is spawned, using temporary files.
RUN-PROGRAM returns 3 values: RUN-PROGRAM returns 3 values:
0- the result of the OUTPUT slurping if any, or NIL 0- the result of the OUTPUT slurping if any, or NIL
......
...@@ -16,6 +16,7 @@ ...@@ -16,6 +16,7 @@
(defsystem :uiop (defsystem :uiop
:licence "MIT" :licence "MIT"
:class #.(if (find-class 'package-system nil) 'package-system 'system)
#+asdf3 :long-name #+asdf3 "Utilities for Implementation- and OS- Portability" #+asdf3 :long-name #+asdf3 "Utilities for Implementation- and OS- Portability"
:description "Runtime support for Common Lisp programs" :description "Runtime support for Common Lisp programs"
:long-description "Basic general-purpose utilities that are in such a need :long-description "Basic general-purpose utilities that are in such a need
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment