diff --git a/asdf.asd b/asdf.asd index c611bcd8de9fd20fcdc35fc0a8d4b9133c3dad8e..7e44b522f34a1aee0be7453f7f89c80ea9abf72b 100644 --- a/asdf.asd +++ b/asdf.asd @@ -74,7 +74,7 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "3.0.0" ;; to be automatically updated by make bump-version + :version "3.0.1" ;; to be automatically updated by make bump-version :depends-on () #+asdf3 :encoding #+asdf3 :utf-8 ;; For most purposes, asdf itself specially counts as a builtin system. diff --git a/bin/asdf-builder b/bin/asdf-builder index 55c804c4be9ba19c57254eb07f58f85d2575500b..7526d337b72a8bbfc51e555e6c209155d1e64388 100755 --- a/bin/asdf-builder +++ b/bin/asdf-builder @@ -198,6 +198,7 @@ (assert (first pv)) (assert (second pv)) (unless (third pv) (appendf pv (list 0))) + (unless (fourth pv) (appendf pv (list 0))) (incf (car (last pv))) (unparse-version pv))) diff --git a/component.lisp b/component.lisp index 69ea1dcd0698703600e2e41861697bd482439ce6..34b0e81e1e5b9c2fd1494d0a09ad4bdcaf2cb491 100644 --- a/component.lisp +++ b/component.lisp @@ -272,7 +272,7 @@ another pathname in a degenerate way.")) (version-satisfies (component-version c) version)) (defmethod version-satisfies ((cver string) version) - (version-compatible-p cver version))) + (version<= version cver))) ;;; all sub-components (of a given type) diff --git a/debian/changelog b/debian/changelog index d638d880c9da7003e2f6e9ee589d41094afb51ab..e10bd38a422ed3c5f385be6a0c67e431890bf1f2 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,14 @@ +cl-asdf (2:3.0.1-1) unstable; urgency=low + + ASDF 3.0.1 is an emergency release for better compatibility with Quicklisp. + + * version-satisfies now uses uiop:version<= for comparison, + and does not check for a same major version number, + like version-compatible-p does, which was the + undocumented behavior since ASDF 1. + + -- Francois-Rene Rideau <fare@tunes.org> Mon, 16 May 2013 19:20:28 -0400 + cl-asdf (2:3.0.0-1) unstable; urgency=low ASDF 3.0.0 is the first official release of ASDF 3; @@ -18,7 +29,7 @@ cl-asdf (2:3.0.0-1) unstable; urgency=low * Build cleanup so make and concatenate-source-op create the same asdf.lisp - -- Francois-Rene Rideau <fare@tunes.org> Mon, 05 May 2013 23:57:22 -0400 + -- Francois-Rene Rideau <fare@tunes.org> Mon, 15 May 2013 23:57:22 -0400 cl-asdf (2:2.33-1) unstable; urgency=low diff --git a/debian/patches/Tweaks-for-a-debian-release-of-3.0.0 b/debian/patches/Tweaks-for-a-debian-release-of-3.0.0 deleted file mode 100644 index b04db9fb966afa83615f9fb4c3a72f6918f4bfa9..0000000000000000000000000000000000000000 --- a/debian/patches/Tweaks-for-a-debian-release-of-3.0.0 +++ /dev/null @@ -1,18525 +0,0 @@ -Description: <short summary of the patch> - TODO: Put a short summary on the line above and replace this paragraph - with a longer explanation of this change. Complete the meta-information - with other relevant fields (see below for details). To make it easier, the - information below has been extracted from the changelog. Adjust it or drop - it. - . - cl-asdf (2:3.0.0-1) unstable; urgency=low - . - ASDF 3.0.0 is the first official release of ASDF 3; - ASDF 2.27 to 2.33 were pre-releases. - Since 2.33, the following changes were done: - . - * Portability: have *uninteresting-conditions* be empty by default. - Move stuff to *usual-uninteresting-conditions*, unused by default. - Will make the SBCL team happy. Also, fix tests on ABCL. - Fix regression of program-op on ECL, by implicitly linking in UIOP or ASDF. - . - * UIOP: improvements to slurp-input-stream and thus run-program, - notably accepting T as alias for *standard-output*, - for better backward-compatibility of the deprecated run-shell-command. - New macro with-output-file. - . - * POIU support enhanced with various tweaks. - . - * Build cleanup so make and concatenate-source-op create the same asdf.lisp -Author: Francois-Rene Rideau <fare@tunes.org> - ---- -The information above should follow the Patch Tagging Guidelines, please -checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here -are templates for supplementary fields that you might want to add: - -Origin: <vendor|upstream|other>, <url of original patch> -Bug: <url in upstream bugtracker> -Bug-Debian: http://bugs.debian.org/<bugnumber> -Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber> -Forwarded: <no|not-needed|url proving that it has been forwarded> -Reviewed-By: <name and email of someone who approved the patch> -Last-Update: <YYYY-MM-DD> - ---- cl-asdf-3.0.0.orig/Makefile -+++ cl-asdf-3.0.0/Makefile -@@ -155,7 +155,7 @@ extract-all-tagged-asdf: build/asdf.lisp - # Note that the debian git at git://git.debian.org/git/pkg-common-lisp/cl-asdf.git is stale, - # as we currently build directly from upstream at git://common-lisp.net/projects/asdf/asdf.git - debian-package: mrproper -- : $${RELEASE:="$$(git tag -l '2.[0-9][0-9]' | tail -n 1)"} ; echo building package version $$RELEASE ; \ -+ : $${RELEASE:="$$(git tag -l '3.[0-9].[0-9]' | tail -n 1)"} ; echo building package version $$RELEASE ; \ - git-buildpackage --git-debian-branch=release --git-upstream-branch=release --git-upstream-tag=$$RELEASE --git-tag --git-retag --git-ignore-branch - - # Replace SBCL's ASDF with the current one. -- NOT recommended now that SBCL has ASDF2. ---- cl-asdf-3.0.0.orig/test/test-utilities.script -+++ cl-asdf-3.0.0/test/test-utilities.script -@@ -34,7 +34,11 @@ - (assert - (version-satisfies (asdf-version) (asdf-version))) - (assert -- (version-satisfies (asdf-version) "2.0")) -+ (version-satisfies (asdf-version) "3.0")) -+(assert -+ (not (version-satisfies (asdf-version) "2.0"))) -+(assert -+ (version<= "2.0" (asdf-version))) - (assert - (not (version-satisfies (asdf-version) "666"))) - (assert-pathnames-equal ---- cl-asdf-3.0.0.orig/uiop/run-program.lisp -+++ cl-asdf-3.0.0/uiop/run-program.lisp -@@ -137,7 +137,7 @@ by /bin/sh in POSIX" - ;;;; Slurping a stream, typically the output of another program - (with-upgradability () - (defgeneric slurp-input-stream (processor input-stream &key &allow-other-keys)) -- -+ - #-(or gcl2.6 genera) - (defmethod slurp-input-stream ((function function) input-stream &key &allow-other-keys) - (funcall function input-stream)) ---- /dev/null -+++ cl-asdf-3.0.0/build/asdf.lisp -@@ -0,0 +1,9725 @@ -+;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- -+;;; This is ASDF 3.0.0: Another System Definition Facility. -+;;; -+;;; Feedback, bug reports, and patches are all welcome: -+;;; please mail to <asdf-devel@common-lisp.net>. -+;;; Note first that the canonical source for ASDF is presently -+;;; <URL:http://common-lisp.net/project/asdf/>. -+;;; -+;;; If you obtained this copy from anywhere else, and you experience -+;;; trouble using it, or find bugs, you may want to check at the -+;;; location above for a more recent version (and for documentation -+;;; and test files, if your copy came without them) before reporting -+;;; bugs. There are usually two "supported" revisions - the git master -+;;; branch is the latest development version, whereas the git release -+;;; branch may be slightly older but is considered `stable' -+ -+;;; -- LICENSE START -+;;; (This is the MIT / X Consortium license as taken from -+;;; http://www.opensource.org/licenses/mit-license.html on or about -+;;; Monday; July 13, 2009) -+;;; -+;;; Copyright (c) 2001-2012 Daniel Barlow and contributors -+;;; -+;;; Permission is hereby granted, free of charge, to any person obtaining -+;;; a copy of this software and associated documentation files (the -+;;; "Software"), to deal in the Software without restriction, including -+;;; without limitation the rights to use, copy, modify, merge, publish, -+;;; distribute, sublicense, and/or sell copies of the Software, and to -+;;; permit persons to whom the Software is furnished to do so, subject to -+;;; the following conditions: -+;;; -+;;; The above copyright notice and this permission notice shall be -+;;; included in all copies or substantial portions of the Software. -+;;; -+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND -+;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE -+;;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION -+;;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION -+;;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -+;;; -+;;; -- LICENSE END -+ -+;;; The problem with writing a defsystem replacement is bootstrapping: -+;;; we can't use defsystem to compile it. Hence, all in one file. -+ -+#+xcvb (module ()) -+ -+(in-package :cl-user) -+ -+#+cmu -+(eval-when (:load-toplevel :compile-toplevel :execute) -+ (declaim (optimize (speed 1) (safety 3) (debug 3))) -+ (setf ext:*gc-verbose* nil)) -+ -+#+(or abcl clisp clozure cmu ecl xcl) -+(eval-when (:load-toplevel :compile-toplevel :execute) -+ (unless (member :asdf3 *features*) -+ (let* ((existing-version -+ (when (find-package :asdf) -+ (or (symbol-value (find-symbol (string :*asdf-version*) :asdf)) -+ (let ((ver (symbol-value (find-symbol (string :*asdf-revision*) :asdf)))) -+ (etypecase ver -+ (string ver) -+ (cons (format nil "~{~D~^.~}" ver)) -+ (null "1.0")))))) -+ (first-dot (when existing-version (position #\. existing-version))) -+ (second-dot (when first-dot (position #\. existing-version :start (1+ first-dot)))) -+ (existing-major-minor (subseq existing-version 0 second-dot)) -+ (existing-version-number (and existing-version (read-from-string existing-major-minor))) -+ (away (format nil "~A-~A" :asdf existing-version))) -+ (when (and existing-version (< existing-version-number -+ (or #+abcl 2.25 #+cmu 2.018 #-(or abcl cmu) 2.27))) -+ (rename-package :asdf away) -+ (when *load-verbose* -+ (format t "~&; Renamed old ~A package away to ~A~%" :asdf away)))))) -+ -+;;;; --------------------------------------------------------------------------- -+;;;; Handle ASDF package upgrade, including implementation-dependent magic. -+;; -+;; See https://bugs.launchpad.net/asdf/+bug/485687 -+;; -+ -+(defpackage :uiop/package -+ ;; CAUTION: we must handle the first few packages specially for hot-upgrade. -+ ;; This package definition MUST NOT change unless its name too changes; -+ ;; if/when it changes, don't forget to add new functions missing from below. -+ ;; Until then, asdf/package is frozen to forever -+ ;; 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) -+ (:export -+ #:find-package* #:find-symbol* #:symbol-call -+ #:intern* #:export* #:import* #:shadowing-import* #:shadow* #:make-symbol* #:unintern* -+ #:symbol-shadowing-p #:home-package-p -+ #:symbol-package-name #:standard-common-lisp-symbol-p -+ #:reify-package #:unreify-package #:reify-symbol #:unreify-symbol -+ #:nuke-symbol-in-package #:nuke-symbol #:rehome-symbol -+ #: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)) -+ -+(in-package :uiop/package) -+ -+;;;; General purpose package utilities -+ -+(eval-when (:load-toplevel :compile-toplevel :execute) -+ (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 find-symbol* (name package-designator &optional (error t)) -+ "Find a symbol in a package of given string'ified NAME; -+unless CL:FIND-SYMBOL, work well with 'modern' case sensitive syntax -+by letting you supply a symbol or keyword for the name; -+also works well when the package is not present. -+If optional ERROR argument is NIL, return NIL instead of an error -+when the symbol is not found." -+ (block nil -+ (let ((package (find-package* package-designator error))) -+ (when package ;; package error handled by find-package* already -+ (multiple-value-bind (symbol status) (find-symbol (string name) package) -+ (cond -+ (status (return (values symbol status))) -+ (error (error "There is no symbol ~S in package ~S" name (package-name package)))))) -+ (values nil nil)))) -+ (defun symbol-call (package name &rest args) -+ "Call a function associated with symbol of given name in given package, -+with given ARGS. Useful when the call is read before the package is loaded, -+or when loading the package is optional." -+ (apply (find-symbol* name package) args)) -+ (defun intern* (name package-designator &optional (error t)) -+ (intern (string name) (find-package* package-designator error))) -+ (defun export* (name package-designator) -+ (let* ((package (find-package* package-designator)) -+ (symbol (intern* name package))) -+ (export (or symbol (list symbol)) package))) -+ (defun import* (symbol package-designator) -+ (import (or symbol (list symbol)) (find-package* package-designator))) -+ (defun shadowing-import* (symbol package-designator) -+ (shadowing-import (or symbol (list symbol)) (find-package* package-designator))) -+ (defun shadow* (name package-designator) -+ (shadow (string name) (find-package* package-designator))) -+ (defun make-symbol* (name) -+ (etypecase name -+ (string (make-symbol name)) -+ (symbol (copy-symbol name)))) -+ (defun unintern* (name package-designator &optional (error t)) -+ (block nil -+ (let ((package (find-package* package-designator error))) -+ (when package -+ (multiple-value-bind (symbol status) (find-symbol* name package error) -+ (cond -+ (status (unintern symbol package) -+ (return (values symbol status))) -+ (error (error "symbol ~A not present in package ~A" -+ (string symbol) (package-name package)))))) -+ (values nil nil)))) -+ (defun symbol-shadowing-p (symbol package) -+ (and (member symbol (package-shadowing-symbols package)) t)) -+ (defun home-package-p (symbol package) -+ (and package (let ((sp (symbol-package symbol))) -+ (and sp (let ((pp (find-package* package))) -+ (and pp (eq sp pp)))))))) -+ -+ -+(eval-when (:load-toplevel :compile-toplevel :execute) -+ (defun symbol-package-name (symbol) -+ (let ((package (symbol-package symbol))) -+ (and package (package-name package)))) -+ (defun standard-common-lisp-symbol-p (symbol) -+ (multiple-value-bind (sym status) (find-symbol* symbol :common-lisp nil) -+ (and (eq sym symbol) (eq status :external)))) -+ (defun reify-package (package &optional package-context) -+ (if (eq package package-context) t -+ (etypecase package -+ (null nil) -+ ((eql (find-package :cl)) :cl) -+ (package (package-name package))))) -+ (defun unreify-package (package &optional package-context) -+ (etypecase package -+ (null nil) -+ ((eql t) package-context) -+ ((or symbol string) (find-package package)))) -+ (defun reify-symbol (symbol &optional package-context) -+ (etypecase symbol -+ ((or keyword (satisfies standard-common-lisp-symbol-p)) symbol) -+ (symbol (vector (symbol-name symbol) -+ (reify-package (symbol-package symbol) package-context))))) -+ (defun unreify-symbol (symbol &optional package-context) -+ (etypecase symbol -+ (symbol symbol) -+ ((simple-vector 2) -+ (let* ((symbol-name (svref symbol 0)) -+ (package-foo (svref symbol 1)) -+ (package (unreify-package package-foo package-context))) -+ (if package (intern* symbol-name package) -+ (make-symbol* symbol-name))))))) -+ -+(eval-when (:load-toplevel :compile-toplevel :execute) -+ (defvar *all-package-happiness* '()) -+ (defvar *all-package-fishiness* (list t)) -+ (defun record-fishy (info) -+ ;;(format t "~&FISHY: ~S~%" info) -+ (push info *all-package-fishiness*)) -+ (defmacro when-package-fishiness (&body body) -+ `(when *all-package-fishiness* ,@body)) -+ (defmacro note-package-fishiness (&rest info) -+ `(when-package-fishiness (record-fishy (list ,@info))))) -+ -+(eval-when (:load-toplevel :compile-toplevel :execute) -+ #+(or clisp clozure) -+ (defun get-setf-function-symbol (symbol) -+ #+clisp (let ((sym (get symbol 'system::setf-function))) -+ (if sym (values sym :setf-function) -+ (let ((sym (get symbol 'system::setf-expander))) -+ (if sym (values sym :setf-expander) -+ (values nil nil))))) -+ #+clozure (gethash symbol ccl::%setf-function-names%)) -+ #+(or clisp clozure) -+ (defun set-setf-function-symbol (new-setf-symbol symbol &optional kind) -+ #+clisp (assert (member kind '(:setf-function :setf-expander))) -+ #+clozure (assert (eq kind t)) -+ #+clisp -+ (cond -+ ((null new-setf-symbol) -+ (remprop symbol 'system::setf-function) -+ (remprop symbol 'system::setf-expander)) -+ ((eq kind :setf-function) -+ (setf (get symbol 'system::setf-function) new-setf-symbol)) -+ ((eq kind :setf-expander) -+ (setf (get symbol 'system::setf-expander) new-setf-symbol)) -+ (t (error "invalid kind of setf-function ~S for ~S to be set to ~S" -+ kind symbol new-setf-symbol))) -+ #+clozure -+ (progn -+ (gethash symbol ccl::%setf-function-names%) new-setf-symbol -+ (gethash new-setf-symbol ccl::%setf-function-name-inverses%) symbol)) -+ #+(or clisp clozure) -+ (defun create-setf-function-symbol (symbol) -+ #+clisp (system::setf-symbol symbol) -+ #+clozure (ccl::construct-setf-function-name symbol)) -+ (defun set-dummy-symbol (symbol reason other-symbol) -+ (setf (get symbol 'dummy-symbol) (cons reason other-symbol))) -+ (defun make-dummy-symbol (symbol) -+ (let ((dummy (copy-symbol symbol))) -+ (set-dummy-symbol dummy 'replacing symbol) -+ (set-dummy-symbol symbol 'replaced-by dummy) -+ dummy)) -+ (defun dummy-symbol (symbol) -+ (get symbol 'dummy-symbol)) -+ (defun get-dummy-symbol (symbol) -+ (let ((existing (dummy-symbol symbol))) -+ (if existing (values (cdr existing) (car existing)) -+ (make-dummy-symbol symbol)))) -+ (defun nuke-symbol-in-package (symbol package-designator) -+ (let ((package (find-package* package-designator)) -+ (name (symbol-name symbol))) -+ (multiple-value-bind (sym stat) (find-symbol name package) -+ (when (and (member stat '(:internal :external)) (eq symbol sym)) -+ (if (symbol-shadowing-p symbol package) -+ (shadowing-import* (get-dummy-symbol symbol) package) -+ (unintern* symbol package)))))) -+ (defun nuke-symbol (symbol &optional (packages (list-all-packages))) -+ #+(or clisp clozure) -+ (multiple-value-bind (setf-symbol kind) -+ (get-setf-function-symbol symbol) -+ (when kind (nuke-symbol setf-symbol))) -+ (loop :for p :in packages :do (nuke-symbol-in-package symbol p))) -+ (defun rehome-symbol (symbol package-designator) -+ "Changes the home package of a symbol, also leaving it present in its old home if any" -+ (let* ((name (symbol-name symbol)) -+ (package (find-package* package-designator)) -+ (old-package (symbol-package symbol)) -+ (old-status (and old-package (nth-value 1 (find-symbol name old-package)))) -+ (shadowing (and old-package (symbol-shadowing-p symbol old-package) (make-symbol name)))) -+ (multiple-value-bind (overwritten-symbol overwritten-symbol-status) (find-symbol name package) -+ (unless (eq package old-package) -+ (let ((overwritten-symbol-shadowing-p -+ (and overwritten-symbol-status -+ (symbol-shadowing-p overwritten-symbol package)))) -+ (note-package-fishiness -+ :rehome-symbol name -+ (when old-package (package-name old-package)) old-status (and shadowing t) -+ (package-name package) overwritten-symbol-status overwritten-symbol-shadowing-p) -+ (when old-package -+ (if shadowing -+ (shadowing-import* shadowing old-package)) -+ (unintern* symbol old-package)) -+ (cond -+ (overwritten-symbol-shadowing-p -+ (shadowing-import* symbol package)) -+ (t -+ (when overwritten-symbol-status -+ (unintern* overwritten-symbol package)) -+ (import* symbol package))) -+ (if shadowing -+ (shadowing-import* symbol old-package) -+ (import* symbol old-package)) -+ #+(or clisp clozure) -+ (multiple-value-bind (setf-symbol kind) -+ (get-setf-function-symbol symbol) -+ (when kind -+ (let* ((setf-function (fdefinition setf-symbol)) -+ (new-setf-symbol (create-setf-function-symbol symbol))) -+ (note-package-fishiness -+ :setf-function -+ name (package-name package) -+ (symbol-name setf-symbol) (symbol-package-name setf-symbol) -+ (symbol-name new-setf-symbol) (symbol-package-name new-setf-symbol)) -+ (when (symbol-package setf-symbol) -+ (unintern* setf-symbol (symbol-package setf-symbol))) -+ (setf (fdefinition new-setf-symbol) setf-function) -+ (set-setf-function-symbol new-setf-symbol symbol kind)))) -+ #+(or clisp clozure) -+ (multiple-value-bind (overwritten-setf foundp) -+ (get-setf-function-symbol overwritten-symbol) -+ (when foundp -+ (unintern overwritten-setf))) -+ (when (eq old-status :external) -+ (export* symbol old-package)) -+ (when (eq overwritten-symbol-status :external) -+ (export* symbol package)))) -+ (values overwritten-symbol overwritten-symbol-status)))) -+ (defun ensure-package-unused (package) -+ (loop :for p :in (package-used-by-list package) :do -+ (unuse-package package p))) -+ (defun delete-package* (package &key nuke) -+ (let ((p (find-package package))) -+ (when p -+ (when nuke (do-symbols (s p) (when (home-package-p s p) (nuke-symbol s)))) -+ (ensure-package-unused p) -+ (delete-package package)))) -+ (defun package-names (package) -+ (cons (package-name package) (package-nicknames package))) -+ (defun packages-from-names (names) -+ (remove-duplicates (remove nil (mapcar #'find-package names)) :from-end t)) -+ (defun fresh-package-name (&key (prefix :%TO-BE-DELETED) -+ separator -+ (index (random most-positive-fixnum))) -+ (loop :for i :from index -+ :for n = (format nil "~A~@[~A~D~]" prefix (and (plusp i) (or separator "")) i) -+ :thereis (and (not (find-package n)) n))) -+ (defun rename-package-away (p &rest keys &key prefix &allow-other-keys) -+ (let ((new-name -+ (apply 'fresh-package-name -+ :prefix (or prefix (format nil "__~A__" (package-name p))) keys))) -+ (record-fishy (list :rename-away (package-names p) new-name)) -+ (rename-package p new-name)))) -+ -+ -+;;; Communicable representation of symbol and package information -+ -+(eval-when (:load-toplevel :compile-toplevel :execute) -+ (defun package-definition-form (package-designator -+ &key (nicknamesp t) (usep t) -+ (shadowp t) (shadowing-import-p t) -+ (exportp t) (importp t) internp (error t)) -+ (let* ((package (or (find-package* package-designator error) -+ (return-from package-definition-form nil))) -+ (name (package-name package)) -+ (nicknames (package-nicknames package)) -+ (use (mapcar #'package-name (package-use-list package))) -+ (shadow ()) -+ (shadowing-import (make-hash-table :test 'equal)) -+ (import (make-hash-table :test 'equal)) -+ (export ()) -+ (intern ())) -+ (when package -+ (loop :for sym :being :the :symbols :in package -+ :for status = (nth-value 1 (find-symbol* sym package)) :do -+ (ecase status -+ ((nil :inherited)) -+ ((:internal :external) -+ (let* ((name (symbol-name sym)) -+ (external (eq status :external)) -+ (home (symbol-package sym)) -+ (home-name (package-name home)) -+ (imported (not (eq home package))) -+ (shadowing (symbol-shadowing-p sym package))) -+ (cond -+ ((and shadowing imported) -+ (push name (gethash home-name shadowing-import))) -+ (shadowing -+ (push name shadow)) -+ (imported -+ (push name (gethash home-name import)))) -+ (cond -+ (external -+ (push name export)) -+ (imported) -+ (t (push name intern))))))) -+ (labels ((sort-names (names) -+ (sort names #'string<)) -+ (table-keys (table) -+ (loop :for k :being :the :hash-keys :of table :collect k)) -+ (when-relevant (key value) -+ (when value (list (cons key value)))) -+ (import-options (key table) -+ (loop :for i :in (sort-names (table-keys table)) -+ :collect `(,key ,i ,@(sort-names (gethash i table)))))) -+ `(defpackage ,name -+ ,@(when-relevant :nicknames (and nicknamesp (sort-names nicknames))) -+ (:use ,@(and usep (sort-names use))) -+ ,@(when-relevant :shadow (and shadowp (sort-names shadow))) -+ ,@(import-options :shadowing-import-from (and shadowing-import-p shadowing-import)) -+ ,@(import-options :import-from (and importp import)) -+ ,@(when-relevant :export (and exportp (sort-names export))) -+ ,@(when-relevant :intern (and internp (sort-names intern))))))))) -+ -+ -+;;; ensure-package, define-package -+(eval-when (:load-toplevel :compile-toplevel :execute) -+ (defun ensure-shadowing-import (name to-package from-package shadowed imported) -+ (check-type name string) -+ (check-type to-package package) -+ (check-type from-package package) -+ (check-type shadowed hash-table) -+ (check-type imported hash-table) -+ (let ((import-me (find-symbol* name from-package))) -+ (multiple-value-bind (existing status) (find-symbol name to-package) -+ (cond -+ ((gethash name shadowed) -+ (unless (eq import-me existing) -+ (error "Conflicting shadowings for ~A" name))) -+ (t -+ (setf (gethash name shadowed) t) -+ (setf (gethash name imported) t) -+ (unless (or (null status) -+ (and (member status '(:internal :external)) -+ (eq existing import-me) -+ (symbol-shadowing-p existing to-package))) -+ (note-package-fishiness -+ :shadowing-import name -+ (package-name from-package) -+ (or (home-package-p import-me from-package) (symbol-package-name import-me)) -+ (package-name to-package) status -+ (and status (or (home-package-p existing to-package) (symbol-package-name existing))))) -+ (shadowing-import* import-me to-package)))))) -+ (defun ensure-imported (import-me into-package &optional from-package) -+ (check-type import-me symbol) -+ (check-type into-package package) -+ (check-type from-package (or null package)) -+ (let ((name (symbol-name import-me))) -+ (multiple-value-bind (existing status) (find-symbol name into-package) -+ (cond -+ ((not status) -+ (import* import-me into-package)) -+ ((eq import-me existing)) -+ (t -+ (let ((shadowing-p (symbol-shadowing-p existing into-package))) -+ (note-package-fishiness -+ :ensure-imported name -+ (and from-package (package-name from-package)) -+ (or (home-package-p import-me from-package) (symbol-package-name import-me)) -+ (package-name into-package) -+ status -+ (and status (or (home-package-p existing into-package) (symbol-package-name existing))) -+ shadowing-p) -+ (cond -+ ((or shadowing-p (eq status :inherited)) -+ (shadowing-import* import-me into-package)) -+ (t -+ (unintern* existing into-package) -+ (import* import-me into-package)))))))) -+ (values)) -+ (defun ensure-import (name to-package from-package shadowed imported) -+ (check-type name string) -+ (check-type to-package package) -+ (check-type from-package package) -+ (check-type shadowed hash-table) -+ (check-type imported hash-table) -+ (multiple-value-bind (import-me import-status) (find-symbol name from-package) -+ (when (null import-status) -+ (note-package-fishiness -+ :import-uninterned name (package-name from-package) (package-name to-package)) -+ (setf import-me (intern* name from-package))) -+ (multiple-value-bind (existing status) (find-symbol name to-package) -+ (cond -+ ((and imported (gethash name imported)) -+ (unless (and status (eq import-me existing)) -+ (error "Can't import ~S from both ~S and ~S" -+ name (package-name (symbol-package existing)) (package-name from-package)))) -+ ((gethash name shadowed) -+ (error "Can't both shadow ~S and import it from ~S" name (package-name from-package))) -+ (t -+ (setf (gethash name imported) t)))) -+ (ensure-imported import-me to-package from-package))) -+ (defun ensure-inherited (name symbol to-package from-package mixp shadowed imported inherited) -+ (check-type name string) -+ (check-type symbol symbol) -+ (check-type to-package package) -+ (check-type from-package package) -+ (check-type mixp (member nil t)) ; no cl:boolean on Genera -+ (check-type shadowed hash-table) -+ (check-type imported hash-table) -+ (check-type inherited hash-table) -+ (multiple-value-bind (existing status) (find-symbol name to-package) -+ (let* ((sp (symbol-package symbol)) -+ (in (gethash name inherited)) -+ (xp (and status (symbol-package existing)))) -+ (when (null sp) -+ (note-package-fishiness -+ :import-uninterned name -+ (package-name from-package) (package-name to-package) mixp) -+ (import* symbol from-package) -+ (setf sp (package-name from-package))) -+ (cond -+ ((gethash name shadowed)) -+ (in -+ (unless (equal sp (first in)) -+ (if mixp -+ (ensure-shadowing-import name to-package (second in) shadowed imported) -+ (error "Can't inherit ~S from ~S, it is inherited from ~S" -+ name (package-name sp) (package-name (first in)))))) -+ ((gethash name imported) -+ (unless (eq symbol existing) -+ (error "Can't inherit ~S from ~S, it is imported from ~S" -+ name (package-name sp) (package-name xp)))) -+ (t -+ (setf (gethash name inherited) (list sp from-package)) -+ (when (and status (not (eq sp xp))) -+ (let ((shadowing (symbol-shadowing-p existing to-package))) -+ (note-package-fishiness -+ :inherited name -+ (package-name from-package) -+ (or (home-package-p symbol from-package) (symbol-package-name symbol)) -+ (package-name to-package) -+ (or (home-package-p existing to-package) (symbol-package-name existing))) -+ (if shadowing (ensure-shadowing-import name to-package from-package shadowed imported) -+ (unintern* existing to-package))))))))) -+ (defun ensure-mix (name symbol to-package from-package shadowed imported inherited) -+ (check-type name string) -+ (check-type symbol symbol) -+ (check-type to-package package) -+ (check-type from-package package) -+ (check-type shadowed hash-table) -+ (check-type imported hash-table) -+ (check-type inherited hash-table) -+ (unless (gethash name shadowed) -+ (multiple-value-bind (existing status) (find-symbol name to-package) -+ (let* ((sp (symbol-package symbol)) -+ (im (gethash name imported)) -+ (in (gethash name inherited))) -+ (cond -+ ((or (null status) -+ (and status (eq symbol existing)) -+ (and in (eq sp (first in)))) -+ (ensure-inherited name symbol to-package from-package t shadowed imported inherited)) -+ (in -+ (remhash name inherited) -+ (ensure-shadowing-import name to-package (second in) shadowed imported)) -+ (im -+ (error "Symbol ~S import from ~S~:[~; actually ~:[uninterned~;~:*from ~S~]~] conflicts with existing symbol in ~S~:[~; actually ~:[uninterned~;from ~:*~S~]~]" -+ name (package-name from-package) -+ (home-package-p symbol from-package) (symbol-package-name symbol) -+ (package-name to-package) -+ (home-package-p existing to-package) (symbol-package-name existing))) -+ (t -+ (ensure-inherited name symbol to-package from-package t shadowed imported inherited))))))) -+ (defun recycle-symbol (name recycle exported) -+ (check-type name string) -+ (check-type recycle list) -+ (check-type exported hash-table) -+ (when (gethash name exported) ;; don't bother recycling private symbols -+ (let (recycled foundp) -+ (dolist (r recycle (values recycled foundp)) -+ (multiple-value-bind (symbol status) (find-symbol name r) -+ (when (and status (home-package-p symbol r)) -+ (cond -+ (foundp -+ ;; (nuke-symbol symbol)) -- even simple variable names like O or C will do that. -+ (note-package-fishiness :recycled-duplicate name (package-name foundp) (package-name r))) -+ (t -+ (setf recycled symbol foundp r))))))))) -+ (defun symbol-recycled-p (sym recycle) -+ (check-type sym symbol) -+ (check-type recycle list) -+ (and (member (symbol-package sym) recycle) t)) -+ (defun ensure-symbol (name package intern recycle shadowed imported inherited exported) -+ (check-type name string) -+ (check-type package package) -+ (check-type intern (member nil t)) ; no cl:boolean on Genera -+ (check-type shadowed hash-table) -+ (check-type imported hash-table) -+ (check-type inherited hash-table) -+ (unless (or (gethash name shadowed) -+ (gethash name imported) -+ (gethash name inherited)) -+ (multiple-value-bind (existing status) -+ (find-symbol name package) -+ (multiple-value-bind (recycled previous) (recycle-symbol name recycle exported) -+ (cond -+ ((and status (eq existing recycled) (eq previous package))) -+ (previous -+ (rehome-symbol recycled package)) -+ ((and status (eq package (symbol-package existing)))) -+ (t -+ (when status -+ (note-package-fishiness -+ :ensure-symbol name -+ (reify-package (symbol-package existing) package) -+ status intern) -+ (unintern existing)) -+ (when intern -+ (intern* name package)))))))) -+ (declaim (ftype function ensure-exported)) -+ (defun ensure-exported-to-user (name symbol to-package &optional recycle) -+ (check-type name string) -+ (check-type symbol symbol) -+ (check-type to-package package) -+ (check-type recycle list) -+ (assert (equal name (symbol-name symbol))) -+ (multiple-value-bind (existing status) (find-symbol name to-package) -+ (unless (and status (eq symbol existing)) -+ (let ((accessible -+ (or (null status) -+ (let ((shadowing (symbol-shadowing-p existing to-package)) -+ (recycled (symbol-recycled-p existing recycle))) -+ (unless (and shadowing (not recycled)) -+ (note-package-fishiness -+ :ensure-export name (symbol-package-name symbol) -+ (package-name to-package) -+ (or (home-package-p existing to-package) (symbol-package-name existing)) -+ status shadowing) -+ (if (or (eq status :inherited) shadowing) -+ (shadowing-import* symbol to-package) -+ (unintern existing to-package)) -+ t))))) -+ (when (and accessible (eq status :external)) -+ (ensure-exported name symbol to-package recycle)))))) -+ (defun ensure-exported (name symbol from-package &optional recycle) -+ (dolist (to-package (package-used-by-list from-package)) -+ (ensure-exported-to-user name symbol to-package recycle)) -+ (unless (eq from-package (symbol-package symbol)) -+ (ensure-imported symbol from-package)) -+ (export* name from-package)) -+ (defun ensure-export (name from-package &optional recycle) -+ (multiple-value-bind (symbol status) (find-symbol* name from-package) -+ (unless (eq status :external) -+ (ensure-exported name symbol from-package recycle)))) -+ (defun ensure-package (name &key -+ nicknames documentation use -+ shadow shadowing-import-from -+ import-from export intern -+ recycle mix reexport -+ unintern) -+ #+(or gcl2.6 genera) (declare (ignore documentation)) -+ (let* ((package-name (string name)) -+ (nicknames (mapcar #'string nicknames)) -+ (names (cons package-name nicknames)) -+ (previous (packages-from-names names)) -+ (discarded (cdr previous)) -+ (to-delete ()) -+ (package (or (first previous) (make-package package-name :nicknames nicknames))) -+ (recycle (packages-from-names recycle)) -+ (use (mapcar 'find-package* use)) -+ (mix (mapcar 'find-package* mix)) -+ (reexport (mapcar 'find-package* reexport)) -+ (shadow (mapcar 'string shadow)) -+ (export (mapcar 'string export)) -+ (intern (mapcar 'string intern)) -+ (unintern (mapcar 'string unintern)) -+ (shadowed (make-hash-table :test 'equal)) ; string to bool -+ (imported (make-hash-table :test 'equal)) ; string to bool -+ (exported (make-hash-table :test 'equal)) ; string to bool -+ ;; string to list home package and use package: -+ (inherited (make-hash-table :test 'equal))) -+ (when-package-fishiness (record-fishy package-name)) -+ #-(or gcl2.6 genera) -+ (when documentation (setf (documentation package t) documentation)) -+ (loop :for p :in (set-difference (package-use-list package) (append mix use)) -+ :do (note-package-fishiness :over-use name (package-names p)) -+ (unuse-package p package)) -+ (loop :for p :in discarded -+ :for n = (remove-if #'(lambda (x) (member x names :test 'equal)) -+ (package-names p)) -+ :do (note-package-fishiness :nickname name (package-names p)) -+ (cond (n (rename-package p (first n) (rest n))) -+ (t (rename-package-away p) -+ (push p to-delete)))) -+ (rename-package package package-name nicknames) -+ (dolist (name unintern) -+ (multiple-value-bind (existing status) (find-symbol name package) -+ (when status -+ (unless (eq status :inherited) -+ (note-package-fishiness -+ :unintern (package-name package) name (symbol-package-name existing) status) -+ (unintern* name package nil))))) -+ (dolist (name export) -+ (setf (gethash name exported) t)) -+ (dolist (p reexport) -+ (do-external-symbols (sym p) -+ (setf (gethash (string sym) exported) t))) -+ (do-external-symbols (sym package) -+ (let ((name (symbol-name sym))) -+ (unless (gethash name exported) -+ (note-package-fishiness -+ :over-export (package-name package) name -+ (or (home-package-p sym package) (symbol-package-name sym))) -+ (unexport sym package)))) -+ (dolist (name shadow) -+ (setf (gethash name shadowed) t) -+ (multiple-value-bind (existing status) (find-symbol name package) -+ (multiple-value-bind (recycled previous) (recycle-symbol name recycle exported) -+ (let ((shadowing (and status (symbol-shadowing-p existing package)))) -+ (cond -+ ((eq previous package)) -+ (previous -+ (rehome-symbol recycled package)) -+ ((or (member status '(nil :inherited)) -+ (home-package-p existing package))) -+ (t -+ (let ((dummy (make-symbol name))) -+ (note-package-fishiness -+ :shadow-imported (package-name package) name -+ (symbol-package-name existing) status shadowing) -+ (shadowing-import* dummy package) -+ (import* dummy package))))))) -+ (shadow* name package)) -+ (loop :for (p . syms) :in shadowing-import-from -+ :for pp = (find-package* p) :do -+ (dolist (sym syms) (ensure-shadowing-import (string sym) package pp shadowed imported))) -+ (loop :for p :in mix -+ :for pp = (find-package* p) :do -+ (do-external-symbols (sym pp) (ensure-mix (symbol-name sym) sym package pp shadowed imported inherited))) -+ (loop :for (p . syms) :in import-from -+ :for pp = (find-package p) :do -+ (dolist (sym syms) (ensure-import (symbol-name sym) package pp shadowed imported))) -+ (dolist (p (append use mix)) -+ (do-external-symbols (sym p) (ensure-inherited (string sym) sym package p nil shadowed imported inherited)) -+ (use-package p package)) -+ (loop :for name :being :the :hash-keys :of exported :do -+ (ensure-symbol name package t recycle shadowed imported inherited exported) -+ (ensure-export name package recycle)) -+ (dolist (name intern) -+ (ensure-symbol name package t recycle shadowed imported inherited exported)) -+ (do-symbols (sym package) -+ (ensure-symbol (symbol-name sym) package nil recycle shadowed imported inherited exported)) -+ (map () 'delete-package* to-delete) -+ package))) -+ -+(eval-when (:load-toplevel :compile-toplevel :execute) -+ (defun parse-define-package-form (package clauses) -+ (loop -+ :with use-p = nil :with recycle-p = nil -+ :with documentation = nil -+ :for (kw . args) :in clauses -+ :when (eq kw :nicknames) :append args :into nicknames :else -+ :when (eq kw :documentation) -+ :do (cond -+ (documentation (error "define-package: can't define documentation twice")) -+ ((or (atom args) (cdr args)) (error "define-package: bad documentation")) -+ (t (setf documentation (car args)))) :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 :shadowing-import-from) :collect args :into shadowing-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 :intern) :append args :into intern :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 :reexport) :append args :into reexport :else -+ :when (eq kw :unintern) :append args :into unintern :else -+ :do (error "unrecognized define-package keyword ~S" kw) -+ :finally (return `(,package -+ :nicknames ,nicknames :documentation ,documentation -+ :use ,(if use-p use '(:common-lisp)) -+ :shadow ,shadow :shadowing-import-from ,shadowing-import-from -+ :import-from ,import-from :export ,export :intern ,intern -+ :recycle ,(if recycle-p recycle (cons package nicknames)) -+ :mix ,mix :reexport ,reexport :unintern ,unintern))))) -+ -+(defmacro define-package (package &rest clauses) -+ (let ((ensure-form -+ `(apply 'ensure-package ',(parse-define-package-form package clauses)))) -+ `(progn -+ #+clisp -+ (eval-when (:compile-toplevel :load-toplevel :execute) -+ ,ensure-form) -+ #+(or clisp ecl gcl) (defpackage ,package (:use)) -+ (eval-when (:compile-toplevel :load-toplevel :execute) -+ ,ensure-form)))) -+ -+;;;; Final tricks to keep various implementations happy. -+;; We want most such tricks in common-lisp.lisp, -+;; but these need to be done before the define-package form there, -+;; that we nevertheless want to be the very first form. -+(eval-when (:load-toplevel :compile-toplevel :execute) -+ #+allegro ;; We need to disable autoloading BEFORE any mention of package ASDF. -+ (setf excl::*autoload-package-name-alist* -+ (remove "asdf" excl::*autoload-package-name-alist* -+ :test 'equalp :key 'car)) -+ #+gcl -+ ;; Debian's GCL 2.7 has bugs with compiling multiple-value stuff, -+ ;; but can run ASDF 2.011. GCL 2.6 has even more issues. -+ (cond -+ ((or (< system::*gcl-major-version* 2) -+ (and (= system::*gcl-major-version* 2) -+ (< system::*gcl-minor-version* 6))) -+ (error "GCL 2.6 or later required to use ASDF")) -+ ((and (= system::*gcl-major-version* 2) -+ (= system::*gcl-minor-version* 6)) -+ (pushnew 'ignorable pcl::*variable-declarations-without-argument*) -+ (pushnew :gcl2.6 *features*)) -+ (t -+ (pushnew :gcl2.7 *features*)))) -+ -+;; Compatibility with whoever calls asdf/package -+(define-package :asdf/package (:use :cl :uiop/package) (:reexport :uiop/package)) -+;;;; ------------------------------------------------------------------------- -+;;;; Handle compatibility with multiple implementations. -+;;; This file is for papering over the deficiencies and peculiarities -+;;; of various Common Lisp implementations. -+;;; For implementation-specific access to the system, see os.lisp instead. -+;;; A few functions are defined here, but actually exported from utility; -+;;; from this package only common-lisp symbols are exported. -+ -+(uiop/package:define-package :uiop/common-lisp -+ (:nicknames :uoip/cl :asdf/common-lisp :asdf/cl) -+ (:use #-genera :common-lisp #+genera :future-common-lisp :uiop/package) -+ (:reexport :common-lisp) -+ (:recycle :uiop/common-lisp :uoip/cl :asdf/common-lisp :asdf/cl :asdf) -+ #+allegro (:intern #:*acl-warn-save*) -+ #+cormanlisp (:shadow #:user-homedir-pathname) -+ #+cormanlisp -+ (:export -+ #:logical-pathname #:translate-logical-pathname -+ #:make-broadcast-stream #:file-namestring) -+ #+gcl2.6 (:shadow #:type-of #:with-standard-io-syntax) ; causes errors when loading fasl(!) -+ #+gcl2.6 (:shadowing-import-from :system #:*load-pathname*) -+ #+genera (:shadowing-import-from :scl #:boolean) -+ #+genera (:export #:boolean #:ensure-directories-exist) -+ #+mcl (:shadow #:user-homedir-pathname)) -+(in-package :uiop/common-lisp) -+ -+#-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl) -+(error "ASDF is not supported on your implementation. Please help us port it.") -+ -+;; (declaim (optimize (speed 1) (debug 3) (safety 3))) ; DON'T: trust implementation defaults. -+ -+ -+;;;; Early meta-level tweaks -+ -+#+(or abcl (and allegro ics) (and (or clisp cmu ecl mkcl) unicode) -+ clozure lispworks (and sbcl sb-unicode) scl) -+(eval-when (:load-toplevel :compile-toplevel :execute) -+ (pushnew :asdf-unicode *features*)) -+ -+#+allegro -+(eval-when (:load-toplevel :compile-toplevel :execute) -+ (defparameter *acl-warn-save* -+ (when (boundp 'excl:*warn-on-nested-reader-conditionals*) -+ excl:*warn-on-nested-reader-conditionals*)) -+ (when (boundp 'excl:*warn-on-nested-reader-conditionals*) -+ (setf excl:*warn-on-nested-reader-conditionals* nil)) -+ (setf *print-readably* nil)) -+ -+#+cormanlisp -+(eval-when (:load-toplevel :compile-toplevel :execute) -+ (deftype logical-pathname () nil) -+ (defun make-broadcast-stream () *error-output*) -+ (defun translate-logical-pathname (x) x) -+ (defun user-homedir-pathname (&optional host) -+ (declare (ignore host)) -+ (parse-namestring (format nil "~A\\" (cl:user-homedir-pathname)))) -+ (defun file-namestring (p) -+ (setf p (pathname p)) -+ (format nil "~@[~A~]~@[.~A~]" (pathname-name p) (pathname-type p)))) -+ -+#+ecl -+(eval-when (:load-toplevel :compile-toplevel :execute) -+ (setf *load-verbose* nil) -+ (defun use-ecl-byte-compiler-p () (and (member :ecl-bytecmp *features*) t)) -+ (unless (use-ecl-byte-compiler-p) (require :cmp))) -+ -+#+gcl ;; Debian's GCL 2.7 has bugs with compiling multiple-value stuff, but can run ASDF 2.011 -+(eval-when (:load-toplevel :compile-toplevel :execute) -+ (unless (member :ansi-cl *features*) -+ (error "ASDF only supports GCL in ANSI mode. Aborting.~%")) -+ (setf compiler::*compiler-default-type* (pathname "") -+ compiler::*lsp-ext* "")) -+ -+#+gcl2.6 -+(eval-when (:compile-toplevel :load-toplevel :execute) -+ (shadow 'type-of :uiop/common-lisp) -+ (shadowing-import 'system:*load-pathname* :uiop/common-lisp)) -+ -+#+gcl2.6 -+(eval-when (:compile-toplevel :load-toplevel :execute) -+ (export 'type-of :uiop/common-lisp) -+ (export 'system:*load-pathname* :uiop/common-lisp)) -+ -+#+gcl2.6 ;; Doesn't support either logical-pathnames or output-translations. -+(eval-when (:load-toplevel :compile-toplevel :execute) -+ (defvar *gcl2.6* t) -+ (deftype logical-pathname () nil) -+ (defun type-of (x) (class-name (class-of x))) -+ (defun wild-pathname-p (path) (declare (ignore path)) nil) -+ (defun translate-logical-pathname (x) x) -+ (defvar *compile-file-pathname* nil) -+ (defun pathname-match-p (in-pathname wild-pathname) -+ (declare (ignore in-wildname wild-wildname)) nil) -+ (defun translate-pathname (source from-wildname to-wildname &key) -+ (declare (ignore from-wildname to-wildname)) source) -+ (defun %print-unreadable-object (object stream type identity thunk) -+ (format stream "#<~@[~S ~]" (when type (type-of object))) -+ (funcall thunk) -+ (format stream "~@[ ~X~]>" (when identity (system:address object)))) -+ (defmacro with-standard-io-syntax (&body body) -+ `(progn ,@body)) -+ (defmacro with-compilation-unit (options &body body) -+ (declare (ignore options)) `(progn ,@body)) -+ (defmacro print-unreadable-object ((object stream &key type identity) &body body) -+ `(%print-unreadable-object ,object ,stream ,type ,identity (lambda () ,@body))) -+ (defun ensure-directories-exist (path) -+ (lisp:system (format nil "mkdir -p ~S" -+ (namestring (make-pathname :name nil :type nil :version nil :defaults path)))))) -+ -+#+genera -+(eval-when (:load-toplevel :compile-toplevel :execute) -+ (unless (fboundp 'ensure-directories-exist) -+ (defun ensure-directories-exist (path) -+ (fs:create-directories-recursively (pathname path))))) -+ -+#.(or #+mcl ;; the #$ doesn't work on other lisps, even protected by #+mcl, so we use this trick -+ (read-from-string -+ "(eval-when (:load-toplevel :compile-toplevel :execute) -+ (ccl:define-entry-point (_getenv \"getenv\") ((name :string)) :string) -+ (ccl:define-entry-point (_system \"system\") ((name :string)) :int) -+ ;; Note: ASDF may expect user-homedir-pathname to provide -+ ;; the pathname of the current user's home directory, whereas -+ ;; MCL by default provides the directory from which MCL was started. -+ ;; See http://code.google.com/p/mcl/wiki/Portability -+ (defun user-homedir-pathname () -+ (ccl::findfolder #$kuserdomain #$kCurrentUserFolderType)) -+ (defun probe-posix (posix-namestring) -+ \"If a file exists for the posix namestring, return the pathname\" -+ (ccl::with-cstrs ((cpath posix-namestring)) -+ (ccl::rlet ((is-dir :boolean) -+ (fsref :fsref)) -+ (when (eq #$noerr (#_fspathmakeref cpath fsref is-dir)) -+ (ccl::%path-from-fsref fsref is-dir))))))")) -+ -+#+mkcl -+(eval-when (:load-toplevel :compile-toplevel :execute) -+ (require :cmp) -+ (setq clos::*redefine-class-in-place* t)) ;; Make sure we have strict ANSI class redefinition semantics -+ -+ -+;;;; Looping -+(eval-when (:load-toplevel :compile-toplevel :execute) -+ (defmacro loop* (&rest rest) -+ #-genera `(loop ,@rest) -+ #+genera `(lisp:loop ,@rest))) ;; In genera, CL:LOOP can't destructure, so we use LOOP*. Sigh. -+ -+ -+;;;; compatfmt: avoid fancy format directives when unsupported -+(eval-when (:load-toplevel :compile-toplevel :execute) -+ (defun frob-substrings (string substrings &optional frob) -+ (declare (optimize (speed 0) (safety 3) (debug 3))) -+ (let ((length (length string)) (stream nil)) -+ (labels ((emit-string (x &optional (start 0) (end (length x))) -+ (when (< start end) -+ (unless stream (setf stream (make-string-output-stream))) -+ (write-string x stream :start start :end end))) -+ (emit-substring (start end) -+ (when (and (zerop start) (= end length)) -+ (return-from frob-substrings string)) -+ (emit-string string start end)) -+ (recurse (substrings start end) -+ (cond -+ ((>= start end)) -+ ((null substrings) (emit-substring start end)) -+ (t (let* ((sub-spec (first substrings)) -+ (sub (if (consp sub-spec) (car sub-spec) sub-spec)) -+ (fun (if (consp sub-spec) (cdr sub-spec) frob)) -+ (found (search sub string :start2 start :end2 end)) -+ (more (rest substrings))) -+ (cond -+ (found -+ (recurse more start found) -+ (etypecase fun -+ (null) -+ (string (emit-string fun)) -+ (function (funcall fun sub #'emit-string))) -+ (recurse substrings (+ found (length sub)) end)) -+ (t -+ (recurse more start end)))))))) -+ (recurse substrings 0 length)) -+ (if stream (get-output-stream-string stream) ""))) -+ -+ (defmacro compatfmt (format) -+ #+(or gcl genera) -+ (frob-substrings format `("~3i~_" #+(or genera gcl2.6) ,@'("~@<" "~@;" "~@:>" "~:>"))) -+ #-(or gcl genera) format)) -+ -+ -+;;;; ------------------------------------------------------------------------- -+;;;; General Purpose Utilities for ASDF -+ -+(uiop/package:define-package :uiop/utility -+ (:nicknames :asdf/utility) -+ (:recycle :uiop/utility :asdf/utility :asdf) -+ (:use :uiop/common-lisp :uiop/package) -+ ;; import and reexport a few things defined in :asdf/common-lisp -+ (:import-from :uiop/common-lisp #:compatfmt #:loop* #:frob-substrings -+ #+ecl #:use-ecl-byte-compiler-p #+mcl #:probe-posix) -+ (:export #:compatfmt #:loop* #:frob-substrings #:compatfmt -+ #+ecl #:use-ecl-byte-compiler-p #+mcl #:probe-posix) -+ (:export -+ ;; magic helper to define debugging functions: -+ #:uiop-debug #:load-uiop-debug-utility #:*uiop-debug-utility* -+ #:undefine-function #:undefine-functions #:defun* #:defgeneric* #:with-upgradability ;; (un)defining functions -+ #:if-let ;; basic flow control -+ #:while-collecting #:appendf #:length=n-p #:ensure-list ;; lists -+ #:remove-plist-keys #:remove-plist-key ;; plists -+ #:emptyp ;; sequences -+ #:+non-base-chars-exist-p+ ;; characters -+ #:base-string-p #:strings-common-element-type #:reduce/strcat #:strcat ;; strings -+ #:first-char #:last-char #:split-string -+ #:string-prefix-p #:string-enclosed-p #:string-suffix-p -+ #:find-class* ;; CLOS -+ #:stamp< #:stamps< #:stamp*< #:stamp<= ;; stamps -+ #:earlier-stamp #:stamps-earliest #:earliest-stamp -+ #:later-stamp #:stamps-latest #:latest-stamp #:latest-stamp-f -+ #:list-to-hash-set ;; hash-table -+ #:ensure-function #:access-at #:access-at-count ;; functions -+ #:call-function #:call-functions #:register-hook-function -+ #:match-condition-p #:match-any-condition-p ;; conditions -+ #:call-with-muffled-conditions #:with-muffled-conditions -+ #:lexicographic< #:lexicographic<= -+ #:parse-version #:unparse-version #:version< #:version<= #:version-compatible-p)) ;; version -+(in-package :uiop/utility) -+ -+;;;; Defining functions in a way compatible with hot-upgrade: -+;; DEFUN* and DEFGENERIC* use FMAKUNBOUND to delete any previous fdefinition, -+;; thus replacing the function without warning or error -+;; even if the signature and/or generic-ness of the function has changed. -+;; For a generic function, this invalidates any previous DEFMETHOD. -+(eval-when (:load-toplevel :compile-toplevel :execute) -+ (defun undefine-function (function-spec) -+ (cond -+ ((symbolp function-spec) -+ #+clisp -+ (let ((f (and (fboundp function-spec) (fdefinition function-spec)))) -+ (when (typep f 'clos:standard-generic-function) -+ (loop :for m :in (clos:generic-function-methods f) -+ :do (remove-method f m)))) -+ (fmakunbound function-spec)) -+ ((and (consp function-spec) (eq (car function-spec) 'setf) -+ (consp (cdr function-spec)) (null (cddr function-spec))) -+ #-gcl2.6 (fmakunbound function-spec)) -+ (t (error "bad function spec ~S" function-spec)))) -+ (defun undefine-functions (function-spec-list) -+ (map () 'undefine-function function-spec-list)) -+ (macrolet -+ ((defdef (def* def) -+ `(defmacro ,def* (name formals &rest rest) -+ (destructuring-bind (name &key (supersede t)) -+ (if (or (atom name) (eq (car name) 'setf)) -+ (list name :supersede nil) -+ name) -+ (declare (ignorable supersede)) -+ `(progn -+ ;; undefining the previous function is the portable way -+ ;; of overriding any incompatible previous gf, except on CLISP. -+ ;; We usually try to do it only for the functions that need it, -+ ;; which happens in asdf/upgrade - however, for ECL, we need this hammer, -+ ;; (which causes issues in clisp) -+ ,@(when (or #-clisp supersede #+(or ecl gcl2.7) t) ; XXX -+ `((undefine-function ',name))) -+ #-gcl ; gcl 2.7.0 notinline functions lose secondary return values :-( -+ ,@(when (and #+ecl (symbolp name)) ; fails for setf functions on ecl -+ `((declaim (notinline ,name)))) -+ (,',def ,name ,formals ,@rest)))))) -+ (defdef defgeneric* defgeneric) -+ (defdef defun* defun)) -+ (defmacro with-upgradability ((&optional) &body body) -+ `(eval-when (:compile-toplevel :load-toplevel :execute) -+ ,@(loop :for form :in body :collect -+ (if (consp form) -+ (destructuring-bind (car . cdr) form -+ (case car -+ ((defun) `(defun* ,@cdr)) -+ ((defgeneric) -+ (unless (or #+gcl2.6 (and (consp (car cdr)) (eq 'setf (caar cdr)))) -+ `(defgeneric* ,@cdr))) -+ (otherwise form))) -+ form))))) -+ -+;;; Magic debugging help. See contrib/debug.lisp -+(with-upgradability () -+ (defvar *uiop-debug-utility* -+ '(or (ignore-errors -+ (symbol-call :asdf :system-relative-pathname :uiop "contrib/debug.lisp")) -+ (symbol-call :uiop/pathname :subpathname (user-homedir-pathname) "cl/asdf/uiop/contrib/debug.lisp")) -+ "form that evaluates to the pathname to your favorite debugging utilities") -+ -+ (defmacro uiop-debug (&rest keys) -+ `(eval-when (:compile-toplevel :load-toplevel :execute) -+ (load-uiop-debug-utility ,@keys))) -+ -+ (defun load-uiop-debug-utility (&key package utility-file) -+ (let* ((*package* (if package (find-package package) *package*)) -+ (keyword (read-from-string -+ (format nil ":DBG-~:@(~A~)" (package-name *package*))))) -+ (unless (member keyword *features*) -+ (let* ((utility-file (or utility-file *uiop-debug-utility*)) -+ (file (ignore-errors (probe-file (eval utility-file))))) -+ (if file (load file) -+ (error "Failed to locate debug utility file: ~S" utility-file))))))) -+ -+ -+;;; Flow control -+(with-upgradability () -+ (defmacro if-let (bindings &body (then-form &optional else-form)) ;; from alexandria -+ ;; bindings can be (var form) or ((var1 form1) ...) -+ (let* ((binding-list (if (and (consp bindings) (symbolp (car bindings))) -+ (list bindings) -+ bindings)) -+ (variables (mapcar #'car binding-list))) -+ `(let ,binding-list -+ (if (and ,@variables) -+ ,then-form -+ ,else-form))))) -+ -+;;; List manipulation -+(with-upgradability () -+ (defmacro while-collecting ((&rest collectors) &body body) -+ "COLLECTORS should be a list of names for collections. A collector -+defines a function that, when applied to an argument inside BODY, will -+add its argument to the corresponding collection. Returns multiple values, -+a list for each collection, in order. -+ E.g., -+\(while-collecting \(foo bar\) -+ \(dolist \(x '\(\(a 1\) \(b 2\) \(c 3\)\)\) -+ \(foo \(first x\)\) -+ \(bar \(second x\)\)\)\) -+Returns two values: \(A B C\) and \(1 2 3\)." -+ (let ((vars (mapcar #'(lambda (x) (gensym (symbol-name x))) collectors)) -+ (initial-values (mapcar (constantly nil) collectors))) -+ `(let ,(mapcar #'list vars initial-values) -+ (flet ,(mapcar #'(lambda (c v) `(,c (x) (push x ,v) (values))) collectors vars) -+ ,@body -+ (values ,@(mapcar #'(lambda (v) `(reverse ,v)) vars)))))) -+ -+ (define-modify-macro appendf (&rest args) -+ append "Append onto list") ;; only to be used on short lists. -+ -+ (defun length=n-p (x n) ;is it that (= (length x) n) ? -+ (check-type n (integer 0 *)) -+ (loop -+ :for l = x :then (cdr l) -+ :for i :downfrom n :do -+ (cond -+ ((zerop i) (return (null l))) -+ ((not (consp l)) (return nil))))) -+ -+ (defun ensure-list (x) -+ (if (listp x) x (list x)))) -+ -+ -+;;; remove a key from a plist, i.e. for keyword argument cleanup -+(with-upgradability () -+ (defun remove-plist-key (key plist) -+ "Remove a single key from a plist" -+ (loop* :for (k v) :on plist :by #'cddr -+ :unless (eq k key) -+ :append (list k v))) -+ -+ (defun remove-plist-keys (keys plist) -+ "Remove a list of keys from a plist" -+ (loop* :for (k v) :on plist :by #'cddr -+ :unless (member k keys) -+ :append (list k v)))) -+ -+ -+;;; Sequences -+(with-upgradability () -+ (defun emptyp (x) -+ "Predicate that is true for an empty sequence" -+ (or (null x) (and (vectorp x) (zerop (length x)))))) -+ -+ -+;;; Characters -+(with-upgradability () -+ (defconstant +non-base-chars-exist-p+ (not (subtypep 'character 'base-char))) -+ (when +non-base-chars-exist-p+ (pushnew :non-base-chars-exist-p *features*))) -+ -+ -+;;; Strings -+(with-upgradability () -+ (defun base-string-p (string) -+ (declare (ignorable string)) -+ (and #+non-base-chars-exist-p (eq 'base-char (array-element-type string)))) -+ -+ (defun strings-common-element-type (strings) -+ (declare (ignorable strings)) -+ #-non-base-chars-exist-p 'character -+ #+non-base-chars-exist-p -+ (if (loop :for s :in strings :always (or (null s) (typep s 'base-char) (base-string-p s))) -+ 'base-char 'character)) -+ -+ (defun reduce/strcat (strings &key key start end) -+ "Reduce a list as if by STRCAT, accepting KEY START and END keywords like REDUCE. -+NIL is interpreted as an empty string. A character is interpreted as a string of length one." -+ (when (or start end) (setf strings (subseq strings start end))) -+ (when key (setf strings (mapcar key strings))) -+ (loop :with output = (make-string (loop :for s :in strings :sum (if (characterp s) 1 (length s))) -+ :element-type (strings-common-element-type strings)) -+ :with pos = 0 -+ :for input :in strings -+ :do (etypecase input -+ (null) -+ (character (setf (char output pos) input) (incf pos)) -+ (string (replace output input :start1 pos) (incf pos (length input)))) -+ :finally (return output))) -+ -+ (defun strcat (&rest strings) -+ (reduce/strcat strings)) -+ -+ (defun first-char (s) -+ (and (stringp s) (plusp (length s)) (char s 0))) -+ -+ (defun last-char (s) -+ (and (stringp s) (plusp (length s)) (char s (1- (length s))))) -+ -+ (defun split-string (string &key max (separator '(#\Space #\Tab))) -+ "Split STRING into a list of components separated by -+any of the characters in the sequence SEPARATOR. -+If MAX is specified, then no more than max(1,MAX) components will be returned, -+starting the separation from the end, e.g. when called with arguments -+ \"a.b.c.d.e\" :max 3 :separator \".\" it will return (\"a.b.c\" \"d\" \"e\")." -+ (block () -+ (let ((list nil) (words 0) (end (length string))) -+ (flet ((separatorp (char) (find char separator)) -+ (done () (return (cons (subseq string 0 end) list)))) -+ (loop -+ :for start = (if (and max (>= words (1- max))) -+ (done) -+ (position-if #'separatorp string :end end :from-end t)) -+ :do (when (null start) (done)) -+ (push (subseq string (1+ start) end) list) -+ (incf words) -+ (setf end start)))))) -+ -+ (defun string-prefix-p (prefix string) -+ "Does STRING begin with PREFIX?" -+ (let* ((x (string prefix)) -+ (y (string string)) -+ (lx (length x)) -+ (ly (length y))) -+ (and (<= lx ly) (string= x y :end2 lx)))) -+ -+ (defun string-suffix-p (string suffix) -+ "Does STRING end with SUFFIX?" -+ (let* ((x (string string)) -+ (y (string suffix)) -+ (lx (length x)) -+ (ly (length y))) -+ (and (<= ly lx) (string= x y :start1 (- lx ly))))) -+ -+ (defun string-enclosed-p (prefix string suffix) -+ "Does STRING begin with PREFIX and end with SUFFIX?" -+ (and (string-prefix-p prefix string) -+ (string-suffix-p string suffix)))) -+ -+ -+;;; CLOS -+(with-upgradability () -+ (defun find-class* (x &optional (errorp t) environment) -+ (etypecase x -+ ((or standard-class built-in-class) x) -+ #+gcl2.6 (keyword nil) -+ (symbol (find-class x errorp environment))))) -+ -+ -+;;; stamps: a REAL or boolean where NIL=-infinity, T=+infinity -+(eval-when (#-lispworks :compile-toplevel :load-toplevel :execute) -+ (deftype stamp () '(or real boolean))) -+(with-upgradability () -+ (defun stamp< (x y) -+ (etypecase x -+ (null (and y t)) -+ ((eql t) nil) -+ (real (etypecase y -+ (null nil) -+ ((eql t) t) -+ (real (< x y)))))) -+ (defun stamps< (list) (loop :for y :in list :for x = nil :then y :always (stamp< x y))) -+ (defun stamp*< (&rest list) (stamps< list)) -+ (defun stamp<= (x y) (not (stamp< y x))) -+ (defun earlier-stamp (x y) (if (stamp< x y) x y)) -+ (defun stamps-earliest (list) (reduce 'earlier-stamp list :initial-value t)) -+ (defun earliest-stamp (&rest list) (stamps-earliest list)) -+ (defun later-stamp (x y) (if (stamp< x y) y x)) -+ (defun stamps-latest (list) (reduce 'later-stamp list :initial-value nil)) -+ (defun latest-stamp (&rest list) (stamps-latest list)) -+ (define-modify-macro latest-stamp-f (&rest stamps) latest-stamp)) -+ -+ -+;;; Hash-tables -+(with-upgradability () -+ (defun list-to-hash-set (list &aux (h (make-hash-table :test 'equal))) -+ (dolist (x list h) (setf (gethash x h) t)))) -+ -+ -+;;; Function designators -+(with-upgradability () -+ (defun ensure-function (fun &key (package :cl)) -+ "Coerce the object FUN into a function. -+ -+If FUN is a FUNCTION, return it. -+If the FUN is a non-sequence literal constant, return constantly that, -+i.e. for a boolean keyword character number or pathname. -+Otherwise if FUN is a non-literally constant symbol, return its FDEFINITION. -+If FUN is a CONS, return the function that applies its CAR -+to the appended list of the rest of its CDR and the arguments. -+If FUN is a string, READ a form from it in the specified PACKAGE (default: CL) -+and EVAL that in a (FUNCTION ...) context." -+ (etypecase fun -+ (function fun) -+ ((or boolean keyword character number pathname) (constantly fun)) -+ ((or function symbol) fun) -+ (cons #'(lambda (&rest args) (apply (car fun) (append (cdr fun) args)))) -+ (string (eval `(function ,(with-standard-io-syntax -+ (let ((*package* (find-package package))) -+ (read-from-string fun)))))))) -+ -+ (defun access-at (object at) -+ "Given an OBJECT and an AT specifier, list of successive accessors, -+call each accessor on the result of the previous calls. -+An accessor may be an integer, meaning a call to ELT, -+a keyword, meaning a call to GETF, -+NIL, meaning identity, -+a function or other symbol, meaning itself, -+or a list of a function designator and arguments, interpreted as per ENSURE-FUNCTION. -+As a degenerate case, the AT specifier may be an atom of a single such accessor -+instead of a list." -+ (flet ((access (object accessor) -+ (etypecase accessor -+ (function (funcall accessor object)) -+ (integer (elt object accessor)) -+ (keyword (getf object accessor)) -+ (null object) -+ (symbol (funcall accessor object)) -+ (cons (funcall (ensure-function accessor) object))))) -+ (if (listp at) -+ (dolist (accessor at object) -+ (setf object (access object accessor))) -+ (access object at)))) -+ -+ (defun access-at-count (at) -+ "From an AT specification, extract a COUNT of maximum number -+ of sub-objects to read as per ACCESS-AT" -+ (cond -+ ((integerp at) -+ (1+ at)) -+ ((and (consp at) (integerp (first at))) -+ (1+ (first at))))) -+ -+ (defun call-function (function-spec &rest arguments) -+ (apply (ensure-function function-spec) arguments)) -+ -+ (defun call-functions (function-specs) -+ (map () 'call-function function-specs)) -+ -+ (defun register-hook-function (variable hook &optional call-now-p) -+ (pushnew hook (symbol-value variable)) -+ (when call-now-p (call-function hook)))) -+ -+ -+;;; Version handling -+(with-upgradability () -+ (defun unparse-version (version-list) -+ (format nil "~{~D~^.~}" version-list)) -+ -+ (defun parse-version (version-string &optional on-error) -+ "Parse a VERSION-STRING as a series of natural integers separated by dots. -+Return a (non-null) list of integers if the string is valid; -+otherwise return NIL. -+ -+When invalid, ON-ERROR is called as per CALL-FUNCTION before to return NIL, -+with format arguments explaining why the version is invalid. -+ON-ERROR is also called if the version is not canonical -+in that it doesn't print back to itself, but the list is returned anyway." -+ (block nil -+ (unless (stringp version-string) -+ (call-function on-error "~S: ~S is not a string" 'parse-version version-string) -+ (return)) -+ (unless (loop :for prev = nil :then c :for c :across version-string -+ :always (or (digit-char-p c) -+ (and (eql c #\.) prev (not (eql prev #\.)))) -+ :finally (return (and c (digit-char-p c)))) -+ (call-function on-error "~S: ~S doesn't follow asdf version numbering convention" -+ 'parse-version version-string) -+ (return)) -+ (let* ((version-list -+ (mapcar #'parse-integer (split-string version-string :separator "."))) -+ (normalized-version (unparse-version version-list))) -+ (unless (equal version-string normalized-version) -+ (call-function on-error "~S: ~S contains leading zeros" 'parse-version version-string)) -+ version-list))) -+ -+ (defun lexicographic< (< x y) -+ (cond ((null y) nil) -+ ((null x) t) -+ ((funcall < (car x) (car y)) t) -+ ((funcall < (car y) (car x)) nil) -+ (t (lexicographic< < (cdr x) (cdr y))))) -+ -+ (defun lexicographic<= (< x y) -+ (not (lexicographic< < y x))) -+ -+ (defun version< (version1 version2) -+ (let ((v1 (parse-version version1 nil)) -+ (v2 (parse-version version2 nil))) -+ (lexicographic< '< v1 v2))) -+ -+ (defun version<= (version1 version2) -+ (not (version< version2 version1))) -+ -+ (defun version-compatible-p (provided-version required-version) -+ "Is the provided version a compatible substitution for the required-version? -+If major versions differ, it's not compatible. -+If they are equal, then any later version is compatible, -+with later being determined by a lexicographical comparison of minor numbers." -+ (let ((x (parse-version provided-version nil)) -+ (y (parse-version required-version nil))) -+ (and x y (= (car x) (car y)) (lexicographic<= '< (cdr y) (cdr x)))))) -+ -+ -+;;; Condition control -+ -+(with-upgradability () -+ (defparameter +simple-condition-format-control-slot+ -+ #+abcl 'system::format-control -+ #+allegro 'excl::format-control -+ #+clisp 'system::$format-control -+ #+clozure 'ccl::format-control -+ #+(or cmu scl) 'conditions::format-control -+ #+ecl 'si::format-control -+ #+(or gcl lispworks) 'conditions::format-string -+ #+sbcl 'sb-kernel:format-control -+ #-(or abcl allegro clisp clozure cmu ecl gcl lispworks sbcl scl) nil -+ "Name of the slot for FORMAT-CONTROL in simple-condition") -+ -+ (defun match-condition-p (x condition) -+ "Compare received CONDITION to some pattern X: -+a symbol naming a condition class, -+a simple vector of length 2, arguments to find-symbol* with result as above, -+or a string describing the format-control of a simple-condition." -+ (etypecase x -+ (symbol (typep condition x)) -+ ((simple-vector 2) -+ (ignore-errors (typep condition (find-symbol* (svref x 0) (svref x 1) nil)))) -+ (function (funcall x condition)) -+ (string (and (typep condition 'simple-condition) -+ ;; On SBCL, it's always set and the check triggers a warning -+ #+(or allegro clozure cmu lispworks scl) -+ (slot-boundp condition +simple-condition-format-control-slot+) -+ (ignore-errors (equal (simple-condition-format-control condition) x)))))) -+ -+ (defun match-any-condition-p (condition conditions) -+ "match CONDITION against any of the patterns of CONDITIONS supplied" -+ (loop :for x :in conditions :thereis (match-condition-p x condition))) -+ -+ (defun call-with-muffled-conditions (thunk conditions) -+ (handler-bind ((t #'(lambda (c) (when (match-any-condition-p c conditions) -+ (muffle-warning c))))) -+ (funcall thunk))) -+ -+ (defmacro with-muffled-conditions ((conditions) &body body) -+ `(call-with-muffled-conditions #'(lambda () ,@body) ,conditions))) -+ -+ -+;;;; --------------------------------------------------------------------------- -+;;;; Access to the Operating System -+ -+(uiop/package:define-package :uiop/os -+ (:nicknames :asdf/os) -+ (:recycle :uiop/os :asdf/os :asdf) -+ (:use :uiop/common-lisp :uiop/package :uiop/utility) -+ (:export -+ #:featurep #:os-unix-p #:os-windows-p #:os-genera-p #:detect-os ;; features -+ #:getenv #:getenvp ;; environment variables -+ #:implementation-identifier ;; implementation identifier -+ #:implementation-type #:*implementation-type* -+ #:operating-system #:architecture #:lisp-version-string -+ #:hostname #:getcwd #:chdir -+ ;; Windows shortcut support -+ #:read-null-terminated-string #:read-little-endian -+ #:parse-file-location-info #:parse-windows-shortcut)) -+(in-package :uiop/os) -+ -+;;; Features -+(with-upgradability () -+ (defun featurep (x &optional (*features* *features*)) -+ (cond -+ ((atom x) (and (member x *features*) t)) -+ ((eq :not (car x)) (assert (null (cddr x))) (not (featurep (cadr x)))) -+ ((eq :or (car x)) (some #'featurep (cdr x))) -+ ((eq :and (car x)) (every #'featurep (cdr x))) -+ (t (error "Malformed feature specification ~S" x)))) -+ -+ (defun os-unix-p () -+ (or #+abcl (featurep :unix) -+ #+(and (not abcl) (or unix cygwin darwin)) t)) -+ -+ (defun os-windows-p () -+ (or #+abcl (featurep :windows) -+ #+(and (not (or unix cygwin darwin)) (or win32 windows mswindows mingw32)) t)) -+ -+ (defun os-genera-p () -+ (or #+genera t)) -+ -+ (defun detect-os () -+ (flet ((yes (yes) (pushnew yes *features*)) -+ (no (no) (setf *features* (remove no *features*)))) -+ (cond -+ ((os-unix-p) (yes :os-unix) (no :os-windows) (no :genera)) -+ ((os-windows-p) (yes :os-windows) (no :os-unix) (no :genera)) -+ ((os-genera-p) (no :os-unix) (no :os-windows) (yes :genera)) -+ (t (error "Congratulations for trying XCVB on an operating system~%~ -+that is neither Unix, nor Windows, nor even Genera.~%Now you port it."))))) -+ -+ (detect-os)) -+ -+;;;; Environment variables: getting them, and parsing them. -+ -+(with-upgradability () -+ (defun getenv (x) -+ (declare (ignorable x)) -+ #+(or abcl clisp ecl xcl) (ext:getenv x) -+ #+allegro (sys:getenv x) -+ #+clozure (ccl:getenv x) -+ #+(or cmu scl) (cdr (assoc x ext:*environment-list* :test #'string=)) -+ #+cormanlisp -+ (let* ((buffer (ct:malloc 1)) -+ (cname (ct:lisp-string-to-c-string x)) -+ (needed-size (win:getenvironmentvariable cname buffer 0)) -+ (buffer1 (ct:malloc (1+ needed-size)))) -+ (prog1 (if (zerop (win:getenvironmentvariable cname buffer1 needed-size)) -+ nil -+ (ct:c-string-to-lisp-string buffer1)) -+ (ct:free buffer) -+ (ct:free buffer1))) -+ #+gcl (system:getenv x) -+ #+genera nil -+ #+lispworks (lispworks:environment-variable x) -+ #+mcl (ccl:with-cstrs ((name x)) -+ (let ((value (_getenv name))) -+ (unless (ccl:%null-ptr-p value) -+ (ccl:%get-cstring value)))) -+ #+mkcl (#.(or (find-symbol* 'getenv :si nil) (find-symbol* 'getenv :mk-ext nil)) x) -+ #+sbcl (sb-ext:posix-getenv x) -+ #-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl) -+ (error "~S is not supported on your implementation" 'getenv)) -+ -+ (defun getenvp (x) -+ "Predicate that is true if the named variable is present in the libc environment, -+then returning the non-empty string value of the variable" -+ (let ((g (getenv x))) (and (not (emptyp g)) g)))) -+ -+ -+;;;; implementation-identifier -+;; -+;; produce a string to identify current implementation. -+;; Initially stolen from SLIME's SWANK, completely rewritten since. -+;; We're back to runtime checking, for the sake of e.g. ABCL. -+ -+(with-upgradability () -+ (defun first-feature (feature-sets) -+ (dolist (x feature-sets) -+ (multiple-value-bind (short long feature-expr) -+ (if (consp x) -+ (values (first x) (second x) (cons :or (rest x))) -+ (values x x x)) -+ (when (featurep feature-expr) -+ (return (values short long)))))) -+ -+ (defun implementation-type () -+ (first-feature -+ '(:abcl (:acl :allegro) (:ccl :clozure) :clisp (:corman :cormanlisp) -+ (:cmu :cmucl :cmu) :ecl :gcl -+ (:lwpe :lispworks-personal-edition) (:lw :lispworks) -+ :mcl :mkcl :sbcl :scl (:smbx :symbolics) :xcl))) -+ -+ (defvar *implementation-type* (implementation-type)) -+ -+ (defun operating-system () -+ (first-feature -+ '(:cygwin (:win :windows :mswindows :win32 :mingw32) ;; try cygwin first! -+ (:linux :linux :linux-target) ;; for GCL at least, must appear before :bsd -+ (:macosx :macosx :darwin :darwin-target :apple) ; also before :bsd -+ (:solaris :solaris :sunos) (:bsd :bsd :freebsd :netbsd :openbsd) :unix -+ :genera))) -+ -+ (defun architecture () -+ (first-feature -+ '((:x64 :x86-64 :x86_64 :x8664-target :amd64 (:and :word-size=64 :pc386)) -+ (:x86 :x86 :i386 :i486 :i586 :i686 :pentium3 :pentium4 :pc386 :iapx386 :x8632-target) -+ (:ppc64 :ppc64 :ppc64-target) (:ppc32 :ppc32 :ppc32-target :ppc :powerpc) -+ :hppa64 :hppa :sparc64 (:sparc32 :sparc32 :sparc) -+ :mipsel :mipseb :mips :alpha (:arm :arm :arm-target) :imach -+ ;; Java comes last: if someone uses C via CFFI or otherwise JNA or JNI, -+ ;; we may have to segregate the code still by architecture. -+ (:java :java :java-1.4 :java-1.5 :java-1.6 :java-1.7)))) -+ -+ #+clozure -+ (defun ccl-fasl-version () -+ ;; the fasl version is target-dependent from CCL 1.8 on. -+ (or (let ((s 'ccl::target-fasl-version)) -+ (and (fboundp s) (funcall s))) -+ (and (boundp 'ccl::fasl-version) -+ (symbol-value 'ccl::fasl-version)) -+ (error "Can't determine fasl version."))) -+ -+ (defun lisp-version-string () -+ (let ((s (lisp-implementation-version))) -+ (car ; as opposed to OR, this idiom prevents some unreachable code warning -+ (list -+ #+allegro -+ (format nil "~A~@[~A~]~@[~A~]~@[~A~]" -+ excl::*common-lisp-version-number* -+ ;; M means "modern", as opposed to ANSI-compatible mode (which I consider default) -+ (and (eq excl:*current-case-mode* :case-sensitive-lower) "M") -+ ;; Note if not using International ACL -+ ;; see http://www.franz.com/support/documentation/8.1/doc/operators/excl/ics-target-case.htm -+ (excl:ics-target-case (:-ics "8")) -+ (and (member :smp *features*) "S")) -+ #+armedbear (format nil "~a-fasl~a" s system::*fasl-version*) -+ #+clisp -+ (subseq s 0 (position #\space s)) ; strip build information (date, etc.) -+ #+clozure -+ (format nil "~d.~d-f~d" ; shorten for windows -+ ccl::*openmcl-major-version* -+ ccl::*openmcl-minor-version* -+ (logand (ccl-fasl-version) #xFF)) -+ #+cmu (substitute #\- #\/ s) -+ #+scl (format nil "~A~A" s -+ ;; ANSI upper case vs lower case. -+ (ecase ext:*case-mode* (:upper "") (:lower "l"))) -+ #+ecl (format nil "~A~@[-~A~]" s -+ (let ((vcs-id (ext:lisp-implementation-vcs-id))) -+ (subseq vcs-id 0 (min (length vcs-id) 8)))) -+ #+gcl (subseq s (1+ (position #\space s))) -+ #+genera -+ (multiple-value-bind (major minor) (sct:get-system-version "System") -+ (format nil "~D.~D" major minor)) -+ #+mcl (subseq s 8) ; strip the leading "Version " -+ s)))) -+ -+ (defun implementation-identifier () -+ (substitute-if -+ #\_ #'(lambda (x) (find x " /:;&^\\|?<>(){}[]$#`'\"")) -+ (format nil "~(~a~@{~@[-~a~]~}~)" -+ (or (implementation-type) (lisp-implementation-type)) -+ (or (lisp-version-string) (lisp-implementation-version)) -+ (or (operating-system) (software-type)) -+ (or (architecture) (machine-type)))))) -+ -+ -+;;;; Other system information -+ -+(with-upgradability () -+ (defun hostname () -+ ;; Note: untested on RMCL -+ #+(or abcl clozure cmu ecl genera lispworks mcl mkcl sbcl scl xcl) (machine-instance) -+ #+cormanlisp "localhost" ;; is there a better way? Does it matter? -+ #+allegro (symbol-call :excl.osi :gethostname) -+ #+clisp (first (split-string (machine-instance) :separator " ")) -+ #+gcl (system:gethostname))) -+ -+ -+;;; Current directory -+(with-upgradability () -+ -+ #+cmu -+ (defun parse-unix-namestring* (unix-namestring) -+ (multiple-value-bind (host device directory name type version) -+ (lisp::parse-unix-namestring unix-namestring 0 (length unix-namestring)) -+ (make-pathname :host (or host lisp::*unix-host*) :device device -+ :directory directory :name name :type type :version version))) -+ -+ (defun getcwd () -+ "Get the current working directory as per POSIX getcwd(3), as a pathname object" -+ (or #+abcl (parse-namestring -+ (java:jstatic "getProperty" "java.lang.System" "user.dir") :ensure-directory t) -+ #+allegro (excl::current-directory) -+ #+clisp (ext:default-directory) -+ #+clozure (ccl:current-directory) -+ #+(or cmu scl) (#+cmu parse-unix-namestring* #+scl lisp::parse-unix-namestring -+ (strcat (nth-value 1 (unix:unix-current-directory)) "/")) -+ #+cormanlisp (pathname (pl::get-current-directory)) ;; Q: what type does it return? -+ #+ecl (ext:getcwd) -+ #+gcl (parse-namestring ;; this is a joke. Isn't there a better way? -+ (first (symbol-call :uiop :run-program '("/bin/pwd") :output :lines))) -+ #+genera *default-pathname-defaults* ;; on a Lisp OS, it *is* canonical! -+ #+lispworks (system:current-directory) -+ #+mkcl (mk-ext:getcwd) -+ #+sbcl (sb-ext:parse-native-namestring (sb-unix:posix-getcwd/)) -+ #+xcl (extensions:current-directory) -+ (error "getcwd not supported on your implementation"))) -+ -+ (defun chdir (x) -+ "Change current directory, as per POSIX chdir(2), to a given pathname object" -+ (if-let (x (pathname x)) -+ (or #+abcl (java:jstatic "setProperty" "java.lang.System" "user.dir" (namestring x)) -+ #+allegro (excl:chdir x) -+ #+clisp (ext:cd x) -+ #+clozure (setf (ccl:current-directory) x) -+ #+(or cmu scl) (unix:unix-chdir (ext:unix-namestring x)) -+ #+cormanlisp (unless (zerop (win32::_chdir (namestring x))) -+ (error "Could not set current directory to ~A" x)) -+ #+ecl (ext:chdir x) -+ #+genera (setf *default-pathname-defaults* x) -+ #+lispworks (hcl:change-directory x) -+ #+mkcl (mk-ext:chdir x) -+ #+sbcl (symbol-call :sb-posix :chdir (sb-ext:native-namestring x)) -+ (error "chdir not supported on your implementation"))))) -+ -+ -+;;;; ----------------------------------------------------------------- -+;;;; Windows shortcut support. Based on: -+;;;; -+;;;; Jesse Hager: The Windows Shortcut File Format. -+;;;; http://www.wotsit.org/list.asp?fc=13 -+ -+#-(or clisp genera) ; CLISP doesn't need it, and READ-SEQUENCE annoys old Genera. -+(with-upgradability () -+ (defparameter *link-initial-dword* 76) -+ (defparameter *link-guid* #(1 20 2 0 0 0 0 0 192 0 0 0 0 0 0 70)) -+ -+ (defun read-null-terminated-string (s) -+ (with-output-to-string (out) -+ (loop :for code = (read-byte s) -+ :until (zerop code) -+ :do (write-char (code-char code) out)))) -+ -+ (defun read-little-endian (s &optional (bytes 4)) -+ (loop :for i :from 0 :below bytes -+ :sum (ash (read-byte s) (* 8 i)))) -+ -+ (defun parse-file-location-info (s) -+ (let ((start (file-position s)) -+ (total-length (read-little-endian s)) -+ (end-of-header (read-little-endian s)) -+ (fli-flags (read-little-endian s)) -+ (local-volume-offset (read-little-endian s)) -+ (local-offset (read-little-endian s)) -+ (network-volume-offset (read-little-endian s)) -+ (remaining-offset (read-little-endian s))) -+ (declare (ignore total-length end-of-header local-volume-offset)) -+ (unless (zerop fli-flags) -+ (cond -+ ((logbitp 0 fli-flags) -+ (file-position s (+ start local-offset))) -+ ((logbitp 1 fli-flags) -+ (file-position s (+ start -+ network-volume-offset -+ #x14)))) -+ (strcat (read-null-terminated-string s) -+ (progn -+ (file-position s (+ start remaining-offset)) -+ (read-null-terminated-string s)))))) -+ -+ (defun parse-windows-shortcut (pathname) -+ (with-open-file (s pathname :element-type '(unsigned-byte 8)) -+ (handler-case -+ (when (and (= (read-little-endian s) *link-initial-dword*) -+ (let ((header (make-array (length *link-guid*)))) -+ (read-sequence header s) -+ (equalp header *link-guid*))) -+ (let ((flags (read-little-endian s))) -+ (file-position s 76) ;skip rest of header -+ (when (logbitp 0 flags) -+ ;; skip shell item id list -+ (let ((length (read-little-endian s 2))) -+ (file-position s (+ length (file-position s))))) -+ (cond -+ ((logbitp 1 flags) -+ (parse-file-location-info s)) -+ (t -+ (when (logbitp 2 flags) -+ ;; skip description string -+ (let ((length (read-little-endian s 2))) -+ (file-position s (+ length (file-position s))))) -+ (when (logbitp 3 flags) -+ ;; finally, our pathname -+ (let* ((length (read-little-endian s 2)) -+ (buffer (make-array length))) -+ (read-sequence buffer s) -+ (map 'string #'code-char buffer))))))) -+ (end-of-file (c) -+ (declare (ignore c)) -+ nil))))) -+ -+ -+;;;; ------------------------------------------------------------------------- -+;;;; Portability layer around Common Lisp pathnames -+;; This layer allows for portable manipulation of pathname objects themselves, -+;; which all is necessary prior to any access the filesystem or environment. -+ -+(uiop/package:define-package :uiop/pathname -+ (:nicknames :asdf/pathname) -+ (:recycle :uiop/pathname :asdf/pathname :asdf) -+ (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/os) -+ (:export -+ ;; Making and merging pathnames, portably -+ #:normalize-pathname-directory-component #:denormalize-pathname-directory-component -+ #:merge-pathname-directory-components #:*unspecific-pathname-type* #:make-pathname* -+ #:make-pathname-component-logical #:make-pathname-logical -+ #:merge-pathnames* -+ #:nil-pathname #:*nil-pathname* #:with-pathname-defaults -+ ;; Predicates -+ #:pathname-equal #:logical-pathname-p #:physical-pathname-p -+ #:absolute-pathname-p #:relative-pathname-p #:hidden-pathname-p #:file-pathname-p -+ ;; Directories -+ #:pathname-directory-pathname #:pathname-parent-directory-pathname -+ #:directory-pathname-p #:ensure-directory-pathname -+ ;; Parsing filenames -+ #:component-name-to-pathname-components -+ #:split-name-type #:parse-unix-namestring #:unix-namestring -+ #:split-unix-namestring-directory-components -+ ;; Absolute and relative pathnames -+ #:subpathname #:subpathname* -+ #:ensure-absolute-pathname -+ #:pathname-root #:pathname-host-pathname -+ #:subpathp -+ ;; Checking constraints -+ #:ensure-pathname ;; implemented in filesystem.lisp to accommodate for existence constraints -+ ;; Wildcard pathnames -+ #:*wild* #:*wild-file* #:*wild-directory* #:*wild-inferiors* #:*wild-path* #:wilden -+ ;; Translate a pathname -+ #:relativize-directory-component #:relativize-pathname-directory -+ #:directory-separator-for-host #:directorize-pathname-host-device -+ #:translate-pathname* -+ #:*output-translation-function*)) -+(in-package :uiop/pathname) -+ -+;;; Normalizing pathnames across implementations -+ -+(with-upgradability () -+ (defun normalize-pathname-directory-component (directory) -+ "Given a pathname directory component, return an equivalent form that is a list" -+ #+gcl2.6 (setf directory (substitute :back :parent directory)) -+ (cond -+ #-(or cmu sbcl scl) ;; these implementations already normalize directory components. -+ ((stringp directory) `(:absolute ,directory)) -+ #+gcl2.6 -+ ((and (consp directory) (eq :root (first directory))) -+ `(:absolute ,@(rest directory))) -+ ((or (null directory) -+ (and (consp directory) (member (first directory) '(:absolute :relative)))) -+ directory) -+ #+gcl2.6 -+ ((consp directory) -+ `(:relative ,@directory)) -+ (t -+ (error (compatfmt "~@<Unrecognized pathname directory component ~S~@:>") directory)))) -+ -+ (defun denormalize-pathname-directory-component (directory-component) -+ #-gcl2.6 directory-component -+ #+gcl2.6 -+ (let ((d (substitute-if :parent (lambda (x) (member x '(:up :back))) -+ directory-component))) -+ (cond -+ ((and (consp d) (eq :relative (first d))) (rest d)) -+ ((and (consp d) (eq :absolute (first d))) `(:root ,@(rest d))) -+ (t d)))) -+ -+ (defun merge-pathname-directory-components (specified defaults) -+ ;; Helper for merge-pathnames* that handles directory components. -+ (let ((directory (normalize-pathname-directory-component specified))) -+ (ecase (first directory) -+ ((nil) defaults) -+ (:absolute specified) -+ (:relative -+ (let ((defdir (normalize-pathname-directory-component defaults)) -+ (reldir (cdr directory))) -+ (cond -+ ((null defdir) -+ directory) -+ ((not (eq :back (first reldir))) -+ (append defdir reldir)) -+ (t -+ (loop :with defabs = (first defdir) -+ :with defrev = (reverse (rest defdir)) -+ :while (and (eq :back (car reldir)) -+ (or (and (eq :absolute defabs) (null defrev)) -+ (stringp (car defrev)))) -+ :do (pop reldir) (pop defrev) -+ :finally (return (cons defabs (append (reverse defrev) reldir))))))))))) -+ -+ ;; Giving :unspecific as :type argument to make-pathname is not portable. -+ ;; See CLHS make-pathname and 19.2.2.2.3. -+ ;; This will be :unspecific if supported, or NIL if not. -+ (defparameter *unspecific-pathname-type* -+ #+(or abcl allegro clozure cmu gcl genera lispworks mkcl sbcl scl xcl) :unspecific -+ #+(or clisp ecl #|These haven't been tested:|# cormanlisp mcl) nil) -+ -+ (defun make-pathname* (&rest keys &key (directory nil #+gcl2.6 directoryp) -+ host (device () #+allegro devicep) name type version defaults -+ #+scl &allow-other-keys) -+ "Takes arguments like CL:MAKE-PATHNAME in the CLHS, and -+ tries hard to make a pathname that will actually behave as documented, -+ despite the peculiarities of each implementation" -+ (declare (ignorable host device directory name type version defaults)) -+ (apply 'make-pathname -+ (append -+ #+allegro (when (and devicep (null device)) `(:device :unspecific)) -+ #+gcl2.6 -+ (when directoryp -+ `(:directory ,(denormalize-pathname-directory-component directory))) -+ keys))) -+ -+ (defun make-pathname-component-logical (x) -+ "Make a pathname component suitable for use in a logical-pathname" -+ (typecase x -+ ((eql :unspecific) nil) -+ #+clisp (string (string-upcase x)) -+ #+clisp (cons (mapcar 'make-pathname-component-logical x)) -+ (t x))) -+ -+ (defun make-pathname-logical (pathname host) -+ "Take a PATHNAME's directory, name, type and version components, -+and make a new pathname with corresponding components and specified logical HOST" -+ (make-pathname* -+ :host host -+ :directory (make-pathname-component-logical (pathname-directory pathname)) -+ :name (make-pathname-component-logical (pathname-name pathname)) -+ :type (make-pathname-component-logical (pathname-type pathname)) -+ :version (make-pathname-component-logical (pathname-version pathname)))) -+ -+ (defun merge-pathnames* (specified &optional (defaults *default-pathname-defaults*)) -+ "MERGE-PATHNAMES* is like MERGE-PATHNAMES except that -+if the SPECIFIED pathname does not have an absolute directory, -+then the HOST and DEVICE both come from the DEFAULTS, whereas -+if the SPECIFIED pathname does have an absolute directory, -+then the HOST and DEVICE both come from the SPECIFIED. -+This is what users want on a modern Unix or Windows operating system, -+unlike the MERGE-PATHNAME behavior. -+Also, if either argument is NIL, then the other argument is returned unmodified; -+this is unlike MERGE-PATHNAME which always merges with a pathname, -+by default *DEFAULT-PATHNAME-DEFAULTS*, which cannot be NIL." -+ (when (null specified) (return-from merge-pathnames* defaults)) -+ (when (null defaults) (return-from merge-pathnames* specified)) -+ #+scl -+ (ext:resolve-pathname specified defaults) -+ #-scl -+ (let* ((specified (pathname specified)) -+ (defaults (pathname defaults)) -+ (directory (normalize-pathname-directory-component (pathname-directory specified))) -+ (name (or (pathname-name specified) (pathname-name defaults))) -+ (type (or (pathname-type specified) (pathname-type defaults))) -+ (version (or (pathname-version specified) (pathname-version defaults)))) -+ (labels ((unspecific-handler (p) -+ (if (typep p 'logical-pathname) #'make-pathname-component-logical #'identity))) -+ (multiple-value-bind (host device directory unspecific-handler) -+ (ecase (first directory) -+ ((:absolute) -+ (values (pathname-host specified) -+ (pathname-device specified) -+ directory -+ (unspecific-handler specified))) -+ ((nil :relative) -+ (values (pathname-host defaults) -+ (pathname-device defaults) -+ (merge-pathname-directory-components directory (pathname-directory defaults)) -+ (unspecific-handler defaults)))) -+ (make-pathname* :host host :device device :directory directory -+ :name (funcall unspecific-handler name) -+ :type (funcall unspecific-handler type) -+ :version (funcall unspecific-handler version)))))) -+ -+ (defun nil-pathname (&optional (defaults *default-pathname-defaults*)) -+ "A pathname that is as neutral as possible for use as defaults -+ when merging, making or parsing pathnames" -+ ;; 19.2.2.2.1 says a NIL host can mean a default host; -+ ;; see also "valid physical pathname host" in the CLHS glossary, that suggests -+ ;; strings and lists of strings or :unspecific -+ ;; But CMUCL decides to die on NIL. -+ #.`(make-pathname* :directory nil :name nil :type nil :version nil :device nil -+ :host (or #+cmu lisp::*unix-host*) -+ #+scl ,@'(:scheme nil :scheme-specific-part nil -+ :username nil :password nil :parameters nil :query nil :fragment nil) -+ ;; the default shouldn't matter, but we really want something physical -+ :defaults defaults)) -+ -+ (defvar *nil-pathname* (nil-pathname (translate-logical-pathname (user-homedir-pathname)))) -+ -+ (defmacro with-pathname-defaults ((&optional defaults) &body body) -+ `(let ((*default-pathname-defaults* ,(or defaults '*nil-pathname*))) ,@body))) -+ -+ -+;;; Some pathname predicates -+(with-upgradability () -+ (defun pathname-equal (p1 p2) -+ (when (stringp p1) (setf p1 (pathname p1))) -+ (when (stringp p2) (setf p2 (pathname p2))) -+ (flet ((normalize-component (x) -+ (unless (member x '(nil :unspecific :newest (:relative)) :test 'equal) -+ x))) -+ (macrolet ((=? (&rest accessors) -+ (flet ((frob (x) -+ (reduce 'list (cons 'normalize-component accessors) -+ :initial-value x :from-end t))) -+ `(equal ,(frob 'p1) ,(frob 'p2))))) -+ (or (and (null p1) (null p2)) -+ (and (pathnamep p1) (pathnamep p2) -+ (and (=? pathname-host) -+ (=? pathname-device) -+ (=? normalize-pathname-directory-component pathname-directory) -+ (=? pathname-name) -+ (=? pathname-type) -+ (=? pathname-version))))))) -+ -+ (defun logical-pathname-p (x) -+ (typep x 'logical-pathname)) -+ -+ (defun physical-pathname-p (x) -+ (and (pathnamep x) (not (logical-pathname-p x)))) -+ -+ (defun absolute-pathname-p (pathspec) -+ "If PATHSPEC is a pathname or namestring object that parses as a pathname -+possessing an :ABSOLUTE directory component, return the (parsed) pathname. -+Otherwise return NIL" -+ (and pathspec -+ (typep pathspec '(or null pathname string)) -+ (let ((pathname (pathname pathspec))) -+ (and (eq :absolute (car (normalize-pathname-directory-component -+ (pathname-directory pathname)))) -+ pathname)))) -+ -+ (defun relative-pathname-p (pathspec) -+ "If PATHSPEC is a pathname or namestring object that parses as a pathname -+possessing a :RELATIVE or NIL directory component, return the (parsed) pathname. -+Otherwise return NIL" -+ (and pathspec -+ (typep pathspec '(or null pathname string)) -+ (let* ((pathname (pathname pathspec)) -+ (directory (normalize-pathname-directory-component -+ (pathname-directory pathname)))) -+ (when (or (null directory) (eq :relative (car directory))) -+ pathname)))) -+ -+ (defun hidden-pathname-p (pathname) -+ "Return a boolean that is true if the pathname is hidden as per Unix style, -+i.e. its name starts with a dot." -+ (and pathname (equal (first-char (pathname-name pathname)) #\.))) -+ -+ (defun file-pathname-p (pathname) -+ "Does PATHNAME represent a file, i.e. has a non-null NAME component? -+ -+Accepts NIL, a string (converted through PARSE-NAMESTRING) or a PATHNAME. -+ -+Note that this does _not_ check to see that PATHNAME points to an -+actually-existing file. -+ -+Returns the (parsed) PATHNAME when true" -+ (when pathname -+ (let* ((pathname (pathname pathname)) -+ (name (pathname-name pathname))) -+ (when (not (member name '(nil :unspecific "") :test 'equal)) -+ pathname))))) -+ -+ -+;;; Directory pathnames -+(with-upgradability () -+ (defun pathname-directory-pathname (pathname) -+ "Returns a new pathname with same HOST, DEVICE, DIRECTORY as PATHNAME, -+and NIL NAME, TYPE and VERSION components" -+ (when pathname -+ (make-pathname :name nil :type nil :version nil :defaults pathname))) -+ -+ (defun pathname-parent-directory-pathname (pathname) -+ "Returns a new pathname that corresponds to the parent of the current pathname's directory, -+i.e. removing one level of depth in the DIRECTORY component. e.g. if pathname is -+Unix pathname /foo/bar/baz/file.type then return /foo/bar/" -+ (when pathname -+ (make-pathname* :name nil :type nil :version nil -+ :directory (merge-pathname-directory-components -+ '(:relative :back) (pathname-directory pathname)) -+ :defaults pathname))) -+ -+ (defun directory-pathname-p (pathname) -+ "Does PATHNAME represent a directory? -+ -+A directory-pathname is a pathname _without_ a filename. The three -+ways that the filename components can be missing are for it to be NIL, -+:UNSPECIFIC or the empty string. -+ -+Note that this does _not_ check to see that PATHNAME points to an -+actually-existing directory." -+ (when pathname -+ (let ((pathname (pathname pathname))) -+ (flet ((check-one (x) -+ (member x '(nil :unspecific "") :test 'equal))) -+ (and (not (wild-pathname-p pathname)) -+ (check-one (pathname-name pathname)) -+ (check-one (pathname-type pathname)) -+ t))))) -+ -+ (defun ensure-directory-pathname (pathspec &optional (on-error 'error)) -+ "Converts the non-wild pathname designator PATHSPEC to directory form." -+ (cond -+ ((stringp pathspec) -+ (ensure-directory-pathname (pathname pathspec))) -+ ((not (pathnamep pathspec)) -+ (call-function on-error (compatfmt "~@<Invalid pathname designator ~S~@:>") pathspec)) -+ ((wild-pathname-p pathspec) -+ (call-function on-error (compatfmt "~@<Can't reliably convert wild pathname ~3i~_~S~@:>") pathspec)) -+ ((directory-pathname-p pathspec) -+ pathspec) -+ (t -+ (make-pathname* :directory (append (or (normalize-pathname-directory-component -+ (pathname-directory pathspec)) -+ (list :relative)) -+ (list (file-namestring pathspec))) -+ :name nil :type nil :version nil :defaults pathspec))))) -+ -+ -+;;; Parsing filenames -+(with-upgradability () -+ (defun split-unix-namestring-directory-components -+ (unix-namestring &key ensure-directory dot-dot) -+ "Splits the path string UNIX-NAMESTRING, returning four values: -+A flag that is either :absolute or :relative, indicating -+ how the rest of the values are to be interpreted. -+A directory path --- a list of strings and keywords, suitable for -+ use with MAKE-PATHNAME when prepended with the flag value. -+ Directory components with an empty name or the name . are removed. -+ Any directory named .. is read as DOT-DOT, or :BACK if it's NIL (not :UP). -+A last-component, either a file-namestring including type extension, -+ or NIL in the case of a directory pathname. -+A flag that is true iff the unix-style-pathname was just -+ a file-namestring without / path specification. -+ENSURE-DIRECTORY forces the namestring to be interpreted as a directory pathname: -+the third return value will be NIL, and final component of the namestring -+will be treated as part of the directory path. -+ -+An empty string is thus read as meaning a pathname object with all fields nil. -+ -+Note that : characters will NOT be interpreted as host specification. -+Absolute pathnames are only appropriate on Unix-style systems. -+ -+The intention of this function is to support structured component names, -+e.g., \(:file \"foo/bar\"\), which will be unpacked to relative pathnames." -+ (check-type unix-namestring string) -+ (check-type dot-dot (member nil :back :up)) -+ (if (and (not (find #\/ unix-namestring)) (not ensure-directory) -+ (plusp (length unix-namestring))) -+ (values :relative () unix-namestring t) -+ (let* ((components (split-string unix-namestring :separator "/")) -+ (last-comp (car (last components)))) -+ (multiple-value-bind (relative components) -+ (if (equal (first components) "") -+ (if (equal (first-char unix-namestring) #\/) -+ (values :absolute (cdr components)) -+ (values :relative nil)) -+ (values :relative components)) -+ (setf components (remove-if #'(lambda (x) (member x '("" ".") :test #'equal)) -+ components)) -+ (setf components (substitute (or dot-dot :back) ".." components :test #'equal)) -+ (cond -+ ((equal last-comp "") -+ (values relative components nil nil)) ; "" already removed from components -+ (ensure-directory -+ (values relative components nil nil)) -+ (t -+ (values relative (butlast components) last-comp nil))))))) -+ -+ (defun split-name-type (filename) -+ "Split a filename into two values NAME and TYPE that are returned. -+We assume filename has no directory component. -+The last . if any separates name and type from from type, -+except that if there is only one . and it is in first position, -+the whole filename is the NAME with an empty type. -+NAME is always a string. -+For an empty type, *UNSPECIFIC-PATHNAME-TYPE* is returned." -+ (check-type filename string) -+ (assert (plusp (length filename))) -+ (destructuring-bind (name &optional (type *unspecific-pathname-type*)) -+ (split-string filename :max 2 :separator ".") -+ (if (equal name "") -+ (values filename *unspecific-pathname-type*) -+ (values name type)))) -+ -+ (defun parse-unix-namestring (name &rest keys &key type defaults dot-dot ensure-directory -+ &allow-other-keys) -+ "Coerce NAME into a PATHNAME using standard Unix syntax. -+ -+Unix syntax is used whether or not the underlying system is Unix; -+on such non-Unix systems it is only usable but for relative pathnames; -+but especially to manipulate relative pathnames portably, it is of crucial -+to possess a portable pathname syntax independent of the underlying OS. -+This is what PARSE-UNIX-NAMESTRING provides, and why we use it in ASDF. -+ -+When given a PATHNAME object, just return it untouched. -+When given NIL, just return NIL. -+When given a non-null SYMBOL, first downcase its name and treat it as a string. -+When given a STRING, portably decompose it into a pathname as below. -+ -+#\\/ separates directory components. -+ -+The last #\\/-separated substring is interpreted as follows: -+1- If TYPE is :DIRECTORY or ENSURE-DIRECTORY is true, -+ the string is made the last directory component, and NAME and TYPE are NIL. -+ if the string is empty, it's the empty pathname with all slots NIL. -+2- If TYPE is NIL, the substring is file-namestring, and its NAME and TYPE -+ are separated by SPLIT-NAME-TYPE. -+3- If TYPE is a string, it is the given TYPE, and the whole string is the NAME. -+ -+Directory components with an empty name the name . are removed. -+Any directory named .. is read as DOT-DOT, -+which must be one of :BACK or :UP and defaults to :BACK. -+ -+HOST, DEVICE and VERSION components are taken from DEFAULTS, -+which itself defaults to *NIL-PATHNAME*, also used if DEFAULTS in NIL. -+No host or device can be specified in the string itself, -+which makes it unsuitable for absolute pathnames outside Unix. -+ -+For relative pathnames, these components (and hence the defaults) won't matter -+if you use MERGE-PATHNAMES* but will matter if you use MERGE-PATHNAMES, -+which is an important reason to always use MERGE-PATHNAMES*. -+ -+Arbitrary keys are accepted, and the parse result is passed to ENSURE-PATHNAME -+with those keys, removing TYPE DEFAULTS and DOT-DOT. -+When you're manipulating pathnames that are supposed to make sense portably -+even though the OS may not be Unixish, we recommend you use :WANT-RELATIVE T -+to throw an error if the pathname is absolute" -+ (block nil -+ (check-type type (or null string (eql :directory))) -+ (when ensure-directory -+ (setf type :directory)) -+ (etypecase name -+ ((or null pathname) (return name)) -+ (symbol -+ (setf name (string-downcase name))) -+ (string)) -+ (multiple-value-bind (relative path filename file-only) -+ (split-unix-namestring-directory-components -+ name :dot-dot dot-dot :ensure-directory (eq type :directory)) -+ (multiple-value-bind (name type) -+ (cond -+ ((or (eq type :directory) (null filename)) -+ (values nil nil)) -+ (type -+ (values filename type)) -+ (t -+ (split-name-type filename))) -+ (apply 'ensure-pathname -+ (make-pathname* -+ :directory (unless file-only (cons relative path)) -+ :name name :type type -+ :defaults (or defaults *nil-pathname*)) -+ (remove-plist-keys '(:type :dot-dot :defaults) keys)))))) -+ -+ (defun unix-namestring (pathname) -+ "Given a non-wild PATHNAME, return a Unix-style namestring for it. -+If the PATHNAME is NIL or a STRING, return it unchanged. -+ -+This only considers the DIRECTORY, NAME and TYPE components of the pathname. -+This is a portable solution for representing relative pathnames, -+But unless you are running on a Unix system, it is not a general solution -+to representing native pathnames. -+ -+An error is signaled if the argument is not NULL, a STRING or a PATHNAME, -+or if it is a PATHNAME but some of its components are not recognized." -+ (etypecase pathname -+ ((or null string) pathname) -+ (pathname -+ (with-output-to-string (s) -+ (flet ((err () (error "Not a valid unix-namestring ~S" pathname))) -+ (let* ((dir (normalize-pathname-directory-component (pathname-directory pathname))) -+ (name (pathname-name pathname)) -+ (type (pathname-type pathname)) -+ (type (and (not (eq type :unspecific)) type))) -+ (cond -+ ((eq dir ())) -+ ((eq dir '(:relative)) (princ "./" s)) -+ ((consp dir) -+ (destructuring-bind (relabs &rest dirs) dir -+ (or (member relabs '(:relative :absolute)) (err)) -+ (when (eq relabs :absolute) (princ #\/ s)) -+ (loop :for x :in dirs :do -+ (cond -+ ((member x '(:back :up)) (princ "../" s)) -+ ((equal x "") (err)) -+ ;;((member x '("." "..") :test 'equal) (err)) -+ ((stringp x) (format s "~A/" x)) -+ (t (err)))))) -+ (t (err))) -+ (cond -+ (name -+ (or (and (stringp name) (or (null type) (stringp type))) (err)) -+ (format s "~A~@[.~A~]" name type)) -+ (t -+ (or (null type) (err))))))))))) -+ -+;;; Absolute and relative pathnames -+(with-upgradability () -+ (defun subpathname (pathname subpath &key type) -+ "This function takes a PATHNAME and a SUBPATH and a TYPE. -+If SUBPATH is already a PATHNAME object (not namestring), -+and is an absolute pathname at that, it is returned unchanged; -+otherwise, SUBPATH is turned into a relative pathname with given TYPE -+as per PARSE-UNIX-NAMESTRING with :WANT-RELATIVE T :TYPE TYPE, -+then it is merged with the PATHNAME-DIRECTORY-PATHNAME of PATHNAME." -+ (or (and (pathnamep subpath) (absolute-pathname-p subpath)) -+ (merge-pathnames* (parse-unix-namestring subpath :type type :want-relative t) -+ (pathname-directory-pathname pathname)))) -+ -+ (defun subpathname* (pathname subpath &key type) -+ "returns NIL if the base pathname is NIL, otherwise like SUBPATHNAME." -+ (and pathname -+ (subpathname (ensure-directory-pathname pathname) subpath :type type))) -+ -+ (defun pathname-root (pathname) -+ (make-pathname* :directory '(:absolute) -+ :name nil :type nil :version nil -+ :defaults pathname ;; host device, and on scl, *some* -+ ;; scheme-specific parts: port username password, not others: -+ . #.(or #+scl '(:parameters nil :query nil :fragment nil)))) -+ -+ (defun pathname-host-pathname (pathname) -+ (make-pathname* :directory nil -+ :name nil :type nil :version nil :device nil -+ :defaults pathname ;; host device, and on scl, *some* -+ ;; scheme-specific parts: port username password, not others: -+ . #.(or #+scl '(:parameters nil :query nil :fragment nil)))) -+ -+ (defun subpathp (maybe-subpath base-pathname) -+ (and (pathnamep maybe-subpath) (pathnamep base-pathname) -+ (absolute-pathname-p maybe-subpath) (absolute-pathname-p base-pathname) -+ (directory-pathname-p base-pathname) (not (wild-pathname-p base-pathname)) -+ (pathname-equal (pathname-root maybe-subpath) (pathname-root base-pathname)) -+ (with-pathname-defaults () -+ (let ((enough (enough-namestring maybe-subpath base-pathname))) -+ (and (relative-pathname-p enough) (pathname enough)))))) -+ -+ (defun ensure-absolute-pathname (path &optional defaults (on-error 'error)) -+ (cond -+ ((absolute-pathname-p path)) -+ ((stringp path) (ensure-absolute-pathname (pathname path) defaults on-error)) -+ ((not (pathnamep path)) (call-function on-error "not a valid pathname designator ~S" path)) -+ ((let ((default-pathname (if (pathnamep defaults) defaults (call-function defaults)))) -+ (or (if (absolute-pathname-p default-pathname) -+ (absolute-pathname-p (merge-pathnames* path default-pathname)) -+ (call-function on-error "Default pathname ~S is not an absolute pathname" -+ default-pathname)) -+ (call-function on-error "Failed to merge ~S with ~S into an absolute pathname" -+ path default-pathname)))) -+ (t (call-function on-error -+ "Cannot ensure ~S is evaluated as an absolute pathname with defaults ~S" -+ path defaults))))) -+ -+ -+;;; Wildcard pathnames -+(with-upgradability () -+ (defparameter *wild* (or #+cormanlisp "*" :wild)) -+ (defparameter *wild-directory-component* (or #+gcl2.6 "*" :wild)) -+ (defparameter *wild-inferiors-component* (or #+gcl2.6 "**" :wild-inferiors)) -+ (defparameter *wild-file* -+ (make-pathname :directory nil :name *wild* :type *wild* -+ :version (or #-(or allegro abcl xcl) *wild*))) -+ (defparameter *wild-directory* -+ (make-pathname* :directory `(:relative ,*wild-directory-component*) -+ :name nil :type nil :version nil)) -+ (defparameter *wild-inferiors* -+ (make-pathname* :directory `(:relative ,*wild-inferiors-component*) -+ :name nil :type nil :version nil)) -+ (defparameter *wild-path* -+ (merge-pathnames* *wild-file* *wild-inferiors*)) -+ -+ (defun wilden (path) -+ (merge-pathnames* *wild-path* path))) -+ -+ -+;;; Translate a pathname -+(with-upgradability () -+ (defun relativize-directory-component (directory-component) -+ (let ((directory (normalize-pathname-directory-component directory-component))) -+ (cond -+ ((stringp directory) -+ (list :relative directory)) -+ ((eq (car directory) :absolute) -+ (cons :relative (cdr directory))) -+ (t -+ directory)))) -+ -+ (defun relativize-pathname-directory (pathspec) -+ (let ((p (pathname pathspec))) -+ (make-pathname* -+ :directory (relativize-directory-component (pathname-directory p)) -+ :defaults p))) -+ -+ (defun directory-separator-for-host (&optional (pathname *default-pathname-defaults*)) -+ (let ((foo (make-pathname* :directory '(:absolute "FOO") :defaults pathname))) -+ (last-char (namestring foo)))) -+ -+ #-scl -+ (defun directorize-pathname-host-device (pathname) -+ #+(or unix abcl) -+ (when (and #+abcl (os-unix-p) (physical-pathname-p pathname)) -+ (return-from directorize-pathname-host-device pathname)) -+ (let* ((root (pathname-root pathname)) -+ (wild-root (wilden root)) -+ (absolute-pathname (merge-pathnames* pathname root)) -+ (separator (directory-separator-for-host root)) -+ (root-namestring (namestring root)) -+ (root-string -+ (substitute-if #\/ -+ #'(lambda (x) (or (eql x #\:) -+ (eql x separator))) -+ root-namestring))) -+ (multiple-value-bind (relative path filename) -+ (split-unix-namestring-directory-components root-string :ensure-directory t) -+ (declare (ignore relative filename)) -+ (let ((new-base -+ (make-pathname* :defaults root :directory `(:absolute ,@path)))) -+ (translate-pathname absolute-pathname wild-root (wilden new-base)))))) -+ -+ #+scl -+ (defun directorize-pathname-host-device (pathname) -+ (let ((scheme (ext:pathname-scheme pathname)) -+ (host (pathname-host pathname)) -+ (port (ext:pathname-port pathname)) -+ (directory (pathname-directory pathname))) -+ (flet ((specificp (x) (and x (not (eq x :unspecific))))) -+ (if (or (specificp port) -+ (and (specificp host) (plusp (length host))) -+ (specificp scheme)) -+ (let ((prefix "")) -+ (when (specificp port) -+ (setf prefix (format nil ":~D" port))) -+ (when (and (specificp host) (plusp (length host))) -+ (setf prefix (strcat host prefix))) -+ (setf prefix (strcat ":" prefix)) -+ (when (specificp scheme) -+ (setf prefix (strcat scheme prefix))) -+ (assert (and directory (eq (first directory) :absolute))) -+ (make-pathname* :directory `(:absolute ,prefix ,@(rest directory)) -+ :defaults pathname))) -+ pathname))) -+ -+ (defun* (translate-pathname*) (path absolute-source destination &optional root source) -+ (declare (ignore source)) -+ (cond -+ ((functionp destination) -+ (funcall destination path absolute-source)) -+ ((eq destination t) -+ path) -+ ((not (pathnamep destination)) -+ (error "Invalid destination")) -+ ((not (absolute-pathname-p destination)) -+ (translate-pathname path absolute-source (merge-pathnames* destination root))) -+ (root -+ (translate-pathname (directorize-pathname-host-device path) absolute-source destination)) -+ (t -+ (translate-pathname path absolute-source destination)))) -+ -+ (defvar *output-translation-function* 'identity -+ "Hook for output translations. -+ -+This function needs to be idempotent, so that actions can work -+whether their inputs were translated or not, -+which they will be if we are composing operations. e.g. if some -+create-lisp-op creates a lisp file from some higher-level input, -+you need to still be able to use compile-op on that lisp file.")) -+ -+;;;; ------------------------------------------------------------------------- -+;;;; Portability layer around Common Lisp filesystem access -+ -+(uiop/package:define-package :uiop/filesystem -+ (:nicknames :asdf/filesystem) -+ (:recycle :uiop/filesystem :asdf/pathname :asdf) -+ (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/os :uiop/pathname) -+ (:export -+ ;; Native namestrings -+ #:native-namestring #:parse-native-namestring -+ ;; Probing the filesystem -+ #:truename* #:safe-file-write-date #:probe-file* #:directory-exists-p #:file-exists-p -+ #:directory* #:filter-logical-directory-results #:directory-files #:subdirectories -+ #:collect-sub*directories -+ ;; Resolving symlinks somewhat -+ #:truenamize #:resolve-symlinks #:*resolve-symlinks* #:resolve-symlinks* -+ ;; merging with cwd -+ #:get-pathname-defaults #:call-with-current-directory #:with-current-directory -+ ;; Environment pathnames -+ #:inter-directory-separator #:split-native-pathnames-string -+ #:getenv-pathname #:getenv-pathnames -+ #:getenv-absolute-directory #:getenv-absolute-directories -+ #:lisp-implementation-directory #:lisp-implementation-pathname-p -+ ;; Simple filesystem operations -+ #:ensure-all-directories-exist -+ #:rename-file-overwriting-target -+ #:delete-file-if-exists #:delete-empty-directory #:delete-directory-tree)) -+(in-package :uiop/filesystem) -+ -+;;; Native namestrings, as seen by the operating system calls rather than Lisp -+(with-upgradability () -+ (defun native-namestring (x) -+ "From a non-wildcard CL pathname, a return namestring suitable for passing to the operating system" -+ (when x -+ (let ((p (pathname x))) -+ #+clozure (with-pathname-defaults () (ccl:native-translated-namestring p)) ; see ccl bug 978 -+ #+(or cmu scl) (ext:unix-namestring p nil) -+ #+sbcl (sb-ext:native-namestring p) -+ #-(or clozure cmu sbcl scl) -+ (if (os-unix-p) (unix-namestring p) -+ (namestring p))))) -+ -+ (defun parse-native-namestring (string &rest constraints &key ensure-directory &allow-other-keys) -+ "From a native namestring suitable for use by the operating system, return -+a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME" -+ (check-type string (or string null)) -+ (let* ((pathname -+ (when string -+ (with-pathname-defaults () -+ #+clozure (ccl:native-to-pathname string) -+ #+sbcl (sb-ext:parse-native-namestring string) -+ #-(or clozure sbcl) -+ (if (os-unix-p) -+ (parse-unix-namestring string :ensure-directory ensure-directory) -+ (parse-namestring string))))) -+ (pathname -+ (if ensure-directory -+ (and pathname (ensure-directory-pathname pathname)) -+ pathname))) -+ (apply 'ensure-pathname pathname constraints)))) -+ -+ -+;;; Probing the filesystem -+(with-upgradability () -+ (defun truename* (p) -+ ;; avoids both logical-pathname merging and physical resolution issues -+ (and p (handler-case (with-pathname-defaults () (truename p)) (file-error () nil)))) -+ -+ (defun safe-file-write-date (pathname) -+ ;; If FILE-WRITE-DATE returns NIL, it's possible that -+ ;; the user or some other agent has deleted an input file. -+ ;; Also, generated files will not exist at the time planning is done -+ ;; and calls compute-action-stamp which calls safe-file-write-date. -+ ;; So it is very possible that we can't get a valid file-write-date, -+ ;; and we can survive and we will continue the planning -+ ;; as if the file were very old. -+ ;; (or should we treat the case in a different, special way?) -+ (and pathname -+ (handler-case (file-write-date (translate-logical-pathname pathname)) -+ (file-error () nil)))) -+ -+ (defun probe-file* (p &key truename) -+ "when given a pathname P (designated by a string as per PARSE-NAMESTRING), -+probes the filesystem for a file or directory with given pathname. -+If it exists, return its truename is ENSURE-PATHNAME is true, -+or the original (parsed) pathname if it is false (the default)." -+ (with-pathname-defaults () ;; avoids logical-pathname issues on some implementations -+ (etypecase p -+ (null nil) -+ (string (probe-file* (parse-namestring p) :truename truename)) -+ (pathname -+ (and (not (wild-pathname-p p)) -+ (handler-case -+ (or -+ #+allegro -+ (probe-file p :follow-symlinks truename) -+ #-(or allegro clisp gcl2.6) -+ (if truename -+ (probe-file p) -+ (ignore-errors -+ (let ((pp (translate-logical-pathname p))) -+ (and -+ #+(or cmu scl) (unix:unix-stat (ext:unix-namestring pp)) -+ #+(and lispworks unix) (system:get-file-stat pp) -+ #+sbcl (sb-unix:unix-stat (sb-ext:native-namestring pp)) -+ #-(or cmu (and lispworks unix) sbcl scl) (file-write-date pp) -+ p)))) -+ #+(or clisp gcl2.6) -+ #.(flet ((probe (probe) -+ `(let ((foundtrue ,probe)) -+ (cond -+ (truename foundtrue) -+ (foundtrue p))))) -+ #+gcl2.6 -+ (probe '(or (probe-file p) -+ (and (directory-pathname-p p) -+ (ignore-errors -+ (ensure-directory-pathname -+ (truename* (subpathname -+ (ensure-directory-pathname p) "."))))))) -+ #+clisp -+ (let* ((fs (find-symbol* '#:file-stat :posix nil)) -+ (pp (find-symbol* '#:probe-pathname :ext nil)) -+ (resolve (if pp -+ `(ignore-errors (,pp p)) -+ '(or (truename* p) -+ (truename* (ignore-errors (ensure-directory-pathname p))))))) -+ (if fs -+ `(if truename -+ ,resolve -+ (and (ignore-errors (,fs p)) p)) -+ (probe resolve))))) -+ (file-error () nil))))))) -+ -+ (defun directory-exists-p (x) -+ (let ((p (probe-file* x :truename t))) -+ (and (directory-pathname-p p) p))) -+ -+ (defun file-exists-p (x) -+ (let ((p (probe-file* x :truename t))) -+ (and (file-pathname-p p) p))) -+ -+ (defun directory* (pathname-spec &rest keys &key &allow-other-keys) -+ (apply 'directory pathname-spec -+ (append keys '#.(or #+allegro '(:directories-are-files nil :follow-symbolic-links nil) -+ #+(or clozure digitool) '(:follow-links nil) -+ #+clisp '(:circle t :if-does-not-exist :ignore) -+ #+(or cmu scl) '(:follow-links nil :truenamep nil) -+ #+sbcl (when (find-symbol* :resolve-symlinks '#:sb-impl nil) -+ '(:resolve-symlinks nil)))))) -+ -+ (defun filter-logical-directory-results (directory entries merger) -+ (if (logical-pathname-p directory) -+ ;; Try hard to not resolve logical-pathname into physical pathnames; -+ ;; otherwise logical-pathname users/lovers will be disappointed. -+ ;; If directory* could use some implementation-dependent magic, -+ ;; we will have logical pathnames already; otherwise, -+ ;; we only keep pathnames for which specifying the name and -+ ;; translating the LPN commute. -+ (loop :for f :in entries -+ :for p = (or (and (logical-pathname-p f) f) -+ (let* ((u (ignore-errors (funcall merger f)))) -+ ;; The first u avoids a cumbersome (truename u) error. -+ ;; At this point f should already be a truename, -+ ;; but isn't quite in CLISP, for it doesn't have :version :newest -+ (and u (equal (truename* u) (truename* f)) u))) -+ :when p :collect p) -+ entries)) -+ -+ (defun directory-files (directory &optional (pattern *wild-file*)) -+ (let ((dir (pathname directory))) -+ (when (logical-pathname-p dir) -+ ;; Because of the filtering we do below, -+ ;; logical pathnames have restrictions on wild patterns. -+ ;; Not that the results are very portable when you use these patterns on physical pathnames. -+ (when (wild-pathname-p dir) -+ (error "Invalid wild pattern in logical directory ~S" directory)) -+ (unless (member (pathname-directory pattern) '(() (:relative)) :test 'equal) -+ (error "Invalid file pattern ~S for logical directory ~S" pattern directory)) -+ (setf pattern (make-pathname-logical pattern (pathname-host dir)))) -+ (let* ((pat (merge-pathnames* pattern dir)) -+ (entries (append (ignore-errors (directory* pat)) -+ #+clisp -+ (when (equal :wild (pathname-type pattern)) -+ (ignore-errors (directory* (make-pathname :type nil :defaults pat))))))) -+ (filter-logical-directory-results -+ directory entries -+ #'(lambda (f) -+ (make-pathname :defaults dir -+ :name (make-pathname-component-logical (pathname-name f)) -+ :type (make-pathname-component-logical (pathname-type f)) -+ :version (make-pathname-component-logical (pathname-version f)))))))) -+ -+ (defun subdirectories (directory) -+ (let* ((directory (ensure-directory-pathname directory)) -+ #-(or abcl cormanlisp genera xcl) -+ (wild (merge-pathnames* -+ #-(or abcl allegro cmu lispworks sbcl scl xcl) -+ *wild-directory* -+ #+(or abcl allegro cmu lispworks sbcl scl xcl) "*.*" -+ directory)) -+ (dirs -+ #-(or abcl cormanlisp genera xcl) -+ (ignore-errors -+ (directory* wild . #.(or #+clozure '(:directories t :files nil) -+ #+mcl '(:directories t)))) -+ #+(or abcl xcl) (system:list-directory directory) -+ #+cormanlisp (cl::directory-subdirs directory) -+ #+genera (fs:directory-list directory)) -+ #+(or abcl allegro cmu genera lispworks sbcl scl xcl) -+ (dirs (loop :for x :in dirs -+ :for d = #+(or abcl xcl) (extensions:probe-directory x) -+ #+allegro (excl:probe-directory x) -+ #+(or cmu sbcl scl) (directory-pathname-p x) -+ #+genera (getf (cdr x) :directory) -+ #+lispworks (lw:file-directory-p x) -+ :when d :collect #+(or abcl allegro xcl) d -+ #+genera (ensure-directory-pathname (first x)) -+ #+(or cmu lispworks sbcl scl) x))) -+ (filter-logical-directory-results -+ directory dirs -+ (let ((prefix (or (normalize-pathname-directory-component (pathname-directory directory)) -+ '(:absolute)))) ; because allegro returns NIL for #p"FOO:" -+ #'(lambda (d) -+ (let ((dir (normalize-pathname-directory-component (pathname-directory d)))) -+ (and (consp dir) (consp (cdr dir)) -+ (make-pathname -+ :defaults directory :name nil :type nil :version nil -+ :directory (append prefix (make-pathname-component-logical (last dir))))))))))) -+ -+ (defun collect-sub*directories (directory collectp recursep collector) -+ (when (call-function collectp directory) -+ (call-function collector directory)) -+ (dolist (subdir (subdirectories directory)) -+ (when (call-function recursep subdir) -+ (collect-sub*directories subdir collectp recursep collector))))) -+ -+;;; Resolving symlinks somewhat -+(with-upgradability () -+ (defun truenamize (pathname) -+ "Resolve as much of a pathname as possible" -+ (block nil -+ (when (typep pathname '(or null logical-pathname)) (return pathname)) -+ (let ((p pathname)) -+ (unless (absolute-pathname-p p) -+ (setf p (or (absolute-pathname-p (ensure-absolute-pathname p 'get-pathname-defaults nil)) -+ (return p)))) -+ (when (logical-pathname-p p) (return p)) -+ (let ((found (probe-file* p :truename t))) -+ (when found (return found))) -+ (let* ((directory (normalize-pathname-directory-component (pathname-directory p))) -+ (up-components (reverse (rest directory))) -+ (down-components ())) -+ (assert (eq :absolute (first directory))) -+ (loop :while up-components :do -+ (if-let (parent (probe-file* (make-pathname* :directory `(:absolute ,@(reverse up-components)) -+ :name nil :type nil :version nil :defaults p))) -+ (return (merge-pathnames* (make-pathname* :directory `(:relative ,@down-components) -+ :defaults p) -+ (ensure-directory-pathname parent))) -+ (push (pop up-components) down-components)) -+ :finally (return p)))))) -+ -+ (defun resolve-symlinks (path) -+ #-allegro (truenamize path) -+ #+allegro -+ (if (physical-pathname-p path) -+ (or (ignore-errors (excl:pathname-resolve-symbolic-links path)) path) -+ path)) -+ -+ (defvar *resolve-symlinks* t -+ "Determine whether or not ASDF resolves symlinks when defining systems. -+Defaults to T.") -+ -+ (defun resolve-symlinks* (path) -+ (if *resolve-symlinks* -+ (and path (resolve-symlinks path)) -+ path))) -+ -+ -+;;; Check pathname constraints -+(with-upgradability () -+ (defun ensure-pathname -+ (pathname &key -+ on-error -+ defaults type dot-dot -+ want-pathname -+ want-logical want-physical ensure-physical -+ want-relative want-absolute ensure-absolute ensure-subpath -+ want-non-wild want-wild wilden -+ want-file want-directory ensure-directory -+ want-existing ensure-directories-exist -+ truename resolve-symlinks truenamize -+ &aux (p pathname)) ;; mutable working copy, preserve original -+ "Coerces its argument into a PATHNAME, -+optionally doing some transformations and checking specified constraints. -+ -+If the argument is NIL, then NIL is returned unless the WANT-PATHNAME constraint is specified. -+ -+If the argument is a STRING, it is first converted to a pathname via PARSE-UNIX-NAMESTRING -+reusing the keywords DEFAULTS TYPE DOT-DOT ENSURE-DIRECTORY WANT-RELATIVE; -+then the result is optionally merged into the DEFAULTS if ENSURE-ABSOLUTE is true, -+and the all the checks and transformations are run. -+ -+Each non-nil constraint argument can be one of the symbols T, ERROR, CERROR or IGNORE. -+The boolean T is an alias for ERROR. -+ERROR means that an error will be raised if the constraint is not satisfied. -+CERROR means that an continuable error will be raised if the constraint is not satisfied. -+IGNORE means just return NIL instead of the pathname. -+ -+The ON-ERROR argument, if not NIL, is a function designator (as per CALL-FUNCTION) -+that will be called with the the following arguments: -+a generic format string for ensure pathname, the pathname, -+the keyword argument corresponding to the failed check or transformation, -+a format string for the reason ENSURE-PATHNAME failed, -+and a list with arguments to that format string. -+If ON-ERROR is NIL, ERROR is used instead, which does the right thing. -+You could also pass (CERROR \"CONTINUE DESPITE FAILED CHECK\"). -+ -+The transformations and constraint checks are done in this order, -+which is also the order in the lambda-list: -+ -+WANT-PATHNAME checks that pathname (after parsing if needed) is not null. -+Otherwise, if the pathname is NIL, ensure-pathname returns NIL. -+WANT-LOGICAL checks that pathname is a LOGICAL-PATHNAME -+WANT-PHYSICAL checks that pathname is not a LOGICAL-PATHNAME -+ENSURE-PHYSICAL ensures that pathname is physical via TRANSLATE-LOGICAL-PATHNAME -+WANT-RELATIVE checks that pathname has a relative directory component -+WANT-ABSOLUTE checks that pathname does have an absolute directory component -+ENSURE-ABSOLUTE merges with the DEFAULTS, then checks again -+that the result absolute is an absolute pathname indeed. -+ENSURE-SUBPATH checks that the pathname is a subpath of the DEFAULTS. -+WANT-FILE checks that pathname has a non-nil FILE component -+WANT-DIRECTORY checks that pathname has nil FILE and TYPE components -+ENSURE-DIRECTORY uses ENSURE-DIRECTORY-PATHNAME to interpret -+any file and type components as being actually a last directory component. -+WANT-NON-WILD checks that pathname is not a wild pathname -+WANT-WILD checks that pathname is a wild pathname -+WILDEN merges the pathname with **/*.*.* if it is not wild -+WANT-EXISTING checks that a file (or directory) exists with that pathname. -+ENSURE-DIRECTORIES-EXIST creates any parent directory with ENSURE-DIRECTORIES-EXIST. -+TRUENAME replaces the pathname by its truename, or errors if not possible. -+RESOLVE-SYMLINKS replaces the pathname by a variant with symlinks resolved by RESOLVE-SYMLINKS. -+TRUENAMIZE uses TRUENAMIZE to resolve as many symlinks as possible." -+ (block nil -+ (flet ((report-error (keyword description &rest arguments) -+ (call-function (or on-error 'error) -+ "Invalid pathname ~S: ~*~?" -+ pathname keyword description arguments))) -+ (macrolet ((err (constraint &rest arguments) -+ `(report-error ',(intern* constraint :keyword) ,@arguments)) -+ (check (constraint condition &rest arguments) -+ `(when ,constraint -+ (unless ,condition (err ,constraint ,@arguments)))) -+ (transform (transform condition expr) -+ `(when ,transform -+ (,@(if condition `(when ,condition) '(progn)) -+ (setf p ,expr))))) -+ (etypecase p -+ ((or null pathname)) -+ (string -+ (setf p (parse-unix-namestring -+ p :defaults defaults :type type :dot-dot dot-dot -+ :ensure-directory ensure-directory :want-relative want-relative)))) -+ (check want-pathname (pathnamep p) "Expected a pathname, not NIL") -+ (unless (pathnamep p) (return nil)) -+ (check want-logical (logical-pathname-p p) "Expected a logical pathname") -+ (check want-physical (physical-pathname-p p) "Expected a physical pathname") -+ (transform ensure-physical () (translate-logical-pathname p)) -+ (check ensure-physical (physical-pathname-p p) "Could not translate to a physical pathname") -+ (check want-relative (relative-pathname-p p) "Expected a relative pathname") -+ (check want-absolute (absolute-pathname-p p) "Expected an absolute pathname") -+ (transform ensure-absolute (not (absolute-pathname-p p)) -+ (ensure-absolute-pathname p defaults (list #'report-error :ensure-absolute "~@?"))) -+ (check ensure-absolute (absolute-pathname-p p) -+ "Could not make into an absolute pathname even after merging with ~S" defaults) -+ (check ensure-subpath (absolute-pathname-p defaults) -+ "cannot be checked to be a subpath of non-absolute pathname ~S" defaults) -+ (check ensure-subpath (subpathp p defaults) "is not a sub pathname of ~S" defaults) -+ (check want-file (file-pathname-p p) "Expected a file pathname") -+ (check want-directory (directory-pathname-p p) "Expected a directory pathname") -+ (transform ensure-directory (not (directory-pathname-p p)) (ensure-directory-pathname p)) -+ (check want-non-wild (not (wild-pathname-p p)) "Expected a non-wildcard pathname") -+ (check want-wild (wild-pathname-p p) "Expected a wildcard pathname") -+ (transform wilden (not (wild-pathname-p p)) (wilden p)) -+ (when want-existing -+ (let ((existing (probe-file* p :truename truename))) -+ (if existing -+ (when truename -+ (return existing)) -+ (err want-existing "Expected an existing pathname")))) -+ (when ensure-directories-exist (ensure-directories-exist p)) -+ (when truename -+ (let ((truename (truename* p))) -+ (if truename -+ (return truename) -+ (err truename "Can't get a truename for pathname")))) -+ (transform resolve-symlinks () (resolve-symlinks p)) -+ (transform truenamize () (truenamize p)) -+ p))))) -+ -+ -+;;; Pathname defaults -+(with-upgradability () -+ (defun get-pathname-defaults (&optional (defaults *default-pathname-defaults*)) -+ (or (absolute-pathname-p defaults) -+ (merge-pathnames* defaults (getcwd)))) -+ -+ (defun call-with-current-directory (dir thunk) -+ (if dir -+ (let* ((dir (resolve-symlinks* (get-pathname-defaults (pathname-directory-pathname dir)))) -+ (*default-pathname-defaults* dir) -+ (cwd (getcwd))) -+ (chdir dir) -+ (unwind-protect -+ (funcall thunk) -+ (chdir cwd))) -+ (funcall thunk))) -+ -+ (defmacro with-current-directory ((&optional dir) &body body) -+ "Call BODY while the POSIX current working directory is set to DIR" -+ `(call-with-current-directory ,dir #'(lambda () ,@body)))) -+ -+ -+;;; Environment pathnames -+(with-upgradability () -+ (defun inter-directory-separator () -+ (if (os-unix-p) #\: #\;)) -+ -+ (defun split-native-pathnames-string (string &rest constraints &key &allow-other-keys) -+ (loop :for namestring :in (split-string string :separator (string (inter-directory-separator))) -+ :collect (apply 'parse-native-namestring namestring constraints))) -+ -+ (defun getenv-pathname (x &rest constraints &key ensure-directory want-directory on-error &allow-other-keys) -+ ;; For backward compatibility with ASDF 2, want-directory implies ensure-directory -+ (apply 'parse-native-namestring (getenvp x) -+ :ensure-directory (or ensure-directory want-directory) -+ :on-error (or on-error -+ `(error "In (~S ~S), invalid pathname ~*~S: ~*~?" getenv-pathname ,x)) -+ constraints)) -+ (defun getenv-pathnames (x &rest constraints &key on-error &allow-other-keys) -+ (apply 'split-native-pathnames-string (getenvp x) -+ :on-error (or on-error -+ `(error "In (~S ~S), invalid pathname ~*~S: ~*~?" getenv-pathnames ,x)) -+ constraints)) -+ (defun getenv-absolute-directory (x) -+ (getenv-pathname x :want-absolute t :ensure-directory t)) -+ (defun getenv-absolute-directories (x) -+ (getenv-pathnames x :want-absolute t :ensure-directory t)) -+ -+ (defun lisp-implementation-directory (&key truename) -+ (declare (ignorable truename)) -+ #+(or clozure ecl gcl mkcl sbcl) -+ (let ((dir -+ (ignore-errors -+ #+clozure #p"ccl:" -+ #+(or ecl mkcl) #p"SYS:" -+ #+gcl system::*system-directory* -+ #+sbcl (if-let (it (find-symbol* :sbcl-homedir-pathname :sb-int nil)) -+ (funcall it) -+ (getenv-pathname "SBCL_HOME" :ensure-directory t))))) -+ (if (and dir truename) -+ (truename* dir) -+ dir))) -+ -+ (defun lisp-implementation-pathname-p (pathname) -+ ;; Other builtin systems are those under the implementation directory -+ (and (when pathname -+ (if-let (impdir (lisp-implementation-directory)) -+ (or (subpathp pathname impdir) -+ (when *resolve-symlinks* -+ (if-let (truename (truename* pathname)) -+ (if-let (trueimpdir (truename* impdir)) -+ (subpathp truename trueimpdir))))))) -+ t))) -+ -+ -+;;; Simple filesystem operations -+(with-upgradability () -+ (defun ensure-all-directories-exist (pathnames) -+ (dolist (pathname pathnames) -+ (when pathname -+ (ensure-directories-exist (translate-logical-pathname pathname))))) -+ -+ (defun rename-file-overwriting-target (source target) -+ #+clisp ;; But for a bug in CLISP 2.48, we should use :if-exists :overwrite and be atomic -+ (posix:copy-file source target :method :rename) -+ #-clisp -+ (rename-file source target -+ #+clozure :if-exists #+clozure :rename-and-delete)) -+ -+ (defun delete-file-if-exists (x) -+ (when x (handler-case (delete-file x) (file-error () nil)))) -+ -+ (defun delete-empty-directory (directory-pathname) -+ "Delete an empty directory" -+ #+(or abcl digitool gcl) (delete-file directory-pathname) -+ #+allegro (excl:delete-directory directory-pathname) -+ #+clisp (ext:delete-directory directory-pathname) -+ #+clozure (ccl::delete-empty-directory directory-pathname) -+ #+(or cmu scl) (multiple-value-bind (ok errno) -+ (unix:unix-rmdir (native-namestring directory-pathname)) -+ (unless ok -+ #+cmu (error "Error number ~A when trying to delete directory ~A" -+ errno directory-pathname) -+ #+scl (error "~@<Error deleting ~S: ~A~@:>" -+ directory-pathname (unix:get-unix-error-msg errno)))) -+ #+cormanlisp (win32:delete-directory directory-pathname) -+ #+ecl (si:rmdir directory-pathname) -+ #+lispworks (lw:delete-directory directory-pathname) -+ #+mkcl (mkcl:rmdir directory-pathname) -+ #+sbcl #.(if-let (dd (find-symbol* :delete-directory :sb-ext nil)) -+ `(,dd directory-pathname) ;; requires SBCL 1.0.44 or later -+ `(progn (require :sb-posix) (symbol-call :sb-posix :rmdir directory-pathname))) -+ #-(or abcl allegro clisp clozure cmu cormanlisp digitool ecl gcl lispworks sbcl scl) -+ (error "~S not implemented on ~S" 'delete-empty-directory (implementation-type))) ; genera xcl -+ -+ (defun delete-directory-tree (directory-pathname &key (validate nil validatep) (if-does-not-exist :error)) -+ "Delete a directory including all its recursive contents, aka rm -rf. -+ -+To reduce the risk of infortunate mistakes, DIRECTORY-PATHNAME must be -+a physical non-wildcard directory pathname (not namestring). -+ -+If the directory does not exist, the IF-DOES-NOT-EXIST argument specifies what happens: -+if it is :ERROR (the default), an error is signaled, whereas if it is :IGNORE, nothing is done. -+ -+Furthermore, before any deletion is attempted, the DIRECTORY-PATHNAME must pass -+the validation function designated (as per ENSURE-FUNCTION) by the VALIDATE keyword argument -+which in practice is thus compulsory, and validates by returning a non-NIL result. -+If you're suicidal or extremely confident, just use :VALIDATE T." -+ (check-type if-does-not-exist (member :error :ignore)) -+ (cond -+ ((not (and (pathnamep directory-pathname) (directory-pathname-p directory-pathname) -+ (physical-pathname-p directory-pathname) (not (wild-pathname-p directory-pathname)))) -+ (error "~S was asked to delete ~S but it is not a physical non-wildcard directory pathname" -+ 'delete-filesystem-tree directory-pathname)) -+ ((not validatep) -+ (error "~S was asked to delete ~S but was not provided a validation predicate" -+ 'delete-filesystem-tree directory-pathname)) -+ ((not (call-function validate directory-pathname)) -+ (error "~S was asked to delete ~S but it is not valid ~@[according to ~S~]" -+ 'delete-filesystem-tree directory-pathname validate)) -+ ((not (directory-exists-p directory-pathname)) -+ (ecase if-does-not-exist -+ (:error -+ (error "~S was asked to delete ~S but the directory does not exist" -+ 'delete-filesystem-tree directory-pathname)) -+ (:ignore nil))) -+ #-(or allegro cmu clozure sbcl scl) -+ ((os-unix-p) ;; On Unix, don't recursively walk the directory and delete everything in Lisp, -+ ;; except on implementations where we can prevent DIRECTORY from following symlinks; -+ ;; instead spawn a standard external program to do the dirty work. -+ (symbol-call :uiop :run-program `("rm" "-rf" ,(native-namestring directory-pathname)))) -+ (t -+ ;; On supported implementation, call supported system functions -+ #+allegro (symbol-call :excl.osi :delete-directory-and-files -+ directory-pathname :if-does-not-exist if-does-not-exist) -+ #+clozure (ccl:delete-directory directory-pathname) -+ #+genera (error "~S not implemented on ~S" 'delete-directory-tree (implementation-type)) -+ #+sbcl #.(if-let (dd (find-symbol* :delete-directory :sb-ext nil)) -+ `(,dd directory-pathname :recursive t) ;; requires SBCL 1.0.44 or later -+ '(error "~S requires SBCL 1.0.44 or later" 'delete-directory-tree)) -+ ;; Outside Unix or on CMUCL and SCL that can avoid following symlinks, -+ ;; do things the hard way. -+ #-(or allegro clozure genera sbcl) -+ (let ((sub*directories -+ (while-collecting (c) -+ (collect-sub*directories directory-pathname t t #'c)))) -+ (dolist (d (nreverse sub*directories)) -+ (map () 'delete-file (directory-files d)) -+ (delete-empty-directory d))))))) -+ -+;;;; --------------------------------------------------------------------------- -+;;;; Utilities related to streams -+ -+(uiop/package:define-package :uiop/stream -+ (:nicknames :asdf/stream) -+ (:recycle :uiop/stream :asdf/stream :asdf) -+ (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/os :uiop/pathname :uiop/filesystem) -+ (:export -+ #:*default-stream-element-type* #:*stderr* #:setup-stderr -+ #:detect-encoding #:*encoding-detection-hook* #:always-default-encoding -+ #:encoding-external-format #:*encoding-external-format-hook* #:default-encoding-external-format -+ #:*default-encoding* #:*utf-8-external-format* -+ #:with-safe-io-syntax #:call-with-safe-io-syntax #:safe-read-from-string -+ #:with-output #:output-string #:with-input -+ #:with-input-file #:call-with-input-file #:with-output-file #:call-with-output-file -+ #:finish-outputs #:format! #:safe-format! -+ #:copy-stream-to-stream #:concatenate-files #:copy-file -+ #:slurp-stream-string #:slurp-stream-lines #:slurp-stream-line -+ #:slurp-stream-forms #:slurp-stream-form -+ #:read-file-string #:read-file-lines #:read-file-forms #:read-file-form #:safe-read-file-form -+ #:eval-input #:eval-thunk #:standard-eval-thunk -+ ;; Temporary files -+ #:*temporary-directory* #:temporary-directory #:default-temporary-directory -+ #:setup-temporary-directory -+ #:call-with-temporary-file #:with-temporary-file -+ #:add-pathname-suffix #:tmpize-pathname -+ #:call-with-staging-pathname #:with-staging-pathname)) -+(in-package :uiop/stream) -+ -+(with-upgradability () -+ (defvar *default-stream-element-type* (or #+(or abcl cmu cormanlisp scl xcl) 'character :default) -+ "default element-type for open (depends on the current CL implementation)") -+ -+ (defvar *stderr* *error-output* -+ "the original error output stream at startup") -+ -+ (defun setup-stderr () -+ (setf *stderr* -+ #+allegro excl::*stderr* -+ #+clozure ccl::*stderr* -+ #-(or allegro clozure) *error-output*)) -+ (setup-stderr)) -+ -+ -+;;; Encodings (mostly hooks only; full support requires asdf-encodings) -+(with-upgradability () -+ (defparameter *default-encoding* -+ ;; preserve explicit user changes to something other than the legacy default :default -+ (or (if-let (previous (and (boundp '*default-encoding*) (symbol-value '*default-encoding*))) -+ (unless (eq previous :default) previous)) -+ :utf-8) -+ "Default encoding for source files. -+The default value :utf-8 is the portable thing. -+The legacy behavior was :default. -+If you (asdf:load-system :asdf-encodings) then -+you will have autodetection via *encoding-detection-hook* below, -+reading emacs-style -*- coding: utf-8 -*- specifications, -+and falling back to utf-8 or latin1 if nothing is specified.") -+ -+ (defparameter *utf-8-external-format* -+ #+(and asdf-unicode (not clisp)) :utf-8 -+ #+(and asdf-unicode clisp) charset:utf-8 -+ #-asdf-unicode :default -+ "Default :external-format argument to pass to CL:OPEN and also -+CL:LOAD or CL:COMPILE-FILE to best process a UTF-8 encoded file. -+On modern implementations, this will decode UTF-8 code points as CL characters. -+On legacy implementations, it may fall back on some 8-bit encoding, -+with non-ASCII code points being read as several CL characters; -+hopefully, if done consistently, that won't affect program behavior too much.") -+ -+ (defun always-default-encoding (pathname) -+ (declare (ignore pathname)) -+ *default-encoding*) -+ -+ (defvar *encoding-detection-hook* #'always-default-encoding -+ "Hook for an extension to define a function to automatically detect a file's encoding") -+ -+ (defun detect-encoding (pathname) -+ (if (and pathname (not (directory-pathname-p pathname)) (probe-file* pathname)) -+ (funcall *encoding-detection-hook* pathname) -+ *default-encoding*)) -+ -+ (defun default-encoding-external-format (encoding) -+ (case encoding -+ (:default :default) ;; for backward-compatibility only. Explicit usage discouraged. -+ (:utf-8 *utf-8-external-format*) -+ (otherwise -+ (cerror "Continue using :external-format :default" (compatfmt "~@<Your ASDF component is using encoding ~S but it isn't recognized. Your system should :defsystem-depends-on (:asdf-encodings).~:>") encoding) -+ :default))) -+ -+ (defvar *encoding-external-format-hook* -+ #'default-encoding-external-format -+ "Hook for an extension to define a mapping between non-default encodings -+and implementation-defined external-format's") -+ -+ (defun encoding-external-format (encoding) -+ (funcall *encoding-external-format-hook* encoding))) -+ -+ -+;;; Safe syntax -+(with-upgradability () -+ (defvar *standard-readtable* (copy-readtable nil)) -+ -+ (defmacro with-safe-io-syntax ((&key (package :cl)) &body body) -+ "Establish safe CL reader options around the evaluation of BODY" -+ `(call-with-safe-io-syntax #'(lambda () (let ((*package* (find-package ,package))) ,@body)))) -+ -+ (defun call-with-safe-io-syntax (thunk &key (package :cl)) -+ (with-standard-io-syntax -+ (let ((*package* (find-package package)) -+ (*read-default-float-format* 'double-float) -+ (*print-readably* nil) -+ (*read-eval* nil)) -+ (funcall thunk)))) -+ -+ (defun safe-read-from-string (string &key (package :cl) (eof-error-p t) eof-value (start 0) end preserve-whitespace) -+ (with-safe-io-syntax (:package package) -+ (read-from-string string eof-error-p eof-value :start start :end end :preserve-whitespace preserve-whitespace)))) -+ -+ -+;;; Output to a stream or string, FORMAT-style -+(with-upgradability () -+ (defun call-with-output (output function) -+ "Calls FUNCTION with an actual stream argument, -+behaving like FORMAT with respect to how stream designators are interpreted: -+If OUTPUT is a stream, use it as the stream. -+If OUTPUT is NIL, use a STRING-OUTPUT-STREAM as the stream, and return the resulting string. -+If OUTPUT is T, use *STANDARD-OUTPUT* as the stream. -+If OUTPUT is a string with a fill-pointer, use it as a string-output-stream. -+Otherwise, signal an error." -+ (etypecase output -+ (null -+ (with-output-to-string (stream) (funcall function stream))) -+ ((eql t) -+ (funcall function *standard-output*)) -+ (stream -+ (funcall function output)) -+ (string -+ (assert (fill-pointer output)) -+ (with-output-to-string (stream output) (funcall function stream))))) -+ -+ (defmacro with-output ((output-var &optional (value output-var)) &body body) -+ "Bind OUTPUT-VAR to an output stream, coercing VALUE (default: previous binding of OUTPUT-VAR) -+as per FORMAT, and evaluate BODY within the scope of this binding." -+ `(call-with-output ,value #'(lambda (,output-var) ,@body))) -+ -+ (defun output-string (string &optional output) -+ "If the desired OUTPUT is not NIL, print the string to the output; otherwise return the string" -+ (if output -+ (with-output (output) (princ string output)) -+ string))) -+ -+ -+;;; Input helpers -+(with-upgradability () -+ (defun call-with-input (input function) -+ "Calls FUNCTION with an actual stream argument, interpreting -+stream designators like READ, but also coercing strings to STRING-INPUT-STREAM. -+If INPUT is a STREAM, use it as the stream. -+If INPUT is NIL, use a *STANDARD-INPUT* as the stream. -+If INPUT is T, use *TERMINAL-IO* as the stream. -+As an extension, if INPUT is a string, use it as a string-input-stream. -+Otherwise, signal an error." -+ (etypecase input -+ (null (funcall function *standard-input*)) -+ ((eql t) (funcall function *terminal-io*)) -+ (stream (funcall function input)) -+ (string (with-input-from-string (stream input) (funcall function stream))))) -+ -+ (defmacro with-input ((input-var &optional (value input-var)) &body body) -+ "Bind INPUT-VAR to an input stream, coercing VALUE (default: previous binding of INPUT-VAR) -+as per CALL-WITH-INPUT, and evaluate BODY within the scope of this binding." -+ `(call-with-input ,value #'(lambda (,input-var) ,@body))) -+ -+ (defun call-with-input-file (pathname thunk -+ &key -+ (element-type *default-stream-element-type*) -+ (external-format *utf-8-external-format*) -+ (if-does-not-exist :error)) -+ "Open FILE for input with given recognizes options, call THUNK with the resulting stream. -+Other keys are accepted but discarded." -+ #+gcl2.6 (declare (ignore external-format)) -+ (with-open-file (s pathname :direction :input -+ :element-type element-type -+ #-gcl2.6 :external-format #-gcl2.6 external-format -+ :if-does-not-exist if-does-not-exist) -+ (funcall thunk s))) -+ -+ (defmacro with-input-file ((var pathname &rest keys -+ &key element-type external-format if-does-not-exist) -+ &body body) -+ (declare (ignore element-type external-format if-does-not-exist)) -+ `(call-with-input-file ,pathname #'(lambda (,var) ,@body) ,@keys)) -+ -+ (defun call-with-output-file (pathname thunk -+ &key -+ (element-type *default-stream-element-type*) -+ (external-format *utf-8-external-format*) -+ (if-exists :error) -+ (if-does-not-exist :create)) -+ "Open FILE for input with given recognizes options, call THUNK with the resulting stream. -+Other keys are accepted but discarded." -+ #+gcl2.6 (declare (ignore external-format)) -+ (with-open-file (s pathname :direction :output -+ :element-type element-type -+ #-gcl2.6 :external-format #-gcl2.6 external-format -+ :if-exists if-exists -+ :if-does-not-exist if-does-not-exist) -+ (funcall thunk s))) -+ -+ (defmacro with-output-file ((var pathname &rest keys -+ &key element-type external-format if-exists if-does-not-exist) -+ &body body) -+ (declare (ignore element-type external-format if-exists if-does-not-exist)) -+ `(call-with-output-file ,pathname #'(lambda (,var) ,@body) ,@keys))) -+ -+;;; Ensure output buffers are flushed -+(with-upgradability () -+ (defun finish-outputs (&rest streams) -+ "Finish output on the main output streams as well as any specified one. -+Useful for portably flushing I/O before user input or program exit." -+ ;; CCL notably buffers its stream output by default. -+ (dolist (s (append streams -+ (list *stderr* *error-output* *standard-output* *trace-output* -+ *debug-io* *terminal-io* *debug-io* *query-io*))) -+ (ignore-errors (finish-output s))) -+ (values)) -+ -+ (defun format! (stream format &rest args) -+ "Just like format, but call finish-outputs before and after the output." -+ (finish-outputs stream) -+ (apply 'format stream format args) -+ (finish-output stream)) -+ -+ (defun safe-format! (stream format &rest args) -+ (with-safe-io-syntax () -+ (ignore-errors (apply 'format! stream format args)) -+ (finish-outputs stream)))) ; just in case format failed -+ -+ -+;;; Simple Whole-Stream processing -+(with-upgradability () -+ (defun copy-stream-to-stream (input output &key element-type buffer-size linewise prefix) -+ "Copy the contents of the INPUT stream into the OUTPUT stream. -+If LINEWISE is true, then read and copy the stream line by line, with an optional PREFIX. -+Otherwise, using WRITE-SEQUENCE using a buffer of size BUFFER-SIZE." -+ (with-open-stream (input input) -+ (if linewise -+ (loop* :for (line eof) = (multiple-value-list (read-line input nil nil)) -+ :while line :do -+ (when prefix (princ prefix output)) -+ (princ line output) -+ (unless eof (terpri output)) -+ (finish-output output) -+ (when eof (return))) -+ (loop -+ :with buffer-size = (or buffer-size 8192) -+ :for buffer = (make-array (list buffer-size) :element-type (or element-type 'character)) -+ :for end = (read-sequence buffer input) -+ :until (zerop end) -+ :do (write-sequence buffer output :end end) -+ (when (< end buffer-size) (return)))))) -+ -+ (defun concatenate-files (inputs output) -+ (with-open-file (o output :element-type '(unsigned-byte 8) -+ :direction :output :if-exists :rename-and-delete) -+ (dolist (input inputs) -+ (with-open-file (i input :element-type '(unsigned-byte 8) -+ :direction :input :if-does-not-exist :error) -+ (copy-stream-to-stream i o :element-type '(unsigned-byte 8)))))) -+ -+ (defun copy-file (input output) -+ ;; Not available on LW personal edition or LW 6.0 on Mac: (lispworks:copy-file i f) -+ (concatenate-files (list input) output)) -+ -+ (defun slurp-stream-string (input &key (element-type 'character)) -+ "Read the contents of the INPUT stream as a string" -+ (with-open-stream (input input) -+ (with-output-to-string (output) -+ (copy-stream-to-stream input output :element-type element-type)))) -+ -+ (defun slurp-stream-lines (input &key count) -+ "Read the contents of the INPUT stream as a list of lines, return those lines. -+ -+Read no more than COUNT lines." -+ (check-type count (or null integer)) -+ (with-open-stream (input input) -+ (loop :for n :from 0 -+ :for l = (and (or (not count) (< n count)) -+ (read-line input nil nil)) -+ :while l :collect l))) -+ -+ (defun slurp-stream-line (input &key (at 0)) -+ "Read the contents of the INPUT stream as a list of lines, -+then return the ACCESS-AT of that list of lines using the AT specifier. -+PATH defaults to 0, i.e. return the first line. -+PATH is typically an integer, or a list of an integer and a function. -+If PATH is NIL, it will return all the lines in the file. -+ -+The stream will not be read beyond the Nth lines, -+where N is the index specified by path -+if path is either an integer or a list that starts with an integer." -+ (access-at (slurp-stream-lines input :count (access-at-count at)) at)) -+ -+ (defun slurp-stream-forms (input &key count) -+ "Read the contents of the INPUT stream as a list of forms, -+and return those forms. -+ -+If COUNT is null, read to the end of the stream; -+if COUNT is an integer, stop after COUNT forms were read. -+ -+BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof" -+ (check-type count (or null integer)) -+ (loop :with eof = '#:eof -+ :for n :from 0 -+ :for form = (if (and count (>= n count)) -+ eof -+ (read-preserving-whitespace input nil eof)) -+ :until (eq form eof) :collect form)) -+ -+ (defun slurp-stream-form (input &key (at 0)) -+ "Read the contents of the INPUT stream as a list of forms, -+then return the ACCESS-AT of these forms following the AT. -+AT defaults to 0, i.e. return the first form. -+AT is typically a list of integers. -+If AT is NIL, it will return all the forms in the file. -+ -+The stream will not be read beyond the Nth form, -+where N is the index specified by path, -+if path is either an integer or a list that starts with an integer. -+ -+BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof" -+ (access-at (slurp-stream-forms input :count (access-at-count at)) at)) -+ -+ (defun read-file-string (file &rest keys) -+ "Open FILE with option KEYS, read its contents as a string" -+ (apply 'call-with-input-file file 'slurp-stream-string keys)) -+ -+ (defun read-file-lines (file &rest keys) -+ "Open FILE with option KEYS, read its contents as a list of lines -+BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof" -+ (apply 'call-with-input-file file 'slurp-stream-lines keys)) -+ -+ (defun read-file-forms (file &rest keys &key count &allow-other-keys) -+ "Open input FILE with option KEYS (except COUNT), -+and read its contents as per SLURP-STREAM-FORMS with given COUNT. -+BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof" -+ (apply 'call-with-input-file file -+ #'(lambda (input) (slurp-stream-forms input :count count)) -+ (remove-plist-key :count keys))) -+ -+ (defun read-file-form (file &rest keys &key (at 0) &allow-other-keys) -+ "Open input FILE with option KEYS (except AT), -+and read its contents as per SLURP-STREAM-FORM with given AT specifier. -+BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof" -+ (apply 'call-with-input-file file -+ #'(lambda (input) (slurp-stream-form input :at at)) -+ (remove-plist-key :at keys))) -+ -+ (defun safe-read-file-form (pathname &rest keys &key (package :cl) &allow-other-keys) -+ "Reads the specified form from the top of a file using a safe standardized syntax. -+Extracts the form using READ-FILE-FORM, -+within an WITH-SAFE-IO-SYNTAX using the specified PACKAGE." -+ (with-safe-io-syntax (:package package) -+ (apply 'read-file-form pathname (remove-plist-key :package keys)))) -+ -+ (defun eval-input (input) -+ "Portably read and evaluate forms from INPUT, return the last values." -+ (with-input (input) -+ (loop :with results :with eof ='#:eof -+ :for form = (read input nil eof) -+ :until (eq form eof) -+ :do (setf results (multiple-value-list (eval form))) -+ :finally (return (apply 'values results))))) -+ -+ (defun eval-thunk (thunk) -+ "Evaluate a THUNK of code: -+If a function, FUNCALL it without arguments. -+If a constant literal and not a sequence, return it. -+If a cons or a symbol, EVAL it. -+If a string, repeatedly read and evaluate from it, returning the last values." -+ (etypecase thunk -+ ((or boolean keyword number character pathname) thunk) -+ ((or cons symbol) (eval thunk)) -+ (function (funcall thunk)) -+ (string (eval-input thunk)))) -+ -+ (defun standard-eval-thunk (thunk &key (package :cl)) -+ "Like EVAL-THUNK, but in a more standardized evaluation context." -+ ;; Note: it's "standard-" not "safe-", because evaluation is never safe. -+ (when thunk -+ (with-safe-io-syntax (:package package) -+ (let ((*read-eval* t)) -+ (eval-thunk thunk)))))) -+ -+ -+;;; Using temporary files -+(with-upgradability () -+ (defun default-temporary-directory () -+ (or -+ (when (os-unix-p) -+ (or (getenv-pathname "TMPDIR" :ensure-directory t) -+ (parse-native-namestring "/tmp/"))) -+ (when (os-windows-p) -+ (getenv-pathname "TEMP" :ensure-directory t)) -+ (subpathname (user-homedir-pathname) "tmp/"))) -+ -+ (defvar *temporary-directory* nil) -+ -+ (defun temporary-directory () -+ (or *temporary-directory* (default-temporary-directory))) -+ -+ (defun setup-temporary-directory () -+ (setf *temporary-directory* (default-temporary-directory)) -+ ;; basic lack fixed after gcl 2.7.0-61, but ending / required still on 2.7.0-64.1 -+ #+(and gcl (not gcl2.6)) (setf system::*tmp-dir* *temporary-directory*)) -+ -+ (defun call-with-temporary-file -+ (thunk &key -+ prefix keep (direction :io) -+ (element-type *default-stream-element-type*) -+ (external-format :default)) -+ #+gcl2.6 (declare (ignorable external-format)) -+ (check-type direction (member :output :io)) -+ (loop -+ :with prefix = (namestring (ensure-absolute-pathname (or prefix "tmp") #'temporary-directory)) -+ :for counter :from (random (ash 1 32)) -+ :for pathname = (pathname (format nil "~A~36R" prefix counter)) :do -+ ;; TODO: on Unix, do something about umask -+ ;; TODO: on Unix, audit the code so we make sure it uses O_CREAT|O_EXCL -+ ;; TODO: on Unix, use CFFI and mkstemp -- but asdf/driver is precisely meant to not depend on CFFI or on anything! Grrrr. -+ (with-open-file (stream pathname -+ :direction direction -+ :element-type element-type -+ #-gcl2.6 :external-format #-gcl2.6 external-format -+ :if-exists nil :if-does-not-exist :create) -+ (when stream -+ (return -+ (if keep -+ (funcall thunk stream pathname) -+ (unwind-protect -+ (funcall thunk stream pathname) -+ (ignore-errors (delete-file pathname))))))))) -+ -+ (defmacro with-temporary-file ((&key (stream (gensym "STREAM") streamp) -+ (pathname (gensym "PATHNAME") pathnamep) -+ prefix keep direction element-type external-format) -+ &body body) -+ "Evaluate BODY where the symbols specified by keyword arguments -+STREAM and PATHNAME are bound corresponding to a newly created temporary file -+ready for I/O. Unless KEEP is specified, delete the file afterwards." -+ (check-type stream symbol) -+ (check-type pathname symbol) -+ `(flet ((think (,stream ,pathname) -+ ,@(unless pathnamep `((declare (ignore ,pathname)))) -+ ,@(unless streamp `((when ,stream (close ,stream)))) -+ ,@body)) -+ #-gcl (declare (dynamic-extent #'think)) -+ (call-with-temporary-file -+ #'think -+ ,@(when direction `(:direction ,direction)) -+ ,@(when prefix `(:prefix ,prefix)) -+ ,@(when keep `(:keep ,keep)) -+ ,@(when element-type `(:element-type ,element-type)) -+ ,@(when external-format `(:external-format external-format))))) -+ -+ ;; Temporary pathnames in simple cases where no contention is assumed -+ (defun add-pathname-suffix (pathname suffix) -+ (make-pathname :name (strcat (pathname-name pathname) suffix) -+ :defaults pathname)) -+ -+ (defun tmpize-pathname (x) -+ (add-pathname-suffix x "-ASDF-TMP")) -+ -+ (defun call-with-staging-pathname (pathname fun) -+ "Calls fun with a staging pathname, and atomically -+renames the staging pathname to the pathname in the end. -+Note: this protects only against failure of the program, -+not against concurrent attempts. -+For the latter case, we ought pick random suffix and atomically open it." -+ (let* ((pathname (pathname pathname)) -+ (staging (tmpize-pathname pathname))) -+ (unwind-protect -+ (multiple-value-prog1 -+ (funcall fun staging) -+ (rename-file-overwriting-target staging pathname)) -+ (delete-file-if-exists staging)))) -+ -+ (defmacro with-staging-pathname ((pathname-var &optional (pathname-value pathname-var)) &body body) -+ `(call-with-staging-pathname ,pathname-value #'(lambda (,pathname-var) ,@body)))) -+ -+;;;; ------------------------------------------------------------------------- -+;;;; Starting, Stopping, Dumping a Lisp image -+ -+(uiop/package:define-package :uiop/image -+ (:nicknames :asdf/image) -+ (:recycle :uiop/image :asdf/image :xcvb-driver) -+ (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/pathname :uiop/stream :uiop/os) -+ (:export -+ #:*image-dumped-p* #:raw-command-line-arguments #:*command-line-arguments* -+ #:command-line-arguments #:raw-command-line-arguments #:setup-command-line-arguments -+ #:*lisp-interaction* -+ #:*fatal-conditions* #:fatal-condition-p #:handle-fatal-condition -+ #:call-with-fatal-condition-handler #:with-fatal-condition-handler -+ #:*image-restore-hook* #:*image-prelude* #:*image-entry-point* -+ #:*image-postlude* #:*image-dump-hook* -+ #:quit #:die #:raw-print-backtrace #:print-backtrace #:print-condition-backtrace -+ #:shell-boolean-exit -+ #:register-image-restore-hook #:register-image-dump-hook -+ #:call-image-restore-hook #:call-image-dump-hook -+ #:restore-image #:dump-image #:create-image -+)) -+(in-package :uiop/image) -+ -+(with-upgradability () -+ (defvar *lisp-interaction* t -+ "Is this an interactive Lisp environment, or is it batch processing?") -+ -+ (defvar *command-line-arguments* nil -+ "Command-line arguments") -+ -+ (defvar *image-dumped-p* nil ; may matter as to how to get to command-line-arguments -+ "Is this a dumped image? As a standalone executable?") -+ -+ (defvar *image-restore-hook* nil -+ "Functions to call (in reverse order) when the image is restored") -+ -+ (defvar *image-restored-p* nil -+ "Has the image been restored? A boolean, or :in-progress while restoring, :in-regress while dumping") -+ -+ (defvar *image-prelude* nil -+ "a form to evaluate, or string containing forms to read and evaluate -+when the image is restarted, but before the entry point is called.") -+ -+ (defvar *image-entry-point* nil -+ "a function with which to restart the dumped image when execution is restored from it.") -+ -+ (defvar *image-postlude* nil -+ "a form to evaluate, or string containing forms to read and evaluate -+before the image dump hooks are called and before the image is dumped.") -+ -+ (defvar *image-dump-hook* nil -+ "Functions to call (in order) when before an image is dumped") -+ -+ (defvar *fatal-conditions* '(error) -+ "conditions that cause the Lisp image to enter the debugger if interactive, -+or to die if not interactive")) -+ -+ -+;;; Exiting properly or im- -+(with-upgradability () -+ (defun quit (&optional (code 0) (finish-output t)) -+ "Quits from the Lisp world, with the given exit status if provided. -+This is designed to abstract away the implementation specific quit forms." -+ (when finish-output ;; essential, for ClozureCL, and for standard compliance. -+ (finish-outputs)) -+ #+(or abcl xcl) (ext:quit :status code) -+ #+allegro (excl:exit code :quiet t) -+ #+clisp (ext:quit code) -+ #+clozure (ccl:quit code) -+ #+cormanlisp (win32:exitprocess code) -+ #+(or cmu scl) (unix:unix-exit code) -+ #+ecl (si:quit code) -+ #+gcl (lisp:quit code) -+ #+genera (error "You probably don't want to Halt the Machine. (code: ~S)" code) -+ #+lispworks (lispworks:quit :status code :confirm nil :return nil :ignore-errors-p t) -+ #+mcl (ccl:quit) ;; or should we use FFI to call libc's exit(3) ? -+ #+mkcl (mk-ext:quit :exit-code code) -+ #+sbcl #.(let ((exit (find-symbol* :exit :sb-ext nil)) -+ (quit (find-symbol* :quit :sb-ext nil))) -+ (cond -+ (exit `(,exit :code code :abort (not finish-output))) -+ (quit `(,quit :unix-status code :recklessly-p (not finish-output))))) -+ #-(or abcl allegro clisp clozure cmu ecl gcl genera lispworks mcl mkcl sbcl scl xcl) -+ (error "~S called with exit code ~S but there's no quitting on this implementation" 'quit code)) -+ -+ (defun die (code format &rest arguments) -+ "Die in error with some error message" -+ (with-safe-io-syntax () -+ (ignore-errors -+ (fresh-line *stderr*) -+ (apply #'format *stderr* format arguments) -+ (format! *stderr* "~&"))) -+ (quit code)) -+ -+ (defun raw-print-backtrace (&key (stream *debug-io*) count) -+ "Print a backtrace, directly accessing the implementation" -+ (declare (ignorable stream count)) -+ #+abcl -+ (let ((*debug-io* stream)) (top-level::backtrace-command count)) -+ #+allegro -+ (let ((*terminal-io* stream) -+ (*standard-output* stream) -+ (tpl:*zoom-print-circle* *print-circle*) -+ (tpl:*zoom-print-level* *print-level*) -+ (tpl:*zoom-print-length* *print-length*)) -+ (tpl:do-command "zoom" -+ :from-read-eval-print-loop nil -+ :count t -+ :all t)) -+ #+clisp -+ (system::print-backtrace :out stream :limit count) -+ #+(or clozure mcl) -+ (let ((*debug-io* stream)) -+ (ccl:print-call-history :count count :start-frame-number 1) -+ (finish-output stream)) -+ #+(or cmu scl) -+ (let ((debug:*debug-print-level* *print-level*) -+ (debug:*debug-print-length* *print-length*)) -+ (debug:backtrace most-positive-fixnum stream)) -+ #+ecl -+ (si::tpl-backtrace) -+ #+lispworks -+ (let ((dbg::*debugger-stack* -+ (dbg::grab-stack nil :how-many (or count most-positive-fixnum))) -+ (*debug-io* stream) -+ (dbg:*debug-print-level* *print-level*) -+ (dbg:*debug-print-length* *print-length*)) -+ (dbg:bug-backtrace nil)) -+ #+sbcl -+ (sb-debug:backtrace -+ #.(if (find-symbol* "*VERBOSITY*" "SB-DEBUG" nil) :stream '(or count most-positive-fixnum)) -+ stream)) -+ -+ (defun print-backtrace (&rest keys &key stream count) -+ (declare (ignore stream count)) -+ (with-safe-io-syntax (:package :cl) -+ (let ((*print-readably* nil) -+ (*print-circle* t) -+ (*print-miser-width* 75) -+ (*print-length* nil) -+ (*print-level* nil) -+ (*print-pretty* t)) -+ (ignore-errors (apply 'raw-print-backtrace keys))))) -+ -+ (defun print-condition-backtrace (condition &key (stream *stderr*) count) -+ ;; We print the condition *after* the backtrace, -+ ;; for the sake of who sees the backtrace at a terminal. -+ ;; It is up to the caller to print the condition *before*, with some context. -+ (print-backtrace :stream stream :count count) -+ (when condition -+ (safe-format! stream "~&Above backtrace due to this condition:~%~A~&" -+ condition))) -+ -+ (defun fatal-condition-p (condition) -+ (match-any-condition-p condition *fatal-conditions*)) -+ -+ (defun handle-fatal-condition (condition) -+ "Depending on whether *LISP-INTERACTION* is set, enter debugger or die" -+ (cond -+ (*lisp-interaction* -+ (invoke-debugger condition)) -+ (t -+ (safe-format! *stderr* "~&Fatal condition:~%~A~%" condition) -+ (print-condition-backtrace condition :stream *stderr*) -+ (die 99 "~A" condition)))) -+ -+ (defun call-with-fatal-condition-handler (thunk) -+ (handler-bind (((satisfies fatal-condition-p) #'handle-fatal-condition)) -+ (funcall thunk))) -+ -+ (defmacro with-fatal-condition-handler ((&optional) &body body) -+ `(call-with-fatal-condition-handler #'(lambda () ,@body))) -+ -+ (defun shell-boolean-exit (x) -+ "Quit with a return code that is 0 iff argument X is true" -+ (quit (if x 0 1)))) -+ -+ -+;;; Using image hooks -+(with-upgradability () -+ (defun register-image-restore-hook (hook &optional (call-now-p t)) -+ (register-hook-function '*image-restore-hook* hook call-now-p)) -+ -+ (defun register-image-dump-hook (hook &optional (call-now-p nil)) -+ (register-hook-function '*image-dump-hook* hook call-now-p)) -+ -+ (defun call-image-restore-hook () -+ (call-functions (reverse *image-restore-hook*))) -+ -+ (defun call-image-dump-hook () -+ (call-functions *image-dump-hook*))) -+ -+ -+;;; Proper command-line arguments -+(with-upgradability () -+ (defun raw-command-line-arguments () -+ "Find what the actual command line for this process was." -+ #+abcl ext:*command-line-argument-list* ; Use 1.0.0 or later! -+ #+allegro (sys:command-line-arguments) ; default: :application t -+ #+clisp (coerce (ext:argv) 'list) -+ #+clozure (ccl::command-line-arguments) -+ #+(or cmu scl) extensions:*command-line-strings* -+ #+ecl (loop :for i :from 0 :below (si:argc) :collect (si:argv i)) -+ #+gcl si:*command-args* -+ #+genera nil -+ #+lispworks sys:*line-arguments-list* -+ #+sbcl sb-ext:*posix-argv* -+ #+xcl system:*argv* -+ #-(or abcl allegro clisp clozure cmu ecl gcl genera lispworks sbcl scl xcl) -+ (error "raw-command-line-arguments not implemented yet")) -+ -+ (defun command-line-arguments (&optional (arguments (raw-command-line-arguments))) -+ "Extract user arguments from command-line invocation of current process. -+Assume the calling conventions of a generated script that uses -- -+if we are not called from a directly executable image." -+ #+abcl arguments -+ #-abcl -+ (let* (#-(or sbcl allegro) -+ (arguments -+ (if (eq *image-dumped-p* :executable) -+ arguments -+ (member "--" arguments :test 'string-equal)))) -+ (rest arguments))) -+ -+ (defun setup-command-line-arguments () -+ (setf *command-line-arguments* (command-line-arguments))) -+ -+ (defun restore-image (&key -+ ((:lisp-interaction *lisp-interaction*) *lisp-interaction*) -+ ((:restore-hook *image-restore-hook*) *image-restore-hook*) -+ ((:prelude *image-prelude*) *image-prelude*) -+ ((:entry-point *image-entry-point*) *image-entry-point*) -+ (if-already-restored '(cerror "RUN RESTORE-IMAGE ANYWAY"))) -+ (when *image-restored-p* -+ (if if-already-restored -+ (call-function if-already-restored "Image already ~:[being ~;~]restored" (eq *image-restored-p* t)) -+ (return-from restore-image))) -+ (with-fatal-condition-handler () -+ (setf *image-restored-p* :in-progress) -+ (call-image-restore-hook) -+ (standard-eval-thunk *image-prelude*) -+ (setf *image-restored-p* t) -+ (let ((results (multiple-value-list -+ (if *image-entry-point* -+ (call-function *image-entry-point*) -+ t)))) -+ (if *lisp-interaction* -+ (apply 'values results) -+ (shell-boolean-exit (first results))))))) -+ -+ -+;;; Dumping an image -+ -+(with-upgradability () -+ (defun dump-image (filename &key output-name executable -+ ((:postlude *image-postlude*) *image-postlude*) -+ ((:dump-hook *image-dump-hook*) *image-dump-hook*) -+ #+clozure prepend-symbols #+clozure (purify t)) -+ (declare (ignorable filename output-name executable)) -+ (setf *image-dumped-p* (if executable :executable t)) -+ (setf *image-restored-p* :in-regress) -+ (standard-eval-thunk *image-postlude*) -+ (call-image-dump-hook) -+ (setf *image-restored-p* nil) -+ #-(or clisp clozure cmu lispworks sbcl scl) -+ (when executable -+ (error "Dumping an executable is not supported on this implementation! Aborting.")) -+ #+allegro -+ (progn -+ (sys:resize-areas :global-gc t :pack-heap t :sift-old-areas t :tenure t) ; :new 5000000 -+ (excl:dumplisp :name filename :suppress-allegro-cl-banner t)) -+ #+clisp -+ (apply #'ext:saveinitmem filename -+ :quiet t -+ :start-package *package* -+ :keep-global-handlers nil -+ :executable (if executable 0 t) ;--- requires clisp 2.48 or later, still catches --clisp-x -+ (when executable -+ (list -+ ;; :parse-options nil ;--- requires a non-standard patch to clisp. -+ :norc t :script nil :init-function #'restore-image))) -+ #+clozure -+ (flet ((dump (prepend-kernel) -+ (ccl:save-application filename :prepend-kernel prepend-kernel :purify purify -+ :toplevel-function (when executable #'restore-image)))) -+ ;;(setf ccl::*application* (make-instance 'ccl::lisp-development-system)) -+ (if prepend-symbols -+ (with-temporary-file (:prefix "ccl-symbols-" :direction :output :pathname path) -+ (require 'elf) -+ (funcall (fdefinition 'ccl::write-elf-symbols-to-file) path) -+ (dump path)) -+ (dump t))) -+ #+(or cmu scl) -+ (progn -+ (ext:gc :full t) -+ (setf ext:*batch-mode* nil) -+ (setf ext::*gc-run-time* 0) -+ (apply 'ext:save-lisp filename #+cmu :executable #+cmu t -+ (when executable '(:init-function restore-image :process-command-line nil)))) -+ #+gcl -+ (progn -+ (si::set-hole-size 500) (si::gbc nil) (si::sgc-on t) -+ (si::save-system filename)) -+ #+lispworks -+ (if executable -+ (lispworks:deliver 'restore-image filename 0 :interface nil) -+ (hcl:save-image filename :environment nil)) -+ #+sbcl -+ (progn -+ ;;(sb-pcl::precompile-random-code-segments) ;--- it is ugly slow at compile-time (!) when the initial core is a big CLOS program. If you want it, do it yourself -+ (setf sb-ext::*gc-run-time* 0) -+ (apply 'sb-ext:save-lisp-and-die filename -+ :executable t ;--- always include the runtime that goes with the core -+ (when executable (list :toplevel #'restore-image :save-runtime-options t)))) ;--- only save runtime-options for standalone executables -+ #-(or allegro clisp clozure cmu gcl lispworks sbcl scl) -+ (error "Can't ~S ~S: UIOP doesn't support image dumping with ~A.~%" -+ 'dump-image filename (nth-value 1 (implementation-type)))) -+ -+ (defun create-image (destination object-files -+ &key kind output-name prologue-code epilogue-code -+ (prelude () preludep) (postlude () postludep) -+ (entry-point () entry-point-p) build-args) -+ (declare (ignorable destination object-files kind output-name prologue-code epilogue-code -+ prelude preludep postlude postludep entry-point entry-point-p build-args)) -+ ;; Is it meaningful to run these in the current environment? -+ ;; only if we also track the object files that constitute the "current" image, -+ ;; and otherwise simulate dump-image, including quitting at the end. -+ #-ecl (error "~S not implemented for your implementation (yet)" 'create-image) -+ #+ecl -+ (progn -+ (check-type kind (member :binary :dll :lib :static-library :program :object :fasl :program)) -+ (apply 'c::builder -+ kind (pathname destination) -+ :lisp-files object-files -+ :init-name (c::compute-init-name (or output-name destination) :kind kind) -+ :prologue-code prologue-code -+ :epilogue-code -+ `(progn -+ ,epilogue-code -+ ,@(when (eq kind :program) -+ `((setf *image-dumped-p* :executable) -+ (restore-image ;; default behavior would be (si::top-level) -+ ,@(when preludep `(:prelude ',prelude)) -+ ,@(when entry-point-p `(:entry-point ',entry-point)))))) -+ build-args)))) -+ -+ -+;;; Some universal image restore hooks -+(with-upgradability () -+ (map () 'register-image-restore-hook -+ '(setup-temporary-directory setup-stderr setup-command-line-arguments -+ #+abcl detect-os))) -+;;;; ------------------------------------------------------------------------- -+;;;; run-program initially from xcvb-driver. -+ -+(uiop/package:define-package :uiop/run-program -+ (:nicknames :asdf/run-program) -+ (:recycle :uiop/run-program :asdf/run-program :xcvb-driver) -+ (:use :uiop/common-lisp :uiop/utility :uiop/pathname :uiop/os :uiop/filesystem :uiop/stream) -+ (:export -+ ;;; Escaping the command invocation madness -+ #:easy-sh-character-p #:escape-sh-token #:escape-sh-command -+ #:escape-windows-token #:escape-windows-command -+ #:escape-token #:escape-command -+ -+ ;;; run-program -+ #:slurp-input-stream -+ #:run-program -+ #:subprocess-error -+ #:subprocess-error-code #:subprocess-error-command #:subprocess-error-process -+ )) -+(in-package :uiop/run-program) -+ -+;;;; ----- Escaping strings for the shell ----- -+ -+(with-upgradability () -+ (defun requires-escaping-p (token &key good-chars bad-chars) -+ "Does this token require escaping, given the specification of -+either good chars that don't need escaping or bad chars that do need escaping, -+as either a recognizing function or a sequence of characters." -+ (some -+ (cond -+ ((and good-chars bad-chars) -+ (error "only one of good-chars and bad-chars can be provided")) -+ ((functionp good-chars) -+ (complement good-chars)) -+ ((functionp bad-chars) -+ bad-chars) -+ ((and good-chars (typep good-chars 'sequence)) -+ #'(lambda (c) (not (find c good-chars)))) -+ ((and bad-chars (typep bad-chars 'sequence)) -+ #'(lambda (c) (find c bad-chars))) -+ (t (error "requires-escaping-p: no good-char criterion"))) -+ token)) -+ -+ (defun escape-token (token &key stream quote good-chars bad-chars escaper) -+ "Call the ESCAPER function on TOKEN string if it needs escaping as per -+REQUIRES-ESCAPING-P using GOOD-CHARS and BAD-CHARS, otherwise output TOKEN, -+using STREAM as output (or returning result as a string if NIL)" -+ (if (requires-escaping-p token :good-chars good-chars :bad-chars bad-chars) -+ (with-output (stream) -+ (apply escaper token stream (when quote `(:quote ,quote)))) -+ (output-string token stream))) -+ -+ (defun escape-windows-token-within-double-quotes (x &optional s) -+ "Escape a string token X within double-quotes -+for use within a MS Windows command-line, outputing to S." -+ (labels ((issue (c) (princ c s)) -+ (issue-backslash (n) (loop :repeat n :do (issue #\\)))) -+ (loop -+ :initially (issue #\") :finally (issue #\") -+ :with l = (length x) :with i = 0 -+ :for i+1 = (1+ i) :while (< i l) :do -+ (case (char x i) -+ ((#\") (issue-backslash 1) (issue #\") (setf i i+1)) -+ ((#\\) -+ (let* ((j (and (< i+1 l) (position-if-not -+ #'(lambda (c) (eql c #\\)) x :start i+1))) -+ (n (- (or j l) i))) -+ (cond -+ ((null j) -+ (issue-backslash (* 2 n)) (setf i l)) -+ ((and (< j l) (eql (char x j) #\")) -+ (issue-backslash (1+ (* 2 n))) (issue #\") (setf i (1+ j))) -+ (t -+ (issue-backslash n) (setf i j))))) -+ (otherwise -+ (issue (char x i)) (setf i i+1)))))) -+ -+ (defun escape-windows-token (token &optional s) -+ "Escape a string TOKEN within double-quotes if needed -+for use within a MS Windows command-line, outputing to S." -+ (escape-token token :stream s :bad-chars #(#\space #\tab #\") :quote nil -+ :escaper 'escape-windows-token-within-double-quotes)) -+ -+ (defun escape-sh-token-within-double-quotes (x s &key (quote t)) -+ "Escape a string TOKEN within double-quotes -+for use within a POSIX Bourne shell, outputing to S; -+omit the outer double-quotes if key argument :QUOTE is NIL" -+ (when quote (princ #\" s)) -+ (loop :for c :across x :do -+ (when (find c "$`\\\"") (princ #\\ s)) -+ (princ c s)) -+ (when quote (princ #\" s))) -+ -+ (defun easy-sh-character-p (x) -+ (or (alphanumericp x) (find x "+-_.,%@:/"))) -+ -+ (defun escape-sh-token (token &optional s) -+ "Escape a string TOKEN within double-quotes if needed -+for use within a POSIX Bourne shell, outputing to S." -+ (escape-token token :stream s :quote #\" :good-chars -+ #'easy-sh-character-p -+ :escaper 'escape-sh-token-within-double-quotes)) -+ -+ (defun escape-shell-token (token &optional s) -+ (cond -+ ((os-unix-p) (escape-sh-token token s)) -+ ((os-windows-p) (escape-windows-token token s)))) -+ -+ (defun escape-command (command &optional s -+ (escaper 'escape-shell-token)) -+ "Given a COMMAND as a list of tokens, return a string of the -+spaced, escaped tokens, using ESCAPER to escape." -+ (etypecase command -+ (string (output-string command s)) -+ (list (with-output (s) -+ (loop :for first = t :then nil :for token :in command :do -+ (unless first (princ #\space s)) -+ (funcall escaper token s)))))) -+ -+ (defun escape-windows-command (command &optional s) -+ "Escape a list of command-line arguments into a string suitable for parsing -+by CommandLineToArgv in MS Windows" -+ ;; http://msdn.microsoft.com/en-us/library/bb776391(v=vs.85).aspx -+ ;; http://msdn.microsoft.com/en-us/library/17w5ykft(v=vs.85).aspx -+ (escape-command command s 'escape-windows-token)) -+ -+ (defun escape-sh-command (command &optional s) -+ "Escape a list of command-line arguments into a string suitable for parsing -+by /bin/sh in POSIX" -+ (escape-command command s 'escape-sh-token)) -+ -+ (defun escape-shell-command (command &optional stream) -+ "Escape a command for the current operating system's shell" -+ (escape-command command stream 'escape-shell-token))) -+ -+ -+;;;; Slurping a stream, typically the output of another program -+(with-upgradability () -+ (defgeneric slurp-input-stream (processor input-stream &key &allow-other-keys)) -+ -+ #-(or gcl2.6 genera) -+ (defmethod slurp-input-stream ((function function) input-stream &key &allow-other-keys) -+ (funcall function input-stream)) -+ -+ (defmethod slurp-input-stream ((list cons) input-stream &key &allow-other-keys) -+ (apply (first list) (cons input-stream (rest list)))) -+ -+ #-(or gcl2.6 genera) -+ (defmethod slurp-input-stream ((output-stream stream) input-stream -+ &key linewise prefix (element-type 'character) buffer-size &allow-other-keys) -+ (copy-stream-to-stream -+ input-stream output-stream -+ :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size)) -+ -+ (defmethod slurp-input-stream ((x (eql 'string)) stream &key &allow-other-keys) -+ (declare (ignorable x)) -+ (slurp-stream-string stream)) -+ -+ (defmethod slurp-input-stream ((x (eql :string)) stream &key &allow-other-keys) -+ (declare (ignorable x)) -+ (slurp-stream-string stream)) -+ -+ (defmethod slurp-input-stream ((x (eql :lines)) stream &key count &allow-other-keys) -+ (declare (ignorable x)) -+ (slurp-stream-lines stream :count count)) -+ -+ (defmethod slurp-input-stream ((x (eql :line)) stream &key (at 0) &allow-other-keys) -+ (declare (ignorable x)) -+ (slurp-stream-line stream :at at)) -+ -+ (defmethod slurp-input-stream ((x (eql :forms)) stream &key count &allow-other-keys) -+ (declare (ignorable x)) -+ (slurp-stream-forms stream :count count)) -+ -+ (defmethod slurp-input-stream ((x (eql :form)) stream &key (at 0) &allow-other-keys) -+ (declare (ignorable x)) -+ (slurp-stream-form stream :at at)) -+ -+ (defmethod slurp-input-stream ((x (eql t)) stream &rest keys &key &allow-other-keys) -+ (declare (ignorable x)) -+ (apply 'slurp-input-stream *standard-output* stream keys)) -+ -+ (defmethod slurp-input-stream ((pathname pathname) input -+ &key -+ (element-type *default-stream-element-type*) -+ (external-format *utf-8-external-format*) -+ (if-exists :rename-and-delete) -+ (if-does-not-exist :create) -+ buffer-size -+ linewise) -+ (with-output-file (output pathname -+ :element-type element-type -+ :external-format external-format -+ :if-exists if-exists -+ :if-does-not-exist if-does-not-exist) -+ (copy-stream-to-stream -+ input output -+ :element-type element-type :buffer-size buffer-size :linewise linewise))) -+ -+ (defmethod slurp-input-stream (x stream -+ &key linewise prefix (element-type 'character) buffer-size -+ &allow-other-keys) -+ (declare (ignorable stream linewise prefix element-type buffer-size)) -+ (cond -+ #+(or gcl2.6 genera) -+ ((functionp x) (funcall x stream)) -+ #+(or gcl2.6 genera) -+ ((output-stream-p x) -+ (copy-stream-to-stream -+ input-stream output-stream -+ :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size)) -+ (t -+ (error "Invalid ~S destination ~S" 'slurp-input-stream x))))) -+ -+ -+;;;; ----- Running an external program ----- -+;;; Simple variant of run-program with no input, and capturing output -+;;; On some implementations, may output to a temporary file... -+(with-upgradability () -+ (define-condition subprocess-error (error) -+ ((code :initform nil :initarg :code :reader subprocess-error-code) -+ (command :initform nil :initarg :command :reader subprocess-error-command) -+ (process :initform nil :initarg :process :reader subprocess-error-process)) -+ (:report (lambda (condition stream) -+ (format stream "Subprocess~@[ ~S~]~@[ run with command ~S~] exited with error~@[ code ~D~]" -+ (subprocess-error-process condition) -+ (subprocess-error-command condition) -+ (subprocess-error-code condition))))) -+ -+ (defun run-program (command -+ &key output ignore-error-status force-shell -+ (element-type *default-stream-element-type*) -+ (external-format :default) -+ &allow-other-keys) -+ "Run program specified by COMMAND, -+either a list of strings specifying a program and list of arguments, -+or a string specifying a shell command (/bin/sh on Unix, CMD.EXE on Windows). -+ -+Always call a shell (rather than directly execute the command) -+if FORCE-SHELL is specified. -+ -+Signal a SUBPROCESS-ERROR if the process wasn't successful (exit-code 0), -+unless IGNORE-ERROR-STATUS is specified. -+ -+If OUTPUT is either NIL or :INTERACTIVE, then -+return the exit status code of the process that was called. -+if it was NIL, the output is discarded; -+if it was :INTERACTIVE, the output and the input are inherited from the current process. -+ -+Otherwise, the output will be processed by SLURP-INPUT-STREAM, -+using OUTPUT as the first argument, and return whatever it returns, -+e.g. using :OUTPUT :STRING will have it return the entire output stream as a string. -+Use ELEMENT-TYPE and EXTERNAL-FORMAT for the stream passed to the OUTPUT processor." -+ ;; TODO: specially recognize :output pathname ? -+ (declare (ignorable ignore-error-status element-type external-format)) -+ #-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl lispworks mcl sbcl scl xcl) -+ (error "RUN-PROGRAM not implemented for this Lisp") -+ (labels (#+(or allegro clisp clozure cmu ecl (and lispworks os-unix) sbcl scl) -+ (run-program (command &key pipe interactive) -+ "runs the specified command (a list of program and arguments). -+ If using a pipe, returns two values: process and stream -+ If not using a pipe, returns one values: the process result; -+ also, inherits the output stream." -+ ;; NB: these implementations have unix vs windows set at compile-time. -+ (assert (not (and pipe interactive))) -+ (let* ((wait (not pipe)) -+ #-(and clisp os-windows) -+ (command -+ (etypecase command -+ #+os-unix (string `("/bin/sh" "-c" ,command)) -+ #+os-unix (list command) -+ #+os-windows -+ (string -+ ;; NB: We do NOT add cmd /c here. You might want to. -+ #+allegro command -+ ;; On ClozureCL for Windows, we assume you are using -+ ;; r15398 or later in 1.9 or later, -+ ;; so that bug 858 is fixed http://trac.clozure.com/ccl/ticket/858 -+ #+clozure (cons "cmd" (strcat "/c " command)) -+ ;; NB: On other Windows implementations, this is utterly bogus -+ ;; except in the most trivial cases where no quoting is needed. -+ ;; Use at your own risk. -+ #-(or allegro clozure) (list "cmd" "/c" command)) -+ #+os-windows -+ (list -+ #+(or allegro clozure) (escape-windows-command command) -+ #-(or allegro clozure) command))) -+ #+(and clozure os-windows) (command (list command)) -+ (process* -+ (multiple-value-list -+ #+allegro -+ (excl:run-shell-command -+ #+os-unix (coerce (cons (first command) command) 'vector) -+ #+os-windows command -+ :input interactive :output (or (and pipe :stream) interactive) :wait wait -+ #+os-windows :show-window #+os-windows (and (or (null output) pipe) :hide)) -+ #+clisp -+ (flet ((run (f &rest args) -+ (apply f `(,@args :input ,(when interactive :terminal) :wait ,wait :output -+ ,(if pipe :stream :terminal))))) -+ (etypecase command -+ #+os-windows (run 'ext:run-shell-command command) -+ (list (run 'ext:run-program (car command) -+ :arguments (cdr command))))) -+ #+lispworks -+ (system:run-shell-command -+ (cons "/usr/bin/env" command) ; lispworks wants a full path. -+ :input interactive :output (or (and pipe :stream) interactive) -+ :wait wait :save-exit-status (and pipe t)) -+ #+(or clozure cmu ecl sbcl scl) -+ (#+(or cmu ecl scl) ext:run-program -+ #+clozure ccl:run-program -+ #+sbcl sb-ext:run-program -+ (car command) (cdr command) -+ :input interactive :wait wait -+ :output (if pipe :stream t) -+ . #.(append -+ #+(or clozure cmu ecl sbcl scl) '(:error t) -+ ;; note: :external-format requires a recent SBCL -+ #+sbcl '(:search t :external-format external-format))))) -+ (process -+ #+allegro (if pipe (third process*) (first process*)) -+ #+ecl (third process*) -+ #-(or allegro ecl) (first process*)) -+ (stream -+ (when pipe -+ #+(or allegro lispworks ecl) (first process*) -+ #+clisp (first process*) -+ #+clozure (ccl::external-process-output process) -+ #+(or cmu scl) (ext:process-output process) -+ #+sbcl (sb-ext:process-output process)))) -+ (values process stream))) -+ #+(or allegro clisp clozure cmu ecl (and lispworks os-unix) sbcl scl) -+ (process-result (process pipe) -+ (declare (ignorable pipe)) -+ ;; 1- wait -+ #+(and clozure os-unix) (ccl::external-process-wait process) -+ #+(or cmu scl) (ext:process-wait process) -+ #+(and ecl os-unix) (ext:external-process-wait process) -+ #+sbcl (sb-ext:process-wait process) -+ ;; 2- extract result -+ #+allegro (if pipe (sys:reap-os-subprocess :pid process :wait t) process) -+ #+clisp process -+ #+clozure (nth-value 1 (ccl:external-process-status process)) -+ #+(or cmu scl) (ext:process-exit-code process) -+ #+ecl (nth-value 1 (ext:external-process-status process)) -+ #+lispworks (if pipe (system:pipe-exit-status process :wait t) process) -+ #+sbcl (sb-ext:process-exit-code process)) -+ (check-result (exit-code process) -+ #+clisp -+ (setf exit-code -+ (typecase exit-code (integer exit-code) (null 0) (t -1))) -+ (unless (or ignore-error-status -+ (equal exit-code 0)) -+ (error 'subprocess-error :command command :code exit-code :process process)) -+ exit-code) -+ (use-run-program () -+ #-(or abcl cormanlisp gcl (and lispworks os-windows) mcl mkcl xcl) -+ (let* ((interactive (eq output :interactive)) -+ (pipe (and output (not interactive)))) -+ (multiple-value-bind (process stream) -+ (run-program command :pipe pipe :interactive interactive) -+ (if (and output (not interactive)) -+ (unwind-protect -+ (slurp-input-stream output stream) -+ (when stream (close stream)) -+ (check-result (process-result process pipe) process)) -+ (unwind-protect -+ (check-result -+ #+(or allegro lispworks) ; when not capturing, returns the exit code! -+ process -+ #-(or allegro lispworks) (process-result process pipe) -+ process)))))) -+ (system-command (command) -+ (etypecase command -+ (string (if (os-windows-p) (format nil "cmd /c ~A" command) command)) -+ (list (escape-shell-command -+ (if (os-unix-p) (cons "exec" command) command))))) -+ (redirected-system-command (command out) -+ (format nil (if (os-unix-p) "exec > ~*~A ; ~2:*~A" "~A > ~A") -+ (system-command command) (native-namestring out))) -+ (system (command &key interactive) -+ (declare (ignorable interactive)) -+ #+(or abcl xcl) (ext:run-shell-command command) -+ #+allegro -+ (excl:run-shell-command -+ command :input interactive :output interactive :wait t -+ #+os-windows :show-window #+os-windows (unless (or interactive (eq output t)) :hide)) -+ #+(or clisp clozure cmu (and lispworks os-unix) sbcl scl) -+ (process-result (run-program command :pipe nil :interactive interactive) nil) -+ #+ecl (ext:system command) -+ #+cormanlisp (win32:system command) -+ #+gcl (lisp:system command) -+ #+(and lispworks os-windows) -+ (system:call-system-showing-output -+ command :show-cmd (or interactive (eq output t)) :prefix "" :output-stream nil) -+ #+mcl (ccl::with-cstrs ((%command command)) (_system %command)) -+ #+mkcl (nth-value 2 -+ (mkcl:run-program #+windows command #+windows () -+ #-windows "/bin/sh" (list "-c" command) -+ :input nil :output nil))) -+ (call-system (command-string &key interactive) -+ (check-result (system command-string :interactive interactive) nil)) -+ (use-system () -+ (let ((interactive (eq output :interactive))) -+ (if (and output (not interactive)) -+ (with-temporary-file (:pathname tmp :direction :output) -+ (call-system (redirected-system-command command tmp)) -+ (with-open-file (stream tmp -+ :direction :input -+ :if-does-not-exist :error -+ :element-type element-type -+ #-gcl2.6 :external-format #-gcl2.6 external-format) -+ (slurp-input-stream output stream))) -+ (call-system (system-command command) :interactive interactive))))) -+ (if (and (not force-shell) -+ #+(or clisp ecl) ignore-error-status -+ #+(or abcl cormanlisp gcl (and lispworks os-windows) mcl mkcl xcl) nil) -+ (use-run-program) -+ (use-system))))) -+ -+;;;; ------------------------------------------------------------------------- -+;;;; Support to build (compile and load) Lisp files -+ -+(uiop/package:define-package :uiop/lisp-build -+ (:nicknames :asdf/lisp-build) -+ (:recycle :uiop/lisp-build :asdf/lisp-build :asdf) -+ (:use :uiop/common-lisp :uiop/package :uiop/utility -+ :uiop/os :uiop/pathname :uiop/filesystem :uiop/stream :uiop/image) -+ (:export -+ ;; Variables -+ #:*compile-file-warnings-behaviour* #:*compile-file-failure-behaviour* -+ #:*output-translation-function* -+ #:*optimization-settings* #:*previous-optimization-settings* -+ #:compile-condition #:compile-file-error #:compile-warned-error #:compile-failed-error -+ #:compile-warned-warning #:compile-failed-warning -+ #:check-lisp-compile-results #:check-lisp-compile-warnings -+ #:*uninteresting-conditions* #:*uninteresting-compiler-conditions* #:*uninteresting-loader-conditions* -+ ;; Types -+ #+sbcl #:sb-grovel-unknown-constant-condition -+ ;; Functions & Macros -+ #:get-optimization-settings #:proclaim-optimization-settings -+ #:call-with-muffled-compiler-conditions #:with-muffled-compiler-conditions -+ #:call-with-muffled-loader-conditions #:with-muffled-loader-conditions -+ #:reify-simple-sexp #:unreify-simple-sexp -+ #:reify-deferred-warnings #:unreify-deferred-warnings -+ #:reset-deferred-warnings #:save-deferred-warnings #:check-deferred-warnings -+ #:with-saved-deferred-warnings #:warnings-file-p #:warnings-file-type #:*warnings-file-type* -+ #:enable-deferred-warnings-check #:disable-deferred-warnings-check -+ #:current-lisp-file-pathname #:load-pathname -+ #:lispize-pathname #:compile-file-type #:call-around-hook -+ #:compile-file* #:compile-file-pathname* -+ #:load* #:load-from-string #:combine-fasls) -+ (:intern #:defaults #:failure-p #:warnings-p #:s #:y #:body)) -+(in-package :uiop/lisp-build) -+ -+(with-upgradability () -+ (defvar *compile-file-warnings-behaviour* -+ (or #+clisp :ignore :warn) -+ "How should ASDF react if it encounters a warning when compiling a file? -+Valid values are :error, :warn, and :ignore.") -+ -+ (defvar *compile-file-failure-behaviour* -+ (or #+(or mkcl sbcl) :error #+clisp :ignore :warn) -+ "How should ASDF react if it encounters a failure (per the ANSI spec of COMPILE-FILE) -+when compiling a file, which includes any non-style-warning warning. -+Valid values are :error, :warn, and :ignore. -+Note that ASDF ALWAYS raises an error if it fails to create an output file when compiling.")) -+ -+ -+;;; Optimization settings -+(with-upgradability () -+ (defvar *optimization-settings* nil) -+ (defvar *previous-optimization-settings* nil) -+ (defun get-optimization-settings () -+ "Get current compiler optimization settings, ready to PROCLAIM again" -+ #-(or clisp clozure cmu ecl sbcl scl) -+ (warn "~S does not support ~S. Please help me fix that." 'get-optimization-settings (implementation-type)) -+ #+clozure (ccl:declaration-information 'optimize nil) -+ #+(or clisp cmu ecl sbcl scl) -+ (let ((settings '(speed space safety debug compilation-speed #+(or cmu scl) c::brevity))) -+ #.`(loop :for x :in settings -+ ,@(or #+ecl '(:for v :in '(c::*speed* c::*space* c::*safety* c::*debug*)) -+ #+(or cmu scl) '(:for f :in '(c::cookie-speed c::cookie-space c::cookie-safety c::cookie-debug c::cookie-cspeed c::cookie-brevity))) -+ :for y = (or #+clisp (gethash x system::*optimize*) -+ #+(or ecl) (symbol-value v) -+ #+(or cmu scl) (funcall f c::*default-cookie*) -+ #+sbcl (cdr (assoc x sb-c::*policy*))) -+ :when y :collect (list x y)))) -+ (defun proclaim-optimization-settings () -+ "Proclaim the optimization settings in *OPTIMIZATION-SETTINGS*" -+ (proclaim `(optimize ,@*optimization-settings*)) -+ (let ((settings (get-optimization-settings))) -+ (unless (equal *previous-optimization-settings* settings) -+ (setf *previous-optimization-settings* settings))))) -+ -+ -+;;; Condition control -+(with-upgradability () -+ #+sbcl -+ (progn -+ (defun sb-grovel-unknown-constant-condition-p (c) -+ (and (typep c 'sb-int:simple-style-warning) -+ (string-enclosed-p -+ "Couldn't grovel for " -+ (simple-condition-format-control c) -+ " (unknown to the C compiler)."))) -+ (deftype sb-grovel-unknown-constant-condition () -+ '(and style-warning (satisfies sb-grovel-unknown-constant-condition-p)))) -+ -+ (defvar *usual-uninteresting-conditions* -+ (append -+ ;;#+clozure '(ccl:compiler-warning) -+ #+cmu '("Deleting unreachable code.") -+ #+lispworks '("~S being redefined in ~A (previously in ~A)." -+ "~S defined more than once in ~A.") ;; lispworks gets confused by eval-when. -+ #+sbcl -+ '(sb-c::simple-compiler-note -+ "&OPTIONAL and &KEY found in the same lambda list: ~S" -+ #+sb-eval sb-kernel:lexical-environment-too-complex -+ sb-kernel:undefined-alien-style-warning -+ sb-grovel-unknown-constant-condition ; defined above. -+ sb-ext:implicit-generic-function-warning ;; Controversial. -+ sb-int:package-at-variance -+ sb-kernel:uninteresting-redefinition -+ ;; BEWARE: the below four are controversial to include here. -+ sb-kernel:redefinition-with-defun -+ sb-kernel:redefinition-with-defgeneric -+ sb-kernel:redefinition-with-defmethod -+ sb-kernel::redefinition-with-defmacro) ; not exported by old SBCLs -+ '("No generic function ~S present when encountering macroexpansion of defmethod. Assuming it will be an instance of standard-generic-function.")) ;; from closer2mop -+ "A suggested value to which to set or bind *uninteresting-conditions*.") -+ -+ (defvar *uninteresting-conditions* '() -+ "Conditions that may be skipped while compiling or loading Lisp code.") -+ (defvar *uninteresting-compiler-conditions* '() -+ "Additional conditions that may be skipped while compiling Lisp code.") -+ (defvar *uninteresting-loader-conditions* -+ (append -+ '("Overwriting already existing readtable ~S." ;; from named-readtables -+ #(#:finalizers-off-warning :asdf-finalizers)) ;; from asdf-finalizers -+ #+clisp '(clos::simple-gf-replacing-method-warning)) -+ "Additional conditions that may be skipped while loading Lisp code.")) -+ -+;;;; ----- Filtering conditions while building ----- -+(with-upgradability () -+ (defun call-with-muffled-compiler-conditions (thunk) -+ (call-with-muffled-conditions -+ thunk (append *uninteresting-conditions* *uninteresting-compiler-conditions*))) -+ (defmacro with-muffled-compiler-conditions ((&optional) &body body) -+ "Run BODY where uninteresting compiler conditions are muffled" -+ `(call-with-muffled-compiler-conditions #'(lambda () ,@body))) -+ (defun call-with-muffled-loader-conditions (thunk) -+ (call-with-muffled-conditions -+ thunk (append *uninteresting-conditions* *uninteresting-loader-conditions*))) -+ (defmacro with-muffled-loader-conditions ((&optional) &body body) -+ "Run BODY where uninteresting compiler and additional loader conditions are muffled" -+ `(call-with-muffled-loader-conditions #'(lambda () ,@body)))) -+ -+ -+;;;; Handle warnings and failures -+(with-upgradability () -+ (define-condition compile-condition (condition) -+ ((context-format -+ :initform nil :reader compile-condition-context-format :initarg :context-format) -+ (context-arguments -+ :initform nil :reader compile-condition-context-arguments :initarg :context-arguments) -+ (description -+ :initform nil :reader compile-condition-description :initarg :description)) -+ (:report (lambda (c s) -+ (format s (compatfmt "~@<~A~@[ while ~?~]~@:>") -+ (or (compile-condition-description c) (type-of c)) -+ (compile-condition-context-format c) -+ (compile-condition-context-arguments c))))) -+ (define-condition compile-file-error (compile-condition error) ()) -+ (define-condition compile-warned-warning (compile-condition warning) ()) -+ (define-condition compile-warned-error (compile-condition error) ()) -+ (define-condition compile-failed-warning (compile-condition warning) ()) -+ (define-condition compile-failed-error (compile-condition error) ()) -+ -+ (defun check-lisp-compile-warnings (warnings-p failure-p -+ &optional context-format context-arguments) -+ (when failure-p -+ (case *compile-file-failure-behaviour* -+ (:warn (warn 'compile-failed-warning -+ :description "Lisp compilation failed" -+ :context-format context-format -+ :context-arguments context-arguments)) -+ (:error (error 'compile-failed-error -+ :description "Lisp compilation failed" -+ :context-format context-format -+ :context-arguments context-arguments)) -+ (:ignore nil))) -+ (when warnings-p -+ (case *compile-file-warnings-behaviour* -+ (:warn (warn 'compile-warned-warning -+ :description "Lisp compilation had style-warnings" -+ :context-format context-format -+ :context-arguments context-arguments)) -+ (:error (error 'compile-warned-error -+ :description "Lisp compilation had style-warnings" -+ :context-format context-format -+ :context-arguments context-arguments)) -+ (:ignore nil)))) -+ -+ (defun check-lisp-compile-results (output warnings-p failure-p -+ &optional context-format context-arguments) -+ (unless output -+ (error 'compile-file-error :context-format context-format :context-arguments context-arguments)) -+ (check-lisp-compile-warnings warnings-p failure-p context-format context-arguments))) -+ -+ -+;;;; Deferred-warnings treatment, originally implemented by Douglas Katzman. -+;;; -+;;; To support an implementation, three functions must be implemented: -+;;; reify-deferred-warnings unreify-deferred-warnings reset-deferred-warnings -+;;; See their respective docstrings. -+(with-upgradability () -+ (defun reify-simple-sexp (sexp) -+ (etypecase sexp -+ (symbol (reify-symbol sexp)) -+ ((or number character simple-string pathname) sexp) -+ (cons (cons (reify-simple-sexp (car sexp)) (reify-simple-sexp (cdr sexp)))) -+ (simple-vector (vector (mapcar 'reify-simple-sexp (coerce sexp 'list)))))) -+ -+ (defun unreify-simple-sexp (sexp) -+ (etypecase sexp -+ ((or symbol number character simple-string pathname) sexp) -+ (cons (cons (unreify-simple-sexp (car sexp)) (unreify-simple-sexp (cdr sexp)))) -+ ((simple-vector 2) (unreify-symbol sexp)) -+ ((simple-vector 1) (coerce (mapcar 'unreify-simple-sexp (aref sexp 0)) 'vector)))) -+ -+ #+clozure -+ (progn -+ (defun reify-source-note (source-note) -+ (when source-note -+ (with-accessors ((source ccl::source-note-source) (filename ccl:source-note-filename) -+ (start-pos ccl:source-note-start-pos) (end-pos ccl:source-note-end-pos)) source-note -+ (declare (ignorable source)) -+ (list :filename filename :start-pos start-pos :end-pos end-pos -+ #|:source (reify-source-note source)|#)))) -+ (defun unreify-source-note (source-note) -+ (when source-note -+ (destructuring-bind (&key filename start-pos end-pos source) source-note -+ (ccl::make-source-note :filename filename :start-pos start-pos :end-pos end-pos -+ :source (unreify-source-note source))))) -+ (defun unsymbolify-function-name (name) -+ (if-let (setfed (gethash name ccl::%setf-function-name-inverses%)) -+ `(setf ,setfed) -+ name)) -+ (defun symbolify-function-name (name) -+ (if (and (consp name) (eq (first name) 'setf)) -+ (let ((setfed (second name))) -+ (gethash setfed ccl::%setf-function-names%)) -+ name)) -+ (defun reify-function-name (function-name) -+ (let ((name (or (first function-name) ;; defun: extract the name -+ (let ((sec (second function-name))) -+ (or (and (atom sec) sec) ; scoped method: drop scope -+ (first sec)))))) ; method: keep gf name, drop method specializers -+ (list name))) -+ (defun unreify-function-name (function-name) -+ function-name) -+ (defun nullify-non-literals (sexp) -+ (typecase sexp -+ ((or number character simple-string symbol pathname) sexp) -+ (cons (cons (nullify-non-literals (car sexp)) -+ (nullify-non-literals (cdr sexp)))) -+ (t nil))) -+ (defun reify-deferred-warning (deferred-warning) -+ (with-accessors ((warning-type ccl::compiler-warning-warning-type) -+ (args ccl::compiler-warning-args) -+ (source-note ccl:compiler-warning-source-note) -+ (function-name ccl:compiler-warning-function-name)) deferred-warning -+ (list :warning-type warning-type :function-name (reify-function-name function-name) -+ :source-note (reify-source-note source-note) -+ :args (destructuring-bind (fun &rest more) -+ args -+ (cons (unsymbolify-function-name fun) -+ (nullify-non-literals more)))))) -+ (defun unreify-deferred-warning (reified-deferred-warning) -+ (destructuring-bind (&key warning-type function-name source-note args) -+ reified-deferred-warning -+ (make-condition (or (cdr (ccl::assq warning-type ccl::*compiler-whining-conditions*)) -+ 'ccl::compiler-warning) -+ :function-name (unreify-function-name function-name) -+ :source-note (unreify-source-note source-note) -+ :warning-type warning-type -+ :args (destructuring-bind (fun . more) args -+ (cons (symbolify-function-name fun) more)))))) -+ #+(or cmu scl) -+ (defun reify-undefined-warning (warning) -+ ;; Extracting undefined-warnings from the compilation-unit -+ ;; To be passed through the above reify/unreify link, it must be a "simple-sexp" -+ (list* -+ (c::undefined-warning-kind warning) -+ (c::undefined-warning-name warning) -+ (c::undefined-warning-count warning) -+ (mapcar -+ #'(lambda (frob) -+ ;; the lexenv slot can be ignored for reporting purposes -+ `(:enclosing-source ,(c::compiler-error-context-enclosing-source frob) -+ :source ,(c::compiler-error-context-source frob) -+ :original-source ,(c::compiler-error-context-original-source frob) -+ :context ,(c::compiler-error-context-context frob) -+ :file-name ,(c::compiler-error-context-file-name frob) ; a pathname -+ :file-position ,(c::compiler-error-context-file-position frob) ; an integer -+ :original-source-path ,(c::compiler-error-context-original-source-path frob))) -+ (c::undefined-warning-warnings warning)))) -+ -+ #+sbcl -+ (defun reify-undefined-warning (warning) -+ ;; Extracting undefined-warnings from the compilation-unit -+ ;; To be passed through the above reify/unreify link, it must be a "simple-sexp" -+ (list* -+ (sb-c::undefined-warning-kind warning) -+ (sb-c::undefined-warning-name warning) -+ (sb-c::undefined-warning-count warning) -+ (mapcar -+ #'(lambda (frob) -+ ;; the lexenv slot can be ignored for reporting purposes -+ `(:enclosing-source ,(sb-c::compiler-error-context-enclosing-source frob) -+ :source ,(sb-c::compiler-error-context-source frob) -+ :original-source ,(sb-c::compiler-error-context-original-source frob) -+ :context ,(sb-c::compiler-error-context-context frob) -+ :file-name ,(sb-c::compiler-error-context-file-name frob) ; a pathname -+ :file-position ,(sb-c::compiler-error-context-file-position frob) ; an integer -+ :original-source-path ,(sb-c::compiler-error-context-original-source-path frob))) -+ (sb-c::undefined-warning-warnings warning)))) -+ -+ (defun reify-deferred-warnings () -+ "return a portable S-expression, portably readable and writeable in any Common Lisp implementation -+using READ within a WITH-SAFE-IO-SYNTAX, that represents the warnings currently deferred by -+WITH-COMPILATION-UNIT. One of three functions required for deferred-warnings support in ASDF." -+ #+allegro -+ (list :functions-defined excl::.functions-defined. -+ :functions-called excl::.functions-called.) -+ #+clozure -+ (mapcar 'reify-deferred-warning -+ (if-let (dw ccl::*outstanding-deferred-warnings*) -+ (let ((mdw (ccl::ensure-merged-deferred-warnings dw))) -+ (ccl::deferred-warnings.warnings mdw)))) -+ #+(or cmu scl) -+ (when lisp::*in-compilation-unit* -+ ;; Try to send nothing through the pipe if nothing needs to be accumulated -+ `(,@(when c::*undefined-warnings* -+ `((c::*undefined-warnings* -+ ,@(mapcar #'reify-undefined-warning c::*undefined-warnings*)))) -+ ,@(loop :for what :in '(c::*compiler-error-count* -+ c::*compiler-warning-count* -+ c::*compiler-note-count*) -+ :for value = (symbol-value what) -+ :when (plusp value) -+ :collect `(,what . ,value)))) -+ #+sbcl -+ (when sb-c::*in-compilation-unit* -+ ;; Try to send nothing through the pipe if nothing needs to be accumulated -+ `(,@(when sb-c::*undefined-warnings* -+ `((sb-c::*undefined-warnings* -+ ,@(mapcar #'reify-undefined-warning sb-c::*undefined-warnings*)))) -+ ,@(loop :for what :in '(sb-c::*aborted-compilation-unit-count* -+ sb-c::*compiler-error-count* -+ sb-c::*compiler-warning-count* -+ sb-c::*compiler-style-warning-count* -+ sb-c::*compiler-note-count*) -+ :for value = (symbol-value what) -+ :when (plusp value) -+ :collect `(,what . ,value))))) -+ -+ (defun unreify-deferred-warnings (reified-deferred-warnings) -+ "given a S-expression created by REIFY-DEFERRED-WARNINGS, reinstantiate the corresponding -+deferred warnings as to be handled at the end of the current WITH-COMPILATION-UNIT. -+Handle any warning that has been resolved already, -+such as an undefined function that has been defined since. -+One of three functions required for deferred-warnings support in ASDF." -+ (declare (ignorable reified-deferred-warnings)) -+ #+allegro -+ (destructuring-bind (&key functions-defined functions-called) -+ reified-deferred-warnings -+ (setf excl::.functions-defined. -+ (append functions-defined excl::.functions-defined.) -+ excl::.functions-called. -+ (append functions-called excl::.functions-called.))) -+ #+clozure -+ (let ((dw (or ccl::*outstanding-deferred-warnings* -+ (setf ccl::*outstanding-deferred-warnings* (ccl::%defer-warnings t))))) -+ (appendf (ccl::deferred-warnings.warnings dw) -+ (mapcar 'unreify-deferred-warning reified-deferred-warnings))) -+ #+(or cmu scl) -+ (dolist (item reified-deferred-warnings) -+ ;; Each item is (symbol . adjustment) where the adjustment depends on the symbol. -+ ;; For *undefined-warnings*, the adjustment is a list of initargs. -+ ;; For everything else, it's an integer. -+ (destructuring-bind (symbol . adjustment) item -+ (case symbol -+ ((c::*undefined-warnings*) -+ (setf c::*undefined-warnings* -+ (nconc (mapcan -+ #'(lambda (stuff) -+ (destructuring-bind (kind name count . rest) stuff -+ (unless (case kind (:function (fboundp name))) -+ (list -+ (c::make-undefined-warning -+ :name name -+ :kind kind -+ :count count -+ :warnings -+ (mapcar #'(lambda (x) -+ (apply #'c::make-compiler-error-context x)) -+ rest)))))) -+ adjustment) -+ c::*undefined-warnings*))) -+ (otherwise -+ (set symbol (+ (symbol-value symbol) adjustment)))))) -+ #+sbcl -+ (dolist (item reified-deferred-warnings) -+ ;; Each item is (symbol . adjustment) where the adjustment depends on the symbol. -+ ;; For *undefined-warnings*, the adjustment is a list of initargs. -+ ;; For everything else, it's an integer. -+ (destructuring-bind (symbol . adjustment) item -+ (case symbol -+ ((sb-c::*undefined-warnings*) -+ (setf sb-c::*undefined-warnings* -+ (nconc (mapcan -+ #'(lambda (stuff) -+ (destructuring-bind (kind name count . rest) stuff -+ (unless (case kind (:function (fboundp name))) -+ (list -+ (sb-c::make-undefined-warning -+ :name name -+ :kind kind -+ :count count -+ :warnings -+ (mapcar #'(lambda (x) -+ (apply #'sb-c::make-compiler-error-context x)) -+ rest)))))) -+ adjustment) -+ sb-c::*undefined-warnings*))) -+ (otherwise -+ (set symbol (+ (symbol-value symbol) adjustment))))))) -+ -+ (defun reset-deferred-warnings () -+ "Reset the set of deferred warnings to be handled at the end of the current WITH-COMPILATION-UNIT. -+One of three functions required for deferred-warnings support in ASDF." -+ #+allegro -+ (setf excl::.functions-defined. nil -+ excl::.functions-called. nil) -+ #+clozure -+ (if-let (dw ccl::*outstanding-deferred-warnings*) -+ (let ((mdw (ccl::ensure-merged-deferred-warnings dw))) -+ (setf (ccl::deferred-warnings.warnings mdw) nil))) -+ #+(or cmu scl) -+ (when lisp::*in-compilation-unit* -+ (setf c::*undefined-warnings* nil -+ c::*compiler-error-count* 0 -+ c::*compiler-warning-count* 0 -+ c::*compiler-note-count* 0)) -+ #+sbcl -+ (when sb-c::*in-compilation-unit* -+ (setf sb-c::*undefined-warnings* nil -+ sb-c::*aborted-compilation-unit-count* 0 -+ sb-c::*compiler-error-count* 0 -+ sb-c::*compiler-warning-count* 0 -+ sb-c::*compiler-style-warning-count* 0 -+ sb-c::*compiler-note-count* 0))) -+ -+ (defun save-deferred-warnings (warnings-file) -+ "Save forward reference conditions so they may be issued at a latter time, -+possibly in a different process." -+ (with-open-file (s warnings-file :direction :output :if-exists :supersede -+ :element-type *default-stream-element-type* -+ :external-format *utf-8-external-format*) -+ (with-safe-io-syntax () -+ (write (reify-deferred-warnings) :stream s :pretty t :readably t) -+ (terpri s)))) -+ -+ (defun warnings-file-type (&optional implementation-type) -+ (case (or implementation-type *implementation-type*) -+ ((:acl :allegro) "allegro-warnings") -+ ;;((:clisp) "clisp-warnings") -+ ((:cmu :cmucl) "cmucl-warnings") -+ ((:sbcl) "sbcl-warnings") -+ ((:clozure :ccl) "ccl-warnings") -+ ((:scl) "scl-warnings"))) -+ -+ (defvar *warnings-file-type* nil -+ "Type for warnings files") -+ -+ (defun enable-deferred-warnings-check () -+ (setf *warnings-file-type* (warnings-file-type))) -+ -+ (defun disable-deferred-warnings-check () -+ (setf *warnings-file-type* nil)) -+ -+ (defun warnings-file-p (file &optional implementation-type) -+ (if-let (type (if implementation-type -+ (warnings-file-type implementation-type) -+ *warnings-file-type*)) -+ (equal (pathname-type file) type))) -+ -+ (defun check-deferred-warnings (files &optional context-format context-arguments) -+ (let ((file-errors nil) -+ (failure-p nil) -+ (warnings-p nil)) -+ (handler-bind -+ ((warning #'(lambda (c) -+ (setf warnings-p t) -+ (unless (typep c 'style-warning) -+ (setf failure-p t))))) -+ (with-compilation-unit (:override t) -+ (reset-deferred-warnings) -+ (dolist (file files) -+ (unreify-deferred-warnings -+ (handler-case (safe-read-file-form file) -+ (error (c) -+ ;;(delete-file-if-exists file) ;; deleting forces rebuild but prevents debugging -+ (push c file-errors) -+ nil)))))) -+ (dolist (error file-errors) (error error)) -+ (check-lisp-compile-warnings -+ (or failure-p warnings-p) failure-p context-format context-arguments))) -+ -+ #| -+ Mini-guide to adding support for deferred warnings on an implementation. -+ -+ First, look at what such a warning looks like: -+ -+ (describe -+ (handler-case -+ (and (eval '(lambda () (some-undefined-function))) nil) -+ (t (c) c))) -+ -+ Then you can grep for the condition type in your compiler sources -+ and see how to catch those that have been deferred, -+ and/or read, clear and restore the deferred list. -+ -+ Also look at -+ (macroexpand-1 '(with-compilation-unit () foo)) -+ |# -+ -+ (defun call-with-saved-deferred-warnings (thunk warnings-file) -+ (if warnings-file -+ (with-compilation-unit (:override t) -+ (unwind-protect -+ (let (#+sbcl (sb-c::*undefined-warnings* nil)) -+ (multiple-value-prog1 -+ (funcall thunk) -+ (save-deferred-warnings warnings-file))) -+ (reset-deferred-warnings))) -+ (funcall thunk))) -+ -+ (defmacro with-saved-deferred-warnings ((warnings-file) &body body) -+ "If WARNINGS-FILE is not nil, records the deferred-warnings around the BODY -+and saves those warnings to the given file for latter use, -+possibly in a different process. Otherwise just run the BODY." -+ `(call-with-saved-deferred-warnings #'(lambda () ,@body) ,warnings-file))) -+ -+ -+;;; from ASDF -+(with-upgradability () -+ (defun current-lisp-file-pathname () -+ (or *compile-file-pathname* *load-pathname*)) -+ -+ (defun load-pathname () -+ *load-pathname*) -+ -+ (defun lispize-pathname (input-file) -+ (make-pathname :type "lisp" :defaults input-file)) -+ -+ (defun compile-file-type (&rest keys) -+ "pathname TYPE for lisp FASt Loading files" -+ (declare (ignorable keys)) -+ #-(or ecl mkcl) (load-time-value (pathname-type (compile-file-pathname "foo.lisp"))) -+ #+(or ecl mkcl) (pathname-type (apply 'compile-file-pathname "foo" keys))) -+ -+ (defun call-around-hook (hook function) -+ (call-function (or hook 'funcall) function)) -+ -+ (defun compile-file-pathname* (input-file &rest keys &key output-file &allow-other-keys) -+ (let* ((keys -+ (remove-plist-keys `(#+(and allegro (not (version>= 8 2))) :external-format -+ ,@(unless output-file '(:output-file))) keys))) -+ (if (absolute-pathname-p output-file) -+ ;; what cfp should be doing, w/ mp* instead of mp -+ (let* ((type (pathname-type (apply 'compile-file-type keys))) -+ (defaults (make-pathname -+ :type type :defaults (merge-pathnames* input-file)))) -+ (merge-pathnames* output-file defaults)) -+ (funcall *output-translation-function* -+ (apply 'compile-file-pathname input-file keys))))) -+ -+ (defun* (compile-file*) (input-file &rest keys -+ &key compile-check output-file warnings-file -+ #+clisp lib-file #+(or ecl mkcl) object-file -+ &allow-other-keys) -+ "This function provides a portable wrapper around COMPILE-FILE. -+It ensures that the OUTPUT-FILE value is only returned and -+the file only actually created if the compilation was successful, -+even though your implementation may not do that, and including -+an optional call to an user-provided consistency check function COMPILE-CHECK; -+it will call this function if not NIL at the end of the compilation -+with the arguments sent to COMPILE-FILE*, except with :OUTPUT-FILE TMP-FILE -+where TMP-FILE is the name of a temporary output-file. -+It also checks two flags (with legacy british spelling from ASDF1), -+*COMPILE-FILE-FAILURE-BEHAVIOUR* and *COMPILE-FILE-WARNINGS-BEHAVIOUR* -+with appropriate implementation-dependent defaults, -+and if a failure (respectively warnings) are reported by COMPILE-FILE -+with consider it an error unless the respective behaviour flag -+is one of :SUCCESS :WARN :IGNORE. -+If WARNINGS-FILE is defined, deferred warnings are saved to that file. -+On ECL or MKCL, it creates both the linkable object and loadable fasl files. -+On implementations that erroneously do not recognize standard keyword arguments, -+it will filter them appropriately." -+ #+ecl (when (and object-file (equal (compile-file-type) (pathname object-file))) -+ (format t "Whoa, some funky ASDF upgrade switched ~S calling convention for ~S and ~S~%" -+ 'compile-file* output-file object-file) -+ (rotatef output-file object-file)) -+ (let* ((keywords (remove-plist-keys -+ `(:output-file :compile-check :warnings-file -+ #+clisp :lib-file #+(or ecl mkcl) :object-file -+ #+gcl2.6 ,@'(:external-format :print :verbose)) keys)) -+ (output-file -+ (or output-file -+ (apply 'compile-file-pathname* input-file :output-file output-file keywords))) -+ #+ecl -+ (object-file -+ (unless (use-ecl-byte-compiler-p) -+ (or object-file -+ (compile-file-pathname output-file :type :object)))) -+ #+mkcl -+ (object-file -+ (or object-file -+ (compile-file-pathname output-file :fasl-p nil))) -+ (tmp-file (tmpize-pathname output-file)) -+ #+clisp -+ (tmp-lib (make-pathname :type "lib" :defaults tmp-file))) -+ (multiple-value-bind (output-truename warnings-p failure-p) -+ (with-saved-deferred-warnings (warnings-file) -+ (with-muffled-compiler-conditions () -+ (or #-(or ecl mkcl) (apply 'compile-file input-file :output-file tmp-file keywords) -+ #+ecl (apply 'compile-file input-file :output-file -+ (if object-file -+ (list* object-file :system-p t keywords) -+ (list* tmp-file keywords))) -+ #+mkcl (apply 'compile-file input-file -+ :output-file object-file :fasl-p nil keywords)))) -+ (cond -+ ((and output-truename -+ (flet ((check-flag (flag behaviour) -+ (or (not flag) (member behaviour '(:success :warn :ignore))))) -+ (and (check-flag failure-p *compile-file-failure-behaviour*) -+ (check-flag warnings-p *compile-file-warnings-behaviour*))) -+ (progn -+ #+(or ecl mkcl) -+ (when (and #+ecl object-file) -+ (setf output-truename -+ (compiler::build-fasl -+ tmp-file #+ecl :lisp-files #+mkcl :lisp-object-files -+ (list object-file)))) -+ (or (not compile-check) -+ (apply compile-check input-file :output-file tmp-file keywords)))) -+ (delete-file-if-exists output-file) -+ (when output-truename -+ #+clisp (when lib-file (rename-file-overwriting-target tmp-lib lib-file)) -+ (rename-file-overwriting-target output-truename output-file) -+ (setf output-truename (truename output-file))) -+ #+clisp (delete-file-if-exists tmp-lib)) -+ (t ;; error or failed check -+ (delete-file-if-exists output-truename) -+ (setf output-truename nil))) -+ (values output-truename warnings-p failure-p)))) -+ -+ (defun load* (x &rest keys &key &allow-other-keys) -+ (etypecase x -+ ((or pathname string #-(or allegro clozure gcl2.6 genera) stream) -+ (apply 'load x -+ #-gcl2.6 keys #+gcl2.6 (remove-plist-key :external-format keys))) -+ ;; GCL 2.6, Genera can't load from a string-input-stream -+ ;; ClozureCL 1.6 can only load from file input stream -+ ;; Allegro 5, I don't remember but it must have been broken when I tested. -+ #+(or allegro clozure gcl2.6 genera) -+ (stream ;; make do this way -+ (let ((*package* *package*) -+ (*readtable* *readtable*) -+ (*load-pathname* nil) -+ (*load-truename* nil)) -+ (eval-input x))))) -+ -+ (defun load-from-string (string) -+ "Portably read and evaluate forms from a STRING." -+ (with-input-from-string (s string) (load* s)))) -+ -+;;; Links FASLs together -+(with-upgradability () -+ (defun combine-fasls (inputs output) -+ #-(or abcl allegro clisp clozure cmu lispworks sbcl scl xcl) -+ (error "~A does not support ~S~%inputs ~S~%output ~S" -+ (implementation-type) 'combine-fasls inputs output) -+ #+abcl (funcall 'sys::concatenate-fasls inputs output) ; requires ABCL 1.2.0 -+ #+(or allegro clisp cmu sbcl scl xcl) (concatenate-files inputs output) -+ #+clozure (ccl:fasl-concatenate output inputs :if-exists :supersede) -+ #+lispworks -+ (let (fasls) -+ (unwind-protect -+ (progn -+ (loop :for i :in inputs -+ :for n :from 1 -+ :for f = (add-pathname-suffix -+ output (format nil "-FASL~D" n)) -+ :do (copy-file i f) -+ (push f fasls)) -+ (ignore-errors (lispworks:delete-system :fasls-to-concatenate)) -+ (eval `(scm:defsystem :fasls-to-concatenate -+ (:default-pathname ,(pathname-directory-pathname output)) -+ :members -+ ,(loop :for f :in (reverse fasls) -+ :collect `(,(namestring f) :load-only t)))) -+ (scm:concatenate-system output :fasls-to-concatenate)) -+ (loop :for f :in fasls :do (ignore-errors (delete-file f))) -+ (ignore-errors (lispworks:delete-system :fasls-to-concatenate)))))) -+ -+;;;; --------------------------------------------------------------------------- -+;;;; Generic support for configuration files -+ -+(uiop/package:define-package :uiop/configuration -+ (:nicknames :asdf/configuration) -+ (:recycle :uiop/configuration :asdf/configuration :asdf) -+ (:use :uiop/common-lisp :uiop/utility -+ :uiop/os :uiop/pathname :uiop/filesystem :uiop/stream :uiop/image :uiop/lisp-build) -+ (:export -+ #:get-folder-path -+ #:user-configuration-directories #:system-configuration-directories -+ #:in-first-directory -+ #:in-user-configuration-directory #:in-system-configuration-directory -+ #:validate-configuration-form #:validate-configuration-file #:validate-configuration-directory -+ #:configuration-inheritance-directive-p -+ #:report-invalid-form #:invalid-configuration #:*ignored-configuration-form* #:*user-cache* -+ #:*clear-configuration-hook* #:clear-configuration #:register-clear-configuration-hook -+ #:resolve-location #:location-designator-p #:location-function-p #:*here-directory* -+ #:resolve-relative-location #:resolve-absolute-location #:upgrade-configuration)) -+(in-package :uiop/configuration) -+ -+(with-upgradability () -+ (define-condition invalid-configuration () -+ ((form :reader condition-form :initarg :form) -+ (location :reader condition-location :initarg :location) -+ (format :reader condition-format :initarg :format) -+ (arguments :reader condition-arguments :initarg :arguments :initform nil)) -+ (:report (lambda (c s) -+ (format s (compatfmt "~@<~? (will be skipped)~@:>") -+ (condition-format c) -+ (list* (condition-form c) (condition-location c) -+ (condition-arguments c)))))) -+ -+ (defun get-folder-path (folder) -+ (or ;; this semi-portably implements a subset of the functionality of lispworks' sys:get-folder-path -+ #+(and lispworks mswindows) (sys:get-folder-path folder) -+ ;; read-windows-registry HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\AppData -+ (ecase folder -+ (:local-appdata (getenv-absolute-directory "LOCALAPPDATA")) -+ (:appdata (getenv-absolute-directory "APPDATA")) -+ (:common-appdata (or (getenv-absolute-directory "ALLUSERSAPPDATA") -+ (subpathname* (getenv-absolute-directory "ALLUSERSPROFILE") "Application Data/")))))) -+ -+ (defun user-configuration-directories () -+ (let ((dirs -+ `(,@(when (os-unix-p) -+ (cons -+ (subpathname* (getenv-absolute-directory "XDG_CONFIG_HOME") "common-lisp/") -+ (loop :for dir :in (getenv-absolute-directories "XDG_CONFIG_DIRS") -+ :collect (subpathname* dir "common-lisp/")))) -+ ,@(when (os-windows-p) -+ `(,(subpathname* (get-folder-path :local-appdata) "common-lisp/config/") -+ ,(subpathname* (get-folder-path :appdata) "common-lisp/config/"))) -+ ,(subpathname (user-homedir-pathname) ".config/common-lisp/")))) -+ (remove-duplicates (remove-if-not #'absolute-pathname-p dirs) -+ :from-end t :test 'equal))) -+ -+ (defun system-configuration-directories () -+ (cond -+ ((os-unix-p) '(#p"/etc/common-lisp/")) -+ ((os-windows-p) -+ (if-let (it (subpathname* (get-folder-path :common-appdata) "common-lisp/config/")) -+ (list it))))) -+ -+ (defun in-first-directory (dirs x &key (direction :input)) -+ (loop :with fun = (ecase direction -+ ((nil :input :probe) 'probe-file*) -+ ((:output :io) 'identity)) -+ :for dir :in dirs -+ :thereis (and dir (funcall fun (merge-pathnames* x (ensure-directory-pathname dir)))))) -+ -+ (defun in-user-configuration-directory (x &key (direction :input)) -+ (in-first-directory (user-configuration-directories) x :direction direction)) -+ (defun in-system-configuration-directory (x &key (direction :input)) -+ (in-first-directory (system-configuration-directories) x :direction direction)) -+ -+ (defun configuration-inheritance-directive-p (x) -+ (let ((kw '(:inherit-configuration :ignore-inherited-configuration))) -+ (or (member x kw) -+ (and (length=n-p x 1) (member (car x) kw))))) -+ -+ (defun report-invalid-form (reporter &rest args) -+ (etypecase reporter -+ (null -+ (apply 'error 'invalid-configuration args)) -+ (function -+ (apply reporter args)) -+ ((or symbol string) -+ (apply 'error reporter args)) -+ (cons -+ (apply 'apply (append reporter args))))) -+ -+ (defvar *ignored-configuration-form* nil) -+ -+ (defun validate-configuration-form (form tag directive-validator -+ &key location invalid-form-reporter) -+ (unless (and (consp form) (eq (car form) tag)) -+ (setf *ignored-configuration-form* t) -+ (report-invalid-form invalid-form-reporter :form form :location location) -+ (return-from validate-configuration-form nil)) -+ (loop :with inherit = 0 :with ignore-invalid-p = nil :with x = (list tag) -+ :for directive :in (cdr form) -+ :when (cond -+ ((configuration-inheritance-directive-p directive) -+ (incf inherit) t) -+ ((eq directive :ignore-invalid-entries) -+ (setf ignore-invalid-p t) t) -+ ((funcall directive-validator directive) -+ t) -+ (ignore-invalid-p -+ nil) -+ (t -+ (setf *ignored-configuration-form* t) -+ (report-invalid-form invalid-form-reporter :form directive :location location) -+ nil)) -+ :do (push directive x) -+ :finally -+ (unless (= inherit 1) -+ (report-invalid-form invalid-form-reporter -+ :arguments (list (compatfmt "~@<One and only one of ~S or ~S is required.~@:>") -+ :inherit-configuration :ignore-inherited-configuration))) -+ (return (nreverse x)))) -+ -+ (defun validate-configuration-file (file validator &key description) -+ (let ((forms (read-file-forms file))) -+ (unless (length=n-p forms 1) -+ (error (compatfmt "~@<One and only one form allowed for ~A. Got: ~3i~_~S~@:>~%") -+ description forms)) -+ (funcall validator (car forms) :location file))) -+ -+ (defun validate-configuration-directory (directory tag validator &key invalid-form-reporter) -+ "Map the VALIDATOR across the .conf files in DIRECTORY, the TAG will -+be applied to the results to yield a configuration form. Current -+values of TAG include :source-registry and :output-translations." -+ (let ((files (sort (ignore-errors -+ (remove-if -+ 'hidden-pathname-p -+ (directory* (make-pathname :name *wild* :type "conf" :defaults directory)))) -+ #'string< :key #'namestring))) -+ `(,tag -+ ,@(loop :for file :in files :append -+ (loop :with ignore-invalid-p = nil -+ :for form :in (read-file-forms file) -+ :when (eq form :ignore-invalid-entries) -+ :do (setf ignore-invalid-p t) -+ :else -+ :when (funcall validator form) -+ :collect form -+ :else -+ :when ignore-invalid-p -+ :do (setf *ignored-configuration-form* t) -+ :else -+ :do (report-invalid-form invalid-form-reporter :form form :location file))) -+ :inherit-configuration))) -+ -+ (defun resolve-relative-location (x &key ensure-directory wilden) -+ (ensure-pathname -+ (etypecase x -+ (pathname x) -+ (string (parse-unix-namestring -+ x :ensure-directory ensure-directory)) -+ (cons -+ (if (null (cdr x)) -+ (resolve-relative-location -+ (car x) :ensure-directory ensure-directory :wilden wilden) -+ (let* ((car (resolve-relative-location -+ (car x) :ensure-directory t :wilden nil))) -+ (merge-pathnames* -+ (resolve-relative-location -+ (cdr x) :ensure-directory ensure-directory :wilden wilden) -+ car)))) -+ ((eql :*/) *wild-directory*) -+ ((eql :**/) *wild-inferiors*) -+ ((eql :*.*.*) *wild-file*) -+ ((eql :implementation) -+ (parse-unix-namestring -+ (implementation-identifier) :ensure-directory t)) -+ ((eql :implementation-type) -+ (parse-unix-namestring -+ (string-downcase (implementation-type)) :ensure-directory t)) -+ ((eql :hostname) -+ (parse-unix-namestring (hostname) :ensure-directory t))) -+ :wilden (and wilden (not (pathnamep x)) (not (member x '(:*/ :**/ :*.*.*)))) -+ :want-relative t)) -+ -+ (defvar *here-directory* nil -+ "This special variable is bound to the currect directory during calls to -+PROCESS-SOURCE-REGISTRY in order that we be able to interpret the :here -+directive.") -+ -+ (defvar *user-cache* nil -+ "A specification as per RESOLVE-LOCATION of where the user keeps his FASL cache") -+ -+ (defun compute-user-cache () -+ (setf *user-cache* -+ (flet ((try (x &rest sub) (and x `(,x ,@sub)))) -+ (or -+ (try (getenv-absolute-directory "XDG_CACHE_HOME") "common-lisp" :implementation) -+ (when (os-windows-p) -+ (try (or (get-folder-path :local-appdata) -+ (get-folder-path :appdata)) -+ "common-lisp" "cache" :implementation)) -+ '(:home ".cache" "common-lisp" :implementation))))) -+ (register-image-restore-hook 'compute-user-cache) -+ -+ (defun resolve-absolute-location (x &key ensure-directory wilden) -+ (ensure-pathname -+ (etypecase x -+ (pathname x) -+ (string -+ (let ((p #-mcl (parse-namestring x) -+ #+mcl (probe-posix x))) -+ #+mcl (unless p (error "POSIX pathname ~S does not exist" x)) -+ (if ensure-directory (ensure-directory-pathname p) p))) -+ (cons -+ (return-from resolve-absolute-location -+ (if (null (cdr x)) -+ (resolve-absolute-location -+ (car x) :ensure-directory ensure-directory :wilden wilden) -+ (merge-pathnames* -+ (resolve-relative-location -+ (cdr x) :ensure-directory ensure-directory :wilden wilden) -+ (resolve-absolute-location -+ (car x) :ensure-directory t :wilden nil))))) -+ ((eql :root) -+ ;; special magic! we return a relative pathname, -+ ;; but what it means to the output-translations is -+ ;; "relative to the root of the source pathname's host and device". -+ (return-from resolve-absolute-location -+ (let ((p (make-pathname* :directory '(:relative)))) -+ (if wilden (wilden p) p)))) -+ ((eql :home) (user-homedir-pathname)) -+ ((eql :here) (resolve-absolute-location -+ (or *here-directory* (pathname-directory-pathname (load-pathname))) -+ :ensure-directory t :wilden nil)) -+ ((eql :user-cache) (resolve-absolute-location -+ *user-cache* :ensure-directory t :wilden nil))) -+ :wilden (and wilden (not (pathnamep x))) -+ :resolve-symlinks *resolve-symlinks* -+ :want-absolute t)) -+ -+ ;; Try to override declaration in previous versions of ASDF. -+ (declaim (ftype (function (t &key (:directory boolean) (:wilden boolean) -+ (:ensure-directory boolean)) t) resolve-location)) -+ -+ (defun* (resolve-location) (x &key ensure-directory wilden directory) -+ ;; :directory backward compatibility, until 2014-01-16: accept directory as well as ensure-directory -+ (loop* :with dirp = (or directory ensure-directory) -+ :with (first . rest) = (if (atom x) (list x) x) -+ :with path = (resolve-absolute-location -+ first :ensure-directory (and (or dirp rest) t) -+ :wilden (and wilden (null rest))) -+ :for (element . morep) :on rest -+ :for dir = (and (or morep dirp) t) -+ :for wild = (and wilden (not morep)) -+ :for sub = (merge-pathnames* -+ (resolve-relative-location -+ element :ensure-directory dir :wilden wild) -+ path) -+ :do (setf path (if (absolute-pathname-p sub) (resolve-symlinks* sub) sub)) -+ :finally (return path))) -+ -+ (defun location-designator-p (x) -+ (flet ((absolute-component-p (c) -+ (typep c '(or string pathname -+ (member :root :home :here :user-cache)))) -+ (relative-component-p (c) -+ (typep c '(or string pathname -+ (member :*/ :**/ :*.*.* :implementation :implementation-type))))) -+ (or (typep x 'boolean) -+ (absolute-component-p x) -+ (and (consp x) (absolute-component-p (first x)) (every #'relative-component-p (rest x)))))) -+ -+ (defun location-function-p (x) -+ (and -+ (length=n-p x 2) -+ (eq (car x) :function) -+ (or (symbolp (cadr x)) -+ (and (consp (cadr x)) -+ (eq (caadr x) 'lambda) -+ (length=n-p (cadadr x) 2))))) -+ -+ (defvar *clear-configuration-hook* '()) -+ -+ (defun register-clear-configuration-hook (hook-function &optional call-now-p) -+ (register-hook-function '*clear-configuration-hook* hook-function call-now-p)) -+ -+ (defun clear-configuration () -+ (call-functions *clear-configuration-hook*)) -+ -+ (register-image-dump-hook 'clear-configuration) -+ -+ ;; If a previous version of ASDF failed to read some configuration, try again. -+ (defun upgrade-configuration () -+ (when *ignored-configuration-form* -+ (clear-configuration) -+ (setf *ignored-configuration-form* nil)))) -+ -+ -+;;;; ------------------------------------------------------------------------- -+;;; Hacks for backward-compatibility of the driver -+ -+(uiop/package:define-package :uiop/backward-driver -+ (:nicknames :asdf/backward-driver) -+ (:recycle :uiop/backward-driver :asdf/backward-driver :asdf) -+ (:use :uiop/common-lisp :uiop/package :uiop/utility -+ :uiop/pathname :uiop/stream :uiop/os :uiop/image -+ :uiop/run-program :uiop/lisp-build -+ :uiop/configuration) -+ (:export -+ #:coerce-pathname #:component-name-to-pathname-components -+ #+(or ecl mkcl) #:compile-file-keeping-object -+ )) -+(in-package :uiop/backward-driver) -+ -+;;;; Backward compatibility with various pathname functions. -+ -+(with-upgradability () -+ (defun coerce-pathname (name &key type defaults) -+ ;; For backward-compatibility only, for people using internals -+ ;; Reported users in quicklisp: hu.dwim.asdf, asdf-utils, xcvb -+ ;; Will be removed after 2014-01-16. -+ ;;(warn "Please don't use ASDF::COERCE-PATHNAME. Use ASDF/PATHNAME:PARSE-UNIX-NAMESTRING.") -+ (parse-unix-namestring name :type type :defaults defaults)) -+ -+ (defun component-name-to-pathname-components (unix-style-namestring -+ &key force-directory force-relative) -+ ;; Will be removed after 2014-01-16. -+ ;; (warn "Please don't use ASDF::COMPONENT-NAME-TO-PATHNAME-COMPONENTS, use SPLIT-UNIX-NAMESTRING-DIRECTORY-COMPONENTS") -+ (multiple-value-bind (relabs path filename file-only) -+ (split-unix-namestring-directory-components -+ unix-style-namestring :ensure-directory force-directory) -+ (declare (ignore file-only)) -+ (when (and force-relative (not (eq relabs :relative))) -+ (error (compatfmt "~@<Absolute pathname designator not allowed: ~3i~_~S~@:>") -+ unix-style-namestring)) -+ (values relabs path filename))) -+ -+ #+(or ecl mkcl) -+ (defun compile-file-keeping-object (&rest args) (apply #'compile-file* args))) -+;;;; --------------------------------------------------------------------------- -+;;;; Re-export all the functionality in asdf/driver -+ -+(uiop/package:define-package :uiop/driver -+ (:nicknames :uiop :asdf/driver :asdf-driver :asdf-utils) -+ (:use :uiop/common-lisp :uiop/package :uiop/utility -+ :uiop/os :uiop/pathname :uiop/stream :uiop/filesystem :uiop/image -+ :uiop/run-program :uiop/lisp-build -+ :uiop/configuration :uiop/backward-driver) -+ (:reexport -+ ;; NB: excluding asdf/common-lisp -+ ;; which include all of CL with compatibility modifications on select platforms. -+ :uiop/package :uiop/utility -+ :uiop/os :uiop/pathname :uiop/stream :uiop/filesystem :uiop/image -+ :uiop/run-program :uiop/lisp-build -+ :uiop/configuration :uiop/backward-driver)) -+;;;; ------------------------------------------------------------------------- -+;;;; Handle upgrade as forward- and backward-compatibly as possible -+;; See https://bugs.launchpad.net/asdf/+bug/485687 -+ -+(asdf/package:define-package :asdf/upgrade -+ (:recycle :asdf/upgrade :asdf) -+ (:use :asdf/common-lisp :asdf/driver) -+ (:export -+ #:asdf-version #:*previous-asdf-versions* #:*asdf-version* -+ #:asdf-message #:*verbose-out* -+ #:upgrading-p #:when-upgrading #:upgrade-asdf #:asdf-upgrade-error -+ #:*post-upgrade-cleanup-hook* #:*post-upgrade-restart-hook* #:cleanup-upgraded-asdf -+ ;; There will be no symbol left behind! -+ #:intern*) -+ (:import-from :asdf/package #:intern* #:find-symbol*)) -+(in-package :asdf/upgrade) -+ -+;;; Special magic to detect if this is an upgrade -+ -+(with-upgradability () -+ (defun asdf-version () -+ "Exported interface to the version of ASDF currently installed. A string. -+You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSION) \"3.4.5.67\")." -+ (when (find-package :asdf) -+ (or (symbol-value (find-symbol (string :*asdf-version*) :asdf)) -+ (let* ((revsym (find-symbol (string :*asdf-revision*) :asdf)) -+ (rev (and revsym (boundp revsym) (symbol-value revsym)))) -+ (etypecase rev -+ (string rev) -+ (cons (format nil "~{~D~^.~}" rev)) -+ (null "1.0")))))) -+ (defvar *asdf-version* nil) -+ (defvar *previous-asdf-versions* nil) -+ (defvar *verbose-out* nil) -+ (defun asdf-message (format-string &rest format-args) -+ (when *verbose-out* (apply 'format *verbose-out* format-string format-args))) -+ (defvar *post-upgrade-cleanup-hook* ()) -+ (defvar *post-upgrade-restart-hook* ()) -+ (defun upgrading-p () -+ (and *previous-asdf-versions* (not (equal *asdf-version* (first *previous-asdf-versions*))))) -+ (defmacro when-upgrading ((&key (upgrading-p '(upgrading-p)) when) &body body) -+ `(with-upgradability () -+ (when (and ,upgrading-p ,@(when when `(,when))) -+ (handler-bind ((style-warning #'muffle-warning)) -+ (eval '(progn ,@body)))))) -+ (let* (;; For bug reporting sanity, please always bump this version when you modify this file. -+ ;; Please also modify asdf.asd to reflect this change. make bump-version v=3.4.5.67.8 -+ ;; can help you do these changes in synch (look at the source for documentation). -+ ;; Relying on its automation, the version is now redundantly present on top of this file. -+ ;; "3.4" would be the general branch for major version 3, minor version 4. -+ ;; "3.4.5" would be an official release in the 3.4 branch. -+ ;; "3.4.5.67" would be a development version in the official upstream of 3.4.5. -+ ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5 -+ ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67 -+ (asdf-version "3.0.0") -+ (existing-version (asdf-version))) -+ (setf *asdf-version* asdf-version) -+ (when (and existing-version (not (equal asdf-version existing-version))) -+ (push existing-version *previous-asdf-versions*) -+ (when (or *load-verbose* *verbose-out*) -+ (format *trace-output* -+ (compatfmt "~&~@<; ~@;Upgrading ASDF ~@[from version ~A ~]to version ~A~@:>~%") -+ existing-version asdf-version))))) -+ -+(when-upgrading () -+ (let ((redefined-functions ;; gf signature and/or semantics changed incompatibly. Oops. -+ '(#:component-relative-pathname #:component-parent-pathname ;; component -+ #:source-file-type -+ #:find-system #:system-source-file #:system-relative-pathname ;; system -+ #:find-component ;; find-component -+ #:explain #:perform #:perform-with-restarts #:input-files #:output-files ;; action -+ #:component-depends-on #:operation-done-p #:component-depends-on -+ #:traverse ;; plan -+ #:operate ;; operate -+ #:parse-component-form ;; defsystem -+ #:apply-output-translations ;; output-translations -+ #:process-output-translations-directive -+ #:inherit-source-registry #:process-source-registry ;; source-registry -+ #:process-source-registry-directive -+ #:trivial-system-p ;; bundle -+ ;; NB: it's too late to do anything about asdf-driver functions! -+ )) -+ (uninterned-symbols -+ '(#:*asdf-revision* #:around #:asdf-method-combination -+ #:split #:make-collector #:do-dep #:do-one-dep -+ #:component-self-dependencies -+ #:resolve-relative-location-component #:resolve-absolute-location-component -+ #:output-files-for-system-and-operation))) ; obsolete ASDF-BINARY-LOCATION function -+ (declare (ignorable redefined-functions uninterned-symbols)) -+ (loop :for name :in (append redefined-functions) -+ :for sym = (find-symbol* name :asdf nil) :do -+ (when sym -+ ;; On CLISP we seem to be unable to fmakunbound and define a function in the same fasl. Sigh. -+ #-clisp (fmakunbound sym))) -+ (loop :with asdf = (find-package :asdf) -+ :for name :in uninterned-symbols -+ :for sym = (find-symbol* name :asdf nil) -+ :for base-pkg = (and sym (symbol-package sym)) :do -+ (when sym -+ (cond -+ ((or (eq base-pkg asdf) (not base-pkg)) -+ (unintern* sym asdf) -+ (intern* sym asdf)) -+ (t -+ (unintern* sym base-pkg) -+ (let ((new (intern* sym base-pkg))) -+ (shadowing-import new asdf)))))))) -+ -+ -+;;; Self-upgrade functions -+ -+(with-upgradability () -+ (defun asdf-upgrade-error () -+ ;; Important notice for whom it concerns. The crux of the matter is that -+ ;; TRAVERSE can be completely refactored, and so after the find-system returns, it's too late. -+ (error "When a system transitively depends on ASDF, it must :defsystem-depends-on (:asdf)~%~ -+ Otherwise, when you upgrade from ASDF 2, you must do it before you operate on any system.~%")) -+ -+ (defun cleanup-upgraded-asdf (&optional (old-version (first *previous-asdf-versions*))) -+ (let ((new-version (asdf-version))) -+ (unless (equal old-version new-version) -+ (push new-version *previous-asdf-versions*) -+ (when old-version -+ (if (version<= new-version old-version) -+ (error (compatfmt "~&~@<; ~@;Downgraded ASDF from version ~A to version ~A~@:>~%") -+ old-version new-version) -+ (asdf-message (compatfmt "~&~@<; ~@;Upgraded ASDF from version ~A to version ~A~@:>~%") -+ old-version new-version)) -+ (call-functions (reverse *post-upgrade-cleanup-hook*)) -+ t)))) -+ -+ (defun upgrade-asdf () -+ "Try to upgrade of ASDF. If a different version was used, return T. -+ We need do that before we operate on anything that may possibly depend on ASDF." -+ (let ((*load-print* nil) -+ (*compile-print* nil)) -+ (handler-bind (((or style-warning) #'muffle-warning)) -+ (symbol-call :asdf :load-system :asdf :verbose nil)))) -+ -+ (register-hook-function '*post-upgrade-cleanup-hook* 'upgrade-configuration)) -+ -+;;;; ------------------------------------------------------------------------- -+;;;; Components -+ -+(asdf/package:define-package :asdf/component -+ (:recycle :asdf/component :asdf) -+ (:use :asdf/common-lisp :asdf/driver :asdf/upgrade) -+ (:export -+ #:component #:component-find-path -+ #:component-name #:component-pathname #:component-relative-pathname -+ #:component-parent #:component-system #:component-parent-pathname -+ #:child-component #:parent-component #:module -+ #:file-component -+ #:source-file #:c-source-file #:java-source-file -+ #:static-file #:doc-file #:html-file -+ #:file-type -+ #:source-file-type #:source-file-explicit-type ;; backward-compatibility -+ #:component-in-order-to #:component-sideway-dependencies -+ #:component-if-feature #:around-compile-hook -+ #:component-description #:component-long-description -+ #:component-version #:version-satisfies -+ #:component-inline-methods ;; backward-compatibility only. DO NOT USE! -+ #:component-operation-times ;; For internal use only. -+ ;; portable ASDF encoding and implementation-specific external-format -+ #:component-external-format #:component-encoding -+ #:component-children-by-name #:component-children #:compute-children-by-name -+ #:component-build-operation -+ #:module-default-component-class -+ #:module-components ;; backward-compatibility. DO NOT USE. -+ #:sub-components -+ -+ ;; Internals we'd like to share with the ASDF package, especially for upgrade purposes -+ #:name #:version #:description #:long-description #:author #:maintainer #:licence -+ #:components-by-name #:components -+ #:children #:children-by-name #:default-component-class -+ #:author #:maintainer #:licence #:source-file #:defsystem-depends-on -+ #:sideway-dependencies #:if-feature #:in-order-to #:inline-methods -+ #:relative-pathname #:absolute-pathname #:operation-times #:around-compile -+ #:%encoding #:properties #:component-properties #:parent)) -+(in-package :asdf/component) -+ -+(with-upgradability () -+ (defgeneric component-name (component) -+ (:documentation "Name of the COMPONENT, unique relative to its parent")) -+ (defgeneric component-system (component) -+ (:documentation "Find the top-level system containing COMPONENT")) -+ (defgeneric component-pathname (component) -+ (:documentation "Extracts the pathname applicable for a particular component.")) -+ (defgeneric (component-relative-pathname) (component) -+ (:documentation "Returns a pathname for the component argument intended to be -+interpreted relative to the pathname of that component's parent. -+Despite the function's name, the return value may be an absolute -+pathname, because an absolute pathname may be interpreted relative to -+another pathname in a degenerate way.")) -+ (defgeneric component-external-format (component)) -+ (defgeneric component-encoding (component)) -+ (defgeneric version-satisfies (component version)) -+ (defgeneric component-version (component)) -+ (defgeneric (setf component-version) (new-version component)) -+ (defgeneric component-parent (component)) -+ (defmethod component-parent ((component null)) (declare (ignorable component)) nil) -+ -+ ;; Backward compatible way of computing the FILE-TYPE of a component. -+ ;; TODO: find users, have them stop using that, remove it for ASDF4. -+ (defgeneric (source-file-type) (component system))) -+ -+(when-upgrading (:when (find-class 'component nil)) -+ (defmethod reinitialize-instance :after ((c component) &rest initargs &key) -+ (declare (ignorable c initargs)) (values))) -+ -+(with-upgradability () -+ (defclass component () -+ ((name :accessor component-name :initarg :name :type string :documentation -+ "Component name: designator for a string composed of portable pathname characters") -+ ;; We might want to constrain version with -+ ;; :type (and string (satisfies parse-version)) -+ ;; but we cannot until we fix all systems that don't use it correctly! -+ (version :accessor component-version :initarg :version :initform nil) -+ (description :accessor component-description :initarg :description :initform nil) -+ (long-description :accessor component-long-description :initarg :long-description :initform nil) -+ (sideway-dependencies :accessor component-sideway-dependencies :initform nil) -+ (if-feature :accessor component-if-feature :initform nil :initarg :if-feature) -+ ;; In the ASDF object model, dependencies exist between *actions*, -+ ;; where an action is a pair of an operation and a component. -+ ;; Dependencies are represented as alists of operations -+ ;; to a list where each entry is a pair of an operation and a list of component specifiers. -+ ;; Up until ASDF 2.26.9, there used to be two kinds of dependencies: -+ ;; in-order-to and do-first, each stored in its own slot. Now there is only in-order-to. -+ ;; in-order-to used to represent things that modify the filesystem (such as compiling a fasl) -+ ;; and do-first things that modify the current image (such as loading a fasl). -+ ;; These are now unified because we now correctly propagate timestamps between dependencies. -+ ;; Happily, no one seems to have used do-first too much (especially since until ASDF 2.017, -+ ;; anything you specified was overridden by ASDF itself anyway), but the name in-order-to remains. -+ ;; The names are bad, but they have been the official API since Dan Barlow's ASDF 1.52! -+ ;; LispWorks's defsystem has caused-by and requires for in-order-to and do-first respectively. -+ ;; Maybe rename the slots in ASDF? But that's not very backward-compatible. -+ ;; See our ASDF 2 paper for more complete explanations. -+ (in-order-to :initform nil :initarg :in-order-to -+ :accessor component-in-order-to) -+ ;; methods defined using the "inline" style inside a defsystem form: -+ ;; need to store them somewhere so we can delete them when the system -+ ;; is re-evaluated. -+ (inline-methods :accessor component-inline-methods :initform nil) ;; OBSOLETE! DELETE THIS IF NO ONE USES. -+ ;; ASDF4: rename it from relative-pathname to specified-pathname. It need not be relative. -+ ;; There is no initform and no direct accessor for this specified pathname, -+ ;; so we only access the information through appropriate methods, after it has been processed. -+ ;; Unhappily, some braindead systems directly access the slot. Make them stop before ASDF4. -+ (relative-pathname :initarg :pathname) -+ ;; The absolute-pathname is computed based on relative-pathname and parent pathname. -+ ;; The slot is but a cache used by component-pathname. -+ (absolute-pathname) -+ (operation-times :initform (make-hash-table) -+ :accessor component-operation-times) -+ (around-compile :initarg :around-compile) -+ ;; Properties are for backward-compatibility with ASDF2 only. DO NOT USE! -+ (properties :accessor component-properties :initarg :properties -+ :initform nil) -+ (%encoding :accessor %component-encoding :initform nil :initarg :encoding) -+ ;; For backward-compatibility, this slot is part of component rather than of child-component. ASDF4: stop it. -+ (parent :initarg :parent :initform nil :reader component-parent) -+ (build-operation -+ :initarg :build-operation :initform nil :reader component-build-operation))) -+ -+ (defun component-find-path (component) -+ (check-type component (or null component)) -+ (reverse -+ (loop :for c = component :then (component-parent c) -+ :while c :collect (component-name c)))) -+ -+ (defmethod print-object ((c component) stream) -+ (print-unreadable-object (c stream :type t :identity nil) -+ (format stream "~{~S~^ ~}" (component-find-path c)))) -+ -+ (defmethod component-system ((component component)) -+ (if-let (system (component-parent component)) -+ (component-system system) -+ component))) -+ -+ -+;;;; Component hierarchy within a system -+;; The tree typically but not necessarily follows the filesystem hierarchy. -+(with-upgradability () -+ (defclass child-component (component) ()) -+ -+ (defclass file-component (child-component) -+ ((type :accessor file-type :initarg :type))) ; no default -+ (defclass source-file (file-component) -+ ((type :accessor source-file-explicit-type ;; backward-compatibility -+ :initform nil))) ;; NB: many systems have come to rely on this default. -+ (defclass c-source-file (source-file) -+ ((type :initform "c"))) -+ (defclass java-source-file (source-file) -+ ((type :initform "java"))) -+ (defclass static-file (source-file) -+ ((type :initform nil))) -+ (defclass doc-file (static-file) ()) -+ (defclass html-file (doc-file) -+ ((type :initform "html"))) -+ -+ (defclass parent-component (component) -+ ((children -+ :initform nil -+ :initarg :components -+ :reader module-components ; backward-compatibility -+ :accessor component-children) -+ (children-by-name -+ :reader module-components-by-name ; backward-compatibility -+ :accessor component-children-by-name) -+ (default-component-class -+ :initform nil -+ :initarg :default-component-class -+ :accessor module-default-component-class)))) -+ -+(with-upgradability () -+ (defun compute-children-by-name (parent &key only-if-needed-p) -+ (unless (and only-if-needed-p (slot-boundp parent 'children-by-name)) -+ (let ((hash (make-hash-table :test 'equal))) -+ (setf (component-children-by-name parent) hash) -+ (loop :for c :in (component-children parent) -+ :for name = (component-name c) -+ :for previous = (gethash name hash) -+ :do (when previous (error 'duplicate-names :name name)) -+ (setf (gethash name hash) c)) -+ hash)))) -+ -+(when-upgrading (:when (find-class 'module nil)) -+ (defmethod reinitialize-instance :after ((m module) &rest initargs &key) -+ (declare (ignorable m initargs)) (values)) -+ (defmethod update-instance-for-redefined-class :after -+ ((m module) added deleted plist &key) -+ (declare (ignorable m added deleted plist)) -+ (when (and (member 'children added) (member 'components deleted)) -+ (setf (slot-value m 'children) -+ ;; old ECLs provide an alist instead of a plist(!) -+ (if (or #+ecl (consp (first plist))) (or #+ecl (cdr (assoc 'components plist))) -+ (getf plist 'components))) -+ (compute-children-by-name m)))) -+ -+(with-upgradability () -+ (defclass module (child-component parent-component) -+ (#+clisp (components)))) ;; backward compatibility during upgrade only -+ -+ -+;;;; component pathnames -+(with-upgradability () -+ (defgeneric* (component-parent-pathname) (component)) -+ (defmethod component-parent-pathname (component) -+ (component-pathname (component-parent component))) -+ -+ (defmethod component-pathname ((component component)) -+ (if (slot-boundp component 'absolute-pathname) -+ (slot-value component 'absolute-pathname) -+ (let ((pathname -+ (merge-pathnames* -+ (component-relative-pathname component) -+ (pathname-directory-pathname (component-parent-pathname component))))) -+ (unless (or (null pathname) (absolute-pathname-p pathname)) -+ (error (compatfmt "~@<Invalid relative pathname ~S for component ~S~@:>") -+ pathname (component-find-path component))) -+ (setf (slot-value component 'absolute-pathname) pathname) -+ pathname))) -+ -+ (defmethod component-relative-pathname ((component component)) -+ ;; source-file-type is backward-compatibility with ASDF1; -+ ;; we ought to be able to extract this from the component alone with COMPONENT-TYPE. -+ ;; TODO: track who uses it, and have them not use it anymore. -+ (parse-unix-namestring -+ (or (and (slot-boundp component 'relative-pathname) -+ (slot-value component 'relative-pathname)) -+ (component-name component)) -+ :want-relative t -+ :type (source-file-type component (component-system component)) -+ :defaults (component-parent-pathname component))) -+ -+ (defmethod source-file-type ((component parent-component) system) -+ (declare (ignorable component system)) -+ :directory) -+ -+ (defmethod source-file-type ((component file-component) system) -+ (declare (ignorable system)) -+ (file-type component))) -+ -+ -+;;;; Encodings -+(with-upgradability () -+ (defmethod component-encoding ((c component)) -+ (or (loop :for x = c :then (component-parent x) -+ :while x :thereis (%component-encoding x)) -+ (detect-encoding (component-pathname c)))) -+ -+ (defmethod component-external-format ((c component)) -+ (encoding-external-format (component-encoding c)))) -+ -+ -+;;;; around-compile-hook -+(with-upgradability () -+ (defgeneric around-compile-hook (component)) -+ (defmethod around-compile-hook ((c component)) -+ (cond -+ ((slot-boundp c 'around-compile) -+ (slot-value c 'around-compile)) -+ ((component-parent c) -+ (around-compile-hook (component-parent c)))))) -+ -+ -+;;;; version-satisfies -+(with-upgradability () -+ (defmethod version-satisfies ((c component) version) -+ (unless (and version (slot-boundp c 'version)) -+ (when version -+ (warn "Requested version ~S but component ~S has no version" version c)) -+ (return-from version-satisfies t)) -+ (version-satisfies (component-version c) version)) -+ -+ (defmethod version-satisfies ((cver string) version) -+ (version-compatible-p cver version))) -+ -+ -+;;; all sub-components (of a given type) -+(with-upgradability () -+ (defun sub-components (component &key (type t)) -+ (while-collecting (c) -+ (labels ((recurse (x) -+ (when (if-let (it (component-if-feature x)) (featurep it) t) -+ (when (typep x type) -+ (c x)) -+ (when (typep x 'parent-component) -+ (map () #'recurse (component-children x)))))) -+ (recurse component))))) -+ -+;;;; ------------------------------------------------------------------------- -+;;;; Systems -+ -+(asdf/package:define-package :asdf/system -+ (:recycle :asdf :asdf/system) -+ (:use :asdf/common-lisp :asdf/driver :asdf/upgrade :asdf/component) -+ (:export -+ #:system #:proto-system -+ #:system-source-file #:system-source-directory #:system-relative-pathname -+ #:reset-system -+ #:system-description #:system-long-description -+ #:system-author #:system-maintainer #:system-licence #:system-license -+ #:system-defsystem-depends-on -+ #:component-build-pathname #:build-pathname -+ #:component-entry-point #:entry-point -+ #:homepage #:system-homepage -+ #:bug-tracker #:system-bug-tracker -+ #:mailto #:system-mailto -+ #:long-name #:system-long-name -+ #:source-control #:system-source-control -+ #:find-system #:builtin-system-p)) ;; forward-reference, defined in find-system -+(in-package :asdf/system) -+ -+(with-upgradability () -+ (defgeneric* (find-system) (system &optional error-p)) -+ (defgeneric* (system-source-file) (system) -+ (:documentation "Return the source file in which system is defined.")) -+ (defgeneric component-build-pathname (component)) -+ -+ (defgeneric component-entry-point (component)) -+ (defmethod component-entry-point ((c component)) -+ (declare (ignorable c)) -+ nil)) -+ -+ -+;;;; The system class -+ -+(with-upgradability () -+ (defclass proto-system () ; slots to keep when resetting a system -+ ;; To preserve identity for all objects, we'd need keep the components slots -+ ;; but also to modify parse-component-form to reset the recycled objects. -+ ((name) (source-file) #|(children) (children-by-names)|#)) -+ -+ (defclass system (module proto-system) -+ ;; Backward-compatibility: inherit from module. ASDF4: only inherit from parent-component. -+ (;; {,long-}description is now inherited from component, but we add the legacy accessors -+ (description :accessor system-description) -+ (long-description :accessor system-long-description) -+ (author :accessor system-author :initarg :author :initform nil) -+ (maintainer :accessor system-maintainer :initarg :maintainer :initform nil) -+ (licence :accessor system-licence :initarg :licence -+ :accessor system-license :initarg :license :initform nil) -+ (homepage :accessor system-homepage :initarg :homepage :initform nil) -+ (bug-tracker :accessor system-bug-tracker :initarg :bug-tracker :initform nil) -+ (mailto :accessor system-mailto :initarg :mailto :initform nil) -+ (long-name :accessor system-long-name :initarg :long-name :initform nil) -+ ;; Conventions for this slot aren't clear yet as of ASDF 2.27, but whenever they are, they will be enforced. -+ ;; I'm introducing the slot before the conventions are set for maximum compatibility. -+ (source-control :accessor system-source-control :initarg :source-control :initform nil) -+ (builtin-system-p :accessor builtin-system-p :initform nil :initarg :builtin-system-p) -+ (build-pathname -+ :initform nil :initarg :build-pathname :accessor component-build-pathname) -+ (entry-point -+ :initform nil :initarg :entry-point :accessor component-entry-point) -+ (source-file :initform nil :initarg :source-file :accessor system-source-file) -+ (defsystem-depends-on :reader system-defsystem-depends-on :initarg :defsystem-depends-on))) -+ -+ (defun reset-system (system &rest keys &key &allow-other-keys) -+ (change-class (change-class system 'proto-system) 'system) -+ (apply 'reinitialize-instance system keys))) -+ -+ -+;;;; Pathnames -+ -+(with-upgradability () -+ (defmethod system-source-file ((system-name string)) -+ (system-source-file (find-system system-name))) -+ (defmethod system-source-file ((system-name symbol)) -+ (system-source-file (find-system system-name))) -+ -+ (defun system-source-directory (system-designator) -+ "Return a pathname object corresponding to the directory -+in which the system specification (.asd file) is located." -+ (pathname-directory-pathname (system-source-file system-designator))) -+ -+ (defun (system-relative-pathname) (system name &key type) -+ (subpathname (system-source-directory system) name :type type)) -+ -+ (defmethod component-pathname ((system system)) -+ (let ((pathname (or (call-next-method) (system-source-directory system)))) -+ (unless (and (slot-boundp system 'relative-pathname) ;; backward-compatibility with ASDF1-age -+ (slot-value system 'relative-pathname)) ;; systems that directly access this slot. -+ (setf (slot-value system 'relative-pathname) pathname)) -+ pathname)) -+ -+ (defmethod component-relative-pathname ((system system)) -+ (parse-unix-namestring -+ (and (slot-boundp system 'relative-pathname) -+ (slot-value system 'relative-pathname)) -+ :want-relative t -+ :type :directory -+ :ensure-absolute t -+ :defaults (system-source-directory system))) -+ -+ (defmethod component-parent-pathname ((system system)) -+ (system-source-directory system)) -+ -+ (defmethod component-build-pathname ((c component)) -+ (declare (ignorable c)) -+ nil)) -+ -+;;;; ------------------------------------------------------------------------- -+;;;; Stamp cache -+ -+(asdf/package:define-package :asdf/cache -+ (:use :asdf/common-lisp :asdf/driver :asdf/upgrade) -+ (:export #:get-file-stamp #:compute-file-stamp #:register-file-stamp -+ #:consult-asdf-cache #:do-asdf-cache -+ #:call-with-asdf-cache #:with-asdf-cache #:*asdf-cache*)) -+(in-package :asdf/cache) -+ -+;;; This stamp cache is useful for: -+;; * consistency of stamps used within a single run -+;; * fewer accesses to the filesystem -+;; * the ability to test with fake timestamps, without touching files -+ -+(with-upgradability () -+ (defvar *asdf-cache* nil) -+ -+ (defun set-asdf-cache-entry (key value-list) -+ (apply 'values -+ (if *asdf-cache* -+ (setf (gethash key *asdf-cache*) value-list) -+ value-list))) -+ -+ (defun consult-asdf-cache (key &optional thunk) -+ (if *asdf-cache* -+ (multiple-value-bind (results foundp) (gethash key *asdf-cache*) -+ (if foundp -+ (apply 'values results) -+ (set-asdf-cache-entry key (multiple-value-list (call-function thunk))))) -+ (call-function thunk))) -+ -+ (defmacro do-asdf-cache (key &body body) -+ `(consult-asdf-cache ,key #'(lambda () ,@body))) -+ -+ (defun call-with-asdf-cache (thunk &key override) -+ (if (and *asdf-cache* (not override)) -+ (funcall thunk) -+ (let ((*asdf-cache* (make-hash-table :test 'equal))) -+ (funcall thunk)))) -+ -+ (defmacro with-asdf-cache ((&key override) &body body) -+ `(call-with-asdf-cache #'(lambda () ,@body) :override ,override)) -+ -+ (defun compute-file-stamp (file) -+ (safe-file-write-date file)) -+ -+ (defun register-file-stamp (file &optional (stamp (compute-file-stamp file))) -+ (set-asdf-cache-entry `(get-file-stamp ,file) (list stamp))) -+ -+ (defun get-file-stamp (file) -+ (do-asdf-cache `(get-file-stamp ,file) (compute-file-stamp file)))) -+ -+ -+;;;; ------------------------------------------------------------------------- -+;;;; Finding systems -+ -+(asdf/package:define-package :asdf/find-system -+ (:recycle :asdf/find-system :asdf) -+ (:use :asdf/common-lisp :asdf/driver :asdf/upgrade -+ :asdf/component :asdf/system :asdf/cache) -+ (:export -+ #:remove-entry-from-registry #:coerce-entry-to-directory -+ #:coerce-name #:primary-system-name #:coerce-filename -+ #:find-system #:locate-system #:load-asd #:with-system-definitions -+ #:system-registered-p #:register-system #:registered-systems #:clear-system #:map-systems -+ #:system-definition-error #:missing-component #:missing-requires #:missing-parent -+ #:formatted-system-definition-error #:format-control #:format-arguments #:sysdef-error -+ #:load-system-definition-error #:error-name #:error-pathname #:error-condition -+ #:*system-definition-search-functions* #:search-for-system-definition -+ #:*central-registry* #:probe-asd #:sysdef-central-registry-search -+ #:find-system-if-being-defined #:*systems-being-defined* -+ #:contrib-sysdef-search #:sysdef-find-asdf ;; backward compatibility symbols, functions removed -+ #:sysdef-preloaded-system-search #:register-preloaded-system #:*preloaded-systems* -+ #:clear-defined-systems #:*defined-systems* -+ ;; defined in source-registry, but specially mentioned here: -+ #:initialize-source-registry #:sysdef-source-registry-search)) -+(in-package :asdf/find-system) -+ -+(with-upgradability () -+ (declaim (ftype (function (&optional t) t) initialize-source-registry)) ; forward reference -+ -+ (define-condition system-definition-error (error) () -+ ;; [this use of :report should be redundant, but unfortunately it's not. -+ ;; cmucl's lisp::output-instance prefers the kernel:slot-class-print-function -+ ;; over print-object; this is always conditions::%print-condition for -+ ;; condition objects, which in turn does inheritance of :report options at -+ ;; run-time. fortunately, inheritance means we only need this kludge here in -+ ;; order to fix all conditions that build on it. -- rgr, 28-Jul-02.] -+ #+cmu (:report print-object)) -+ -+ (define-condition missing-component (system-definition-error) -+ ((requires :initform "(unnamed)" :reader missing-requires :initarg :requires) -+ (parent :initform nil :reader missing-parent :initarg :parent))) -+ -+ (define-condition formatted-system-definition-error (system-definition-error) -+ ((format-control :initarg :format-control :reader format-control) -+ (format-arguments :initarg :format-arguments :reader format-arguments)) -+ (:report (lambda (c s) -+ (apply 'format s (format-control c) (format-arguments c))))) -+ -+ (define-condition load-system-definition-error (system-definition-error) -+ ((name :initarg :name :reader error-name) -+ (pathname :initarg :pathname :reader error-pathname) -+ (condition :initarg :condition :reader error-condition)) -+ (:report (lambda (c s) -+ (format s (compatfmt "~@<Error while trying to load definition for system ~A from pathname ~A: ~3i~_~A~@:>") -+ (error-name c) (error-pathname c) (error-condition c))))) -+ -+ (defun sysdef-error (format &rest arguments) -+ (error 'formatted-system-definition-error :format-control -+ format :format-arguments arguments)) -+ -+ (defun coerce-name (name) -+ (typecase name -+ (component (component-name name)) -+ (symbol (string-downcase (symbol-name name))) -+ (string name) -+ (t (sysdef-error (compatfmt "~@<Invalid component designator: ~3i~_~A~@:>") name)))) -+ -+ (defun primary-system-name (name) -+ ;; When a system name has slashes, the file with defsystem is named by -+ ;; the first of the slash-separated components. -+ (first (split-string (coerce-name name) :separator "/"))) -+ -+ (defun coerce-filename (name) -+ (frob-substrings (coerce-name name) '("/" ":" "\\") "--")) -+ -+ (defvar *defined-systems* (make-hash-table :test 'equal) -+ "This is a hash table whose keys are strings, being the -+names of the systems, and whose values are pairs, the first -+element of which is a universal-time indicating when the -+system definition was last updated, and the second element -+of which is a system object.") -+ -+ (defun system-registered-p (name) -+ (gethash (coerce-name name) *defined-systems*)) -+ -+ (defun registered-systems () -+ (loop :for registered :being :the :hash-values :of *defined-systems* -+ :collect (coerce-name (cdr registered)))) -+ -+ (defun register-system (system) -+ (check-type system system) -+ (let ((name (component-name system))) -+ (check-type name string) -+ (asdf-message (compatfmt "~&~@<; ~@;Registering ~3i~_~A~@:>~%") system) -+ (unless (eq system (cdr (gethash name *defined-systems*))) -+ (setf (gethash name *defined-systems*) -+ (cons (if-let (file (ignore-errors (system-source-file system))) -+ (get-file-stamp file)) -+ system))))) -+ -+ (defun clear-defined-systems () -+ ;; Invalidate all systems but ASDF itself, if registered. -+ (let ((asdf (cdr (system-registered-p :asdf)))) -+ (setf *defined-systems* (make-hash-table :test 'equal)) -+ (when asdf -+ (setf (component-version asdf) *asdf-version*) -+ (setf (builtin-system-p asdf) t) -+ (register-system asdf))) -+ (values)) -+ -+ (register-hook-function '*post-upgrade-cleanup-hook* 'clear-defined-systems nil) -+ -+ (defun clear-system (name) -+ "Clear the entry for a system in the database of systems previously loaded. -+Note that this does NOT in any way cause the code of the system to be unloaded." -+ ;; There is no "unload" operation in Common Lisp, and -+ ;; a general such operation cannot be portably written, -+ ;; considering how much CL relies on side-effects to global data structures. -+ (remhash (coerce-name name) *defined-systems*)) -+ -+ (defun map-systems (fn) -+ "Apply FN to each defined system. -+ -+FN should be a function of one argument. It will be -+called with an object of type asdf:system." -+ (loop :for registered :being :the :hash-values :of *defined-systems* -+ :do (funcall fn (cdr registered))))) -+ -+;;; for the sake of keeping things reasonably neat, we adopt a -+;;; convention that functions in this list are prefixed SYSDEF- -+(with-upgradability () -+ (defvar *system-definition-search-functions* '()) -+ -+ (defun cleanup-system-definition-search-functions () -+ (setf *system-definition-search-functions* -+ (append -+ ;; Remove known-incompatible sysdef functions from old versions of asdf. -+ (remove-if #'(lambda (x) (member x '(contrib-sysdef-search sysdef-find-asdf))) -+ *system-definition-search-functions*) -+ ;; Tuck our defaults at the end of the list if they were absent. -+ ;; This is imperfect, in case they were removed on purpose, -+ ;; but then it will be the responsibility of whoever does that -+ ;; to upgrade asdf before he does such a thing rather than after. -+ (remove-if #'(lambda (x) (member x *system-definition-search-functions*)) -+ '(sysdef-central-registry-search -+ sysdef-source-registry-search -+ sysdef-preloaded-system-search))))) -+ (cleanup-system-definition-search-functions) -+ -+ (defun search-for-system-definition (system) -+ (some (let ((name (coerce-name system))) #'(lambda (x) (funcall x name))) -+ (cons 'find-system-if-being-defined -+ *system-definition-search-functions*))) -+ -+ (defvar *central-registry* nil -+ "A list of 'system directory designators' ASDF uses to find systems. -+ -+A 'system directory designator' is a pathname or an expression -+which evaluates to a pathname. For example: -+ -+ (setf asdf:*central-registry* -+ (list '*default-pathname-defaults* -+ #p\"/home/me/cl/systems/\" -+ #p\"/usr/share/common-lisp/systems/\")) -+ -+This is for backward compatibility. -+Going forward, we recommend new users should be using the source-registry. -+") -+ -+ (defun probe-asd (name defaults &key truename) -+ (block nil -+ (when (directory-pathname-p defaults) -+ (if-let (file (probe-file* -+ (ensure-absolute-pathname -+ (parse-unix-namestring name :type "asd") -+ #'(lambda () (ensure-absolute-pathname defaults 'get-pathname-defaults nil)) -+ nil) -+ :truename truename)) -+ (return file)) -+ #-(or clisp genera) ; clisp doesn't need it, plain genera doesn't have read-sequence(!) -+ (when (os-windows-p) -+ (let ((shortcut -+ (make-pathname -+ :defaults defaults :case :local -+ :name (strcat name ".asd") -+ :type "lnk"))) -+ (when (probe-file* shortcut) -+ (let ((target (parse-windows-shortcut shortcut))) -+ (when target -+ (return (pathname target)))))))))) -+ -+ (defun sysdef-central-registry-search (system) -+ (let ((name (primary-system-name system)) -+ (to-remove nil) -+ (to-replace nil)) -+ (block nil -+ (unwind-protect -+ (dolist (dir *central-registry*) -+ (let ((defaults (eval dir)) -+ directorized) -+ (when defaults -+ (cond ((directory-pathname-p defaults) -+ (let* ((file (probe-asd name defaults :truename *resolve-symlinks*))) -+ (when file -+ (return file)))) -+ (t -+ (restart-case -+ (let* ((*print-circle* nil) -+ (message -+ (format nil -+ (compatfmt "~@<While searching for system ~S: ~3i~_~S evaluated to ~S which is not an absolute directory.~@:>") -+ system dir defaults))) -+ (error message)) -+ (remove-entry-from-registry () -+ :report "Remove entry from *central-registry* and continue" -+ (push dir to-remove)) -+ (coerce-entry-to-directory () -+ :test (lambda (c) (declare (ignore c)) -+ (and (not (directory-pathname-p defaults)) -+ (directory-pathname-p -+ (setf directorized -+ (ensure-directory-pathname defaults))))) -+ :report (lambda (s) -+ (format s (compatfmt "~@<Coerce entry to ~a, replace ~a and continue.~@:>") -+ directorized dir)) -+ (push (cons dir directorized) to-replace)))))))) -+ ;; cleanup -+ (dolist (dir to-remove) -+ (setf *central-registry* (remove dir *central-registry*))) -+ (dolist (pair to-replace) -+ (let* ((current (car pair)) -+ (new (cdr pair)) -+ (position (position current *central-registry*))) -+ (setf *central-registry* -+ (append (subseq *central-registry* 0 position) -+ (list new) -+ (subseq *central-registry* (1+ position)))))))))) -+ -+ (defvar *preloaded-systems* (make-hash-table :test 'equal)) -+ -+ (defun make-preloaded-system (name keys) -+ (apply 'make-instance (getf keys :class 'system) -+ :name name :source-file (getf keys :source-file) -+ (remove-plist-keys '(:class :name :source-file) keys))) -+ -+ (defun sysdef-preloaded-system-search (requested) -+ (let ((name (coerce-name requested))) -+ (multiple-value-bind (keys foundp) (gethash name *preloaded-systems*) -+ (when foundp -+ (make-preloaded-system name keys))))) -+ -+ (defun register-preloaded-system (system-name &rest keys) -+ (setf (gethash (coerce-name system-name) *preloaded-systems*) keys)) -+ -+ (register-preloaded-system "asdf" :version *asdf-version*) -+ (register-preloaded-system "asdf-driver" :version *asdf-version*) -+ -+ (defmethod find-system ((name null) &optional (error-p t)) -+ (declare (ignorable name)) -+ (when error-p -+ (sysdef-error (compatfmt "~@<NIL is not a valid system name~@:>")))) -+ -+ (defmethod find-system (name &optional (error-p t)) -+ (find-system (coerce-name name) error-p)) -+ -+ (defvar *systems-being-defined* nil -+ "A hash-table of systems currently being defined keyed by name, or NIL") -+ -+ (defun find-system-if-being-defined (name) -+ (when *systems-being-defined* -+ (gethash (coerce-name name) *systems-being-defined*))) -+ -+ (defun call-with-system-definitions (thunk) -+ (if *systems-being-defined* -+ (call-with-asdf-cache thunk) -+ (let ((*systems-being-defined* (make-hash-table :test 'equal))) -+ (call-with-asdf-cache thunk)))) -+ -+ (defun clear-systems-being-defined () -+ (when *systems-being-defined* -+ (clrhash *systems-being-defined*))) -+ -+ (register-hook-function '*post-upgrade-cleanup-hook* 'clear-systems-being-defined) -+ -+ (defmacro with-system-definitions ((&optional) &body body) -+ `(call-with-system-definitions #'(lambda () ,@body))) -+ -+ (defun load-asd (pathname &key name (external-format (encoding-external-format (detect-encoding pathname))) &aux (readtable *readtable*) (print-pprint-dispatch *print-pprint-dispatch*)) -+ ;; Tries to load system definition with canonical NAME from PATHNAME. -+ (with-system-definitions () -+ (with-standard-io-syntax -+ (let ((*package* (find-package :asdf-user)) -+ ;; Note that our backward-compatible *readtable* is -+ ;; a global readtable that gets globally side-effected. Ouch. -+ ;; Same for the *print-pprint-dispatch* table. -+ ;; We should do something about that for ASDF3 if possible, or else ASDF4. -+ (*readtable* readtable) -+ (*print-pprint-dispatch* print-pprint-dispatch) -+ (*print-readably* nil) -+ (*default-pathname-defaults* -+ ;; resolve logical-pathnames so they won't wreak havoc in parsing namestrings. -+ (pathname-directory-pathname (translate-logical-pathname pathname)))) -+ (handler-bind -+ ((error #'(lambda (condition) -+ (error 'load-system-definition-error -+ :name name :pathname pathname -+ :condition condition)))) -+ (asdf-message (compatfmt "~&~@<; ~@;Loading system definition~@[ for ~A~] from ~A~@:>~%") -+ name pathname) -+ (with-muffled-loader-conditions () -+ (load* pathname :external-format external-format))))))) -+ -+ (defvar *old-asdf-systems* (make-hash-table :test 'equal)) -+ -+ (defun check-not-old-asdf-system (name pathname) -+ (or (not (equal name "asdf")) -+ (null pathname) -+ (let* ((version-pathname (subpathname pathname "version.lisp-expr")) -+ (version (and (probe-file* version-pathname :truename nil) -+ (read-file-form version-pathname))) -+ (old-version (asdf-version))) -+ (or (version<= old-version version) -+ (let ((old-pathname -+ (if-let (pair (system-registered-p "asdf")) -+ (system-source-file (cdr pair)))) -+ (key (list pathname old-version))) -+ (unless (gethash key *old-asdf-systems*) -+ (setf (gethash key *old-asdf-systems*) t) -+ (warn "~@<~ -+ You are using ASDF version ~A ~:[(probably from (require \"asdf\") ~ -+ or loaded by quicklisp)~;from ~:*~S~] and have an older version of ASDF ~ -+ ~:[(and older than 2.27 at that)~;~:*~A~] registered at ~S. ~ -+ Having an ASDF installed and registered is the normal way of configuring ASDF to upgrade itself, ~ -+ and having an old version registered is a configuration error. ~ -+ ASDF will ignore this configured system rather than downgrade itself. ~ -+ In the future, you may want to either: ~ -+ (a) upgrade this configured ASDF to a newer version, ~ -+ (b) install a newer ASDF and register it in front of the former in your configuration, or ~ -+ (c) uninstall or unregister this and any other old version of ASDF from your configuration. ~ -+ Note that the older ASDF might be registered implicitly through configuration inherited ~ -+ from your system installation, in which case you might have to specify ~ -+ :ignore-inherited-configuration in your in your ~~/.config/common-lisp/source-registry.conf ~ -+ or other source-registry configuration file, environment variable or lisp parameter. ~ -+ Indeed, a likely offender is an obsolete version of the cl-asdf debian or ubuntu package, ~ -+ that you might want to upgrade (if a recent enough version is available) ~ -+ or else remove altogether (since most implementations ship with a recent asdf); ~ -+ if you lack the system administration rights to upgrade or remove this package, ~ -+ then you might indeed want to either install and register a more recent version, ~ -+ or use :ignore-inherited-configuration to avoid registering the old one. ~ -+ Please consult ASDF documentation and/or experts.~@:>~%" -+ old-version old-pathname version pathname))))))) -+ -+ (defun locate-system (name) -+ "Given a system NAME designator, try to locate where to load the system from. -+Returns five values: FOUNDP FOUND-SYSTEM PATHNAME PREVIOUS PREVIOUS-TIME -+FOUNDP is true when a system was found, -+either a new unregistered one or a previously registered one. -+FOUND-SYSTEM when not null is a SYSTEM object that may be REGISTER-SYSTEM'ed as is -+PATHNAME when not null is a path from where to load the system, -+either associated with FOUND-SYSTEM, or with the PREVIOUS system. -+PREVIOUS when not null is a previously loaded SYSTEM object of same name. -+PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded." -+ (let* ((name (coerce-name name)) -+ (in-memory (system-registered-p name)) ; load from disk if absent or newer on disk -+ (previous (cdr in-memory)) -+ (previous (and (typep previous 'system) previous)) -+ (previous-time (car in-memory)) -+ (found (search-for-system-definition name)) -+ (found-system (and (typep found 'system) found)) -+ (pathname (ensure-pathname -+ (or (and (typep found '(or pathname string)) (pathname found)) -+ (and found-system (system-source-file found-system)) -+ (and previous (system-source-file previous))) -+ :want-absolute t :resolve-symlinks *resolve-symlinks*)) -+ (foundp (and (or found-system pathname previous) t))) -+ (check-type found (or null pathname system)) -+ (unless (check-not-old-asdf-system name pathname) -+ (cond -+ (previous (setf found nil pathname nil)) -+ (t -+ (setf found (sysdef-preloaded-system-search "asdf")) -+ (assert (typep found 'system)) -+ (setf found-system found pathname nil)))) -+ (values foundp found-system pathname previous previous-time))) -+ -+ (defmethod find-system ((name string) &optional (error-p t)) -+ (with-system-definitions () -+ (loop -+ (restart-case -+ (multiple-value-bind (foundp found-system pathname previous previous-time) -+ (locate-system name) -+ (assert (eq foundp (and (or found-system pathname previous) t))) -+ (let ((previous-pathname (and previous (system-source-file previous))) -+ (system (or previous found-system))) -+ (when (and found-system (not previous)) -+ (register-system found-system)) -+ (when (and system pathname) -+ (setf (system-source-file system) pathname)) -+ (when (and pathname -+ (let ((stamp (get-file-stamp pathname))) -+ (and stamp -+ (not (and previous -+ (or (pathname-equal pathname previous-pathname) -+ (and pathname previous-pathname -+ (pathname-equal -+ (translate-logical-pathname pathname) -+ (translate-logical-pathname previous-pathname)))) -+ (stamp<= stamp previous-time)))))) -+ ;; only load when it's a pathname that is different or has newer content, and not an old asdf -+ (load-asd pathname :name name))) -+ (let ((in-memory (system-registered-p name))) ; try again after loading from disk if needed -+ (return -+ (cond -+ (in-memory -+ (when pathname -+ (setf (car in-memory) (get-file-stamp pathname))) -+ (cdr in-memory)) -+ (error-p -+ (error 'missing-component :requires name)))))) -+ (reinitialize-source-registry-and-retry () -+ :report (lambda (s) -+ (format s (compatfmt "~@<Retry finding system ~A after reinitializing the source-registry.~@:>") name)) -+ (initialize-source-registry))))))) -+ -+;;;; ------------------------------------------------------------------------- -+;;;; Finding components -+ -+(asdf/package:define-package :asdf/find-component -+ (:recycle :asdf/find-component :asdf) -+ (:use :asdf/common-lisp :asdf/driver :asdf/upgrade -+ :asdf/component :asdf/system :asdf/find-system) -+ (:export -+ #:find-component -+ #:resolve-dependency-name #:resolve-dependency-spec -+ #:resolve-dependency-combination -+ ;; Conditions -+ #:missing-component #:missing-component-of-version #:retry -+ #:missing-dependency #:missing-dependency-of-version -+ #:missing-requires #:missing-parent -+ #:missing-required-by #:missing-version)) -+(in-package :asdf/find-component) -+ -+;;;; Missing component conditions -+ -+(with-upgradability () -+ (define-condition missing-component-of-version (missing-component) -+ ((version :initform nil :reader missing-version :initarg :version))) -+ -+ (define-condition missing-dependency (missing-component) -+ ((required-by :initarg :required-by :reader missing-required-by))) -+ -+ (defmethod print-object ((c missing-dependency) s) -+ (format s (compatfmt "~@<~A, required by ~A~@:>") -+ (call-next-method c nil) (missing-required-by c))) -+ -+ (define-condition missing-dependency-of-version (missing-dependency -+ missing-component-of-version) -+ ()) -+ -+ (defmethod print-object ((c missing-component) s) -+ (format s (compatfmt "~@<Component ~S not found~@[ in ~A~]~@:>") -+ (missing-requires c) -+ (when (missing-parent c) -+ (coerce-name (missing-parent c))))) -+ -+ (defmethod print-object ((c missing-component-of-version) s) -+ (format s (compatfmt "~@<Component ~S does not match version ~A~@[ in ~A~]~@:>") -+ (missing-requires c) -+ (missing-version c) -+ (when (missing-parent c) -+ (coerce-name (missing-parent c)))))) -+ -+ -+;;;; Finding components -+ -+(with-upgradability () -+ (defgeneric* (find-component) (base path) -+ (:documentation "Find a component by resolving the PATH starting from BASE parent")) -+ (defgeneric resolve-dependency-combination (component combinator arguments)) -+ -+ (defmethod find-component ((base string) path) -+ (let ((s (find-system base nil))) -+ (and s (find-component s path)))) -+ -+ (defmethod find-component ((base symbol) path) -+ (cond -+ (base (find-component (coerce-name base) path)) -+ (path (find-component path nil)) -+ (t nil))) -+ -+ (defmethod find-component ((base cons) path) -+ (find-component (car base) (cons (cdr base) path))) -+ -+ (defmethod find-component ((parent parent-component) (name string)) -+ (compute-children-by-name parent :only-if-needed-p t) ;; SBCL may miss the u-i-f-r-c method!!! -+ (values (gethash name (component-children-by-name parent)))) -+ -+ (defmethod find-component (base (name symbol)) -+ (if name -+ (find-component base (coerce-name name)) -+ base)) -+ -+ (defmethod find-component ((c component) (name cons)) -+ (find-component (find-component c (car name)) (cdr name))) -+ -+ (defmethod find-component (base (actual component)) -+ (declare (ignorable base)) -+ actual) -+ -+ (defun resolve-dependency-name (component name &optional version) -+ (loop -+ (restart-case -+ (return -+ (let ((comp (find-component (component-parent component) name))) -+ (unless comp -+ (error 'missing-dependency -+ :required-by component -+ :requires name)) -+ (when version -+ (unless (version-satisfies comp version) -+ (error 'missing-dependency-of-version -+ :required-by component -+ :version version -+ :requires name))) -+ comp)) -+ (retry () -+ :report (lambda (s) -+ (format s (compatfmt "~@<Retry loading ~3i~_~A.~@:>") name)) -+ :test -+ (lambda (c) -+ (or (null c) -+ (and (typep c 'missing-dependency) -+ (eq (missing-required-by c) component) -+ (equal (missing-requires c) name)))))))) -+ -+ (defun resolve-dependency-spec (component dep-spec) -+ (let ((component (find-component () component))) -+ (if (atom dep-spec) -+ (resolve-dependency-name component dep-spec) -+ (resolve-dependency-combination component (car dep-spec) (cdr dep-spec))))) -+ -+ (defmethod resolve-dependency-combination (component combinator arguments) -+ (error (compatfmt "~@<Bad dependency ~S for ~S~@:>") -+ (cons combinator arguments) component)) -+ -+ (defmethod resolve-dependency-combination (component (combinator (eql :feature)) arguments) -+ (declare (ignorable combinator)) -+ (when (featurep (first arguments)) -+ (resolve-dependency-spec component (second arguments)))) -+ -+ (defmethod resolve-dependency-combination (component (combinator (eql :version)) arguments) -+ (declare (ignorable combinator)) ;; See https://bugs.launchpad.net/asdf/+bug/527788 -+ (resolve-dependency-name component (first arguments) (second arguments)))) -+ -+;;;; ------------------------------------------------------------------------- -+;;;; Operations -+ -+(asdf/package:define-package :asdf/operation -+ (:recycle :asdf/operation :asdf/action :asdf) ;; asdf/action for FEATURE pre 2.31.5. -+ (:use :asdf/common-lisp :asdf/driver :asdf/upgrade) -+ (:export -+ #:operation -+ #:operation-original-initargs #:original-initargs ;; backward-compatibility only. DO NOT USE. -+ #:build-op ;; THE generic operation -+ #:*operations* #:make-operation #:find-operation #:feature)) -+(in-package :asdf/operation) -+ -+;;; Operation Classes -+ -+(when-upgrading (:when (find-class 'operation nil)) -+ (defmethod shared-initialize :after ((o operation) slot-names &rest initargs &key) -+ (declare (ignorable o slot-names initargs)) (values))) -+ -+(with-upgradability () -+ (defclass operation () -+ ((original-initargs ;; for backward-compat -- used by GBBopen and swank (via operation-forced) -+ :initform nil :initarg :original-initargs :accessor operation-original-initargs))) -+ -+ (defmethod initialize-instance :after ((o operation) &rest initargs -+ &key force force-not system verbose &allow-other-keys) -+ (declare (ignorable force force-not system verbose)) -+ (unless (slot-boundp o 'original-initargs) -+ (setf (operation-original-initargs o) initargs))) -+ -+ (defmethod print-object ((o operation) stream) -+ (print-unreadable-object (o stream :type t :identity nil) -+ (ignore-errors -+ (format stream "~{~S~^ ~}" (operation-original-initargs o)))))) -+ -+;;; make-operation, find-operation -+ -+(with-upgradability () -+ (defparameter *operations* (make-hash-table :test 'equal)) -+ (defun make-operation (operation-class &rest initargs) -+ (let ((key (cons operation-class initargs))) -+ (multiple-value-bind (operation foundp) (gethash key *operations*) -+ (if foundp operation -+ (setf (gethash key *operations*) -+ (apply 'make-instance operation-class initargs)))))) -+ -+ (defgeneric find-operation (context spec) -+ (:documentation "Find an operation by resolving the SPEC in the CONTEXT")) -+ (defmethod find-operation (context (spec operation)) -+ (declare (ignorable context)) -+ spec) -+ (defmethod find-operation (context (spec symbol)) -+ (unless (member spec '(nil feature)) -+ ;; NIL designates itself, i.e. absence of operation -+ ;; FEATURE is the ASDF1 misfeature that comes with IF-COMPONENT-DEP-FAILS -+ (apply 'make-operation spec (operation-original-initargs context)))) -+ (defmethod operation-original-initargs ((context symbol)) -+ (declare (ignorable context)) -+ nil) -+ -+ (defclass build-op (operation) ())) -+ -+ -+;;;; ------------------------------------------------------------------------- -+;;;; Actions -+ -+(asdf/package:define-package :asdf/action -+ (:nicknames :asdf-action) -+ (:recycle :asdf/action :asdf) -+ (:use :asdf/common-lisp :asdf/driver :asdf/upgrade -+ :asdf/component :asdf/system #:asdf/cache :asdf/find-system :asdf/find-component :asdf/operation) -+ (:export -+ #:action #:define-convenience-action-methods -+ #:explain #:action-description -+ #:downward-operation #:upward-operation #:sideway-operation #:selfward-operation -+ #:component-depends-on -+ #:input-files #:output-files #:output-file #:operation-done-p -+ #:action-status #:action-stamp #:action-done-p -+ #:component-operation-time #:mark-operation-done #:compute-action-stamp -+ #:perform #:perform-with-restarts #:retry #:accept -+ #:traverse-actions #:traverse-sub-actions #:required-components ;; in plan -+ #:action-path #:find-action #:stamp #:done-p)) -+(in-package :asdf/action) -+ -+(eval-when (#-lispworks :compile-toplevel :load-toplevel :execute) -+ (deftype action () '(cons operation component))) ;; a step to be performed while building -+ -+(with-upgradability () -+ (defgeneric traverse-actions (actions &key &allow-other-keys)) -+ (defgeneric traverse-sub-actions (operation component &key &allow-other-keys)) -+ (defgeneric required-components (component &key &allow-other-keys))) -+ -+;;;; Reified representation for storage or debugging. Note: dropping original-initargs -+(with-upgradability () -+ (defun action-path (action) -+ (destructuring-bind (o . c) action (cons (type-of o) (component-find-path c)))) -+ (defun find-action (path) -+ (destructuring-bind (o . c) path (cons (make-operation o) (find-component () c))))) -+ -+ -+;;;; Convenience methods -+(with-upgradability () -+ (defmacro define-convenience-action-methods -+ (function (operation component &optional keyp) -+ &key if-no-operation if-no-component operation-initargs) -+ (let* ((rest (gensym "REST")) -+ (found (gensym "FOUND")) -+ (more-args (when keyp `(&rest ,rest &key &allow-other-keys)))) -+ (flet ((next-method (o c) -+ (if keyp -+ `(apply ',function ,o ,c ,rest) -+ `(,function ,o ,c)))) -+ `(progn -+ (defmethod ,function ((,operation symbol) ,component ,@more-args) -+ (if ,operation -+ ,(next-method -+ (if operation-initargs ;backward-compatibility with ASDF1's operate. Yuck. -+ `(apply 'make-operation ,operation :original-initargs ,rest ,rest) -+ `(make-operation ,operation)) -+ `(or (find-component () ,component) ,if-no-component)) -+ ,if-no-operation)) -+ (defmethod ,function ((,operation operation) ,component ,@more-args) -+ (if (typep ,component 'component) -+ (error "No defined method for ~S on ~/asdf-action:format-action/" -+ ',function (cons ,operation ,component)) -+ (let ((,found (find-component () ,component))) -+ (if ,found -+ ,(next-method operation found) -+ ,if-no-component))))))))) -+ -+ -+;;;; self-description -+(with-upgradability () -+ (defgeneric action-description (operation component) -+ (:documentation "returns a phrase that describes performing this operation -+on this component, e.g. \"loading /a/b/c\". -+You can put together sentences using this phrase.")) -+ (defmethod action-description (operation component) -+ (format nil (compatfmt "~@<~A on ~A~@:>") -+ (type-of operation) component)) -+ (defgeneric* (explain) (operation component)) -+ (defmethod explain ((o operation) (c component)) -+ (asdf-message (compatfmt "~&~@<; ~@;~A~:>~%") (action-description o c))) -+ (define-convenience-action-methods explain (operation component)) -+ -+ (defun format-action (stream action &optional colon-p at-sign-p) -+ (assert (null colon-p)) (assert (null at-sign-p)) -+ (destructuring-bind (operation . component) action -+ (princ (action-description operation component) stream)))) -+ -+ -+;;;; Dependencies -+(with-upgradability () -+ (defgeneric* (component-depends-on) (operation component) ;; ASDF4: rename to component-dependencies -+ (:documentation -+ "Returns a list of dependencies needed by the component to perform -+ the operation. A dependency has one of the following forms: -+ -+ (<operation> <component>*), where <operation> is an operation designator -+ with respect to FIND-OPERATION in the context of the OPERATION argument, -+ and each <component> is a component designator with respect to -+ FIND-COMPONENT in the context of the COMPONENT argument, -+ and means that the component depends on -+ <operation> having been performed on each <component>; or -+ -+ (FEATURE <feature>), which means that the component depends -+ on the <feature> expression satisfying FEATUREP. -+ (This is DEPRECATED -- use :IF-FEATURE instead.) -+ -+ Methods specialized on subclasses of existing component types -+ should usually append the results of CALL-NEXT-METHOD to the list.")) -+ (define-convenience-action-methods component-depends-on (operation component)) -+ -+ (defmethod component-depends-on :around ((o operation) (c component)) -+ (do-asdf-cache `(component-depends-on ,o ,c) -+ (call-next-method))) -+ -+ (defmethod component-depends-on ((o operation) (c component)) -+ (cdr (assoc (type-of o) (component-in-order-to c))))) ; User-specified in-order dependencies -+ -+ -+;;;; upward-operation, downward-operation -+;; These together handle actions that propagate along the component hierarchy. -+;; Downward operations like load-op or compile-op propagate down the hierarchy: -+;; operation on a parent depends-on operation on its children. -+;; By default, an operation propagates itself, but it may propagate another one instead. -+(with-upgradability () -+ (defclass downward-operation (operation) -+ ((downward-operation -+ :initform nil :initarg :downward-operation :reader downward-operation :allocation :class))) -+ (defmethod component-depends-on ((o downward-operation) (c parent-component)) -+ `((,(or (downward-operation o) o) ,@(component-children c)) ,@(call-next-method))) -+ ;; Upward operations like prepare-op propagate up the component hierarchy: -+ ;; operation on a child depends-on operation on its parent. -+ ;; By default, an operation propagates itself, but it may propagate another one instead. -+ (defclass upward-operation (operation) -+ ((upward-operation -+ :initform nil :initarg :downward-operation :reader upward-operation :allocation :class))) -+ ;; For backward-compatibility reasons, a system inherits from module and is a child-component -+ ;; so we must guard against this case. ASDF4: remove that. -+ (defmethod component-depends-on ((o upward-operation) (c child-component)) -+ `(,@(if-let (p (component-parent c)) -+ `((,(or (upward-operation o) o) ,p))) ,@(call-next-method))) -+ ;; Sibling operations propagate to siblings in the component hierarchy: -+ ;; operation on a child depends-on operation on its parent. -+ ;; By default, an operation propagates itself, but it may propagate another one instead. -+ (defclass sideway-operation (operation) -+ ((sideway-operation -+ :initform nil :initarg :sideway-operation :reader sideway-operation :allocation :class))) -+ (defmethod component-depends-on ((o sideway-operation) (c component)) -+ `((,(or (sideway-operation o) o) -+ ,@(loop :for dep :in (component-sideway-dependencies c) -+ :collect (resolve-dependency-spec c dep))) -+ ,@(call-next-method))) -+ ;; Selfward operations propagate to themselves a sub-operation: -+ ;; they depend on some other operation being acted on the same component. -+ (defclass selfward-operation (operation) -+ ((selfward-operation -+ :initform nil :initarg :selfward-operation :reader selfward-operation :allocation :class))) -+ (defmethod component-depends-on ((o selfward-operation) (c component)) -+ `(,@(loop :for op :in (ensure-list (selfward-operation o)) -+ :collect `(,op ,c)) -+ ,@(call-next-method)))) -+ -+ -+;;;; Inputs, Outputs, and invisible dependencies -+(with-upgradability () -+ (defgeneric* (output-files) (operation component)) -+ (defgeneric* (input-files) (operation component)) -+ (defgeneric* (operation-done-p) (operation component) -+ (:documentation "Returns a boolean, which is NIL if the action is forced to be performed again")) -+ (define-convenience-action-methods output-files (operation component)) -+ (define-convenience-action-methods input-files (operation component)) -+ (define-convenience-action-methods operation-done-p (operation component)) -+ -+ (defmethod operation-done-p ((o operation) (c component)) -+ (declare (ignorable o c)) -+ t) -+ -+ (defmethod output-files :around (operation component) -+ "Translate output files, unless asked not to. Memoize the result." -+ operation component ;; hush genera, not convinced by declare ignorable(!) -+ (do-asdf-cache `(output-files ,operation ,component) -+ (values -+ (multiple-value-bind (pathnames fixedp) (call-next-method) -+ ;; 1- Make sure we have absolute pathnames -+ (let* ((directory (pathname-directory-pathname -+ (component-pathname (find-component () component)))) -+ (absolute-pathnames -+ (loop -+ :for pathname :in pathnames -+ :collect (ensure-absolute-pathname pathname directory)))) -+ ;; 2- Translate those pathnames as required -+ (if fixedp -+ absolute-pathnames -+ (mapcar *output-translation-function* absolute-pathnames)))) -+ t))) -+ (defmethod output-files ((o operation) (c component)) -+ (declare (ignorable o c)) -+ nil) -+ (defun output-file (operation component) -+ "The unique output file of performing OPERATION on COMPONENT" -+ (let ((files (output-files operation component))) -+ (assert (length=n-p files 1)) -+ (first files))) -+ -+ (defmethod input-files :around (operation component) -+ "memoize input files." -+ (do-asdf-cache `(input-files ,operation ,component) -+ (call-next-method))) -+ -+ (defmethod input-files ((o operation) (c component)) -+ (declare (ignorable o c)) -+ nil) -+ -+ (defmethod input-files ((o selfward-operation) (c component)) -+ `(,@(or (loop :for dep-o :in (ensure-list (selfward-operation o)) -+ :append (or (output-files dep-o c) (input-files dep-o c))) -+ (if-let ((pathname (component-pathname c))) -+ (and (file-pathname-p pathname) (list pathname)))) -+ ,@(call-next-method)))) -+ -+ -+;;;; Done performing -+(with-upgradability () -+ (defgeneric component-operation-time (operation component)) ;; ASDF4: hide it behind plan-action-stamp -+ (define-convenience-action-methods component-operation-time (operation component)) -+ -+ (defgeneric mark-operation-done (operation component)) ;; ASDF4: hide it behind (setf plan-action-stamp) -+ (defgeneric compute-action-stamp (plan operation component &key just-done) -+ (:documentation "Has this action been successfully done already, -+and at what known timestamp has it been done at or will it be done at? -+Takes two keywords JUST-DONE and PLAN: -+JUST-DONE is a boolean that is true if the action was just successfully performed, -+at which point we want compute the actual stamp and warn if files are missing; -+otherwise we are making plans, anticipating the effects of the action. -+PLAN is a plan object modelling future effects of actions, -+or NIL to denote what actually happened. -+Returns two values: -+* a STAMP saying when it was done or will be done, -+ or T if the action has involves files that need to be recomputed. -+* a boolean DONE-P that indicates whether the action has actually been done, -+ and both its output-files and its in-image side-effects are up to date.")) -+ -+ (defclass action-status () -+ ((stamp -+ :initarg :stamp :reader action-stamp -+ :documentation "STAMP associated with the ACTION if it has been completed already -+in some previous image, or T if it needs to be done.") -+ (done-p -+ :initarg :done-p :reader action-done-p -+ :documentation "a boolean, true iff the action was already done (before any planned action).")) -+ (:documentation "Status of an action")) -+ -+ (defmethod print-object ((status action-status) stream) -+ (print-unreadable-object (status stream :type t) -+ (with-slots (stamp done-p) status -+ (format stream "~@{~S~^ ~}" :stamp stamp :done-p done-p)))) -+ -+ (defmethod component-operation-time ((o operation) (c component)) -+ (gethash (type-of o) (component-operation-times c))) -+ -+ (defmethod mark-operation-done ((o operation) (c component)) -+ (setf (gethash (type-of o) (component-operation-times c)) -+ (compute-action-stamp nil o c :just-done t)))) -+ -+ -+;;;; Perform -+(with-upgradability () -+ (defgeneric* (perform-with-restarts) (operation component)) -+ (defgeneric* (perform) (operation component)) -+ (define-convenience-action-methods perform (operation component)) -+ -+ (defmethod perform :before ((o operation) (c component)) -+ (ensure-all-directories-exist (output-files o c))) -+ (defmethod perform :after ((o operation) (c component)) -+ (mark-operation-done o c)) -+ (defmethod perform ((o operation) (c parent-component)) -+ (declare (ignorable o c)) -+ nil) -+ (defmethod perform ((o operation) (c source-file)) -+ (sysdef-error -+ (compatfmt "~@<Required method PERFORM not implemented for operation ~A, component ~A~@:>") -+ (class-of o) (class-of c))) -+ -+ (defmethod perform-with-restarts (operation component) -+ ;; TOO verbose, especially as the default. Add your own :before method -+ ;; to perform-with-restart or perform if you want that: -+ #|(explain operation component)|# -+ (perform operation component)) -+ (defmethod perform-with-restarts :around (operation component) -+ (loop -+ (restart-case -+ (return (call-next-method)) -+ (retry () -+ :report -+ (lambda (s) -+ (format s (compatfmt "~@<Retry ~A.~@:>") -+ (action-description operation component)))) -+ (accept () -+ :report -+ (lambda (s) -+ (format s (compatfmt "~@<Continue, treating ~A as having been successful.~@:>") -+ (action-description operation component))) -+ (mark-operation-done operation component) -+ (return)))))) -+ -+;;; Generic build operation -+(with-upgradability () -+ (defmethod component-depends-on ((o build-op) (c component)) -+ `((,(or (component-build-operation c) 'load-op) ,c)))) -+ -+;;;; ------------------------------------------------------------------------- -+;;;; Actions to build Common Lisp software -+ -+(asdf/package:define-package :asdf/lisp-action -+ (:recycle :asdf/lisp-action :asdf) -+ (:intern #:proclamations #:flags) -+ (:use :asdf/common-lisp :asdf/driver :asdf/upgrade -+ :asdf/cache :asdf/component :asdf/system :asdf/find-component :asdf/find-system -+ :asdf/operation :asdf/action) -+ (:export -+ #:try-recompiling -+ #:cl-source-file #:cl-source-file.cl #:cl-source-file.lsp -+ #:basic-load-op #:basic-compile-op #:compile-op-flags #:compile-op-proclamations -+ #:load-op #:prepare-op #:compile-op #:test-op #:load-source-op #:prepare-source-op -+ #:call-with-around-compile-hook -+ #:perform-lisp-compilation #:perform-lisp-load-fasl #:perform-lisp-load-source -+ #:lisp-compilation-output-files #:flags)) -+(in-package :asdf/lisp-action) -+ -+ -+;;;; Component classes -+(with-upgradability () -+ (defclass cl-source-file (source-file) -+ ((type :initform "lisp"))) -+ (defclass cl-source-file.cl (cl-source-file) -+ ((type :initform "cl"))) -+ (defclass cl-source-file.lsp (cl-source-file) -+ ((type :initform "lsp")))) -+ -+ -+;;;; Operation classes -+(with-upgradability () -+ (defclass basic-load-op (operation) ()) -+ (defclass basic-compile-op (operation) -+ ((proclamations :initarg :proclamations :accessor compile-op-proclamations :initform nil) -+ (flags :initarg :flags :accessor compile-op-flags -+ :initform nil)))) -+ -+;;; Our default operations: loading into the current lisp image -+(with-upgradability () -+ (defclass prepare-op (upward-operation sideway-operation) -+ ((sideway-operation :initform 'load-op))) -+ (defclass load-op (basic-load-op downward-operation sideway-operation selfward-operation) -+ ;; NB: even though compile-op depends-on on prepare-op it is not needed-in-image-p, -+ ;; so we need to directly depend on prepare-op for its side-effects in the current image. -+ ((selfward-operation :initform '(prepare-op compile-op)))) -+ (defclass compile-op (basic-compile-op downward-operation selfward-operation) -+ ((selfward-operation :initform 'prepare-op) -+ (downward-operation :initform 'load-op))) -+ -+ (defclass prepare-source-op (upward-operation sideway-operation) -+ ((sideway-operation :initform 'load-source-op))) -+ (defclass load-source-op (basic-load-op downward-operation selfward-operation) -+ ((selfward-operation :initform 'prepare-source-op))) -+ -+ (defclass test-op (selfward-operation) -+ ((selfward-operation :initform 'load-op)))) -+ -+ -+;;;; prepare-op, compile-op and load-op -+ -+;;; prepare-op -+(with-upgradability () -+ (defmethod action-description ((o prepare-op) (c component)) -+ (declare (ignorable o)) -+ (format nil (compatfmt "~@<loading dependencies of ~3i~_~A~@:>") c)) -+ (defmethod perform ((o prepare-op) (c component)) -+ (declare (ignorable o c)) -+ nil) -+ (defmethod input-files ((o prepare-op) (c component)) -+ (declare (ignorable o c)) -+ nil) -+ (defmethod input-files ((o prepare-op) (s system)) -+ (declare (ignorable o)) -+ (if-let (it (system-source-file s)) (list it)))) -+ -+;;; compile-op -+(with-upgradability () -+ (defmethod action-description ((o compile-op) (c component)) -+ (declare (ignorable o)) -+ (format nil (compatfmt "~@<compiling ~3i~_~A~@:>") c)) -+ (defmethod action-description ((o compile-op) (c parent-component)) -+ (declare (ignorable o)) -+ (format nil (compatfmt "~@<completing compilation for ~3i~_~A~@:>") c)) -+ (defgeneric call-with-around-compile-hook (component thunk)) -+ (defmethod call-with-around-compile-hook ((c component) function) -+ (call-around-hook (around-compile-hook c) function)) -+ (defun perform-lisp-compilation (o c) -+ (let (;; Before 2.26.53, that was unfortunately component-pathname. Now, -+ ;; we consult input-files, the first of which should be the one to compile-file -+ (input-file (first (input-files o c))) -+ ;; on some implementations, there are more than one output-file, -+ ;; but the first one should always be the primary fasl that gets loaded. -+ (outputs (output-files o c))) -+ (multiple-value-bind (output warnings-p failure-p) -+ (destructuring-bind -+ (output-file -+ &optional -+ #+clisp lib-file -+ #+(or ecl mkcl) object-file -+ warnings-file) outputs -+ (call-with-around-compile-hook -+ c #'(lambda (&rest flags) -+ (with-muffled-compiler-conditions () -+ (apply 'compile-file* input-file -+ :output-file output-file -+ :external-format (component-external-format c) -+ :warnings-file warnings-file -+ (append -+ #+clisp (list :lib-file lib-file) -+ #+(or ecl mkcl) (list :object-file object-file) -+ flags (compile-op-flags o))))))) -+ (check-lisp-compile-results output warnings-p failure-p -+ "~/asdf-action::format-action/" (list (cons o c)))))) -+ -+ (defun report-file-p (f) -+ (equalp (pathname-type f) "build-report")) -+ (defun perform-lisp-warnings-check (o c) -+ (let* ((expected-warnings-files (remove-if-not #'warnings-file-p (input-files o c))) -+ (actual-warnings-files (loop :for w :in expected-warnings-files -+ :when (get-file-stamp w) -+ :collect w -+ :else :do (warn "Missing warnings file ~S while ~A" -+ w (action-description o c))))) -+ (check-deferred-warnings actual-warnings-files) -+ (let* ((output (output-files o c)) -+ (report (find-if #'report-file-p output))) -+ (when report -+ (with-open-file (s report :direction :output :if-exists :supersede) -+ (format s ":success~%")))))) -+ (defmethod perform ((o compile-op) (c cl-source-file)) -+ (perform-lisp-compilation o c)) -+ (defun lisp-compilation-output-files (o c) -+ (let* ((i (first (input-files o c))) -+ (f (compile-file-pathname -+ i #+mkcl :fasl-p #+mkcl t #+ecl :type #+ecl :fasl))) -+ `(,f ;; the fasl is the primary output, in first position -+ #+clisp -+ ,@`(,(make-pathname :type "lib" :defaults f)) -+ #+ecl -+ ,@(unless (use-ecl-byte-compiler-p) -+ `(,(compile-file-pathname i :type :object))) -+ #+mkcl -+ ,(compile-file-pathname i :fasl-p nil) ;; object file -+ ,@(when (and *warnings-file-type* (not (builtin-system-p (component-system c)))) -+ `(,(make-pathname :type *warnings-file-type* :defaults f)))))) -+ (defmethod output-files ((o compile-op) (c cl-source-file)) -+ (lisp-compilation-output-files o c)) -+ (defmethod perform ((o compile-op) (c static-file)) -+ (declare (ignorable o c)) -+ nil) -+ (defmethod output-files ((o compile-op) (c static-file)) -+ (declare (ignorable o c)) -+ nil) -+ (defmethod perform ((o compile-op) (c system)) -+ (when (and *warnings-file-type* (not (builtin-system-p c))) -+ (perform-lisp-warnings-check o c))) -+ (defmethod input-files ((o compile-op) (c system)) -+ (when (and *warnings-file-type* (not (builtin-system-p c))) -+ ;; The most correct way to do it would be to use: -+ ;; (traverse-sub-actions o c :other-systems nil :keep-operation 'compile-op :keep-component 'cl-source-file) -+ ;; but it's expensive and we don't care too much about file order or ASDF extensions. -+ (loop :for sub :in (sub-components c :type 'cl-source-file) -+ :nconc (remove-if-not 'warnings-file-p (output-files o sub))))) -+ (defmethod output-files ((o compile-op) (c system)) -+ (when (and *warnings-file-type* (not (builtin-system-p c))) -+ (if-let ((pathname (component-pathname c))) -+ (list (subpathname pathname (coerce-filename c) :type "build-report")))))) -+ -+;;; load-op -+(with-upgradability () -+ (defmethod action-description ((o load-op) (c cl-source-file)) -+ (declare (ignorable o)) -+ (format nil (compatfmt "~@<loading FASL for ~3i~_~A~@:>") c)) -+ (defmethod action-description ((o load-op) (c parent-component)) -+ (declare (ignorable o)) -+ (format nil (compatfmt "~@<completing load for ~3i~_~A~@:>") c)) -+ (defmethod action-description ((o load-op) component) -+ (declare (ignorable o)) -+ (format nil (compatfmt "~@<loading ~3i~_~A~@:>") -+ component)) -+ (defmethod perform-with-restarts ((o load-op) (c cl-source-file)) -+ (loop -+ (restart-case -+ (return (call-next-method)) -+ (try-recompiling () -+ :report (lambda (s) -+ (format s "Recompile ~a and try loading it again" -+ (component-name c))) -+ (perform (find-operation o 'compile-op) c))))) -+ (defun perform-lisp-load-fasl (o c) -+ (if-let (fasl (first (input-files o c))) -+ (with-muffled-loader-conditions () (load* fasl)))) -+ (defmethod perform ((o load-op) (c cl-source-file)) -+ (perform-lisp-load-fasl o c)) -+ (defmethod perform ((o load-op) (c static-file)) -+ (declare (ignorable o c)) -+ nil)) -+ -+ -+;;;; prepare-source-op, load-source-op -+ -+;;; prepare-source-op -+(with-upgradability () -+ (defmethod action-description ((o prepare-source-op) (c component)) -+ (declare (ignorable o)) -+ (format nil (compatfmt "~@<loading source for dependencies of ~3i~_~A~@:>") c)) -+ (defmethod input-files ((o prepare-source-op) (c component)) -+ (declare (ignorable o c)) -+ nil) -+ (defmethod input-files ((o prepare-source-op) (s system)) -+ (declare (ignorable o)) -+ (if-let (it (system-source-file s)) (list it))) -+ (defmethod perform ((o prepare-source-op) (c component)) -+ (declare (ignorable o c)) -+ nil)) -+ -+;;; load-source-op -+(with-upgradability () -+ (defmethod action-description ((o load-source-op) c) -+ (declare (ignorable o)) -+ (format nil (compatfmt "~@<Loading source of ~3i~_~A~@:>") c)) -+ (defmethod action-description ((o load-source-op) (c parent-component)) -+ (declare (ignorable o)) -+ (format nil (compatfmt "~@<Loaded source of ~3i~_~A~@:>") c)) -+ (defun perform-lisp-load-source (o c) -+ (call-with-around-compile-hook -+ c #'(lambda () -+ (with-muffled-loader-conditions () -+ (load* (first (input-files o c)) -+ :external-format (component-external-format c)))))) -+ -+ (defmethod perform ((o load-source-op) (c cl-source-file)) -+ (perform-lisp-load-source o c)) -+ (defmethod perform ((o load-source-op) (c static-file)) -+ (declare (ignorable o c)) -+ nil) -+ (defmethod output-files ((o load-source-op) (c component)) -+ (declare (ignorable o c)) -+ nil)) -+ -+ -+;;;; test-op -+(with-upgradability () -+ (defmethod perform ((o test-op) (c component)) -+ (declare (ignorable o c)) -+ nil) -+ (defmethod operation-done-p ((o test-op) (c system)) -+ "Testing a system is _never_ done." -+ (declare (ignorable o c)) -+ nil)) -+ -+;;;; ------------------------------------------------------------------------- -+;;;; Plan -+ -+(asdf/package:define-package :asdf/plan -+ (:recycle :asdf/plan :asdf) -+ (:use :asdf/common-lisp :asdf/driver :asdf/upgrade -+ :asdf/component :asdf/operation :asdf/system -+ :asdf/cache :asdf/find-system :asdf/find-component -+ :asdf/operation :asdf/action :asdf/lisp-action) -+ (:export -+ #:component-operation-time #:mark-operation-done -+ #:plan-traversal #:sequential-plan #:*default-plan-class* -+ #:planned-action-status #:plan-action-status #:action-already-done-p -+ #:circular-dependency #:circular-dependency-actions -+ #:node-for #:needed-in-image-p -+ #:action-index #:action-planned-p #:action-valid-p -+ #:plan-record-dependency -+ #:normalize-forced-systems #:action-forced-p #:action-forced-not-p -+ #:map-direct-dependencies #:reduce-direct-dependencies #:direct-dependencies -+ #:visit-dependencies #:compute-action-stamp #:traverse-action -+ #:circular-dependency #:circular-dependency-actions -+ #:call-while-visiting-action #:while-visiting-action -+ #:traverse #:plan-actions #:perform-plan #:plan-operates-on-p -+ #:planned-p #:index #:forced #:forced-not #:total-action-count -+ #:planned-action-count #:planned-output-action-count #:visited-actions -+ #:visiting-action-set #:visiting-action-list #:plan-actions-r -+ #:required-components #:filtered-sequential-plan -+ #:plan-system -+ #:plan-action-filter #:plan-component-type #:plan-keep-operation #:plan-keep-component -+ #:traverse-actions #:traverse-sub-actions)) -+(in-package :asdf/plan) -+ -+;;;; Generic plan traversal class -+(with-upgradability () -+ (defclass plan-traversal () -+ ((system :initform nil :initarg :system :accessor plan-system) -+ (forced :initform nil :initarg :force :accessor plan-forced) -+ (forced-not :initform nil :initarg :force-not :accessor plan-forced-not) -+ (total-action-count :initform 0 :accessor plan-total-action-count) -+ (planned-action-count :initform 0 :accessor plan-planned-action-count) -+ (planned-output-action-count :initform 0 :accessor plan-planned-output-action-count) -+ (visited-actions :initform (make-hash-table :test 'equal) :accessor plan-visited-actions) -+ (visiting-action-set :initform (make-hash-table :test 'equal) :accessor plan-visiting-action-set) -+ (visiting-action-list :initform () :accessor plan-visiting-action-list)))) -+ -+ -+;;;; Planned action status -+(with-upgradability () -+ (defgeneric plan-action-status (plan operation component) -+ (:documentation "Returns the ACTION-STATUS associated to -+the action of OPERATION on COMPONENT in the PLAN")) -+ -+ (defgeneric (setf plan-action-status) (new-status plan operation component) -+ (:documentation "Sets the ACTION-STATUS associated to -+the action of OPERATION on COMPONENT in the PLAN")) -+ -+ (defclass planned-action-status (action-status) -+ ((planned-p -+ :initarg :planned-p :reader action-planned-p -+ :documentation "a boolean, true iff the action was included in the plan.") -+ (index -+ :initarg :index :reader action-index -+ :documentation "an integer, counting all traversed actions in traversal order.")) -+ (:documentation "Status of an action in a plan")) -+ -+ (defmethod print-object ((status planned-action-status) stream) -+ (print-unreadable-object (status stream :type t :identity nil) -+ (with-slots (stamp done-p planned-p index) status -+ (format stream "~@{~S~^ ~}" :stamp stamp :done-p done-p :planned-p planned-p :index index)))) -+ -+ (defmethod action-planned-p (action-status) -+ (declare (ignorable action-status)) ; default method for non planned-action-status objects -+ t) -+ -+ ;; TODO: eliminate NODE-FOR, use CONS. -+ ;; Supposes cleaner protocol for operation initargs passed to MAKE-OPERATION. -+ ;; However, see also component-operation-time and mark-operation-done -+ (defun node-for (o c) (cons (type-of o) c)) -+ -+ (defun action-already-done-p (plan operation component) -+ (action-done-p (plan-action-status plan operation component))) -+ -+ (defmethod plan-action-status ((plan null) (o operation) (c component)) -+ (declare (ignorable plan)) -+ (multiple-value-bind (stamp done-p) (component-operation-time o c) -+ (make-instance 'action-status :stamp stamp :done-p done-p))) -+ -+ (defmethod (setf plan-action-status) (new-status (plan null) (o operation) (c component)) -+ (declare (ignorable plan)) -+ (let ((to (type-of o)) -+ (times (component-operation-times c))) -+ (if (action-done-p new-status) -+ (remhash to times) -+ (setf (gethash to times) (action-stamp new-status)))) -+ new-status)) -+ -+ -+;;;; forcing -+(with-upgradability () -+ (defgeneric action-forced-p (plan operation component)) -+ (defgeneric action-forced-not-p (plan operation component)) -+ -+ (defun normalize-forced-systems (x system) -+ (etypecase x -+ ((member nil :all) x) -+ (cons (list-to-hash-set (mapcar #'coerce-name x))) -+ ((eql t) (when system (list-to-hash-set (list (coerce-name system))))))) -+ -+ (defun action-override-p (plan operation component override-accessor) -+ (declare (ignorable operation)) -+ (let* ((override (funcall override-accessor plan))) -+ (and override -+ (if (typep override 'hash-table) -+ (gethash (coerce-name (component-system (find-component () component))) override) -+ t)))) -+ -+ (defmethod action-forced-p (plan operation component) -+ (and -+ ;; Did the user ask us to re-perform the action? -+ (action-override-p plan operation component 'plan-forced) -+ ;; You really can't force a builtin system and :all doesn't apply to it, -+ ;; except it it's the specifically the system currently being built. -+ (not (let ((system (component-system component))) -+ (and (builtin-system-p system) -+ (not (eq system (plan-system plan)))))))) -+ -+ (defmethod action-forced-not-p (plan operation component) -+ (and -+ ;; Did the user ask us to not re-perform the action? -+ (action-override-p plan operation component 'plan-forced-not) -+ ;; Force takes precedence over force-not -+ (not (action-forced-p plan operation component)))) -+ -+ (defmethod action-forced-p ((plan null) operation component) -+ (declare (ignorable plan operation component)) -+ nil) -+ -+ (defmethod action-forced-not-p ((plan null) operation component) -+ (declare (ignorable plan operation component)) -+ nil)) -+ -+ -+;;;; action-valid-p -+(with-upgradability () -+ (defgeneric action-valid-p (plan operation component) -+ (:documentation "Is this action valid to include amongst dependencies?")) -+ (defmethod action-valid-p (plan operation (c component)) -+ (declare (ignorable plan operation)) -+ (if-let (it (component-if-feature c)) (featurep it) t)) -+ (defmethod action-valid-p (plan (o null) c) (declare (ignorable plan o c)) nil) -+ (defmethod action-valid-p (plan o (c null)) (declare (ignorable plan o c)) nil) -+ (defmethod action-valid-p ((plan null) operation component) -+ (declare (ignorable plan operation component)) -+ (and operation component t))) -+ -+ -+;;;; Is the action needed in this image? -+(with-upgradability () -+ (defgeneric needed-in-image-p (operation component) -+ (:documentation "Is the action of OPERATION on COMPONENT needed in the current image to be meaningful, -+ or could it just as well have been done in another Lisp image?")) -+ -+ (defmethod needed-in-image-p ((o operation) (c component)) -+ ;; We presume that actions that modify the filesystem don't need be run -+ ;; in the current image if they have already been done in another, -+ ;; and can be run in another process (e.g. a fork), -+ ;; whereas those that don't are meant to side-effect the current image and can't. -+ (not (output-files o c)))) -+ -+ -+;;;; Visiting dependencies of an action and computing action stamps -+(with-upgradability () -+ (defun map-direct-dependencies (operation component fun) -+ (loop* :for (dep-o-spec . dep-c-specs) :in (component-depends-on operation component) -+ :for dep-o = (find-operation operation dep-o-spec) -+ :when dep-o -+ :do (loop :for dep-c-spec :in dep-c-specs -+ :for dep-c = (and dep-c-spec (resolve-dependency-spec component dep-c-spec)) -+ :when dep-c -+ :do (funcall fun dep-o dep-c)))) -+ -+ (defun reduce-direct-dependencies (operation component combinator seed) -+ (map-direct-dependencies -+ operation component -+ #'(lambda (dep-o dep-c) -+ (setf seed (funcall combinator dep-o dep-c seed)))) -+ seed) -+ -+ (defun direct-dependencies (operation component) -+ (reduce-direct-dependencies operation component #'acons nil)) -+ -+ (defun visit-dependencies (plan operation component dependency-stamper &aux stamp) -+ (map-direct-dependencies -+ operation component -+ #'(lambda (dep-o dep-c) -+ (when (action-valid-p plan dep-o dep-c) -+ (latest-stamp-f stamp (funcall dependency-stamper dep-o dep-c))))) -+ stamp) -+ -+ (defmethod compute-action-stamp (plan (o operation) (c component) &key just-done) -+ ;; In a distant future, get-file-stamp and component-operation-time -+ ;; shall also be parametrized by the plan, or by a second model object. -+ (let* ((stamp-lookup #'(lambda (o c) -+ (if-let (it (plan-action-status plan o c)) (action-stamp it) t))) -+ (out-files (output-files o c)) -+ (in-files (input-files o c)) -+ ;; Three kinds of actions: -+ (out-op (and out-files t)) ; those that create files on the filesystem -+ ;(image-op (and in-files (null out-files))) ; those that load stuff into the image -+ ;(null-op (and (null out-files) (null in-files))) ; dependency placeholders that do nothing -+ ;; When was the thing last actually done? (Now, or ask.) -+ (op-time (or just-done (component-operation-time o c))) -+ ;; Accumulated timestamp from dependencies (or T if forced or out-of-date) -+ (dep-stamp (visit-dependencies plan o c stamp-lookup)) -+ ;; Time stamps from the files at hand, and whether any is missing -+ (out-stamps (mapcar (if just-done 'register-file-stamp 'get-file-stamp) out-files)) -+ (in-stamps (mapcar #'get-file-stamp in-files)) -+ (missing-in -+ (loop :for f :in in-files :for s :in in-stamps :unless s :collect f)) -+ (missing-out -+ (loop :for f :in out-files :for s :in out-stamps :unless s :collect f)) -+ (all-present (not (or missing-in missing-out))) -+ ;; Has any input changed since we last generated the files? -+ (earliest-out (stamps-earliest out-stamps)) -+ (latest-in (stamps-latest (cons dep-stamp in-stamps))) -+ (up-to-date-p (stamp<= latest-in earliest-out)) -+ ;; If everything is up to date, the latest of inputs and outputs is our stamp -+ (done-stamp (stamps-latest (cons latest-in out-stamps)))) -+ ;; Warn if some files are missing: -+ ;; either our model is wrong or some other process is messing with our files. -+ (when (and just-done (not all-present)) -+ (warn "~A completed without ~:[~*~;~*its input file~:p~2:*~{ ~S~}~*~]~ -+ ~:[~; or ~]~:[~*~;~*its output file~:p~2:*~{ ~S~}~*~]" -+ (action-description o c) -+ missing-in (length missing-in) (and missing-in missing-out) -+ missing-out (length missing-out))) -+ ;; Note that we use stamp<= instead of stamp< to play nice with generated files. -+ ;; Any race condition is intrinsic to the limited timestamp resolution. -+ (if (or just-done ;; The done-stamp is valid: if we're just done, or -+ ;; if all filesystem effects are up-to-date and there's no invalidating reason. -+ (and all-present up-to-date-p (operation-done-p o c) (not (action-forced-p plan o c)))) -+ (values done-stamp ;; return the hard-earned timestamp -+ (or just-done -+ out-op ;; a file-creating op is done when all files are up to date -+ ;; a image-effecting a placeholder op is done when it was actually run, -+ (and op-time (eql op-time done-stamp)))) ;; with the matching stamp -+ ;; done-stamp invalid: return a timestamp in an indefinite future, action not done yet -+ (values t nil))))) -+ -+ -+;;;; Generic support for plan-traversal -+(with-upgradability () -+ (defgeneric plan-record-dependency (plan operation component)) -+ -+ (defgeneric call-while-visiting-action (plan operation component function) -+ (:documentation "Detect circular dependencies")) -+ -+ (defmethod initialize-instance :after ((plan plan-traversal) -+ &key (force () fp) (force-not () fnp) system -+ &allow-other-keys) -+ (with-slots (forced forced-not) plan -+ (when fp (setf forced (normalize-forced-systems force system))) -+ (when fnp (setf forced-not (normalize-forced-systems force-not system))))) -+ -+ (defmethod (setf plan-action-status) (new-status (plan plan-traversal) (o operation) (c component)) -+ (setf (gethash (node-for o c) (plan-visited-actions plan)) new-status)) -+ -+ (defmethod plan-action-status ((plan plan-traversal) (o operation) (c component)) -+ (or (and (action-forced-not-p plan o c) (plan-action-status nil o c)) -+ (values (gethash (node-for o c) (plan-visited-actions plan))))) -+ -+ (defmethod action-valid-p ((plan plan-traversal) (o operation) (s system)) -+ (and (not (action-forced-not-p plan o s)) (call-next-method))) -+ -+ (defmethod call-while-visiting-action ((plan plan-traversal) operation component fun) -+ (with-accessors ((action-set plan-visiting-action-set) -+ (action-list plan-visiting-action-list)) plan -+ (let ((action (cons operation component))) -+ (when (gethash action action-set) -+ (error 'circular-dependency :actions -+ (member action (reverse action-list) :test 'equal))) -+ (setf (gethash action action-set) t) -+ (push action action-list) -+ (unwind-protect -+ (funcall fun) -+ (pop action-list) -+ (setf (gethash action action-set) nil)))))) -+ -+ -+;;;; Actual traversal: traverse-action -+(with-upgradability () -+ (define-condition circular-dependency (system-definition-error) -+ ((actions :initarg :actions :reader circular-dependency-actions)) -+ (:report (lambda (c s) -+ (format s (compatfmt "~@<Circular dependency: ~3i~_~S~@:>") -+ (circular-dependency-actions c))))) -+ -+ (defmacro while-visiting-action ((p o c) &body body) -+ `(call-while-visiting-action ,p ,o ,c #'(lambda () ,@body))) -+ -+ (defgeneric traverse-action (plan operation component needed-in-image-p)) -+ -+ (defmethod traverse-action (plan operation component needed-in-image-p) -+ (block nil -+ (unless (action-valid-p plan operation component) (return nil)) -+ (plan-record-dependency plan operation component) -+ (let* ((aniip (needed-in-image-p operation component)) -+ (eniip (and aniip needed-in-image-p)) -+ (status (plan-action-status plan operation component))) -+ (when (and status (or (action-done-p status) (action-planned-p status) (not eniip))) -+ ;; Already visited with sufficient need-in-image level: just return the stamp. -+ (return (action-stamp status))) -+ (labels ((visit-action (niip) -+ (visit-dependencies plan operation component -+ #'(lambda (o c) (traverse-action plan o c niip))) -+ (multiple-value-bind (stamp done-p) -+ (compute-action-stamp plan operation component) -+ (let ((add-to-plan-p (or (eql stamp t) (and niip (not done-p))))) -+ (cond -+ ((and add-to-plan-p (not niip)) ;; if we need to do it, -+ (visit-action t)) ;; then we need to do it in the image! -+ (t -+ (setf (plan-action-status plan operation component) -+ (make-instance -+ 'planned-action-status -+ :stamp stamp -+ :done-p (and done-p (not add-to-plan-p)) -+ :planned-p add-to-plan-p -+ :index (if status (action-index status) (incf (plan-total-action-count plan))))) -+ (when add-to-plan-p -+ (incf (plan-planned-action-count plan)) -+ (unless aniip -+ (incf (plan-planned-output-action-count plan)))) -+ stamp)))))) -+ (while-visiting-action (plan operation component) ; maintain context, handle circularity. -+ (visit-action eniip))))))) -+ -+ -+;;;; Sequential plans (the default) -+(with-upgradability () -+ (defclass sequential-plan (plan-traversal) -+ ((actions-r :initform nil :accessor plan-actions-r))) -+ -+ (defgeneric plan-actions (plan)) -+ (defmethod plan-actions ((plan sequential-plan)) -+ (reverse (plan-actions-r plan))) -+ -+ (defmethod plan-record-dependency ((plan sequential-plan) -+ (operation operation) (component component)) -+ (declare (ignorable plan operation component)) -+ (values)) -+ -+ (defmethod (setf plan-action-status) :after -+ (new-status (p sequential-plan) (o operation) (c component)) -+ (when (action-planned-p new-status) -+ (push (cons o c) (plan-actions-r p))))) -+ -+ -+;;;; high-level interface: traverse, perform-plan, plan-operates-on-p -+(with-upgradability () -+ (defgeneric* (traverse) (operation component &key &allow-other-keys) -+ (:documentation -+ "Generate and return a plan for performing OPERATION on COMPONENT. -+ -+The plan returned is a list of dotted-pairs. Each pair is the CONS -+of ASDF operation object and a COMPONENT object. The pairs will be -+processed in order by OPERATE.")) -+ (define-convenience-action-methods traverse (operation component &key)) -+ -+ (defgeneric perform-plan (plan &key)) -+ (defgeneric plan-operates-on-p (plan component)) -+ -+ (defvar *default-plan-class* 'sequential-plan) -+ -+ (defmethod traverse ((o operation) (c component) &rest keys &key plan-class &allow-other-keys) -+ (let ((plan (apply 'make-instance -+ (or plan-class *default-plan-class*) -+ :system (component-system c) (remove-plist-key :plan-class keys)))) -+ (traverse-action plan o c t) -+ (plan-actions plan))) -+ -+ (defmethod perform-plan :around (plan &key) -+ (declare (ignorable plan)) -+ (let ((*package* *package*) -+ (*readtable* *readtable*)) -+ (with-compilation-unit () ;; backward-compatibility. -+ (call-next-method)))) ;; Going forward, see deferred-warning support in lisp-build. -+ -+ (defmethod perform-plan ((steps list) &key force &allow-other-keys) -+ (loop* :for (o . c) :in steps -+ :when (or force (not (nth-value 1 (compute-action-stamp nil o c)))) -+ :do (perform-with-restarts o c))) -+ -+ (defmethod plan-operates-on-p ((plan list) (component-path list)) -+ (find component-path (mapcar 'cdr plan) -+ :test 'equal :key 'component-find-path))) -+ -+ -+;;;; Incidental traversals -+(with-upgradability () -+ (defclass filtered-sequential-plan (sequential-plan) -+ ((action-filter :initform t :initarg :action-filter :reader plan-action-filter) -+ (component-type :initform t :initarg :component-type :reader plan-component-type) -+ (keep-operation :initform t :initarg :keep-operation :reader plan-keep-operation) -+ (keep-component :initform t :initarg :keep-component :reader plan-keep-component))) -+ -+ (defmethod initialize-instance :after ((plan filtered-sequential-plan) -+ &key (force () fp) (force-not () fnp) -+ other-systems) -+ (declare (ignore force force-not)) -+ (with-slots (forced forced-not action-filter system) plan -+ (unless fp (setf forced (normalize-forced-systems (if other-systems :all t) system))) -+ (unless fnp (setf forced-not (normalize-forced-systems (if other-systems nil :all) system))) -+ (setf action-filter (ensure-function action-filter)))) -+ -+ (defmethod action-valid-p ((plan filtered-sequential-plan) o c) -+ (and (funcall (plan-action-filter plan) o c) -+ (typep c (plan-component-type plan)) -+ (call-next-method))) -+ -+ (defmethod traverse-actions (actions &rest keys &key plan-class &allow-other-keys) -+ (let ((plan (apply 'make-instance (or plan-class 'filtered-sequential-plan) keys))) -+ (loop* :for (o . c) :in actions :do -+ (traverse-action plan o c t)) -+ (plan-actions plan))) -+ -+ (define-convenience-action-methods traverse-sub-actions (o c &key)) -+ (defmethod traverse-sub-actions ((operation operation) (component component) &rest keys &key &allow-other-keys) -+ (apply 'traverse-actions (direct-dependencies operation component) -+ :system (component-system component) keys)) -+ -+ (defmethod plan-actions ((plan filtered-sequential-plan)) -+ (with-slots (keep-operation keep-component) plan -+ (loop* :for (o . c) :in (call-next-method) -+ :when (and (typep o keep-operation) -+ (typep c keep-component)) -+ :collect (cons o c)))) -+ -+ (defmethod required-components (system &rest keys &key (goal-operation 'load-op) &allow-other-keys) -+ (remove-duplicates -+ (mapcar 'cdr (apply 'traverse-sub-actions goal-operation system -+ (remove-plist-key :goal-operation keys))) -+ :from-end t))) -+ -+;;;; ------------------------------------------------------------------------- -+;;;; Invoking Operations -+ -+(asdf/package:define-package :asdf/operate -+ (:recycle :asdf/operate :asdf) -+ (:use :asdf/common-lisp :asdf/driver :asdf/upgrade -+ :asdf/component :asdf/system :asdf/operation :asdf/action -+ :asdf/find-system :asdf/find-component :asdf/lisp-action :asdf/plan) -+ (:export -+ #:operate #:oos -+ #:*systems-being-operated* -+ #:build-system -+ #:load-system #:load-systems #:compile-system #:test-system #:require-system -+ #:*load-system-operation* #:module-provide-asdf -+ #:component-loaded-p #:already-loaded-systems)) -+(in-package :asdf/operate) -+ -+(with-upgradability () -+ (defgeneric* (operate) (operation component &key &allow-other-keys) -+ (:documentation -+ "Operate does three things: -+ -+1. It creates an instance of OPERATION-CLASS using any keyword parameters as initargs. -+2. It finds the asdf-system specified by SYSTEM (possibly loading it from disk). -+3. It then calls TRAVERSE with the operation and system as arguments -+ -+The traverse operation is wrapped in WITH-COMPILATION-UNIT and error handling code. -+If a VERSION argument is supplied, then operate also ensures that the system found -+satisfies it using the VERSION-SATISFIES method. -+ -+Note that dependencies may cause the operation to invoke other operations on the system -+or its components: the new operations will be created with the same initargs as the original one. -+ -+The :FORCE or :FORCE-NOT argument to OPERATE can be: -+ T to force the inside of the specified system to be rebuilt (resp. not), -+ without recursively forcing the other systems we depend on. -+ :ALL to force all systems including other systems we depend on to be rebuilt (resp. not). -+ (SYSTEM1 SYSTEM2 ... SYSTEMN) to force systems named in a given list -+:FORCE has precedence over :FORCE-NOT; builtin systems cannot be forced.")) -+ -+ (define-convenience-action-methods -+ operate (operation component &key) -+ ;; I'd like to at least remove-plist-keys :force :force-not :verbose, -+ ;; but swank.asd relies on :force (!). -+ :operation-initargs t ;; backward-compatibility with ASDF1. Yuck. -+ :if-no-component (error 'missing-component :requires component)) -+ -+ (defvar *systems-being-operated* nil -+ "A boolean indicating that some systems are being operated on") -+ -+ (defmethod operate :around (operation component &rest keys -+ &key verbose -+ (on-warnings *compile-file-warnings-behaviour*) -+ (on-failure *compile-file-failure-behaviour*) &allow-other-keys) -+ (declare (ignorable operation component)) -+ (let* ((systems-being-operated *systems-being-operated*) -+ (*systems-being-operated* (or systems-being-operated (make-hash-table :test 'equal))) -+ (operation-name (reify-symbol (etypecase operation -+ (operation (type-of operation)) -+ (symbol operation)))) -+ (component-path (typecase component -+ (component (component-find-path component)) -+ (t component)))) -+ ;; Before we operate on any system, make sure ASDF is up-to-date, -+ ;; for if an upgrade is ever attempted at any later time, there may be BIG trouble. -+ (unless systems-being-operated -+ (when (upgrade-asdf) -+ ;; If we were upgraded, restart OPERATE the hardest of ways, for -+ ;; its function may have been redefined, its symbol uninterned, its package deleted. -+ (return-from operate -+ (apply (find-symbol* 'operate :asdf) -+ (unreify-symbol operation-name) -+ component-path keys)))) -+ ;; Setup proper bindings around any operate call. -+ (with-system-definitions () -+ (let* ((*verbose-out* (and verbose *standard-output*)) -+ (*compile-file-warnings-behaviour* on-warnings) -+ (*compile-file-failure-behaviour* on-failure)) -+ (call-next-method))))) -+ -+ (defmethod operate :before ((operation operation) (component component) -+ &key version &allow-other-keys) -+ (let ((system (component-system component))) -+ (setf (gethash (coerce-name system) *systems-being-operated*) system)) -+ (unless (version-satisfies component version) -+ (error 'missing-component-of-version :requires component :version version))) -+ -+ (defmethod operate ((operation operation) (component component) -+ &rest keys &key &allow-other-keys) -+ (let ((plan (apply 'traverse operation component keys))) -+ (apply 'perform-plan plan keys) -+ (values operation plan))) -+ -+ (defun oos (operation component &rest args &key &allow-other-keys) -+ (apply 'operate operation component args)) -+ -+ (setf (documentation 'oos 'function) -+ (format nil "Short for _operate on system_ and an alias for the OPERATE function.~%~%~a" -+ (documentation 'operate 'function)))) -+ -+ -+;;;; Common operations -+(with-upgradability () -+ (defvar *load-system-operation* 'load-op -+ "Operation used by ASDF:LOAD-SYSTEM. By default, ASDF:LOAD-OP. -+You may override it with e.g. ASDF:LOAD-FASL-OP from asdf-bundle, -+or ASDF:LOAD-SOURCE-OP if your fasl loading is somehow broken. -+ -+This may change in the future as we will implement component-based strategy -+for how to load or compile stuff") -+ -+ (defun build-system (system &rest keys) -+ "Shorthand for `(operate 'asdf:build-op system)`." -+ (apply 'operate 'build-op system keys) -+ t) -+ -+ (defun load-system (system &rest keys &key force force-not verbose version &allow-other-keys) -+ "Shorthand for `(operate 'asdf:load-op system)`. See OPERATE for details." -+ (declare (ignore force force-not verbose version)) -+ (apply 'operate *load-system-operation* system keys) -+ t) -+ -+ (defun load-systems (&rest systems) -+ "Loading multiple systems at once." -+ (map () 'load-system systems)) -+ -+ (defun compile-system (system &rest args &key force force-not verbose version &allow-other-keys) -+ "Shorthand for `(asdf:operate 'asdf:compile-op system)`. See OPERATE for details." -+ (declare (ignore force force-not verbose version)) -+ (apply 'operate 'compile-op system args) -+ t) -+ -+ (defun test-system (system &rest args &key force force-not verbose version &allow-other-keys) -+ "Shorthand for `(asdf:operate 'asdf:test-op system)`. See OPERATE for details." -+ (declare (ignore force force-not verbose version)) -+ (apply 'operate 'test-op system args) -+ t)) -+ -+ -+;;;; Define require-system, to be hooked into CL:REQUIRE when possible, -+;; i.e. for ABCL, CLISP, ClozureCL, CMUCL, ECL, MKCL and SBCL -+(with-upgradability () -+ (defun component-loaded-p (c) -+ (action-already-done-p nil (make-instance 'load-op) (find-component c ()))) -+ -+ (defun already-loaded-systems () -+ (remove-if-not 'component-loaded-p (registered-systems))) -+ -+ (defun require-system (s &rest keys &key &allow-other-keys) -+ (apply 'load-system s :force-not (already-loaded-systems) keys)) -+ -+ (defvar *modules-being-required* nil) -+ -+ (defclass require-system (system) -+ ((module :initarg :module :initform nil :accessor required-module))) -+ -+ (defmethod perform ((o compile-op) (c require-system)) -+ (declare (ignorable o c)) -+ nil) -+ -+ (defmethod perform ((o load-op) (s require-system)) -+ (declare (ignorable o)) -+ (let* ((module (or (required-module s) (coerce-name s))) -+ (*modules-being-required* (cons module *modules-being-required*))) -+ (assert (null (component-children s))) -+ (require module))) -+ -+ (defmethod resolve-dependency-combination (component (combinator (eql :require)) arguments) -+ (declare (ignorable component combinator)) -+ (unless (length=n-p arguments 1) -+ (error (compatfmt "~@<Bad dependency ~S for ~S. ~S takes only one argument~@:>") -+ (cons combinator arguments) component combinator)) -+ (let* ((module (car arguments)) -+ (name (string-downcase module)) -+ (system (find-system name nil))) -+ (assert module) -+ ;;(unless (typep system '(or null require-system)) -+ ;; (warn "~S depends on ~S but ~S is registered as a ~S" -+ ;; component (cons combinator arguments) module (type-of system))) -+ (or system (let ((system (make-instance 'require-system :name name))) -+ (register-system system) -+ system)))) -+ -+ (defun module-provide-asdf (name) -+ (let ((module (string-downcase name))) -+ (unless (member module *modules-being-required* :test 'equal) -+ (let ((*modules-being-required* (cons module *modules-being-required*)) -+ #+sbcl (sb-impl::*requiring* (remove module sb-impl::*requiring* :test 'equal))) -+ (handler-bind -+ ((style-warning #'muffle-warning) -+ (missing-component (constantly nil)) -+ (error #'(lambda (e) -+ (format *error-output* (compatfmt "~@<ASDF could not load ~(~A~) because ~A.~@:>~%") -+ name e)))) -+ (let ((*verbose-out* (make-broadcast-stream))) -+ (let ((system (find-system module nil))) -+ (when system -+ (require-system system :verbose nil) -+ t))))))))) -+ -+ -+;;;; Some upgrade magic -+(with-upgradability () -+ (defun restart-upgraded-asdf () -+ ;; If we're in the middle of something, restart it. -+ (when *systems-being-defined* -+ (let ((l (loop :for name :being :the :hash-keys :of *systems-being-defined* :collect name))) -+ (clrhash *systems-being-defined*) -+ (dolist (s l) (find-system s nil))))) -+ -+ (register-hook-function '*post-upgrade-restart-hook* 'restart-upgraded-asdf)) -+ -+ -+;;;; ------------------------------------------------------------------------- -+;;; Internal hacks for backward-compatibility -+ -+(asdf/package:define-package :asdf/backward-internals -+ (:recycle :asdf/backward-internals :asdf) -+ (:use :asdf/common-lisp :asdf/driver :asdf/upgrade -+ :asdf/system :asdf/component :asdf/operation -+ :asdf/find-system :asdf/action :asdf/lisp-action) -+ (:export ;; for internal use -+ #:load-sysdef #:make-temporary-package -+ #:%refresh-component-inline-methods -+ #:%resolve-if-component-dep-fails -+ #:make-sub-operation -+ #:load-sysdef #:make-temporary-package)) -+(in-package :asdf/backward-internals) -+ -+;;;; Backward compatibility with "inline methods" -+(with-upgradability () -+ (defparameter +asdf-methods+ -+ '(perform-with-restarts perform explain output-files operation-done-p)) -+ -+ (defun %remove-component-inline-methods (component) -+ (dolist (name +asdf-methods+) -+ (map () -+ ;; this is inefficient as most of the stored -+ ;; methods will not be for this particular gf -+ ;; But this is hardly performance-critical -+ #'(lambda (m) -+ (remove-method (symbol-function name) m)) -+ (component-inline-methods component))) -+ (component-inline-methods component) nil) -+ -+ (defun %define-component-inline-methods (ret rest) -+ (loop* :for (key value) :on rest :by #'cddr -+ :for name = (and (keywordp key) (find key +asdf-methods+ :test 'string=)) -+ :when name :do -+ (destructuring-bind (op &rest body) value -+ (loop :for arg = (pop body) -+ :while (atom arg) -+ :collect arg :into qualifiers -+ :finally -+ (destructuring-bind (o c) arg -+ (pushnew -+ (eval `(defmethod ,name ,@qualifiers ((,o ,op) (,c (eql ,ret))) ,@body)) -+ (component-inline-methods ret))))))) -+ -+ (defun %refresh-component-inline-methods (component rest) -+ ;; clear methods, then add the new ones -+ (%remove-component-inline-methods component) -+ (%define-component-inline-methods component rest))) -+ -+;;;; PARTIAL SUPPORT for the :if-component-dep-fails component attribute -+;; and the companion asdf:feature pseudo-dependency. -+;; This won't recurse into dependencies to accumulate feature conditions. -+;; Therefore it will accept the SB-ROTATE-BYTE of an old SBCL -+;; (older than 1.1.2.20-fe6da9f) but won't suffice to load an old nibbles. -+(with-upgradability () -+ (defun %resolve-if-component-dep-fails (if-component-dep-fails component) -+ (asdf-message "The system definition for ~S uses deprecated ~ -+ ASDF option :IF-COMPONENT-DEP-DAILS. ~ -+ Starting with ASDF 3, please use :IF-FEATURE instead" -+ (coerce-name (component-system component))) -+ ;; This only supports the pattern of use of the "feature" seen in the wild -+ (check-type component parent-component) -+ (check-type if-component-dep-fails (member :fail :ignore :try-next)) -+ (unless (eq if-component-dep-fails :fail) -+ (loop :with o = (make-operation 'compile-op) -+ :for c :in (component-children component) :do -+ (loop* :for (feature? feature) :in (component-depends-on o c) -+ :when (eq feature? 'feature) :do -+ (setf (component-if-feature c) feature)))))) -+ -+(when-upgrading (:when (fboundp 'make-sub-operation)) -+ (defun make-sub-operation (c o dep-c dep-o) -+ (declare (ignore c o dep-c dep-o)) (asdf-upgrade-error))) -+ -+ -+;;;; load-sysdef -+(with-upgradability () -+ (defun load-sysdef (name pathname) -+ (load-asd pathname :name name)) -+ -+ (defun make-temporary-package () -+ ;; For loading a .asd file, we dont't make a temporary package anymore, -+ ;; but use ASDF-USER. I'd like to have this function do this, -+ ;; but since whoever uses it is likely to delete-package the result afterwards, -+ ;; this would be a bad idea, so preserve the old behavior. -+ (make-package (fresh-package-name :prefix :asdf :index 0) :use '(:cl :asdf)))) -+ -+ -+;;;; ------------------------------------------------------------------------- -+;;;; Defsystem -+ -+(asdf/package:define-package :asdf/defsystem -+ (:recycle :asdf/defsystem :asdf) -+ (:use :asdf/common-lisp :asdf/driver :asdf/upgrade -+ :asdf/component :asdf/system :asdf/cache -+ :asdf/find-system :asdf/find-component :asdf/lisp-action :asdf/operate -+ :asdf/backward-internals) -+ (:export -+ #:defsystem #:register-system-definition -+ #:class-for-type #:*default-component-class* -+ #:determine-system-directory #:parse-component-form -+ #:duplicate-names #:non-toplevel-system #:non-system-system -+ #:sysdef-error-component #:check-component-input)) -+(in-package :asdf/defsystem) -+ -+;;; Pathname -+(with-upgradability () -+ (defun determine-system-directory (pathname) -+ ;; The defsystem macro calls this function to determine -+ ;; the pathname of a system as follows: -+ ;; 1. if the pathname argument is an pathname object (NOT a namestring), -+ ;; that is already an absolute pathname, return it. -+ ;; 2. otherwise, the directory containing the LOAD-PATHNAME -+ ;; is considered (as deduced from e.g. *LOAD-PATHNAME*), and -+ ;; if it is indeed available and an absolute pathname, then -+ ;; the PATHNAME argument is normalized to a relative pathname -+ ;; as per PARSE-UNIX-NAMESTRING (with ENSURE-DIRECTORY T) -+ ;; and merged into that DIRECTORY as per SUBPATHNAME. -+ ;; Note: avoid *COMPILE-FILE-PATHNAME* because .asd is loaded, -+ ;; and may be from within the EVAL-WHEN of a file compilation. -+ ;; If no absolute pathname was found, we return NIL. -+ (check-type pathname (or null string pathname)) -+ (pathname-directory-pathname -+ (resolve-symlinks* -+ (ensure-absolute-pathname -+ (parse-unix-namestring pathname :type :directory) -+ #'(lambda () (ensure-absolute-pathname -+ (load-pathname) 'get-pathname-defaults nil)) -+ nil))))) -+ -+ -+;;; Component class -+(with-upgradability () -+ (defvar *default-component-class* 'cl-source-file) -+ -+ (defun class-for-type (parent type) -+ (or (loop :for symbol :in (list -+ type -+ (find-symbol* type *package* nil) -+ (find-symbol* type :asdf/interface nil) -+ (and (stringp type) (safe-read-from-string type :package :asdf/interface))) -+ :for class = (and symbol (symbolp symbol) (find-class* symbol nil)) -+ :when (and class -+ (#-cormanlisp subtypep #+cormanlisp cl::subclassp -+ class (find-class* 'component))) -+ :return class) -+ (and (eq type :file) -+ (find-class* -+ (or (loop :for p = parent :then (component-parent p) :while p -+ :thereis (module-default-component-class p)) -+ *default-component-class*) nil)) -+ (sysdef-error "don't recognize component type ~A" type)))) -+ -+ -+;;; Check inputs -+(with-upgradability () -+ (define-condition duplicate-names (system-definition-error) -+ ((name :initarg :name :reader duplicate-names-name)) -+ (:report (lambda (c s) -+ (format s (compatfmt "~@<Error while defining system: multiple components are given same name ~S~@:>") -+ (duplicate-names-name c))))) -+ -+ (define-condition non-system-system (system-definition-error) -+ ((name :initarg :name :reader non-system-system-name) -+ (class-name :initarg :class-name :reader non-system-system-class-name)) -+ (:report (lambda (c s) -+ (format s (compatfmt "~@<Error while defining system ~S: class ~S isn't a subclass of ~S~@:>") -+ (non-system-system-name c) (non-system-system-class-name c) 'system)))) -+ -+ (define-condition non-toplevel-system (system-definition-error) -+ ((parent :initarg :parent :reader non-toplevel-system-parent) -+ (name :initarg :name :reader non-toplevel-system-name)) -+ (:report (lambda (c s) -+ (format s (compatfmt "~@<Error while defining system: component ~S claims to have a system ~S as a child~@:>") -+ (non-toplevel-system-parent c) (non-toplevel-system-name c))))) -+ -+ (defun sysdef-error-component (msg type name value) -+ (sysdef-error (strcat msg (compatfmt "~&~@<The value specified for ~(~A~) ~A is ~S~@:>")) -+ type name value)) -+ -+ (defun check-component-input (type name weakly-depends-on -+ depends-on components) -+ "A partial test of the values of a component." -+ (unless (listp depends-on) -+ (sysdef-error-component ":depends-on must be a list." -+ type name depends-on)) -+ (unless (listp weakly-depends-on) -+ (sysdef-error-component ":weakly-depends-on must be a list." -+ type name weakly-depends-on)) -+ (unless (listp components) -+ (sysdef-error-component ":components must be NIL or a list of components." -+ type name components))) -+ -+ (defun* (normalize-version) (form &key pathname component parent) -+ (labels ((invalid (&optional (continuation "using NIL instead")) -+ (warn (compatfmt "~@<Invalid :version specifier ~S~@[ for component ~S~]~@[ in ~S~]~@[ from file ~S~]~@[, ~A~]~@:>") -+ form component parent pathname continuation)) -+ (invalid-parse (control &rest args) -+ (unless (builtin-system-p (find-component parent component)) -+ (apply 'warn control args) -+ (invalid)))) -+ (if-let (v (typecase form -+ ((or string null) form) -+ (real -+ (invalid "Substituting a string") -+ (format nil "~D" form)) ;; 1.0 becomes "1.0" -+ (cons -+ (case (first form) -+ ((:read-file-form) -+ (destructuring-bind (subpath &key (at 0)) (rest form) -+ (safe-read-file-form (subpathname pathname subpath) :at at :package :asdf-user))) -+ ((:read-file-line) -+ (destructuring-bind (subpath &key (at 0)) (rest form) -+ (read-file-lines (subpathname pathname subpath) :at at))) -+ (otherwise -+ (invalid)))) -+ (t -+ (invalid)))) -+ (if-let (pv (parse-version v #'invalid-parse)) -+ (unparse-version pv) -+ (invalid)))))) -+ -+ -+;;; Main parsing function -+(with-upgradability () -+ (defun* (parse-component-form) (parent options &key previous-serial-component) -+ (destructuring-bind -+ (type name &rest rest &key -+ (builtin-system-p () bspp) -+ ;; the following list of keywords is reproduced below in the -+ ;; remove-plist-keys form. important to keep them in sync -+ components pathname perform explain output-files operation-done-p -+ weakly-depends-on depends-on serial -+ do-first if-component-dep-fails version -+ ;; list ends -+ &allow-other-keys) options -+ (declare (ignorable perform explain output-files operation-done-p builtin-system-p)) -+ (check-component-input type name weakly-depends-on depends-on components) -+ (when (and parent -+ (find-component parent name) -+ (not ;; ignore the same object when rereading the defsystem -+ (typep (find-component parent name) -+ (class-for-type parent type)))) -+ (error 'duplicate-names :name name)) -+ (when do-first (error "DO-FIRST is not supported anymore as of ASDF 3")) -+ (let* ((name (coerce-name name)) -+ (args `(:name ,name -+ :pathname ,pathname -+ ,@(when parent `(:parent ,parent)) -+ ,@(remove-plist-keys -+ '(:components :pathname :if-component-dep-fails :version -+ :perform :explain :output-files :operation-done-p -+ :weakly-depends-on :depends-on :serial) -+ rest))) -+ (component (find-component parent name)) -+ (class (class-for-type parent type))) -+ (when (and parent (subtypep class 'system)) -+ (error 'non-toplevel-system :parent parent :name name)) -+ (if component ; preserve identity -+ (apply 'reinitialize-instance component args) -+ (setf component (apply 'make-instance class args))) -+ (component-pathname component) ; eagerly compute the absolute pathname -+ (let ((sysfile (system-source-file (component-system component)))) ;; requires the previous -+ (when (and (typep component 'system) (not bspp)) -+ (setf (builtin-system-p component) (lisp-implementation-pathname-p sysfile))) -+ (setf version (normalize-version version :component name :parent parent :pathname sysfile))) -+ ;; Don't use the accessor: kluge to avoid upgrade issue on CCL 1.8. -+ ;; A better fix is required. -+ (setf (slot-value component 'version) version) -+ (when (typep component 'parent-component) -+ (setf (component-children component) -+ (loop -+ :with previous-component = nil -+ :for c-form :in components -+ :for c = (parse-component-form component c-form -+ :previous-serial-component previous-component) -+ :for name = (component-name c) -+ :collect c -+ :when serial :do (setf previous-component name))) -+ (compute-children-by-name component)) -+ (when previous-serial-component -+ (push previous-serial-component depends-on)) -+ (when weakly-depends-on -+ ;; ASDF4: deprecate this feature and remove it. -+ (appendf depends-on -+ (remove-if (complement #'(lambda (x) (find-system x nil))) weakly-depends-on))) -+ ;; Used by POIU. ASDF4: rename to component-depends-on? -+ (setf (component-sideway-dependencies component) depends-on) -+ (%refresh-component-inline-methods component rest) -+ (when if-component-dep-fails -+ (%resolve-if-component-dep-fails if-component-dep-fails component)) -+ component))) -+ -+ (defun register-system-definition -+ (name &rest options &key pathname (class 'system) (source-file () sfp) -+ defsystem-depends-on &allow-other-keys) -+ ;; The system must be registered before we parse the body, -+ ;; otherwise we recur when trying to find an existing system -+ ;; of the same name to reuse options (e.g. pathname) from. -+ ;; To avoid infinite recursion in cases where you defsystem a system -+ ;; that is registered to a different location to find-system, -+ ;; we also need to remember it in a special variable *systems-being-defined*. -+ (with-system-definitions () -+ (let* ((name (coerce-name name)) -+ (source-file (if sfp source-file (resolve-symlinks* (load-pathname)))) -+ (registered (system-registered-p name)) -+ (registered! (if registered -+ (rplaca registered (get-file-stamp source-file)) -+ (register-system -+ (make-instance 'system :name name :source-file source-file)))) -+ (system (reset-system (cdr registered!) -+ :name name :source-file source-file)) -+ (component-options (remove-plist-key :class options)) -+ (defsystem-dependencies (loop :for spec :in defsystem-depends-on :collect -+ (resolve-dependency-spec nil spec)))) -+ (setf (gethash name *systems-being-defined*) system) -+ (apply 'load-systems defsystem-dependencies) -+ ;; We change-class AFTER we loaded the defsystem-depends-on -+ ;; since the class might be defined as part of those. -+ (let ((class (class-for-type nil class))) -+ (unless (subtypep class 'system) -+ (error 'non-system-system :name name :class-name (class-name class))) -+ (unless (eq (type-of system) class) -+ (change-class system class))) -+ (parse-component-form -+ nil (list* -+ :module name -+ :pathname (determine-system-directory pathname) -+ component-options))))) -+ -+ (defmacro defsystem (name &body options) -+ `(apply 'register-system-definition ',name ',options))) -+;;;; ------------------------------------------------------------------------- -+;;;; ASDF-Bundle -+ -+(asdf/package:define-package :asdf/bundle -+ (:recycle :asdf/bundle :asdf) -+ (:use :asdf/common-lisp :asdf/driver :asdf/upgrade -+ :asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/operation -+ :asdf/action :asdf/lisp-action :asdf/plan :asdf/operate) -+ (:export -+ #:bundle-op #:bundle-op-build-args #:bundle-type -+ #:bundle-system #:bundle-pathname-type #:bundlable-file-p #:direct-dependency-files -+ #:monolithic-op #:monolithic-bundle-op #:operation-monolithic-p -+ #:basic-fasl-op #:prepare-fasl-op #:fasl-op #:load-fasl-op #:monolithic-fasl-op -+ #:lib-op #:monolithic-lib-op -+ #:dll-op #:monolithic-dll-op -+ #:binary-op #:monolithic-binary-op -+ #:program-op #:compiled-file #:precompiled-system #:prebuilt-system -+ #:user-system-p #:user-system #:trivial-system-p -+ #+ecl #:make-build -+ #:register-pre-built-system -+ #:build-args #:name-suffix #:prologue-code #:epilogue-code #:static-library)) -+(in-package :asdf/bundle) -+ -+(with-upgradability () -+ (defclass bundle-op (operation) -+ ((build-args :initarg :args :initform nil :accessor bundle-op-build-args) -+ (name-suffix :initarg :name-suffix :initform nil) -+ (bundle-type :initform :no-output-file :reader bundle-type) -+ #+ecl (lisp-files :initform nil :accessor bundle-op-lisp-files) -+ #+mkcl (do-fasb :initarg :do-fasb :initform t :reader bundle-op-do-fasb-p) -+ #+mkcl (do-static-library :initarg :do-static-library :initform t :reader bundle-op-do-static-library-p))) -+ -+ (defclass bundle-compile-op (bundle-op basic-compile-op) -+ () -+ (:documentation "Abstract operation for ways to bundle the outputs of compiling *Lisp* files")) -+ -+ ;; create a single fasl for the entire library -+ (defclass basic-fasl-op (bundle-compile-op) -+ ((bundle-type :initform :fasl))) -+ (defclass prepare-fasl-op (sideway-operation) -+ ((sideway-operation :initform 'load-fasl-op))) -+ (defclass fasl-op (basic-fasl-op selfward-operation) -+ ((selfward-operation :initform '(prepare-fasl-op #+ecl lib-op)))) -+ (defclass load-fasl-op (basic-load-op selfward-operation) -+ ((selfward-operation :initform '(prepare-op fasl-op)))) -+ -+ ;; NB: since the monolithic-op's can't be sideway-operation's, -+ ;; if we wanted lib-op, dll-op, binary-op to be sideway-operation's, -+ ;; we'd have to have the monolithic-op not inherit from the main op, -+ ;; but instead inherit from a basic-FOO-op as with basic-fasl-op above. -+ -+ (defclass lib-op (bundle-compile-op) -+ ((bundle-type :initform #+(or ecl mkcl) :lib #-(or ecl mkcl) :no-output-file)) -+ (:documentation #+(or ecl mkcl) "compile the system and produce linkable (.a) library for it." -+ #-(or ecl mkcl) "just compile the system")) -+ -+ (defclass dll-op (bundle-op basic-compile-op) -+ ((bundle-type :initform :dll)) -+ (:documentation "Link together all the dynamic library used by this system into a single one.")) -+ -+ (defclass binary-op (basic-compile-op selfward-operation) -+ ((selfward-operation :initform '(fasl-op lib-op))) -+ (:documentation "produce fasl and asd files for the system")) -+ -+ (defclass monolithic-op (operation) ()) ;; operation on a system and its dependencies -+ -+ (defclass monolithic-bundle-op (monolithic-op bundle-op) -+ ((prologue-code :accessor monolithic-op-prologue-code) -+ (epilogue-code :accessor monolithic-op-epilogue-code))) -+ -+ (defclass monolithic-bundle-compile-op (monolithic-bundle-op bundle-compile-op) -+ () -+ (:documentation "Abstract operation for ways to bundle the outputs of compiling *Lisp* files over all systems")) -+ -+ (defclass monolithic-binary-op (monolithic-op binary-op) -+ ((selfward-operation :initform '(monolithic-fasl-op monolithic-lib-op))) -+ (:documentation "produce fasl and asd files for combined system and dependencies.")) -+ -+ (defclass monolithic-fasl-op (monolithic-bundle-compile-op basic-fasl-op) () -+ (:documentation "Create a single fasl for the system and its dependencies.")) -+ -+ (defclass monolithic-lib-op (monolithic-bundle-compile-op basic-compile-op) -+ ((bundle-type :initform #+(or ecl mkcl) :lib #-(or ecl mkcl) :no-output-file)) -+ (:documentation #+(or ecl mkcl) "Create a single linkable library for the system and its dependencies." -+ #-(or ecl mkcl) "Compile a system and its dependencies.")) -+ -+ (defclass monolithic-dll-op (monolithic-bundle-op basic-compile-op sideway-operation selfward-operation) -+ ((bundle-type :initform :dll) -+ (selfward-operation :initform 'dll-op) -+ (sideway-operation :initform 'dll-op))) -+ -+ (defclass program-op #+(or mkcl ecl) (monolithic-bundle-compile-op) -+ #-(or mkcl ecl) (monolithic-bundle-op selfward-operation) -+ ((bundle-type :initform :program) -+ #-(or mkcl ecl) (selfward-operation :initform #-(or mkcl ecl) 'load-op)) -+ (:documentation "create an executable file from the system and its dependencies")) -+ -+ (defun bundle-pathname-type (bundle-type) -+ (etypecase bundle-type -+ ((eql :no-output-file) nil) ;; should we error out instead? -+ ((or null string) bundle-type) -+ ((eql :fasl) #-(or ecl mkcl) (compile-file-type) #+(or ecl mkcl) "fasb") -+ #+ecl -+ ((member :binary :dll :lib :static-library :program :object :program) -+ (compile-file-type :type bundle-type)) -+ ((eql :binary) "image") -+ ((eql :dll) (cond ((os-unix-p) "so") ((os-windows-p) "dll"))) -+ ((member :lib :static-library) (cond ((os-unix-p) "a") ((os-windows-p) "lib"))) -+ ((eql :program) (cond ((os-unix-p) nil) ((os-windows-p) "exe"))))) -+ -+ (defun bundle-output-files (o c) -+ (when (input-files o c) -+ (let ((bundle-type (bundle-type o))) -+ (unless (eq bundle-type :no-output-file) ;; NIL already means something regarding type. -+ (let ((name (or (component-build-pathname c) -+ (format nil "~A~@[~A~]" (component-name c) (slot-value o 'name-suffix)))) -+ (type (bundle-pathname-type bundle-type))) -+ (values (list (subpathname (component-pathname c) name :type type)) -+ (eq (type-of o) (component-build-operation c)))))))) -+ -+ (defmethod output-files ((o bundle-op) (c system)) -+ (bundle-output-files o c)) -+ -+ #-(or ecl mkcl) -+ (defmethod perform ((o program-op) (c system)) -+ (let ((output-file (output-file o c))) -+ (setf *image-entry-point* (ensure-function (component-entry-point c))) -+ (dump-image output-file :executable t))) -+ -+ (defclass compiled-file (file-component) -+ ((type :initform #-(or ecl mkcl) (compile-file-type) #+(or ecl mkcl) "fasb"))) -+ -+ (defclass precompiled-system (system) -+ ((build-pathname :initarg :fasl))) -+ -+ (defclass prebuilt-system (system) -+ ((build-pathname :initarg :static-library :initarg :lib -+ :accessor prebuilt-system-static-library)))) -+ -+ -+;;; -+;;; BUNDLE-OP -+;;; -+;;; This operation takes all components from one or more systems and -+;;; creates a single output file, which may be -+;;; a FASL, a statically linked library, a shared library, etc. -+;;; The different targets are defined by specialization. -+;;; -+(with-upgradability () -+ (defun operation-monolithic-p (op) -+ (typep op 'monolithic-op)) -+ -+ (defmethod initialize-instance :after ((instance bundle-op) &rest initargs -+ &key (name-suffix nil name-suffix-p) -+ &allow-other-keys) -+ (declare (ignorable initargs name-suffix)) -+ (unless name-suffix-p -+ (setf (slot-value instance 'name-suffix) -+ (unless (typep instance 'program-op) -+ (if (operation-monolithic-p instance) "--all-systems" #-ecl "--system")))) ; . no good for Logical Pathnames -+ (when (typep instance 'monolithic-bundle-op) -+ (destructuring-bind (&rest original-initargs -+ &key lisp-files prologue-code epilogue-code -+ &allow-other-keys) -+ (operation-original-initargs instance) -+ (setf (operation-original-initargs instance) -+ (remove-plist-keys '(:lisp-files :epilogue-code :prologue-code) original-initargs) -+ (monolithic-op-prologue-code instance) prologue-code -+ (monolithic-op-epilogue-code instance) epilogue-code) -+ #-ecl (assert (null (or lisp-files epilogue-code prologue-code))) -+ #+ecl (setf (bundle-op-lisp-files instance) lisp-files))) -+ (setf (bundle-op-build-args instance) -+ (remove-plist-keys '(:type :monolithic :name-suffix) -+ (operation-original-initargs instance)))) -+ -+ (defmethod bundle-op-build-args :around ((o lib-op)) -+ (declare (ignorable o)) -+ (let ((args (call-next-method))) -+ (remf args :ld-flags) -+ args)) -+ -+ (defun bundlable-file-p (pathname) -+ (let ((type (pathname-type pathname))) -+ (declare (ignorable type)) -+ (or #+ecl (or (equalp type (compile-file-type :type :object)) -+ (equalp type (compile-file-type :type :static-library))) -+ #+mkcl (equalp type (compile-file-type :fasl-p nil)) -+ #+(or abcl allegro clisp clozure cmu lispworks sbcl scl xcl) (equalp type (compile-file-type))))) -+ -+ (defgeneric* (trivial-system-p) (component)) -+ -+ (defun user-system-p (s) -+ (and (typep s 'system) -+ (not (builtin-system-p s)) -+ (not (trivial-system-p s))))) -+ -+(eval-when (#-lispworks :compile-toplevel :load-toplevel :execute) -+ (deftype user-system () '(and system (satisfies user-system-p)))) -+ -+;;; -+;;; First we handle monolithic bundles. -+;;; These are standalone systems which contain everything, -+;;; including other ASDF systems required by the current one. -+;;; A PROGRAM is always monolithic. -+;;; -+;;; MONOLITHIC SHARED LIBRARIES, PROGRAMS, FASL -+;;; -+(with-upgradability () -+ (defmethod component-depends-on ((o bundle-compile-op) (c system)) -+ `(,(if (operation-monolithic-p o) -+ `(#-(or ecl mkcl) fasl-op #+(or ecl mkcl) lib-op -+ ,@(required-components c :other-systems t :component-type 'system -+ :goal-operation (find-operation o 'load-op) -+ :keep-operation 'compile-op)) -+ `(compile-op -+ ,@(required-components c :other-systems nil :component-type '(not system) -+ :goal-operation (find-operation o 'load-op) -+ :keep-operation 'compile-op))) -+ ,@(call-next-method))) -+ -+ (defmethod component-depends-on :around ((o bundle-op) (c component)) -+ (declare (ignorable o c)) -+ (if-let (op (and (eq (type-of o) 'bundle-op) (component-build-operation c))) -+ `((,op ,c)) -+ (call-next-method))) -+ -+ (defun direct-dependency-files (o c &key (test 'identity) (key 'output-files) &allow-other-keys) -+ ;; This file selects output files from direct dependencies; -+ ;; your component-depends-on method better gathered the correct dependencies in the correct order. -+ (while-collecting (collect) -+ (map-direct-dependencies -+ o c #'(lambda (sub-o sub-c) -+ (loop :for f :in (funcall key sub-o sub-c) -+ :when (funcall test f) :do (collect f)))))) -+ -+ (defmethod input-files ((o bundle-compile-op) (c system)) -+ (unless (eq (bundle-type o) :no-output-file) -+ (direct-dependency-files o c :test 'bundlable-file-p :key 'output-files))) -+ -+ (defun select-bundle-operation (type &optional monolithic) -+ (ecase type -+ ((:binary) -+ (if monolithic 'monolithic-binary-op 'binary-op)) -+ ((:dll :shared-library) -+ (if monolithic 'monolithic-dll-op 'dll-op)) -+ ((:lib :static-library) -+ (if monolithic 'monolithic-lib-op 'lib-op)) -+ ((:fasl) -+ (if monolithic 'monolithic-fasl-op 'fasl-op)) -+ ((:program) -+ 'program-op))) -+ -+ (defun make-build (system &rest args &key (monolithic nil) (type :fasl) -+ (move-here nil move-here-p) -+ &allow-other-keys) -+ (let* ((operation-name (select-bundle-operation type monolithic)) -+ (move-here-path (if (and move-here -+ (typep move-here '(or pathname string))) -+ (pathname move-here) -+ (system-relative-pathname system "asdf-output/"))) -+ (operation (apply #'operate operation-name -+ system -+ (remove-plist-keys '(:monolithic :type :move-here) args))) -+ (system (find-system system)) -+ (files (and system (output-files operation system)))) -+ (if (or move-here (and (null move-here-p) -+ (member operation-name '(:program :binary)))) -+ (loop :with dest-path = (resolve-symlinks* (ensure-directories-exist move-here-path)) -+ :for f :in files -+ :for new-f = (make-pathname :name (pathname-name f) -+ :type (pathname-type f) -+ :defaults dest-path) -+ :do (rename-file-overwriting-target f new-f) -+ :collect new-f) -+ files)))) -+ -+;;; -+;;; LOAD-FASL-OP -+;;; -+;;; This is like ASDF's LOAD-OP, but using monolithic fasl files. -+;;; -+(with-upgradability () -+ (defmethod component-depends-on ((o load-fasl-op) (c system)) -+ (declare (ignorable o)) -+ `((,o ,@(loop :for dep :in (component-sideway-dependencies c) -+ :collect (resolve-dependency-spec c dep))) -+ (,(if (user-system-p c) 'fasl-op 'load-op) ,c) -+ ,@(call-next-method))) -+ -+ (defmethod input-files ((o load-fasl-op) (c system)) -+ (when (user-system-p c) -+ (output-files (find-operation o 'fasl-op) c))) -+ -+ (defmethod perform ((o load-fasl-op) c) -+ (declare (ignorable o c)) -+ nil) -+ -+ (defmethod perform ((o load-fasl-op) (c system)) -+ (when (input-files o c) -+ (perform-lisp-load-fasl o c))) -+ -+ (defmethod mark-operation-done :after ((o load-fasl-op) (c system)) -+ (mark-operation-done (find-operation o 'load-op) c))) -+ -+;;; -+;;; PRECOMPILED FILES -+;;; -+;;; This component can be used to distribute ASDF systems in precompiled form. -+;;; Only useful when the dependencies have also been precompiled. -+;;; -+(with-upgradability () -+ (defmethod trivial-system-p ((s system)) -+ (every #'(lambda (c) (typep c 'compiled-file)) (component-children s))) -+ -+ (defmethod output-files (o (c compiled-file)) -+ (declare (ignorable o c)) -+ nil) -+ (defmethod input-files (o (c compiled-file)) -+ (declare (ignorable o)) -+ (component-pathname c)) -+ (defmethod perform ((o load-op) (c compiled-file)) -+ (perform-lisp-load-fasl o c)) -+ (defmethod perform ((o load-source-op) (c compiled-file)) -+ (perform (find-operation o 'load-op) c)) -+ (defmethod perform ((o load-fasl-op) (c compiled-file)) -+ (perform (find-operation o 'load-op) c)) -+ (defmethod perform ((o operation) (c compiled-file)) -+ (declare (ignorable o c)) -+ nil)) -+ -+;;; -+;;; Pre-built systems -+;;; -+(with-upgradability () -+ (defmethod trivial-system-p ((s prebuilt-system)) -+ (declare (ignorable s)) -+ t) -+ -+ (defmethod perform ((o lib-op) (c prebuilt-system)) -+ (declare (ignorable o c)) -+ nil) -+ -+ (defmethod component-depends-on ((o lib-op) (c prebuilt-system)) -+ (declare (ignorable o c)) -+ nil) -+ -+ (defmethod component-depends-on ((o monolithic-lib-op) (c prebuilt-system)) -+ (declare (ignorable o)) -+ nil)) -+ -+ -+;;; -+;;; PREBUILT SYSTEM CREATOR -+;;; -+(with-upgradability () -+ (defmethod output-files ((o binary-op) (s system)) -+ (list (make-pathname :name (component-name s) :type "asd" -+ :defaults (component-pathname s)))) -+ -+ (defmethod perform ((o binary-op) (s system)) -+ (let* ((inputs (input-files o s)) -+ (fasl (first inputs)) -+ (library (second inputs)) -+ (asd (first (output-files o s))) -+ (name (if (and fasl asd) (pathname-name asd) (return-from perform))) -+ (dependencies -+ (if (operation-monolithic-p o) -+ (remove-if-not 'builtin-system-p -+ (required-components s :component-type 'system -+ :keep-operation 'load-op)) -+ (while-collecting (x) ;; resolve the sideway-dependencies of s -+ (map-direct-dependencies -+ 'load-op s -+ #'(lambda (o c) -+ (when (and (typep o 'load-op) (typep c 'system)) -+ (x c))))))) -+ (depends-on (mapcar 'coerce-name dependencies))) -+ (when (pathname-equal asd (system-source-file s)) -+ (cerror "overwrite the asd file" -+ "~/asdf-action:format-action/ is going to overwrite the system definition file ~S which is probably not what you want; you probably need to tweak your output translations." -+ (cons o s) asd)) -+ (with-open-file (s asd :direction :output :if-exists :supersede -+ :if-does-not-exist :create) -+ (format s ";;; Prebuilt~:[~; monolithic~] ASDF definition for system ~A~%" -+ (operation-monolithic-p o) name) -+ (format s ";;; Built for ~A ~A on a ~A/~A ~A~%" -+ (lisp-implementation-type) -+ (lisp-implementation-version) -+ (software-type) -+ (machine-type) -+ (software-version)) -+ (let ((*package* (find-package :asdf-user))) -+ (pprint `(defsystem ,name -+ :class prebuilt-system -+ :depends-on ,depends-on -+ :components ((:compiled-file ,(pathname-name fasl))) -+ ,@(when library `(:lib ,(file-namestring library)))) -+ s) -+ (terpri s))))) -+ -+ #-(or ecl mkcl) -+ (defmethod perform ((o bundle-compile-op) (c system)) -+ (let* ((input-files (input-files o c)) -+ (fasl-files (remove (compile-file-type) input-files :key #'pathname-type :test-not #'equalp)) -+ (non-fasl-files (remove (compile-file-type) input-files :key #'pathname-type :test #'equalp)) -+ (output-files (output-files o c)) -+ (output-file (first output-files))) -+ (assert (eq (not input-files) (not output-files))) -+ (when input-files -+ (when non-fasl-files -+ (error "On ~A, asdf-bundle can only bundle FASL files, but these were also produced: ~S" -+ (implementation-type) non-fasl-files)) -+ (when (and (typep o 'monolithic-bundle-op) -+ (or (monolithic-op-prologue-code o) (monolithic-op-epilogue-code o))) -+ (error "prologue-code and epilogue-code are not supported on ~A" -+ (implementation-type))) -+ (with-staging-pathname (output-file) -+ (combine-fasls fasl-files output-file))))) -+ -+ (defmethod input-files ((o load-op) (s precompiled-system)) -+ (declare (ignorable o)) -+ (bundle-output-files (find-operation o 'fasl-op) s)) -+ -+ (defmethod perform ((o load-op) (s precompiled-system)) -+ (perform-lisp-load-fasl o s)) -+ -+ (defmethod component-depends-on ((o load-fasl-op) (s precompiled-system)) -+ (declare (ignorable o)) -+ `((load-op ,s) ,@(call-next-method)))) -+ -+ #| ;; Example use: -+(asdf:defsystem :precompiled-asdf-utils :class asdf::precompiled-system :fasl (asdf:apply-output-translations (asdf:system-relative-pathname :asdf-utils "asdf-utils.system.fasl"))) -+(asdf:load-system :precompiled-asdf-utils) -+|# -+ -+#+(or ecl mkcl) -+(with-upgradability () -+ (defun uiop-library-file () -+ (or (and (find-system :uiop nil) -+ (system-source-directory :uiop) -+ (progn -+ (operate 'lib-op :uiop) -+ (output-file 'lib-op :uiop))) -+ (resolve-symlinks* (c::compile-file-pathname "sys:asdf" :type :lib)))) -+ (defmethod input-files :around ((o program-op) (c system)) -+ (let ((files (call-next-method)) -+ (plan (traverse-sub-actions o c :plan-class 'sequential-plan))) -+ (unless (or (and (find-system :uiop nil) -+ (system-source-directory :uiop) -+ (plan-operates-on-p plan '("uiop"))) -+ (and (system-source-directory :asdf) -+ (plan-operates-on-p plan '("asdf")))) -+ (pushnew (uiop-library-file) files :test 'pathname-equal)) -+ files)) -+ -+ (defun register-pre-built-system (name) -+ (register-system (make-instance 'system :name (coerce-name name) :source-file nil)))) -+ -+#+ecl -+(with-upgradability () -+ (defmethod perform ((o bundle-compile-op) (c system)) -+ (let* ((object-files (input-files o c)) -+ (output (output-files o c)) -+ (bundle (first output)) -+ (kind (bundle-type o))) -+ (when output -+ (create-image -+ bundle (append object-files (bundle-op-lisp-files o)) -+ :kind kind -+ :entry-point (component-entry-point c) -+ :prologue-code -+ (when (typep o 'monolithic-bundle-op) -+ (monolithic-op-prologue-code o)) -+ :epilogue-code -+ (when (typep o 'monolithic-bundle-op) -+ (monolithic-op-epilogue-code o)) -+ :build-args (bundle-op-build-args o)))))) -+ -+#+mkcl -+(with-upgradability () -+ (defmethod perform ((o lib-op) (s system)) -+ (apply #'compiler::build-static-library (output-file o c) -+ :lisp-object-files (input-files o s) (bundle-op-build-args o))) -+ -+ (defmethod perform ((o basic-fasl-op) (s system)) -+ (apply #'compiler::build-bundle (output-file o c) ;; second??? -+ :lisp-object-files (input-files o s) (bundle-op-build-args o))) -+ -+ (defun bundle-system (system &rest args &key force (verbose t) version &allow-other-keys) -+ (declare (ignore force verbose version)) -+ (apply #'operate 'binary-op system args))) -+;;;; ------------------------------------------------------------------------- -+;;;; Concatenate-source -+ -+(asdf/package:define-package :asdf/concatenate-source -+ (:recycle :asdf/concatenate-source :asdf) -+ (:use :asdf/common-lisp :asdf/driver :asdf/upgrade -+ :asdf/component :asdf/operation -+ :asdf/system :asdf/find-system :asdf/defsystem -+ :asdf/action :asdf/lisp-action :asdf/bundle) -+ (:export -+ #:concatenate-source-op -+ #:load-concatenated-source-op -+ #:compile-concatenated-source-op -+ #:load-compiled-concatenated-source-op -+ #:monolithic-concatenate-source-op -+ #:monolithic-load-concatenated-source-op -+ #:monolithic-compile-concatenated-source-op -+ #:monolithic-load-compiled-concatenated-source-op)) -+(in-package :asdf/concatenate-source) -+ -+;;; -+;;; Concatenate sources -+;;; -+(with-upgradability () -+ (defclass basic-concatenate-source-op (bundle-op) -+ ((bundle-type :initform "lisp"))) -+ (defclass basic-load-concatenated-source-op (basic-load-op selfward-operation) ()) -+ (defclass basic-compile-concatenated-source-op (basic-compile-op selfward-operation) ()) -+ (defclass basic-load-compiled-concatenated-source-op (basic-load-op selfward-operation) ()) -+ -+ (defclass concatenate-source-op (basic-concatenate-source-op) ()) -+ (defclass load-concatenated-source-op (basic-load-concatenated-source-op) -+ ((selfward-operation :initform '(prepare-op concatenate-source-op)))) -+ (defclass compile-concatenated-source-op (basic-compile-concatenated-source-op) -+ ((selfward-operation :initform '(prepare-op concatenate-source-op)))) -+ (defclass load-compiled-concatenated-source-op (basic-load-compiled-concatenated-source-op) -+ ((selfward-operation :initform '(prepare-op compile-concatenated-source-op)))) -+ -+ (defclass monolithic-concatenate-source-op (basic-concatenate-source-op monolithic-bundle-op) ()) -+ (defclass monolithic-load-concatenated-source-op (basic-load-concatenated-source-op) -+ ((selfward-operation :initform 'monolithic-concatenate-source-op))) -+ (defclass monolithic-compile-concatenated-source-op (basic-compile-concatenated-source-op) -+ ((selfward-operation :initform 'monolithic-concatenate-source-op))) -+ (defclass monolithic-load-compiled-concatenated-source-op (basic-load-compiled-concatenated-source-op) -+ ((selfward-operation :initform 'monolithic-compile-concatenated-source-op))) -+ -+ (defmethod input-files ((operation basic-concatenate-source-op) (s system)) -+ (loop :with encoding = (or (component-encoding s) *default-encoding*) -+ :with other-encodings = '() -+ :with around-compile = (around-compile-hook s) -+ :with other-around-compile = '() -+ :for c :in (required-components -+ s :goal-operation 'compile-op -+ :keep-operation 'compile-op -+ :other-systems (operation-monolithic-p operation)) -+ :append -+ (when (typep c 'cl-source-file) -+ (let ((e (component-encoding c))) -+ (unless (equal e encoding) -+ (pushnew e other-encodings :test 'equal))) -+ (let ((a (around-compile-hook c))) -+ (unless (equal a around-compile) -+ (pushnew a other-around-compile :test 'equal))) -+ (input-files (make-operation 'compile-op) c)) :into inputs -+ :finally -+ (when other-encodings -+ (warn "~S uses encoding ~A but has sources that use these encodings: ~A" -+ operation encoding other-encodings)) -+ (when other-around-compile -+ (warn "~S uses around-compile hook ~A but has sources that use these hooks: ~A" -+ operation around-compile other-around-compile)) -+ (return inputs))) -+ (defmethod output-files ((o basic-compile-concatenated-source-op) (s system)) -+ (lisp-compilation-output-files o s)) -+ -+ (defmethod perform ((o basic-concatenate-source-op) (s system)) -+ (let ((inputs (input-files o s)) -+ (output (output-file o s))) -+ (concatenate-files inputs output))) -+ (defmethod perform ((o basic-load-concatenated-source-op) (s system)) -+ (perform-lisp-load-source o s)) -+ (defmethod perform ((o basic-compile-concatenated-source-op) (s system)) -+ (perform-lisp-compilation o s)) -+ (defmethod perform ((o basic-load-compiled-concatenated-source-op) (s system)) -+ (perform-lisp-load-fasl o s))) -+ -+;;;; --------------------------------------------------------------------------- -+;;;; asdf-output-translations -+ -+(asdf/package:define-package :asdf/output-translations -+ (:recycle :asdf/output-translations :asdf) -+ (:use :asdf/common-lisp :asdf/driver :asdf/upgrade) -+ (:export -+ #:*output-translations* #:*output-translations-parameter* -+ #:invalid-output-translation -+ #:output-translations #:output-translations-initialized-p -+ #:initialize-output-translations #:clear-output-translations -+ #:disable-output-translations #:ensure-output-translations -+ #:apply-output-translations -+ #:validate-output-translations-directive #:validate-output-translations-form -+ #:validate-output-translations-file #:validate-output-translations-directory -+ #:parse-output-translations-string #:wrapping-output-translations -+ #:user-output-translations-pathname #:system-output-translations-pathname -+ #:user-output-translations-directory-pathname #:system-output-translations-directory-pathname -+ #:environment-output-translations #:process-output-translations -+ #:compute-output-translations -+ #+abcl #:translate-jar-pathname -+ )) -+(in-package :asdf/output-translations) -+ -+(when-upgrading () (undefine-function '(setf output-translations))) -+ -+(with-upgradability () -+ (define-condition invalid-output-translation (invalid-configuration warning) -+ ((format :initform (compatfmt "~@<Invalid asdf output-translation ~S~@[ in ~S~]~@{ ~@?~}~@:>")))) -+ -+ (defvar *output-translations* () -+ "Either NIL (for uninitialized), or a list of one element, -+said element itself being a sorted list of mappings. -+Each mapping is a pair of a source pathname and destination pathname, -+and the order is by decreasing length of namestring of the source pathname.") -+ -+ (defun output-translations () -+ (car *output-translations*)) -+ -+ (defun set-output-translations (new-value) -+ (setf *output-translations* -+ (list -+ (stable-sort (copy-list new-value) #'> -+ :key #'(lambda (x) -+ (etypecase (car x) -+ ((eql t) -1) -+ (pathname -+ (let ((directory (pathname-directory (car x)))) -+ (if (listp directory) (length directory) 0)))))))) -+ new-value) -+ #-gcl2.6 -+ (defun* ((setf output-translations)) (new-value) (set-output-translations new-value)) -+ #+gcl2.6 -+ (defsetf output-translations set-output-translations) -+ -+ (defun output-translations-initialized-p () -+ (and *output-translations* t)) -+ -+ (defun clear-output-translations () -+ "Undoes any initialization of the output translations." -+ (setf *output-translations* '()) -+ (values)) -+ (register-clear-configuration-hook 'clear-output-translations) -+ -+ (defun validate-output-translations-directive (directive) -+ (or (member directive '(:enable-user-cache :disable-cache nil)) -+ (and (consp directive) -+ (or (and (length=n-p directive 2) -+ (or (and (eq (first directive) :include) -+ (typep (second directive) '(or string pathname null))) -+ (and (location-designator-p (first directive)) -+ (or (location-designator-p (second directive)) -+ (location-function-p (second directive)))))) -+ (and (length=n-p directive 1) -+ (location-designator-p (first directive))))))) -+ -+ (defun validate-output-translations-form (form &key location) -+ (validate-configuration-form -+ form -+ :output-translations -+ 'validate-output-translations-directive -+ :location location :invalid-form-reporter 'invalid-output-translation)) -+ -+ (defun validate-output-translations-file (file) -+ (validate-configuration-file -+ file 'validate-output-translations-form :description "output translations")) -+ -+ (defun validate-output-translations-directory (directory) -+ (validate-configuration-directory -+ directory :output-translations 'validate-output-translations-directive -+ :invalid-form-reporter 'invalid-output-translation)) -+ -+ (defun parse-output-translations-string (string &key location) -+ (cond -+ ((or (null string) (equal string "")) -+ '(:output-translations :inherit-configuration)) -+ ((not (stringp string)) -+ (error (compatfmt "~@<Environment string isn't: ~3i~_~S~@:>") string)) -+ ((eql (char string 0) #\") -+ (parse-output-translations-string (read-from-string string) :location location)) -+ ((eql (char string 0) #\() -+ (validate-output-translations-form (read-from-string string) :location location)) -+ (t -+ (loop -+ :with inherit = nil -+ :with directives = () -+ :with start = 0 -+ :with end = (length string) -+ :with source = nil -+ :with separator = (inter-directory-separator) -+ :for i = (or (position separator string :start start) end) :do -+ (let ((s (subseq string start i))) -+ (cond -+ (source -+ (push (list source (if (equal "" s) nil s)) directives) -+ (setf source nil)) -+ ((equal "" s) -+ (when inherit -+ (error (compatfmt "~@<Only one inherited configuration allowed: ~3i~_~S~@:>") -+ string)) -+ (setf inherit t) -+ (push :inherit-configuration directives)) -+ (t -+ (setf source s))) -+ (setf start (1+ i)) -+ (when (> start end) -+ (when source -+ (error (compatfmt "~@<Uneven number of components in source to destination mapping: ~3i~_~S~@:>") -+ string)) -+ (unless inherit -+ (push :ignore-inherited-configuration directives)) -+ (return `(:output-translations ,@(nreverse directives))))))))) -+ -+ (defparameter *default-output-translations* -+ '(environment-output-translations -+ user-output-translations-pathname -+ user-output-translations-directory-pathname -+ system-output-translations-pathname -+ system-output-translations-directory-pathname)) -+ -+ (defun wrapping-output-translations () -+ `(:output-translations -+ ;; Some implementations have precompiled ASDF systems, -+ ;; so we must disable translations for implementation paths. -+ #+(or #|clozure|# ecl mkcl sbcl) -+ ,@(let ((h (resolve-symlinks* (lisp-implementation-directory)))) -+ (when h `(((,h ,*wild-path*) ())))) -+ #+mkcl (,(translate-logical-pathname "CONTRIB:") ()) -+ ;; All-import, here is where we want user stuff to be: -+ :inherit-configuration -+ ;; These are for convenience, and can be overridden by the user: -+ #+abcl (#p"/___jar___file___root___/**/*.*" (:user-cache #p"**/*.*")) -+ #+abcl (#p"jar:file:/**/*.jar!/**/*.*" (:function translate-jar-pathname)) -+ ;; We enable the user cache by default, and here is the place we do: -+ :enable-user-cache)) -+ -+ (defparameter *output-translations-file* (parse-unix-namestring "asdf-output-translations.conf")) -+ (defparameter *output-translations-directory* (parse-unix-namestring "asdf-output-translations.conf.d/")) -+ -+ (defun user-output-translations-pathname (&key (direction :input)) -+ (in-user-configuration-directory *output-translations-file* :direction direction)) -+ (defun system-output-translations-pathname (&key (direction :input)) -+ (in-system-configuration-directory *output-translations-file* :direction direction)) -+ (defun user-output-translations-directory-pathname (&key (direction :input)) -+ (in-user-configuration-directory *output-translations-directory* :direction direction)) -+ (defun system-output-translations-directory-pathname (&key (direction :input)) -+ (in-system-configuration-directory *output-translations-directory* :direction direction)) -+ (defun environment-output-translations () -+ (getenv "ASDF_OUTPUT_TRANSLATIONS")) -+ -+ (defgeneric process-output-translations (spec &key inherit collect)) -+ -+ (defun inherit-output-translations (inherit &key collect) -+ (when inherit -+ (process-output-translations (first inherit) :collect collect :inherit (rest inherit)))) -+ -+ (defun* (process-output-translations-directive) (directive &key inherit collect) -+ (if (atom directive) -+ (ecase directive -+ ((:enable-user-cache) -+ (process-output-translations-directive '(t :user-cache) :collect collect)) -+ ((:disable-cache) -+ (process-output-translations-directive '(t t) :collect collect)) -+ ((:inherit-configuration) -+ (inherit-output-translations inherit :collect collect)) -+ ((:ignore-inherited-configuration :ignore-invalid-entries nil) -+ nil)) -+ (let ((src (first directive)) -+ (dst (second directive))) -+ (if (eq src :include) -+ (when dst -+ (process-output-translations (pathname dst) :inherit nil :collect collect)) -+ (when src -+ (let ((trusrc (or (eql src t) -+ (let ((loc (resolve-location src :ensure-directory t :wilden t))) -+ (if (absolute-pathname-p loc) (resolve-symlinks* loc) loc))))) -+ (cond -+ ((location-function-p dst) -+ (funcall collect -+ (list trusrc -+ (if (symbolp (second dst)) -+ (fdefinition (second dst)) -+ (eval (second dst)))))) -+ ((eq dst t) -+ (funcall collect (list trusrc t))) -+ (t -+ (let* ((trudst (if dst -+ (resolve-location dst :ensure-directory t :wilden t) -+ trusrc))) -+ (funcall collect (list trudst t)) -+ (funcall collect (list trusrc trudst))))))))))) -+ -+ (defmethod process-output-translations ((x symbol) &key -+ (inherit *default-output-translations*) -+ collect) -+ (process-output-translations (funcall x) :inherit inherit :collect collect)) -+ (defmethod process-output-translations ((pathname #-gcl2.6 pathname #+gcl2.6 t) &key inherit collect) -+ (cond -+ ((directory-pathname-p pathname) -+ (process-output-translations (validate-output-translations-directory pathname) -+ :inherit inherit :collect collect)) -+ ((probe-file* pathname :truename *resolve-symlinks*) -+ (process-output-translations (validate-output-translations-file pathname) -+ :inherit inherit :collect collect)) -+ (t -+ (inherit-output-translations inherit :collect collect)))) -+ (defmethod process-output-translations ((string string) &key inherit collect) -+ (process-output-translations (parse-output-translations-string string) -+ :inherit inherit :collect collect)) -+ (defmethod process-output-translations ((x null) &key inherit collect) -+ (declare (ignorable x)) -+ (inherit-output-translations inherit :collect collect)) -+ (defmethod process-output-translations ((form cons) &key inherit collect) -+ (dolist (directive (cdr (validate-output-translations-form form))) -+ (process-output-translations-directive directive :inherit inherit :collect collect))) -+ -+ (defun compute-output-translations (&optional parameter) -+ "read the configuration, return it" -+ (remove-duplicates -+ (while-collecting (c) -+ (inherit-output-translations -+ `(wrapping-output-translations ,parameter ,@*default-output-translations*) :collect #'c)) -+ :test 'equal :from-end t)) -+ -+ (defvar *output-translations-parameter* nil) -+ -+ (defun initialize-output-translations (&optional (parameter *output-translations-parameter*)) -+ "read the configuration, initialize the internal configuration variable, -+return the configuration" -+ (setf *output-translations-parameter* parameter -+ (output-translations) (compute-output-translations parameter))) -+ -+ (defun disable-output-translations () -+ "Initialize output translations in a way that maps every file to itself, -+effectively disabling the output translation facility." -+ (initialize-output-translations -+ '(:output-translations :disable-cache :ignore-inherited-configuration))) -+ -+ ;; checks an initial variable to see whether the state is initialized -+ ;; or cleared. In the former case, return current configuration; in -+ ;; the latter, initialize. ASDF will call this function at the start -+ ;; of (asdf:find-system). -+ (defun ensure-output-translations () -+ (if (output-translations-initialized-p) -+ (output-translations) -+ (initialize-output-translations))) -+ -+ (defun* (apply-output-translations) (path) -+ (etypecase path -+ (logical-pathname -+ path) -+ ((or pathname string) -+ (ensure-output-translations) -+ (loop* :with p = (resolve-symlinks* path) -+ :for (source destination) :in (car *output-translations*) -+ :for root = (when (or (eq source t) -+ (and (pathnamep source) -+ (not (absolute-pathname-p source)))) -+ (pathname-root p)) -+ :for absolute-source = (cond -+ ((eq source t) (wilden root)) -+ (root (merge-pathnames* source root)) -+ (t source)) -+ :when (or (eq source t) (pathname-match-p p absolute-source)) -+ :return (translate-pathname* p absolute-source destination root source) -+ :finally (return p))))) -+ -+ ;; Hook into asdf/driver's output-translation mechanism -+ #-cormanlisp -+ (setf *output-translation-function* 'apply-output-translations) -+ -+ #+abcl -+ (defun translate-jar-pathname (source wildcard) -+ (declare (ignore wildcard)) -+ (flet ((normalize-device (pathname) -+ (if (find :windows *features*) -+ pathname -+ (make-pathname :defaults pathname :device :unspecific)))) -+ (let* ((jar -+ (pathname (first (pathname-device source)))) -+ (target-root-directory-namestring -+ (format nil "/___jar___file___root___/~@[~A/~]" -+ (and (find :windows *features*) -+ (pathname-device jar)))) -+ (relative-source -+ (relativize-pathname-directory source)) -+ (relative-jar -+ (relativize-pathname-directory (ensure-directory-pathname jar))) -+ (target-root-directory -+ (normalize-device -+ (pathname-directory-pathname -+ (parse-namestring target-root-directory-namestring)))) -+ (target-root -+ (merge-pathnames* relative-jar target-root-directory)) -+ (target -+ (merge-pathnames* relative-source target-root))) -+ (normalize-device (apply-output-translations target)))))) -+ -+;;;; ------------------------------------------------------------------------- -+;;; Backward-compatible interfaces -+ -+(asdf/package:define-package :asdf/backward-interface -+ (:recycle :asdf/backward-interface :asdf) -+ (:use :uiop/common-lisp :uiop :asdf/upgrade -+ :asdf/component :asdf/system :asdf/find-system :asdf/operation :asdf/action -+ :asdf/lisp-action :asdf/operate :asdf/output-translations) -+ (:export -+ #:*asdf-verbose* -+ #:operation-error #:compile-error #:compile-failed #:compile-warned -+ #:error-component #:error-operation -+ #:component-load-dependencies -+ #:enable-asdf-binary-locations-compatibility -+ #:operation-forced -+ #:operation-on-failure #:operation-on-warnings #:on-failure #:on-warnings -+ #:component-property -+ #:run-shell-command -+ #:system-definition-pathname)) -+(in-package :asdf/backward-interface) -+ -+(with-upgradability () -+ (define-condition operation-error (error) ;; Bad, backward-compatible name -+ ;; Used by SBCL, cffi-tests, clsql-mysql, clsql-uffi, qt, elephant, uffi-tests, sb-grovel -+ ((component :reader error-component :initarg :component) -+ (operation :reader error-operation :initarg :operation)) -+ (:report (lambda (c s) -+ (format s (compatfmt "~@<~A while invoking ~A on ~A~@:>") -+ (type-of c) (error-operation c) (error-component c))))) -+ (define-condition compile-error (operation-error) ()) -+ (define-condition compile-failed (compile-error) ()) -+ (define-condition compile-warned (compile-error) ()) -+ -+ (defun component-load-dependencies (component) -+ ;; Old deprecated name for the same thing. Please update your software. -+ (component-sideway-dependencies component)) -+ -+ (defgeneric operation-forced (operation)) ;; Used by swank.asd for swank-loader. -+ (defmethod operation-forced ((o operation)) (getf (operation-original-initargs o) :force)) -+ -+ (defgeneric operation-on-warnings (operation)) -+ (defgeneric operation-on-failure (operation)) -+ #-gcl2.6 (defgeneric (setf operation-on-warnings) (x operation)) -+ #-gcl2.6 (defgeneric (setf operation-on-failure) (x operation)) -+ (defmethod operation-on-warnings ((o operation)) -+ (declare (ignorable o)) *compile-file-warnings-behaviour*) -+ (defmethod operation-on-failure ((o operation)) -+ (declare (ignorable o)) *compile-file-failure-behaviour*) -+ (defmethod (setf operation-on-warnings) (x (o operation)) -+ (declare (ignorable o)) (setf *compile-file-warnings-behaviour* x)) -+ (defmethod (setf operation-on-failure) (x (o operation)) -+ (declare (ignorable o)) (setf *compile-file-failure-behaviour* x)) -+ -+ (defun system-definition-pathname (x) -+ ;; As of 2.014.8, we mean to make this function obsolete, -+ ;; but that won't happen until all clients have been updated. -+ ;;(cerror "Use ASDF:SYSTEM-SOURCE-FILE instead" -+ "Function ASDF:SYSTEM-DEFINITION-PATHNAME is obsolete. -+It used to expose ASDF internals with subtle differences with respect to -+user expectations, that have been refactored away since. -+We recommend you use ASDF:SYSTEM-SOURCE-FILE instead -+for a mostly compatible replacement that we're supporting, -+or even ASDF:SYSTEM-SOURCE-DIRECTORY or ASDF:SYSTEM-RELATIVE-PATHNAME -+if that's whay you mean." ;;) -+ (system-source-file x))) -+ -+ -+;;;; ASDF-Binary-Locations compatibility -+;; This remains supported for legacy user, but not recommended for new users. -+(with-upgradability () -+ (defun enable-asdf-binary-locations-compatibility -+ (&key -+ (centralize-lisp-binaries nil) -+ (default-toplevel-directory -+ (subpathname (user-homedir-pathname) ".fasls/")) ;; Use ".cache/common-lisp/" instead ??? -+ (include-per-user-information nil) -+ (map-all-source-files (or #+(or clisp ecl mkcl) t nil)) -+ (source-to-target-mappings nil) -+ (file-types `(,(compile-file-type) -+ "build-report" -+ #+ecl (compile-file-type :type :object) -+ #+mkcl (compile-file-type :fasl-p nil) -+ #+clisp "lib" #+sbcl "cfasl" -+ #+sbcl "sbcl-warnings" #+clozure "ccl-warnings"))) -+ #+(or clisp ecl mkcl) -+ (when (null map-all-source-files) -+ (error "asdf:enable-asdf-binary-locations-compatibility doesn't support :map-all-source-files nil on CLISP, ECL and MKCL")) -+ (let* ((patterns (if map-all-source-files (list *wild-file*) -+ (loop :for type :in file-types -+ :collect (make-pathname :type type :defaults *wild-file*)))) -+ (destination-directory -+ (if centralize-lisp-binaries -+ `(,default-toplevel-directory -+ ,@(when include-per-user-information -+ (cdr (pathname-directory (user-homedir-pathname)))) -+ :implementation ,*wild-inferiors*) -+ `(:root ,*wild-inferiors* :implementation)))) -+ (initialize-output-translations -+ `(:output-translations -+ ,@source-to-target-mappings -+ #+abcl (#p"jar:file:/**/*.jar!/**/*.*" (:function translate-jar-pathname)) -+ #+abcl (#p"/___jar___file___root___/**/*.*" (,@destination-directory)) -+ ,@(loop :for pattern :in patterns -+ :collect `((:root ,*wild-inferiors* ,pattern) -+ (,@destination-directory ,pattern))) -+ (t t) -+ :ignore-inherited-configuration)))) -+ -+ (defmethod operate :before (operation-class system &rest args &key &allow-other-keys) -+ (declare (ignorable operation-class system args)) -+ (when (find-symbol* '#:output-files-for-system-and-operation :asdf nil) -+ (error "ASDF 2 is not compatible with ASDF-BINARY-LOCATIONS, which you are using. -+ASDF 2 now achieves the same purpose with its builtin ASDF-OUTPUT-TRANSLATIONS, -+which should be easier to configure. Please stop using ASDF-BINARY-LOCATIONS, -+and instead use ASDF-OUTPUT-TRANSLATIONS. See the ASDF manual for details. -+In case you insist on preserving your previous A-B-L configuration, but -+do not know how to achieve the same effect with A-O-T, you may use function -+ASDF:ENABLE-ASDF-BINARY-LOCATIONS-COMPATIBILITY as documented in the manual; -+call that function where you would otherwise have loaded and configured A-B-L.")))) -+ -+ -+;;; run-shell-command -+;; WARNING! The function below is not just deprecated but also dysfunctional. -+;; Please use asdf/run-program:run-program instead. -+(with-upgradability () -+ (defun run-shell-command (control-string &rest args) -+ "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and -+synchronously execute the result using a Bourne-compatible shell, with -+output to *VERBOSE-OUT*. Returns the shell's exit code. -+ -+PLEASE DO NOT USE. -+Deprecated function, for backward-compatibility only. -+Please use UIOP:RUN-PROGRAM instead." -+ (let ((command (apply 'format nil control-string args))) -+ (asdf-message "; $ ~A~%" command) -+ (run-program command :force-shell t :ignore-error-status t :output *verbose-out*)))) -+ -+(with-upgradability () -+ (defvar *asdf-verbose* nil)) ;; backward-compatibility with ASDF2 only. Unused. -+ -+;; backward-compatibility methods. Do NOT use in new code. NOT SUPPORTED. -+(with-upgradability () -+ (defgeneric component-property (component property)) -+ (defgeneric (setf component-property) (new-value component property)) -+ -+ (defmethod component-property ((c component) property) -+ (cdr (assoc property (slot-value c 'properties) :test #'equal))) -+ -+ (defmethod (setf component-property) (new-value (c component) property) -+ (let ((a (assoc property (slot-value c 'properties) :test #'equal))) -+ (if a -+ (setf (cdr a) new-value) -+ (setf (slot-value c 'properties) -+ (acons property new-value (slot-value c 'properties))))) -+ new-value)) -+;;;; ----------------------------------------------------------------- -+;;;; Source Registry Configuration, by Francois-Rene Rideau -+;;;; See the Manual and https://bugs.launchpad.net/asdf/+bug/485918 -+ -+(asdf/package:define-package :asdf/source-registry -+ (:recycle :asdf/source-registry :asdf) -+ (:use :asdf/common-lisp :asdf/driver :asdf/upgrade :asdf/find-system) -+ (:export -+ #:*source-registry-parameter* #:*default-source-registries* -+ #:invalid-source-registry -+ #:source-registry-initialized-p -+ #:initialize-source-registry #:clear-source-registry #:*source-registry* -+ #:ensure-source-registry #:*source-registry-parameter* -+ #:*default-source-registry-exclusions* #:*source-registry-exclusions* -+ #:*wild-asd* #:directory-asd-files #:register-asd-directory -+ #:collect-asds-in-directory #:collect-sub*directories-asd-files -+ #:validate-source-registry-directive #:validate-source-registry-form -+ #:validate-source-registry-file #:validate-source-registry-directory -+ #:parse-source-registry-string #:wrapping-source-registry #:default-source-registry -+ #:user-source-registry #:system-source-registry -+ #:user-source-registry-directory #:system-source-registry-directory -+ #:environment-source-registry #:process-source-registry -+ #:compute-source-registry #:flatten-source-registry -+ #:sysdef-source-registry-search)) -+(in-package :asdf/source-registry) -+ -+(with-upgradability () -+ (define-condition invalid-source-registry (invalid-configuration warning) -+ ((format :initform (compatfmt "~@<Invalid source registry ~S~@[ in ~S~]~@{ ~@?~}~@:>")))) -+ -+ ;; Using ack 1.2 exclusions -+ (defvar *default-source-registry-exclusions* -+ '(".bzr" ".cdv" -+ ;; "~.dep" "~.dot" "~.nib" "~.plst" ; we don't support ack wildcards -+ ".git" ".hg" ".pc" ".svn" "CVS" "RCS" "SCCS" "_darcs" -+ "_sgbak" "autom4te.cache" "cover_db" "_build" -+ "debian")) ;; debian often builds stuff under the debian directory... BAD. -+ -+ (defvar *source-registry-exclusions* *default-source-registry-exclusions*) -+ -+ (defvar *source-registry* nil -+ "Either NIL (for uninitialized), or an equal hash-table, mapping -+system names to pathnames of .asd files") -+ -+ (defun source-registry-initialized-p () -+ (typep *source-registry* 'hash-table)) -+ -+ (defun clear-source-registry () -+ "Undoes any initialization of the source registry." -+ (setf *source-registry* nil) -+ (values)) -+ (register-clear-configuration-hook 'clear-source-registry) -+ -+ (defparameter *wild-asd* -+ (make-pathname* :directory nil :name *wild* :type "asd" :version :newest)) -+ -+ (defun directory-asd-files (directory) -+ (directory-files directory *wild-asd*)) -+ -+ (defun collect-asds-in-directory (directory collect) -+ (map () collect (directory-asd-files directory))) -+ -+ (defun collect-sub*directories-asd-files -+ (directory &key (exclude *default-source-registry-exclusions*) collect) -+ (collect-sub*directories -+ directory -+ (constantly t) -+ #'(lambda (x &aux (l (car (last (pathname-directory x))))) (not (member l exclude :test #'equal))) -+ #'(lambda (dir) (collect-asds-in-directory dir collect)))) -+ -+ (defun validate-source-registry-directive (directive) -+ (or (member directive '(:default-registry)) -+ (and (consp directive) -+ (let ((rest (rest directive))) -+ (case (first directive) -+ ((:include :directory :tree) -+ (and (length=n-p rest 1) -+ (location-designator-p (first rest)))) -+ ((:exclude :also-exclude) -+ (every #'stringp rest)) -+ ((:default-registry) -+ (null rest))))))) -+ -+ (defun validate-source-registry-form (form &key location) -+ (validate-configuration-form -+ form :source-registry 'validate-source-registry-directive -+ :location location :invalid-form-reporter 'invalid-source-registry)) -+ -+ (defun validate-source-registry-file (file) -+ (validate-configuration-file -+ file 'validate-source-registry-form :description "a source registry")) -+ -+ (defun validate-source-registry-directory (directory) -+ (validate-configuration-directory -+ directory :source-registry 'validate-source-registry-directive -+ :invalid-form-reporter 'invalid-source-registry)) -+ -+ (defun parse-source-registry-string (string &key location) -+ (cond -+ ((or (null string) (equal string "")) -+ '(:source-registry :inherit-configuration)) -+ ((not (stringp string)) -+ (error (compatfmt "~@<Environment string isn't: ~3i~_~S~@:>") string)) -+ ((find (char string 0) "\"(") -+ (validate-source-registry-form (read-from-string string) :location location)) -+ (t -+ (loop -+ :with inherit = nil -+ :with directives = () -+ :with start = 0 -+ :with end = (length string) -+ :with separator = (inter-directory-separator) -+ :for pos = (position separator string :start start) :do -+ (let ((s (subseq string start (or pos end)))) -+ (flet ((check (dir) -+ (unless (absolute-pathname-p dir) -+ (error (compatfmt "~@<source-registry string must specify absolute pathnames: ~3i~_~S~@:>") string)) -+ dir)) -+ (cond -+ ((equal "" s) ; empty element: inherit -+ (when inherit -+ (error (compatfmt "~@<Only one inherited configuration allowed: ~3i~_~S~@:>") -+ string)) -+ (setf inherit t) -+ (push ':inherit-configuration directives)) -+ ((string-suffix-p s "//") ;; TODO: allow for doubling of separator even outside Unix? -+ (push `(:tree ,(check (subseq s 0 (- (length s) 2)))) directives)) -+ (t -+ (push `(:directory ,(check s)) directives)))) -+ (cond -+ (pos -+ (setf start (1+ pos))) -+ (t -+ (unless inherit -+ (push '(:ignore-inherited-configuration) directives)) -+ (return `(:source-registry ,@(nreverse directives)))))))))) -+ -+ (defun register-asd-directory (directory &key recurse exclude collect) -+ (if (not recurse) -+ (collect-asds-in-directory directory collect) -+ (collect-sub*directories-asd-files -+ directory :exclude exclude :collect collect))) -+ -+ (defparameter *default-source-registries* -+ '(environment-source-registry -+ user-source-registry -+ user-source-registry-directory -+ system-source-registry -+ system-source-registry-directory -+ default-source-registry)) -+ -+ (defparameter *source-registry-file* (parse-unix-namestring "source-registry.conf")) -+ (defparameter *source-registry-directory* (parse-unix-namestring "source-registry.conf.d/")) -+ -+ (defun wrapping-source-registry () -+ `(:source-registry -+ #+(or ecl sbcl) (:tree ,(resolve-symlinks* (lisp-implementation-directory))) -+ #+mkcl (:tree ,(translate-logical-pathname "CONTRIB:")) -+ :inherit-configuration -+ #+cmu (:tree #p"modules:") -+ #+scl (:tree #p"file://modules/"))) -+ (defun default-source-registry () -+ `(:source-registry -+ #+sbcl (:directory ,(subpathname (user-homedir-pathname) ".sbcl/systems/")) -+ ,@(loop :for dir :in -+ `(,@(when (os-unix-p) -+ `(,(or (getenv-absolute-directory "XDG_DATA_HOME") -+ (subpathname (user-homedir-pathname) ".local/share/")) -+ ,@(or (getenv-absolute-directories "XDG_DATA_DIRS") -+ '("/usr/local/share" "/usr/share")))) -+ ,@(when (os-windows-p) -+ (mapcar 'get-folder-path '(:local-appdata :appdata :common-appdata)))) -+ :collect `(:directory ,(subpathname* dir "common-lisp/systems/")) -+ :collect `(:tree ,(subpathname* dir "common-lisp/source/"))) -+ :inherit-configuration)) -+ (defun user-source-registry (&key (direction :input)) -+ (in-user-configuration-directory *source-registry-file* :direction direction)) -+ (defun system-source-registry (&key (direction :input)) -+ (in-system-configuration-directory *source-registry-file* :direction direction)) -+ (defun user-source-registry-directory (&key (direction :input)) -+ (in-user-configuration-directory *source-registry-directory* :direction direction)) -+ (defun system-source-registry-directory (&key (direction :input)) -+ (in-system-configuration-directory *source-registry-directory* :direction direction)) -+ (defun environment-source-registry () -+ (getenv "CL_SOURCE_REGISTRY")) -+ -+ (defgeneric* (process-source-registry) (spec &key inherit register)) -+ -+ (defun* (inherit-source-registry) (inherit &key register) -+ (when inherit -+ (process-source-registry (first inherit) :register register :inherit (rest inherit)))) -+ -+ (defun* (process-source-registry-directive) (directive &key inherit register) -+ (destructuring-bind (kw &rest rest) (if (consp directive) directive (list directive)) -+ (ecase kw -+ ((:include) -+ (destructuring-bind (pathname) rest -+ (process-source-registry (resolve-location pathname) :inherit nil :register register))) -+ ((:directory) -+ (destructuring-bind (pathname) rest -+ (when pathname -+ (funcall register (resolve-location pathname :ensure-directory t))))) -+ ((:tree) -+ (destructuring-bind (pathname) rest -+ (when pathname -+ (funcall register (resolve-location pathname :ensure-directory t) -+ :recurse t :exclude *source-registry-exclusions*)))) -+ ((:exclude) -+ (setf *source-registry-exclusions* rest)) -+ ((:also-exclude) -+ (appendf *source-registry-exclusions* rest)) -+ ((:default-registry) -+ (inherit-source-registry '(default-source-registry) :register register)) -+ ((:inherit-configuration) -+ (inherit-source-registry inherit :register register)) -+ ((:ignore-inherited-configuration) -+ nil))) -+ nil) -+ -+ (defmethod process-source-registry ((x symbol) &key inherit register) -+ (process-source-registry (funcall x) :inherit inherit :register register)) -+ (defmethod process-source-registry ((pathname #-gcl2.6 pathname #+gcl2.6 t) &key inherit register) -+ (cond -+ ((directory-pathname-p pathname) -+ (let ((*here-directory* (resolve-symlinks* pathname))) -+ (process-source-registry (validate-source-registry-directory pathname) -+ :inherit inherit :register register))) -+ ((probe-file* pathname :truename *resolve-symlinks*) -+ (let ((*here-directory* (pathname-directory-pathname pathname))) -+ (process-source-registry (validate-source-registry-file pathname) -+ :inherit inherit :register register))) -+ (t -+ (inherit-source-registry inherit :register register)))) -+ (defmethod process-source-registry ((string string) &key inherit register) -+ (process-source-registry (parse-source-registry-string string) -+ :inherit inherit :register register)) -+ (defmethod process-source-registry ((x null) &key inherit register) -+ (declare (ignorable x)) -+ (inherit-source-registry inherit :register register)) -+ (defmethod process-source-registry ((form cons) &key inherit register) -+ (let ((*source-registry-exclusions* *default-source-registry-exclusions*)) -+ (dolist (directive (cdr (validate-source-registry-form form))) -+ (process-source-registry-directive directive :inherit inherit :register register)))) -+ -+ (defun flatten-source-registry (&optional parameter) -+ (remove-duplicates -+ (while-collecting (collect) -+ (with-pathname-defaults () ;; be location-independent -+ (inherit-source-registry -+ `(wrapping-source-registry -+ ,parameter -+ ,@*default-source-registries*) -+ :register #'(lambda (directory &key recurse exclude) -+ (collect (list directory :recurse recurse :exclude exclude)))))) -+ :test 'equal :from-end t)) -+ -+ ;; Will read the configuration and initialize all internal variables. -+ (defun compute-source-registry (&optional parameter (registry *source-registry*)) -+ (dolist (entry (flatten-source-registry parameter)) -+ (destructuring-bind (directory &key recurse exclude) entry -+ (let* ((h (make-hash-table :test 'equal))) ; table to detect duplicates -+ (register-asd-directory -+ directory :recurse recurse :exclude exclude :collect -+ #'(lambda (asd) -+ (let* ((name (pathname-name asd)) -+ (name (if (typep asd 'logical-pathname) -+ ;; logical pathnames are upper-case, -+ ;; at least in the CLHS and on SBCL, -+ ;; yet (coerce-name :foo) is lower-case. -+ ;; won't work well with (load-system "Foo") -+ ;; instead of (load-system 'foo) -+ (string-downcase name) -+ name))) -+ (cond -+ ((gethash name registry) ; already shadowed by something else -+ nil) -+ ((gethash name h) ; conflict at current level -+ (when *verbose-out* -+ (warn (compatfmt "~@<In source-registry entry ~A~@[/~*~] ~ -+ found several entries for ~A - picking ~S over ~S~:>") -+ directory recurse name (gethash name h) asd))) -+ (t -+ (setf (gethash name registry) asd) -+ (setf (gethash name h) asd)))))) -+ h))) -+ (values)) -+ -+ (defvar *source-registry-parameter* nil) -+ -+ (defun initialize-source-registry (&optional (parameter *source-registry-parameter*)) -+ ;; Record the parameter used to configure the registry -+ (setf *source-registry-parameter* parameter) -+ ;; Clear the previous registry database: -+ (setf *source-registry* (make-hash-table :test 'equal)) -+ ;; Do it! -+ (compute-source-registry parameter)) -+ -+ ;; Checks an initial variable to see whether the state is initialized -+ ;; or cleared. In the former case, return current configuration; in -+ ;; the latter, initialize. ASDF will call this function at the start -+ ;; of (asdf:find-system) to make sure the source registry is initialized. -+ ;; However, it will do so *without* a parameter, at which point it -+ ;; will be too late to provide a parameter to this function, though -+ ;; you may override the configuration explicitly by calling -+ ;; initialize-source-registry directly with your parameter. -+ (defun ensure-source-registry (&optional parameter) -+ (unless (source-registry-initialized-p) -+ (initialize-source-registry parameter)) -+ (values)) -+ -+ (defun sysdef-source-registry-search (system) -+ (ensure-source-registry) -+ (values (gethash (primary-system-name system) *source-registry*)))) -+ -+ -+;;;; --------------------------------------------------------------------------- -+;;;; Handle ASDF package upgrade, including implementation-dependent magic. -+ -+(asdf/package:define-package :asdf/interface -+ (:nicknames :asdf :asdf-utilities) -+ (:recycle :asdf/interface :asdf) -+ (:unintern -+ #:*asdf-revision* #:around #:asdf-method-combination -+ #:do-traverse #:do-dep #:do-one-dep #:visit-action #:component-visited-p -+ #:split #:make-collector -+ #:loaded-systems ; makes for annoying SLIME completion -+ #:output-files-for-system-and-operation) ; obsolete ASDF-BINARY-LOCATION function -+ (:use :asdf/common-lisp :asdf/driver :asdf/upgrade :asdf/cache -+ :asdf/component :asdf/system :asdf/find-system :asdf/find-component -+ :asdf/operation :asdf/action :asdf/lisp-action -+ :asdf/output-translations :asdf/source-registry -+ :asdf/plan :asdf/operate :asdf/defsystem :asdf/bundle :asdf/concatenate-source -+ :asdf/backward-internals :asdf/backward-interface) -+ ;; TODO: automatically generate interface with reexport? -+ (:export -+ #:defsystem #:find-system #:locate-system #:coerce-name -+ #:oos #:operate #:traverse #:perform-plan #:sequential-plan -+ #:system-definition-pathname #:with-system-definitions -+ #:search-for-system-definition #:find-component #:component-find-path -+ #:compile-system #:load-system #:load-systems -+ #:require-system #:test-system #:clear-system -+ #:operation #:make-operation #:find-operation -+ #:upward-operation #:downward-operation #:sideway-operation #:selfward-operation -+ #:build-system #:build-op -+ #:load-op #:prepare-op #:compile-op -+ #:prepare-source-op #:load-source-op #:test-op -+ #:feature #:version #:version-satisfies #:upgrade-asdf -+ #:implementation-identifier #:implementation-type #:hostname -+ #:input-files #:output-files #:output-file #:perform -+ #:operation-done-p #:explain #:action-description #:component-sideway-dependencies -+ #:needed-in-image-p -+ ;; #:run-program ; we can't export it, because SB-GROVEL :use's both ASDF and SB-EXT. -+ #:component-load-dependencies #:run-shell-command ; deprecated, do not use -+ #:bundle-op #:monolithic-bundle-op #:precompiled-system #:compiled-file #:bundle-system -+ #+ecl #:make-build -+ #:basic-fasl-op #:prepare-fasl-op #:fasl-op #:load-fasl-op #:monolithic-fasl-op -+ #:lib-op #:dll-op #:binary-op #:program-op -+ #:monolithic-lib-op #:monolithic-dll-op #:monolithic-binary-op -+ #:concatenate-source-op -+ #:load-concatenated-source-op -+ #:compile-concatenated-source-op -+ #:load-compiled-concatenated-source-op -+ #:monolithic-concatenate-source-op -+ #:monolithic-load-concatenated-source-op -+ #:monolithic-compile-concatenated-source-op -+ #:monolithic-load-compiled-concatenated-source-op -+ #:operation-monolithic-p -+ #:required-components -+ #:component-loaded-p -+ -+ #:component #:parent-component #:child-component #:system #:module -+ #:file-component #:source-file #:c-source-file #:java-source-file -+ #:cl-source-file #:cl-source-file.cl #:cl-source-file.lsp -+ #:static-file #:doc-file #:html-file -+ #:file-type -+ #:source-file-type -+ -+ #:component-children ; component accessors -+ #:component-children-by-name -+ #:component-pathname -+ #:component-relative-pathname -+ #:component-name -+ #:component-version -+ #:component-parent -+ #:component-system -+ #:component-encoding -+ #:component-external-format -+ -+ #:component-depends-on ; backward-compatible name rather than action-depends-on -+ #:module-components ; backward-compatibility -+ #:operation-on-warnings #:operation-on-failure ; backward-compatibility -+ #:component-property ; backward-compatibility -+ -+ #:system-description -+ #:system-long-description -+ #:system-author -+ #:system-maintainer -+ #:system-license -+ #:system-licence -+ #:system-source-file -+ #:system-source-directory -+ #:system-relative-pathname -+ #:system-homepage -+ #:system-mailto -+ #:system-bug-tracker -+ #:system-long-name -+ #:system-source-control -+ #:map-systems -+ -+ #:*system-definition-search-functions* ; variables -+ #:*central-registry* -+ #:*compile-file-warnings-behaviour* -+ #:*compile-file-failure-behaviour* -+ #:*resolve-symlinks* -+ #:*load-system-operation* -+ #:*asdf-verbose* ;; unused. For backward-compatibility only. -+ #:*verbose-out* -+ -+ #:asdf-version -+ -+ #:compile-condition #:compile-file-error #:compile-warned-error #:compile-failed-error -+ #:compile-warned-warning #:compile-failed-warning -+ #:operation-error #:compile-failed #:compile-warned #:compile-error ;; backward compatibility -+ #:error-name -+ #:error-pathname -+ #:load-system-definition-error -+ #:error-component #:error-operation -+ #:system-definition-error -+ #:missing-component -+ #:missing-component-of-version -+ #:missing-dependency -+ #:missing-dependency-of-version -+ #:circular-dependency ; errors -+ #:duplicate-names #:non-toplevel-system #:non-system-system -+ -+ #:try-recompiling -+ #:retry -+ #:accept ; restarts -+ #:coerce-entry-to-directory -+ #:remove-entry-from-registry -+ -+ #:*encoding-detection-hook* -+ #:*encoding-external-format-hook* -+ #:*default-encoding* -+ #:*utf-8-external-format* -+ -+ #:clear-configuration -+ #:*output-translations-parameter* -+ #:initialize-output-translations -+ #:disable-output-translations -+ #:clear-output-translations -+ #:ensure-output-translations -+ #:apply-output-translations -+ #:compile-file* -+ #:compile-file-pathname* -+ #:*warnings-file-type* #:enable-deferred-warnings-check #:disable-deferred-warnings-check -+ #:enable-asdf-binary-locations-compatibility -+ #:*default-source-registries* -+ #:*source-registry-parameter* -+ #:initialize-source-registry -+ #:compute-source-registry -+ #:clear-source-registry -+ #:ensure-source-registry -+ #:process-source-registry -+ #:system-registered-p #:registered-systems #:already-loaded-systems -+ #:resolve-location -+ #:asdf-message -+ #:*user-cache* -+ #:user-output-translations-pathname -+ #:system-output-translations-pathname -+ #:user-output-translations-directory-pathname -+ #:system-output-translations-directory-pathname -+ #:user-source-registry -+ #:system-source-registry -+ #:user-source-registry-directory -+ #:system-source-registry-directory)) -+ -+;;;; --------------------------------------------------------------------------- -+;;;; ASDF-USER, where the action happens. -+ -+(asdf/package:define-package :asdf/user -+ (:nicknames :asdf-user) -+ (:use :asdf/common-lisp :asdf/package :asdf/interface)) -+;;;; ----------------------------------------------------------------------- -+;;;; ASDF Footer: last words and cleanup -+ -+(asdf/package:define-package :asdf/footer -+ (:recycle :asdf/footer :asdf) -+ (:use :asdf/common-lisp :asdf/driver :asdf/upgrade -+ :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) -+ -+;;;; Hook ASDF into the implementation's REQUIRE and other entry points. -+ -+(with-upgradability () -+ #+(or abcl clisp clozure cmu ecl mkcl sbcl) -+ (if-let (x (and #+clisp (find-symbol* '#:*module-provider-functions* :custom nil))) -+ (eval `(pushnew 'module-provide-asdf -+ #+abcl sys::*module-provider-functions* -+ #+clisp ,x -+ #+clozure ccl:*module-provider-functions* -+ #+(or cmu ecl) ext:*module-provider-functions* -+ #+mkcl mk-ext:*module-provider-functions* -+ #+sbcl sb-ext:*module-provider-functions*))) -+ -+ #+(or ecl mkcl) -+ (progn -+ (pushnew '("fasb" . si::load-binary) si:*load-hooks* :test 'equal :key 'car) -+ -+ #+(or (and ecl win32) (and mkcl windows)) -+ (unless (assoc "asd" #+ecl ext:*load-hooks* #+mkcl si::*load-hooks* :test 'equal) -+ (appendf #+ecl ext:*load-hooks* #+mkcl si::*load-hooks* '(("asd" . si::load-source)))) -+ -+ (setf #+ecl ext:*module-provider-functions* #+mkcl mk-ext::*module-provider-functions* -+ (loop :for f :in #+ecl ext:*module-provider-functions* -+ #+mkcl mk-ext::*module-provider-functions* -+ :collect -+ (if (eq f 'module-provide-asdf) f -+ #'(lambda (name) -+ (let ((l (multiple-value-list (funcall f name)))) -+ (and (first l) (register-pre-built-system (coerce-name name))) -+ (values-list l)))))))) -+ -+ -+;;;; Done! -+(with-upgradability () -+ #+allegro -+ (when (boundp 'excl:*warn-on-nested-reader-conditionals*) -+ (setf excl:*warn-on-nested-reader-conditionals* asdf/common-lisp::*acl-warn-save*)) -+ -+ (dolist (f '(:asdf :asdf2 :asdf3)) (pushnew f *features*)) -+ -+ (provide :asdf) -+ -+ (cleanup-upgraded-asdf)) -+ -+(when *load-verbose* -+ (asdf-message ";; ASDF, version ~a~%" (asdf-version))) -+ -+ ---- cl-asdf-3.0.0.orig/doc/index.html -+++ cl-asdf-3.0.0/doc/index.html -@@ -32,7 +32,8 @@ - <div class="contents"> - <a id="ASDF 3"></a> - <h3>ASDF 3</h3> -- <p>ASDF 3, pre-released as 2.28 on February 1st 2013, -+ <p>ASDF 3, pre-released as 2.28 on February 1st 2013, and -+ released as 3.0.0 on May 15th 2013, - is the current successor to Daniel Barlow's ASDF. - It was rewritten for improved portability, robustness, usability, - extensibility, configurability, internal consistency, ---- /dev/null -+++ cl-asdf-3.0.0/doc/asdf.log -@@ -0,0 +1,190 @@ -+This is pdfTeX, Version 3.1415926-1.40.10 (TeX Live 2009/Debian) (format=pdfetex 2013.4.24) 16 MAY 2013 00:33 -+entering extended mode -+ file:line:error style messages enabled. -+ %&-line parsing enabled. -+**\catcode126=12 \def\normaltilde{~}\catcode126=13 \let~\normaltilde \input ./ -+asdf.texinfo -+(./asdf.texinfo (/usr/share/texmf/tex/texinfo/texinfo.tex -+Loading texinfo [version 2008-04-18.10]: -+\bindingoffset=\dimen16 -+\normaloffset=\dimen17 -+\pagewidth=\dimen18 -+\pageheight=\dimen19 -+\outerhsize=\dimen20 -+\outervsize=\dimen21 -+\cornerlong=\dimen22 -+\cornerthick=\dimen23 -+\topandbottommargin=\dimen24 -+\headlinebox=\box16 -+\footlinebox=\box17 -+\margin=\insert252 -+\EMsimple=\toks13 -+\groupbox=\box18 -+\groupinvalidhelp=\toks14 -+\mil=\dimen25 -+\exdentamount=\skip18 -+\inmarginspacing=\skip19 -+ pdf, -+\tempnum=\count27 -+\lnkcount=\count28 -+\filename=\toks15 -+\filenamelength=\count29 -+\pgn=\count30 -+\toksA=\toks16 -+\toksB=\toks17 -+\toksC=\toks18 -+\toksD=\toks19 -+\boxA=\box19 -+\countA=\count31 -+\nopdfimagehelp=\toks20 -+ fonts, -+\sffam=\fam8 -+\textleading=\dimen26 -+\fontdepth=\count32 -+ page headings, -+\titlepagetopglue=\skip20 -+\titlepagebottomglue=\skip21 -+\evenheadline=\toks21 -+\oddheadline=\toks22 -+\evenfootline=\toks23 -+\oddfootline=\toks24 -+ tables, -+\tableindent=\dimen27 -+\itemindent=\dimen28 -+\itemmargin=\dimen29 -+\itemmax=\dimen30 -+\itemno=\count33 -+\multitableparskip=\skip22 -+\multitableparindent=\skip23 -+\multitablecolspace=\dimen31 -+\multitablelinespace=\skip24 -+\colcount=\count34 -+\everytab=\toks25 -+ -+conditionals, -+\doignorecount=\count35 -+ indexing, -+\whatsitskip=\skip25 -+\whatsitpenalty=\count36 -+\secondaryindent=\skip26 -+\partialpage=\box20 -+\doublecolumnhsize=\dimen32 -+ sectioning, -+\unnumberedno=\count37 -+\chapno=\count38 -+\secno=\count39 -+\subsecno=\count40 -+\subsubsecno=\count41 -+\appendixno=\count42 -+\absseclevel=\count43 -+\secbase=\count44 -+\chapheadingskip=\skip27 -+\secheadingskip=\skip28 -+\subsecheadingskip=\skip29 -+ toc, -+\tocfile=\write0 -+\contentsrightmargin=\skip30 -+\savepageno=\count45 -+\lastnegativepageno=\count46 -+\tocindent=\dimen33 -+ environments, -+\errorbox=\box21 -+\lispnarrowing=\skip31 -+\envskipamount=\skip32 -+\circthick=\dimen34 -+\cartouter=\dimen35 -+\cartinner=\dimen36 -+\normbskip=\skip33 -+\normpskip=\skip34 -+\normlskip=\skip35 -+\lskip=\skip36 -+\rskip=\skip37 -+\tabw=\dimen37 -+ defuns, -+\defbodyindent=\skip38 -+\defargsindent=\skip39 -+\deflastargmargin=\skip40 -+\defunpenalty=\count47 -+\parencount=\count48 -+\brackcount=\count49 -+ macros, -+\paramno=\count50 -+\macname=\toks26 -+ -+cross references, -+\auxfile=\write1 -+\savesfregister=\count51 -+ insertions, -+\footnoteno=\count52 -+\SAVEfootins=\box22 -+\SAVEmargin=\box23 -+ -+(/usr/share/texmf-texlive/tex/generic/epsf/epsf.tex -+This is `epsf.tex' v2.7.3 <23 July 2005> -+\epsffilein=\read1 -+\epsfframemargin=\dimen38 -+\epsfframethickness=\dimen39 -+\epsfrsize=\dimen40 -+\epsftmp=\dimen41 -+\epsftsize=\dimen42 -+\epsfxsize=\dimen43 -+\epsfysize=\dimen44 -+\pspoints=\dimen45 -+) -+\noepsfhelp=\toks27 -+ localization, -+\nolanghelp=\toks28 -+\countUTFx=\count53 -+\countUTFy=\count54 -+\countUTFz=\count55 -+ formatting, -+\defaultparindent=\dimen46 -+ and turning on texinfo input format.) -+\openout1 = `asdf.aux'. -+ -+@cpindfile=@write2 -+@fnindfile=@write3 -+@vrindfile=@write4 -+@tpindfile=@write5 -+@kyindfile=@write6 -+@pgindfile=@write7 -+ [1 -+\openout2 = `asdf.cp'. -+ -+\openout3 = `asdf.fn'. -+ -+\openout4 = `asdf.vr'. -+ -+\openout5 = `asdf.tp'. -+ -+\openout6 = `asdf.ky'. -+ -+\openout7 = `asdf.pg'. -+ -+{/var/lib/texmf/fonts/map/pdftex/updmap/pdftex.map}] -+Overfull \hbox (52.19247pt too wide) in paragraph at lines 5--7 -+[]@textrm You can find the lat-est ver-sion of this man-ual at [][]@texttt http -+://common-lisp.net/project/asdf/asdf.html[][][]@textrm . | -+ -+@hbox(7.60416+2.43333)x433.62, glue set - 1.0 -+.@hbox(0.0+0.0)x0.0 -+.@textrm Y -+.@kern-0.91252 -+.@textrm o -+.@textrm u -+.etc. -+ -+[2] [-1] Chapter 1 -+\openout0 = `asdf.toc'. -+ -+ Cross reference values unknown; you must run TeX again. -+Chapter 2 [1] -+Overfull \hbox (26.43913pt too wide) in paragraph at lines 268--268 -+ [] @texttt (let ((ver (symbol-value (or (find-symbol (string :*asdf-version*) -+ :asdf)[] | -+ -+@hbox(7.60416+2.43333)x433.62 -+.@glue(@leftskip) 28.90755 -+.@hbox(0.0+0.0)x0.0 -+.@penalty 10000 -+.@glue 5.7 -\ No newline at end of file ---- /dev/null -+++ cl-asdf-3.0.0/doc/asdf.html -@@ -0,0 +1,4384 @@ -+<html lang="en"> -+<head> -+<title>ASDF Manual</title> -+<meta http-equiv="Content-Type" content="text/html"> -+<meta name="description" content="ASDF Manual"> -+<meta name="generator" content="makeinfo 4.13"> -+<link title="Top" rel="top" href="#Top"> -+<link href="http://www.gnu.org/software/texinfo/" rel="generator-home" title="Texinfo Homepage"> -+<!-- -+This manual describes ASDF, a system definition facility -+for Common Lisp programs and libraries. -+ -+You can find the latest version of this manual at -+`http://common-lisp.net/project/asdf/asdf.html'. -+ -+ASDF Copyright (C) 2001-2013 Daniel Barlow and contributors. -+ -+This manual Copyright (C) 2001-2013 Daniel Barlow and contributors. -+ -+This manual revised (C) 2009-2013 Robert P. Goldman and Francois-Rene Rideau. -+ -+Permission is hereby granted, free of charge, to any person obtaining -+a copy of this software and associated documentation files (the -+"Software"), to deal in the Software without restriction, including -+without limitation the rights to use, copy, modify, merge, publish, -+distribute, sublicense, and/or sell copies of the Software, and to -+permit persons to whom the Software is furnished to do so, subject to -+the following conditions: -+ -+The above copyright notice and this permission notice shall be -+included in all copies or substantial portions of the Software. -+ -+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND -+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE -+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION -+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION -+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.--> -+<meta http-equiv="Content-Style-Type" content="text/css"> -+<style type="text/css"><!-- -+ pre.display { font-family:inherit } -+ pre.format { font-family:inherit } -+ pre.smalldisplay { font-family:inherit; font-size:smaller } -+ pre.smallformat { font-family:inherit; font-size:smaller } -+ pre.smallexample { font-size:smaller } -+ pre.smalllisp { font-size:smaller } -+ span.sc { font-variant:small-caps } -+ span.roman { font-family:serif; font-weight:normal; } -+ span.sansserif { font-family:sans-serif; font-weight:normal; } -+--></style> -+</head> -+<body> -+<h1 class="settitle">ASDF Manual</h1> -+ <div class="contents"> -+<h2>Table of Contents</h2> -+<ul> -+<li><a name="toc_Top" href="#Top">asdf: another system definition facility</a> -+<li><a name="toc_Introduction" href="#Introduction">1 Introduction</a> -+<li><a name="toc_Loading-ASDF" href="#Loading-ASDF">2 Loading ASDF</a> -+<ul> -+<li><a href="#Loading-ASDF">2.1 Loading a pre-installed ASDF</a> -+<li><a href="#Loading-ASDF">2.2 Checking whether ASDF is loaded</a> -+<li><a href="#Loading-ASDF">2.3 Upgrading ASDF</a> -+<li><a href="#Loading-ASDF">2.4 Loading an otherwise installed ASDF</a> -+</li></ul> -+<li><a name="toc_Configuring-ASDF" href="#Configuring-ASDF">3 Configuring ASDF</a> -+<ul> -+<li><a href="#Configuring-ASDF">3.1 Configuring ASDF to find your systems</a> -+<li><a href="#Configuring-ASDF">3.2 Configuring ASDF to find your systems — old style</a> -+<li><a href="#Configuring-ASDF">3.3 Configuring where ASDF stores object files</a> -+<li><a href="#Using-ASDF">3.4 Resetting Configuration</a> -+</li></ul> -+<li><a name="toc_Using-ASDF" href="#Using-ASDF">4 Using ASDF</a> -+<ul> -+<li><a href="#Using-ASDF">4.1 Loading a system</a> -+<li><a href="#Using-ASDF">4.2 Other Operations</a> -+<li><a href="#Using-ASDF">4.3 Summary</a> -+<li><a href="#Using-ASDF">4.4 Moving on</a> -+</li></ul> -+<li><a name="toc_Defining-systems-with-defsystem" href="#Defining-systems-with-defsystem">5 Defining systems with defsystem</a> -+<ul> -+<li><a href="#The-defsystem-form">5.1 The defsystem form</a> -+<li><a href="#A-more-involved-example">5.2 A more involved example</a> -+<li><a href="#The-defsystem-grammar">5.3 The defsystem grammar</a> -+<ul> -+<li><a href="#The-defsystem-grammar">5.3.1 Component names</a> -+<li><a href="#The-defsystem-grammar">5.3.2 Component types</a> -+<li><a href="#The-defsystem-grammar">5.3.3 System class names</a> -+<li><a href="#The-defsystem-grammar">5.3.4 Defsystem depends on</a> -+<li><a href="#The-defsystem-grammar">5.3.5 Weakly depends on</a> -+<li><a href="#The-defsystem-grammar">5.3.6 Pathname specifiers</a> -+<li><a href="#The-defsystem-grammar">5.3.7 Version specifiers</a> -+<li><a href="#The-defsystem-grammar">5.3.8 Using logical pathnames</a> -+<li><a href="#The-defsystem-grammar">5.3.9 Serial dependencies</a> -+<li><a href="#The-defsystem-grammar">5.3.10 Source location</a> -+<li><a href="#The-defsystem-grammar">5.3.11 if-feature option</a> -+<li><a href="#The-defsystem-grammar">5.3.12 if-component-dep-fails option</a> -+</li></ul> -+<li><a href="#Other-code-in-_002easd-files">5.4 Other code in .asd files</a> -+</li></ul> -+<li><a name="toc_The-object-model-of-ASDF" href="#The-object-model-of-ASDF">6 The object model of ASDF</a> -+<ul> -+<li><a href="#Operations">6.1 Operations</a> -+<ul> -+<li><a href="#Predefined-operations-of-ASDF">6.1.1 Predefined operations of ASDF</a> -+<li><a href="#Creating-new-operations">6.1.2 Creating new operations</a> -+</li></ul> -+<li><a href="#Components">6.2 Components</a> -+<ul> -+<li><a href="#Common-attributes-of-components">6.2.1 Common attributes of components</a> -+<ul> -+<li><a href="#Common-attributes-of-components">6.2.1.1 Name</a> -+<li><a href="#Common-attributes-of-components">6.2.1.2 Version identifier</a> -+<li><a href="#Common-attributes-of-components">6.2.1.3 Required features</a> -+<li><a href="#Common-attributes-of-components">6.2.1.4 Dependencies</a> -+<li><a href="#Common-attributes-of-components">6.2.1.5 pathname</a> -+<li><a href="#Common-attributes-of-components">6.2.1.6 properties</a> -+</li></ul> -+<li><a href="#Pre_002ddefined-subclasses-of-component">6.2.2 Pre-defined subclasses of component</a> -+<li><a href="#Creating-new-component-types">6.2.3 Creating new component types</a> -+</li></ul> -+<li><a href="#Functions">6.3 Functions</a> -+</li></ul> -+<li><a name="toc_Controlling-where-ASDF-searches-for-systems" href="#Controlling-where-ASDF-searches-for-systems">7 Controlling where ASDF searches for systems</a> -+<ul> -+<li><a href="#Controlling-where-ASDF-searches-for-systems">7.1 Configurations</a> -+<li><a href="#Controlling-where-ASDF-searches-for-systems">7.2 Truenames and other dangers</a> -+<li><a href="#Controlling-where-ASDF-searches-for-systems">7.3 XDG base directory</a> -+<li><a href="#Controlling-where-ASDF-searches-for-systems">7.4 Backward Compatibility</a> -+<li><a href="#Controlling-where-ASDF-searches-for-systems">7.5 Configuration DSL</a> -+<li><a href="#Controlling-where-ASDF-searches-for-systems">7.6 Configuration Directories</a> -+<ul> -+<li><a href="#Controlling-where-ASDF-searches-for-systems">7.6.1 The :here directive</a> -+</li></ul> -+<li><a href="#Controlling-where-ASDF-searches-for-systems">7.7 Shell-friendly syntax for configuration</a> -+<li><a href="#Controlling-where-ASDF-searches-for-systems">7.8 Search Algorithm</a> -+<li><a href="#Controlling-where-ASDF-searches-for-systems">7.9 Caching Results</a> -+<li><a href="#Controlling-where-ASDF-searches-for-systems">7.10 Configuration API</a> -+<li><a href="#Controlling-where-ASDF-searches-for-systems">7.11 Status</a> -+<li><a href="#Controlling-where-ASDF-searches-for-systems">7.12 Rejected ideas</a> -+<li><a href="#Controlling-where-ASDF-searches-for-systems">7.13 TODO</a> -+<li><a href="#Controlling-where-ASDF-searches-for-systems">7.14 Credits for the source-registry</a> -+</li></ul> -+<li><a name="toc_Controlling-where-ASDF-saves-compiled-files" href="#Controlling-where-ASDF-saves-compiled-files">8 Controlling where ASDF saves compiled files</a> -+<ul> -+<li><a href="#Controlling-where-ASDF-saves-compiled-files">8.1 Configurations</a> -+<li><a href="#Controlling-where-ASDF-saves-compiled-files">8.2 Backward Compatibility</a> -+<li><a href="#Controlling-where-ASDF-saves-compiled-files">8.3 Configuration DSL</a> -+<li><a href="#Controlling-where-ASDF-saves-compiled-files">8.4 Configuration Directories</a> -+<li><a href="#Controlling-where-ASDF-saves-compiled-files">8.5 Shell-friendly syntax for configuration</a> -+<li><a href="#Controlling-where-ASDF-saves-compiled-files">8.6 Semantics of Output Translations</a> -+<li><a href="#Controlling-where-ASDF-saves-compiled-files">8.7 Caching Results</a> -+<li><a href="#Controlling-where-ASDF-saves-compiled-files">8.8 Output location API</a> -+<li><a href="#Controlling-where-ASDF-saves-compiled-files">8.9 Credits for output translations</a> -+</li></ul> -+<li><a name="toc_Error-handling" href="#Error-handling">9 Error handling</a> -+<ul> -+<li><a href="#Error-handling">9.1 ASDF errors</a> -+<li><a href="#Error-handling">9.2 Compilation error and warning handling</a> -+</li></ul> -+<li><a name="toc_Miscellaneous-additional-functionality" href="#Miscellaneous-additional-functionality">10 Miscellaneous additional functionality</a> -+<ul> -+<li><a href="#Miscellaneous-additional-functionality">10.1 Controlling file compilation</a> -+<li><a href="#Miscellaneous-additional-functionality">10.2 Controlling source file character encoding</a> -+<li><a href="#Miscellaneous-additional-functionality">10.3 Miscellaneous Functions</a> -+</li></ul> -+<li><a name="toc_Getting-the-latest-version" href="#Getting-the-latest-version">11 Getting the latest version</a> -+<li><a name="toc_FAQ" href="#FAQ">12 FAQ</a> -+<ul> -+<li><a href="#FAQ">12.1 “Where do I report a bug?”</a> -+<li><a href="#FAQ">12.2 “What has changed between ASDF 1 and ASDF 2?”</a> -+<ul> -+<li><a href="#FAQ">12.2.1 What are ASDF 1 and ASDF 2?</a> -+<li><a href="#FAQ">12.2.2 ASDF can portably name files in subdirectories</a> -+<li><a href="#FAQ">12.2.3 Output translations</a> -+<li><a href="#FAQ">12.2.4 Source Registry Configuration</a> -+<li><a href="#FAQ">12.2.5 Usual operations are made easier to the user</a> -+<li><a href="#FAQ">12.2.6 Many bugs have been fixed</a> -+<li><a href="#FAQ">12.2.7 ASDF itself is versioned</a> -+<li><a href="#FAQ">12.2.8 ASDF can be upgraded</a> -+<li><a href="#FAQ">12.2.9 Decoupled release cycle</a> -+<li><a href="#FAQ">12.2.10 Pitfalls of the transition to ASDF 2</a> -+</li></ul> -+<li><a href="#FAQ">12.3 Issues with installing the proper version of ASDF</a> -+<ul> -+<li><a href="#FAQ">12.3.1 “My Common Lisp implementation comes with an outdated version of ASDF. What to do?”</a> -+<li><a href="#FAQ">12.3.2 “I'm a Common Lisp implementation vendor. When and how should I upgrade ASDF?”</a> -+</li></ul> -+<li><a href="#FAQ">12.4 Issues with configuring ASDF</a> -+<ul> -+<li><a href="#FAQ">12.4.1 “How can I customize where fasl files are stored?”</a> -+<li><a href="#FAQ">12.4.2 “How can I wholly disable the compiler output cache?”</a> -+</li></ul> -+<li><a href="#FAQ">12.5 Issues with using and extending ASDF to define systems</a> -+<ul> -+<li><a href="#FAQ">12.5.1 “How can I cater for unit-testing in my system?”</a> -+<li><a href="#FAQ">12.5.2 “How can I cater for documentation generation in my system?”</a> -+<li><a href="#FAQ">12.5.3 “How can I maintain non-Lisp (e.g. C) source files?”</a> -+<li><a href="#FAQ">12.5.4 “I want to put my module's files at the top level. How do I do this?”</a> -+<li><a href="#FAQ">12.5.5 How do I create a system definition where all the source files have a .cl extension?</a> -+</li></ul> -+</li></ul> -+<li><a name="toc_TODO-list" href="#TODO-list">13 TODO list</a> -+<ul> -+<li><a href="#TODO-list">13.1 Outstanding spec questions, things to add</a> -+<li><a href="#TODO-list">13.2 Missing bits in implementation</a> -+</li></ul> -+<li><a name="toc_Inspiration" href="#Inspiration">14 Inspiration</a> -+<ul> -+<li><a href="#Inspiration">14.1 mk-defsystem (defsystem-3.x)</a> -+<li><a href="#Inspiration">14.2 defsystem-4 proposal</a> -+<li><a href="#Inspiration">14.3 kmp's “The Description of Large Systems”, MIT AI Memo 801</a> -+</li></ul> -+<li><a name="toc_Concept-Index" href="#Concept-Index">Concept Index</a> -+<li><a name="toc_Function-and-Class-Index" href="#Function-and-Class-Index">Function and Class Index</a> -+<li><a name="toc_Variable-Index" href="#Variable-Index">Variable Index</a> -+</li></ul> -+</div> -+ -+ -+ -+<!-- --> -+<p><a name="Top"></a> -+ -+<h2 class="unnumbered">asdf: another system definition facility</h2> -+ -+<p>This manual describes ASDF, a system definition facility -+for Common Lisp programs and libraries. -+ -+ <p>You can find the latest version of this manual at -+<a href="http://common-lisp.net/project/asdf/asdf.html">http://common-lisp.net/project/asdf/asdf.html</a>. -+ -+ <p>ASDF Copyright © 2001-2013 Daniel Barlow and contributors. -+ -+ <p>This manual Copyright © 2001-2013 Daniel Barlow and contributors. -+ -+ <p>This manual revised © 2009-2013 Robert P. Goldman and Francois-Rene Rideau. -+ -+ <p>Permission is hereby granted, free of charge, to any person obtaining -+a copy of this software and associated documentation files (the -+“Software”), to deal in the Software without restriction, including -+without limitation the rights to use, copy, modify, merge, publish, -+distribute, sublicense, and/or sell copies of the Software, and to -+permit persons to whom the Software is furnished to do so, subject to -+the following conditions: -+ -+ <p>The above copyright notice and this permission notice shall be -+included in all copies or substantial portions of the Software. -+ -+ <p>THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, -+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND -+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE -+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION -+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION -+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -+ -+<!-- --> -+<p><a name="Introduction"></a> -+ -+<!-- node-name, next, previous, up --> -+<h2 class="chapter">1 Introduction</h2> -+ -+<p><a name="index-ASDF_002drelated-features-1"></a><a name="index-g_t_002afeatures_002a-2"></a><a name="index-Testing-for-ASDF-3"></a><a name="index-ASDF-versions-4"></a><a name="index-g_t_003aasdf-5"></a><a name="index-g_t_003aasdf2-6"></a><a name="index-g_t_003aasdf3-7"></a> -+ASDF is Another System Definition Facility: -+a tool for specifying how systems of Common Lisp software -+are comprised of components (sub-systems and files), -+and how to operate on these components in the right order -+so that they can be compiled, loaded, tested, etc. -+ -+ <p>ASDF presents three faces: -+one for users of Common Lisp software who want to reuse other people's code, -+one for writers of Common Lisp software who want to specify how to build their systems, -+one for implementers of Common Lisp extensions who want to extend the build system. -+See <a href="#Using-ASDF">Loading a system</a>, -+to learn how to use ASDF to load a system. -+See <a href="#Defining-systems-with-defsystem">Defining systems with defsystem</a>, -+to learn how to define a system of your own. -+See <a href="#The-object-model-of-ASDF">The object model of ASDF</a>, for a description of -+the ASDF internals and how to extend ASDF. -+ -+ <p><em>Nota Bene</em>: -+We have released ASDF 2.000 on May 31st 2010, -+and ASDF 3.0 on January 31st 2013. -+Releases of ASDF 2 and later have since then been included -+in all actively maintained CL implementations that used to bundle ASDF 1, -+plus some implementations that didn't use to, -+and has been made to work with all actively used CL implementations and a few more. -+See <a href="#FAQ">“What has changed between ASDF 1 and ASDF 2?”</a>. -+Furthermore, it is possible to upgrade from ASDF 1 to ASDF 2 or ASDF 3 on the fly. -+For this reason, we have stopped supporting ASDF 1 and ASDF 2. -+If you are using ASDF 1 or ASDF 2 and are experiencing any kind of issues or limitations, -+we recommend you upgrade to ASDF 3 -+— and we explain how to do that. See <a href="#Loading-ASDF">Loading ASDF</a>. -+ -+ <p>Also note that ASDF is not to be confused with ASDF-Install. -+ASDF-Install is not part of ASDF, but a separate piece of software. -+ASDF-Install is also unmaintained and obsolete. -+We recommend you use Quicklisp instead, -+which works great and is being actively maintained. -+If you want to download software from version control instead of tarballs, -+so you may more easily modify it, we recommend clbuild. -+ -+<p><a name="Loading-ASDF"></a> -+ -+<!-- node-name, next, previous, up --> -+<h2 class="chapter">2 Loading ASDF</h2> -+ -+<p><a name="index-g_t_002acentral_002dregistry_002a-8"></a><a name="index-link-farm-9"></a><a name="index-load_002dsystem-10"></a><a name="index-require_002dsystem-11"></a><a name="index-compile_002dsystem-12"></a><a name="index-test_002dsystem-13"></a><a name="index-system-directory-designator-14"></a><a name="index-operate-15"></a><a name="index-oos-16"></a> -+<!-- @menu --> -+<!-- * Installing ASDF:: --> -+<!-- @end menu --> -+ -+<h3 class="section">2.1 Loading a pre-installed ASDF</h3> -+ -+<p>Most recent Lisp implementations include a copy of ASDF 2, and soon ASDF 3. -+You can usually load this copy using Common Lisp's <code>require</code> function: -+ -+<pre class="lisp"> (require "asdf") -+</pre> -+ <p>As of the writing of this manual, -+the following implementations provide ASDF 2 this way: -+abcl allegro ccl clisp cmucl ecl lispworks mkcl sbcl xcl. -+The following implementation doesn't provide it yet but will in an upcoming release: -+scl. -+The following implementations are obsolete, not actively maintained, -+and most probably will never bundle it: -+cormanlisp gcl genera mcl. -+ -+ <p>If the implementation you are using doesn't provide ASDF 2 or ASDF 3, -+see see <a href="#Loading-ASDF">Loading an otherwise installed ASDF</a> below. -+If that implementation is still actively maintained, -+you may also send a bug report to your Lisp vendor and complain -+about their failing to provide ASDF. -+ -+ <p>NB: all implementations except clisp also accept -+<code>(require "ASDF")</code>, <code>(require 'asdf)</code> and <code>(require :asdf)</code>. -+For portability's sake, you probably want to use <code>(require "asdf")</code>. -+ -+<h3 class="section">2.2 Checking whether ASDF is loaded</h3> -+ -+<p>To check whether ASDF is properly loaded in your current Lisp image, -+you can run this form: -+ -+<pre class="lisp"> (asdf:asdf-version) -+</pre> -+ <p>If it returns a string, -+that is the version of ASDF that is currently installed. -+ -+ <p>If it raises an error, -+then either ASDF is not loaded, or -+you are using an old version of ASDF. -+ -+ <p>You can check whether an old version is loaded -+by checking if the ASDF package is present. -+The form below will allow you to programmatically determine -+whether a recent version is loaded, an old version is loaded, -+or none at all: -+ -+<pre class="lisp"> (when (find-package :asdf) -+ (let ((ver (symbol-value (or (find-symbol (string :*asdf-version*) :asdf) -+ (find-symbol (string :*asdf-revision*) :asdf))))) -+ (etypecase ver -+ (string ver) -+ (cons (with-output-to-string (s) -+ (loop for (n . m) on ver do (princ n s) (when m (princ "." s))))) -+ (null "1.0")))) -+</pre> -+ <p>If it returns <code>NIL</code> then ASDF is not installed. -+Otherwise it should return a string. -+If it returns <code>"1.0"</code>, then it can actually be -+any version before 1.77 or so, or some buggy variant of 1.x. -+ -+ <p>If you are experiencing problems with ASDF, -+please try upgrading to the latest released version, -+using the method below, -+before you contact us and raise an issue. -+ -+<h3 class="section">2.3 Upgrading ASDF</h3> -+ -+<p>If your implementation provides ASDF 3 or later, -+you only need to <code>(require "asdf")</code>: -+ASDF will automatically look whether an updated version of itself is available -+amongst the regularly configured systems, before it compiles anything else. -+See see <a href="#Configuring-ASDF">Configuring ASDF</a> below. -+ -+ <p>If your implementation does provide ASDF 2 or later, -+but not ASDF 3 or later, -+and you want to upgrade to a more recent version, -+you need to install and configure your ASDF as above, -+and additionally, you need to explicitly tell ASDF to load itself, -+right after you require your implementation's old ASDF 2: -+ -+<pre class="lisp"> (require "asdf") -+ (asdf:load-system :asdf) -+</pre> -+ <p>If on the other hand, your implementation only provides an old ASDF, -+you will require a special configuration step and an old-style loading. -+Take special attention to not omit the trailing directory separator -+<code>/</code> at the end of your pathname: -+ -+<pre class="lisp"> (require "asdf") -+ (push #p"<var>/path/to/new/asdf/</var>" asdf:*central-registry*) -+ (asdf:oos 'asdf:load-op :asdf) -+</pre> -+ <p>Note that ASDF 1 won't redirect its output files, -+or at least won't do it according to your usual ASDF 2 configuration. -+You therefore need write access on the directory -+where you install the new ASDF, -+and make sure you're not using it -+for multiple mutually incompatible implementations. -+At worst, you may have to have multiple copies of the new ASDF, -+e.g. one per implementation installation, to avoid clashes. -+Note that to our knowledge all implementations that provide ASDF -+provide ASDF 2 in their latest release, so -+you may want to upgrade your implementation rather than go through that hoop. -+ -+ <p>Finally, if you are using an unmaintained implementation -+that does not provide ASDF at all, -+see see <a href="#Loading-ASDF">Loading an otherwise installed ASDF</a> below. -+ -+ <p>Note that there are some limitations to upgrading ASDF: -+ <ul> -+<li>Previously loaded ASDF extension becomes invalid, and will need to be reloaded. -+This applies to e.g. CFFI-Grovel, or to hacks used by ironclad, etc. -+Since it isn't possible to automatically detect what extensions are present -+that need to be invalidated, -+ASDF will actually invalidate all previously loaded systems -+when it is loaded on top of a different ASDF version, -+starting with ASDF 2.014.8 (as far as releases go, 2.015); -+and it will automatically attempt this self-upgrade as its very first step -+starting with ASDF 3. -+ -+ <li>For this an many other reasons, -+it important reason to load, configure and upgrade ASDF (if needed) -+as one of the very first things done by your build and startup scripts. -+Until all implementations provide ASDF 3 or later, -+it is safer if you upgrade ASDF and its extensions as a special step -+at the very beginning of whatever script you are running, -+before you start using ASDF to load anything else; -+even afterwards, it is still a good idea, to avoid having to -+load and reload code twice as it gets invalidated. -+ -+ <li>Until all implementations provide ASDF 3 or later, -+it is unsafe to upgrade ASDF as part of loading a system -+that depends on a more recent version of ASDF, -+since the new one might shadow the old one while the old one is running, -+and the running old one will be confused -+when extensions are loaded into the new one. -+In the meantime, we recommend that your systems should <em>not</em> specify -+<code>:depends-on (:asdf)</code>, or <code>:depends-on ((:version :asdf "2.010"))</code>, -+but instead that they check that a recent enough ASDF is installed, -+with such code as: -+ <pre class="example"> (unless (or #+asdf2 (asdf:version-satisfies -+ (asdf:asdf-version) *required-asdf-version*)) -+ (error "FOO requires ASDF ~A or later." *required-asdf-version*)) -+</pre> -+ <li>Until all implementations provide ASDF 3 or later, -+it is unsafe for a system to transitively depend on ASDF -+and not directly depend on ASDF; -+if any of the system you use either depends-on asdf, -+system-depends-on asdf, or transitively does, -+you should also do as well. -+</ul> -+ -+<h3 class="section">2.4 Loading an otherwise installed ASDF</h3> -+ -+<p>If your implementation doesn't include ASDF, -+if for some reason the upgrade somehow fails, -+does not or cannot apply to your case, -+you will have to install the file <samp><span class="file">asdf.lisp</span></samp> -+somewhere and load it with: -+ -+<pre class="lisp"> (load "/path/to/your/installed/asdf.lisp") -+</pre> -+ <p>The single file <samp><span class="file">asdf.lisp</span></samp> is all you normally need to use ASDF. -+ -+ <p>You can extract this file from latest release tarball on the -+<a href="http://common-lisp.net/project/asdf/">ASDF website</a>. -+If you are daring and willing to report bugs, you can get -+the latest and greatest version of ASDF from its git repository. -+See <a href="#Getting-the-latest-version">Getting the latest version</a>. -+ -+ <p>For maximum convenience you might want to have ASDF loaded -+whenever you start your Lisp implementation, -+for example by loading it from the startup script or dumping a custom core -+— check your Lisp implementation's manual for details. -+ -+<p><a name="Configuring-ASDF"></a> -+ -+<!-- node-name, next, previous, up --> -+<h2 class="chapter">3 Configuring ASDF</h2> -+ -+<h3 class="section">3.1 Configuring ASDF to find your systems</h3> -+ -+<p>So it may compile and load your systems, ASDF must be configured to find -+the <samp><span class="file">.asd</span></samp> files that contain system definitions. -+ -+ <p>Since ASDF 2, the preferred way to configure where ASDF finds your systems is -+the <code>source-registry</code> facility, -+fully described in its own chapter of this manual. -+See <a href="#Controlling-where-ASDF-searches-for-systems">Controlling where ASDF searches for systems</a>. -+ -+ <p>The default location for a user to install Common Lisp software is under -+<samp><span class="file">~/.local/share/common-lisp/source/</span></samp>. -+If you install software there (it can be a symlink), -+you don't need further configuration. -+If you're installing software yourself at a location that isn't standard, -+you have to tell ASDF where you installed it. See below. -+If you're using some tool to install software (e.g. Quicklisp), -+the authors of that tool should already have configured ASDF. -+ -+ <p>The simplest way to add a path to your search path, -+say <samp><span class="file">/home/luser/.asd-link-farm/</span></samp> -+is to create the directory -+<samp><span class="file">~/.config/common-lisp/source-registry.conf.d/</span></samp> -+and there create a file with any name of your choice, -+and with the type <samp><span class="file">conf</span></samp>, -+for instance <samp><span class="file">42-asd-link-farm.conf</span></samp> -+containing the line: -+ -+ <p><kbd>(:directory "/home/luser/.asd-link-farm/")</kbd> -+ -+ <p>If you want all the subdirectories under <samp><span class="file">/home/luser/lisp/</span></samp> -+to be recursively scanned for <samp><span class="file">.asd</span></samp> files, instead use: -+ -+ <p><kbd>(:tree "/home/luser/lisp/")</kbd> -+ -+ <p>Note that your Operating System distribution or your system administrator -+may already have configured system-managed libraries for you. -+ -+ <p>The required <samp><span class="file">.conf</span></samp> extension allows you to have disabled files -+or editor backups (ending in <samp><span class="file">~</span></samp>), and works portably -+(for instance, it is a pain to allow both empty and non-empty extension on CLISP). -+Excluded are files the name of which start with a <samp><span class="file">.</span></samp> character. -+It is customary to start the filename with two digits -+that specify the order in which the directories will be scanned. -+ -+ <p>ASDF will automatically read your configuration -+the first time you try to find a system. -+You can reset the source-registry configuration with: -+ -+<pre class="lisp"> (asdf:clear-source-registry) -+</pre> -+ <p>And you probably should do so before you dump your Lisp image, -+if the configuration may change -+between the machine where you save it at the time you save it -+and the machine you resume it at the time you resume it. -+Actually, you should use <code>(asdf:clear-configuration)</code> -+before you dump your Lisp image, which includes the above. -+ -+<h3 class="section">3.2 Configuring ASDF to find your systems — old style</h3> -+ -+<p>The old way to configure ASDF to find your systems is by -+<code>push</code>ing directory pathnames onto the variable -+<code>asdf:*central-registry*</code>. -+ -+ <p>You must configure this variable between the time you load ASDF -+and the time you first try to use it. -+Loading and configuring ASDF presumably happen -+as part of some initialization script that builds or starts -+your Common Lisp software system. -+(For instance, some SBCL users used to put it in their <samp><span class="file">~/.sbclrc</span></samp>.) -+ -+ <p>The <code>asdf:*central-registry*</code> is empty by default in ASDF 2 or ASDF 3, -+but is still supported for compatibility with ASDF 1. -+When used, it takes precedence over the above source-registry<a rel="footnote" href="#fn-1" name="fnd-1"><sup>1</sup></a>. -+ -+ <p>For instance, if you wanted ASDF to find the <samp><span class="file">.asd</span></samp> file -+<samp><span class="file">/home/me/src/foo/foo.asd</span></samp> your initialization script -+could after it loads ASDF with <code>(require "asdf")</code> -+configure it with: -+ -+<pre class="lisp"> (push "/home/me/src/foo/" asdf:*central-registry*) -+</pre> -+ <p>Note the trailing slash: when searching for a system, -+ASDF will evaluate each entry of the central registry -+and coerce the result to a pathname<a rel="footnote" href="#fn-2" name="fnd-2"><sup>2</sup></a> -+at which point the presence of the trailing directory name separator -+is necessary to tell Lisp that you're discussing a directory -+rather than a file. -+ -+ <p>Typically, however, there are a lot of <samp><span class="file">.asd</span></samp> files, and -+a common idiom was to have to put -+a bunch of <em>symbolic links</em> to <samp><span class="file">.asd</span></samp> files -+in a common directory -+and push <em>that</em> directory (the “link farm”) -+to the -+<code>asdf:*central-registry*</code> -+instead of pushing each of the many involved directories -+to the <code>asdf:*central-registry*</code>. -+ASDF knows how to follow such <em>symlinks</em> -+to the actual file location when resolving the paths of system components -+(on Windows, you can use Windows shortcuts instead of POSIX symlinks; -+if you try aliases under MacOS, we are curious to hear about your experience). -+ -+ <p>For example, if <code>#p"/home/me/cl/systems/"</code> (note the trailing slash) -+is a member of <code>*central-registry*</code>, you could set up the -+system <var>foo</var> for loading with asdf with the following -+commands at the shell: -+ -+<pre class="example"> $ cd /home/me/cl/systems/ -+ $ ln -s ~/src/foo/foo.asd . -+</pre> -+ <p>This old style for configuring ASDF is not recommended for new users, -+but it is supported for old users, and for users who want to programmatically -+control what directories are added to the ASDF search path. -+ -+<h3 class="section">3.3 Configuring where ASDF stores object files</h3> -+ -+<p><a name="index-clear_002doutput_002dtranslations-17"></a> -+ASDF lets you configure where object files will be stored. -+Sensible defaults are provided and -+you shouldn't normally have to worry about it. -+ -+ <p>This allows the same source code repository may be shared -+between several versions of several Common Lisp implementations, -+between several users using different compilation options -+and without write privileges on shared source directories, etc. -+This also allows to keep source directories uncluttered -+by plenty of object files. -+ -+ <p>Starting with ASDF 2, the <code>asdf-output-translations</code> facility -+was added to ASDF itself, that controls where object files will be stored. -+This facility is fully described in a chapter of this manual, -+<a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a>. -+ -+ <p>The simplest way to add a translation to your search path, -+say from <samp><span class="file">/foo/bar/baz/quux/</span></samp> -+to <samp><span class="file">/where/i/want/my/fasls/</span></samp> -+is to create the directory -+<samp><span class="file">~/.config/common-lisp/asdf-output-translations.conf.d/</span></samp> -+and there create a file with any name of your choice and the type <samp><span class="file">conf</span></samp>, -+for instance <samp><span class="file">42-bazquux.conf</span></samp> -+containing the line: -+ -+ <p><kbd>("/foo/bar/baz/quux/" "/where/i/want/my/fasls/")</kbd> -+ -+ <p>To disable output translations for source under a given directory, -+say <samp><span class="file">/toto/tata/</span></samp> -+you can create a file <samp><span class="file">40-disable-toto.conf</span></samp> -+with the line: -+ -+ <p><kbd>("/toto/tata/")</kbd> -+ -+ <p>To wholly disable output translations for all directories, -+you can create a file <samp><span class="file">00-disable.conf</span></samp> -+with the line: -+ -+ <p><kbd>(t t)</kbd> -+ -+ <p>Note that your Operating System distribution or your system administrator -+may already have configured translations for you. -+In absence of any configuration, the default is to redirect everything -+under an implementation-dependent subdirectory of <samp><span class="file">~/.cache/common-lisp/</span></samp>. -+See <a href="#Controlling-where-ASDF-searches-for-systems">Controlling where ASDF searches for systems</a>, for full details. -+ -+ <p>The required <samp><span class="file">.conf</span></samp> extension allows you to have disabled files -+or editor backups (ending in <samp><span class="file">~</span></samp>), and works portably -+(for instance, it is a pain to allow both empty and non-empty extension on CLISP). -+Excluded are files the name of which start with a <samp><span class="file">.</span></samp> character. -+It is customary to start the filename with two digits -+that specify the order in which the directories will be scanned. -+ -+ <p>ASDF will automatically read your configuration -+the first time you try to find a system. -+You can reset the source-registry configuration with: -+ -+<pre class="lisp"> (asdf:clear-output-translations) -+</pre> -+ <p>And you probably should do so before you dump your Lisp image, -+if the configuration may change -+between the machine where you save it at the time you save it -+and the machine you resume it at the time you resume it. -+(Once again, you should use <code>(asdf:clear-configuration)</code> -+before you dump your Lisp image, which includes the above.) -+ -+ <p>Finally note that before ASDF 2, -+other ASDF add-ons offered the same functionality, -+each in subtly different and incompatible ways: -+ASDF-Binary-Locations, cl-launch, common-lisp-controller. -+ASDF-Binary-Locations is now not needed anymore and should not be used. -+cl-launch 3.000 and common-lisp-controller 7.2 have been updated -+to just delegate this functionality to ASDF. -+ -+<p><a name="Using-ASDF"></a> -+ -+<!-- node-name, next, previous, up --> -+<h3 class="section">3.4 Resetting Configuration</h3> -+ -+<p>When you dump and restore an image, or when you tweak your configuration, -+you may want to reset the ASDF configuration. -+For that you may use the following function: -+ -+<div class="defun"> -+— Function: <b>clear-configuration</b><var><a name="index-clear_002dconfiguration-18"></a></var><br> -+<blockquote><p> undoes any ASDF configuration, -+ regarding source-registry or output-translations. -+</p></blockquote></div> -+ -+ <p>If you use SBCL, CMUCL or SCL, you may use this snippet -+so that the ASDF configuration be cleared automatically as you dump an image: -+ -+<pre class="example"> #+(or cmu sbcl scl) -+ (pushnew 'clear-configuration -+ #+(or cmu scl) ext:*before-save-initializations* -+ #+sbcl sb-ext:*save-hooks*) -+</pre> -+ <p>For compatibility with all Lisp implementations, however, -+you might want instead your build script to explicitly call -+<code>(asdf:clear-configuration)</code> at an appropriate moment before dumping. -+ -+<h2 class="chapter">4 Using ASDF</h2> -+ -+<h3 class="section">4.1 Loading a system</h3> -+ -+<p>The system <var>foo</var> is loaded (and compiled, if necessary) -+by evaluating the following Lisp form: -+ -+<pre class="example"> (asdf:load-system :<var>foo</var>) -+</pre> -+ <p>On some implementations (namely recent versions of -+ABCL, Allegro CL, Clozure CL, CMUCL, ECL, GNU CLISP, -+LispWorks, MKCL, SBCL and XCL), -+ASDF hooks into the <code>CL:REQUIRE</code> facility -+and you can just use: -+ -+<pre class="example"> (require :<var>foo</var>) -+</pre> -+ <p>In older versions of ASDF, you needed to use -+<code>(asdf:oos 'asdf:load-op :</code><var>foo</var><code>)</code>. -+If your ASDF is too old to provide <code>asdf:load-system</code> though -+we recommend that you upgrade to ASDF 3. -+See <a href="#Loading-ASDF">Loading an otherwise installed ASDF</a>. -+ -+ <p>Note the name of a system is specified as a string or a symbol, -+typically a keyword. -+If a symbol (including a keyword), its name is taken and lowercased. -+The name must be a suitable value for the <code>:name</code> initarg -+to <code>make-pathname</code> in whatever filesystem the system is to be found. -+The lower-casing-symbols behaviour is unconventional, -+but was selected after some consideration. -+Observations suggest that the type of systems we want to support -+either have lowercase as customary case (unix, mac, windows) -+or silently convert lowercase to uppercase (lpns), -+so this makes more sense than attempting to use <code>:case :common</code>, -+which is reported not to work on some implementations -+ -+<h3 class="section">4.2 Other Operations</h3> -+ -+<p>ASDF provides three commands for the most common system operations: -+<code>load-system</code>, <code>compile-system</code> or <code>test-system</code>. -+It also provides <code>require-system</code>, a version of <code>load-system</code> -+that skips trying to update systems that are already loaded. -+ -+ <p>Because ASDF is an extensible system -+for defining <em>operations</em> on <em>components</em>, -+it also provides a generic function <code>operate</code> -+(which is usually abbreviated by <code>oos</code>). -+You'll use <code>oos</code> whenever you want to do something beyond -+compiling, loading and testing. -+ -+ <p>Output from ASDF and ASDF extensions are supposed to be sent -+to the CL stream <code>*standard-output*</code>, -+and so rebinding that stream around calls to <code>asdf:operate</code> -+should redirect all output from ASDF operations. -+ -+ <p>Reminder: before ASDF can operate on a system, however, -+it must be able to find and load that system's definition. -+See <a href="#Configuring-ASDF">Configuring ASDF to find your systems</a>. -+ -+ <p>For the advanced users, note that -+<code>require-system</code> calls <code>load-system</code> -+with keyword arguments <code>:force-not (loaded-systems)</code>. -+<code>loaded-systems</code> returns a list of the names of loaded systems. -+<code>load-system</code> applies <code>operate</code> with the operation from -+<code>*load-system-operation*</code>, which by default is <code>load-op</code>, -+the system, and any provided keyword arguments. -+ -+<h3 class="section">4.3 Summary</h3> -+ -+<p>To use ASDF: -+ -+ <ul> -+<li>Load ASDF itself into your Lisp image, either through -+<code>(require "asdf")</code> or else through -+<code>(load "/path/to/asdf.lisp")</code>. -+ -+ <li>Make sure ASDF can find system definitions -+thanks to proper source-registry configuration. -+ -+ <li>Load a system with <code>(asdf:load-system :my-system)</code> -+or use some other operation on some system of your choice. -+ -+ </ul> -+ -+<h3 class="section">4.4 Moving on</h3> -+ -+<p>That's all you need to know to use ASDF to load systems written by others. -+The rest of this manual deals with writing system definitions -+for Common Lisp software you write yourself, -+including how to extend ASDF to define new operation and component types. -+ -+<p><a name="Defining-systems-with-defsystem"></a> -+ -+<!-- node-name, next, previous, up --> -+<h2 class="chapter">5 Defining systems with defsystem</h2> -+ -+<p>This chapter describes how to use asdf to define systems and develop -+software. -+ -+<p><a name="The-defsystem-form"></a> -+ -+<!-- node-name, next, previous, up --> -+<h3 class="section">5.1 The defsystem form</h3> -+ -+<p>Systems can be constructed programmatically -+by instantiating components using <code>make-instance</code>. -+Most of the time, however, it is much more practical to use -+a static <code>defsystem</code> form. -+This section begins with an example of a system definition, -+then gives the full grammar of <code>defsystem</code>. -+ -+ <p>Let's look at a simple system. -+This is a complete file that would -+usually be saved as <samp><span class="file">hello-lisp.asd</span></samp>: -+ -+<pre class="lisp"> (in-package :asdf) -+ -+ (defsystem "hello-lisp" -+ :description "hello-lisp: a sample Lisp system." -+ :version "0.2.1" -+ :author "Joe User <joe@example.com>" -+ :licence "Public Domain" -+ :components ((:file "packages") -+ (:file "macros" :depends-on ("packages")) -+ (:file "hello" :depends-on ("macros")))) -+</pre> -+ <p>Some notes about this example: -+ -+ <ul> -+<li>The file starts with an <code>in-package</code> form -+to use package <code>asdf</code>. -+You could instead start your definition by using -+a qualified name <code>asdf:defsystem</code>. -+ -+ <li>If in addition to simply using <code>defsystem</code>, -+you are going to define functions, -+create ASDF extension, globally bind symbols, etc., -+it is recommended that to avoid namespace pollution between systems, -+you should create your own package for that purpose, -+for instance replacing the above <code>(in-package :asdf)</code> with: -+ -+ <pre class="lisp"> (defpackage :foo-system -+ (:use :cl :asdf)) -+ -+ (in-package :foo-system) -+</pre> -+ <li>The <code>defsystem</code> form defines a system named <code>hello-lisp</code> -+that contains three source files: -+<samp><span class="file">packages</span></samp>, <samp><span class="file">macros</span></samp> and <samp><span class="file">hello</span></samp>. -+ -+ <li>The file <samp><span class="file">macros</span></samp> depends on <samp><span class="file">packages</span></samp> -+(presumably because the package it's in is defined in <samp><span class="file">packages</span></samp>), -+and the file <samp><span class="file">hello</span></samp> depends on <samp><span class="file">macros</span></samp> -+(and hence, transitively on <samp><span class="file">packages</span></samp>). -+This means that ASDF will compile and load <samp><span class="file">packages</span></samp> and <samp><span class="file">macros</span></samp> -+before starting the compilation of file <samp><span class="file">hello</span></samp>. -+ -+ <li>The files are located in the same directory -+as the file with the system definition. -+ASDF resolves symbolic links (or Windows shortcuts) -+before loading the system definition file and -+stores its location in the resulting system<a rel="footnote" href="#fn-3" name="fnd-3"><sup>3</sup></a>. -+This is a good thing because the user can move the system sources -+without having to edit the system definition. -+ -+ <!-- FIXME: Should have cross-reference to "Version specifiers" in the --> -+ <!-- defsystem grammar, but the cross-referencing is so broken by --> -+ <!-- insufficient node breakdown that I have not put one in. --> -+ <li>Make sure you know how the <code>:version</code> numbers will be parsed! They -+are parsed as period-separated lists of integers. I.e., in the example, -+<code>0.2.1</code> is to be interpreted, roughly speaking, as <code>(0 2 1)</code>. -+In particular, version <code>0.2.1</code> is interpreted the same as -+<code>0.0002.1</code> and is strictly version-less-than version <code>0.20.1</code>, -+even though the two are the same when interpreted as decimal fractions. -+Instead of a string representing the version, -+the <code>:version</code> argument can be an expression that is resolved to -+such a string using the following trivial domain-specific language: -+in addition to being a literal string, it can be an expression of the form -+<code>(:read-file-form <pathname-or-string> :at <access-at-specifier>)</code>, -+which will be resolved by reading a form -+in the specified pathname -+(read as a subpathname of the current system if relative or a unix-namestring). -+You may use an access-at specifier with the (optional) :at keyword, -+by default the specifier is 0, meaning the first form is returned. -+ -+ <p><a name="index-g_t_003aversion-19"></a> -+</ul> -+ -+<p><a name="A-more-involved-example"></a> -+ -+<!-- node-name, next, previous, up --> -+<h3 class="section">5.2 A more involved example</h3> -+ -+<p>Let's illustrate some more involved uses of <code>defsystem</code> via a -+slightly convoluted example: -+ -+<pre class="lisp"> (defsystem "foo" -+ :version "1.0.0" -+ :components ((:module "mod" -+ :components ((:file "bar") -+ (:file"baz") -+ (:file "quux")) -+ :perform (compile-op :after (op c) -+ (do-something c)) -+ :explain (compile-op :after (op c) -+ (explain-something c))) -+ (:file "blah"))) -+</pre> -+ <p>The <code>:module</code> component named <code>"mod"</code> is a collection of three files, -+which will be located in a subdirectory of the main code directory named -+<samp><span class="file">mod</span></samp> (this location can be overridden; see the discussion of the -+<code>:pathname</code> option in <a href="#The-defsystem-grammar">The defsystem grammar</a>). -+ -+ <p>The method-form tokens provide a shorthand for defining methods on -+particular components. This part -+ -+<pre class="lisp"> :perform (compile-op :after (op c) -+ (do-something c)) -+ :explain (compile-op :after (op c) -+ (explain-something c)) -+</pre> -+ <p>has the effect of -+ -+<pre class="lisp"> (defmethod perform :after ((op compile-op) (c (eql ...))) -+ (do-something c)) -+ (defmethod explain :after ((op compile-op) (c (eql ...))) -+ (explain-something c)) -+</pre> -+ <p>where <code>...</code> is the component in question. -+In this case <code>...</code> would expand to something like -+ -+<pre class="lisp"> (find-component (find-system "foo") "mod") -+</pre> -+ <p>For more details on the syntax of such forms, see <a href="#The-defsystem-grammar">The defsystem grammar</a>. -+For more details on what these methods do, see <a href="#Operations">Operations</a> in -+<a href="#The-object-model-of-ASDF">The object model of ASDF</a>. -+ -+<!-- The following plunge into the weeds is not appropriate in this --> -+<!-- location. [2010/10/03:rpg] --> -+<!-- note that although this also supports @code{:before} methods, --> -+<!-- they may not do what you want them to - --> -+<!-- a @code{:before} method on perform @code{((op compile-op) (c (eql ...)))} --> -+<!-- will run after all the dependencies and sub-components have been processed, --> -+<!-- but before the component in question has been compiled. --> -+<p><a name="The-defsystem-grammar"></a> -+ -+<!-- node-name, next, previous, up --> -+<h3 class="section">5.3 The defsystem grammar</h3> -+ -+<!-- FIXME: @var typesetting not consistently used here. We should either expand --> -+<!-- its use to everywhere, or we should kill it everywhere. --> -+<pre class="example"> system-definition := ( defsystem system-designator <var>system-option</var>* ) -+ -+ system-option := :defsystem-depends-on system-list -+ | :weakly-depends-on <var>system-list</var> -+ | :class class-name (see discussion below) -+ | module-option -+ | option -+ -+ module-option := :components component-list -+ | :serial [ t | nil ] -+ -+ option := -+ | :pathname pathname-specifier -+ | :default-component-class class-name -+ | :perform method-form -+ | :explain method-form -+ | :output-files method-form -+ | :operation-done-p method-form -+ | :if-feature feature-expression -+ | :depends-on ( <var>dependency-def</var>* ) -+ | :in-order-to ( <var>dependency</var>+ ) -+ -+ -+ system-list := ( <var>simple-component-name</var>* ) -+ -+ component-list := ( <var>component-def</var>* ) -+ -+ component-def := ( component-type simple-component-name <var>option</var>* ) -+ -+ component-type := :module | :file | :static-file | other-component-type -+ -+ other-component-type := symbol-by-name (see <a href="#The-defsystem-grammar">Component types</a>) -+ -+ dependency-def := simple-component-name -+ | ( :feature name ) -+ | ( :version simple-component-name version-specifier) -+ -+ dependency := (dependent-op <var>requirement</var>+) -+ requirement := (required-op <var>required-component</var>+) -+ | (feature feature-name) -+ dependent-op := operation-name -+ required-op := operation-name | feature -+ -+ simple-component-name := string -+ | symbol -+ -+ pathname-specifier := pathname | string | symbol -+ -+ method-form := (operation-name qual lambda-list &rest body) -+ qual := method qualifier -+ -+ component-dep-fail-option := :fail | :try-next | :ignore -+ -+ feature-expression := keyword | (:and <var>feature-expression</var>*) -+ | (:or <var>feature-expression</var>*) | (:not <var>feature-expression</var>) -+</pre> -+<h4 class="subsection">5.3.1 Component names</h4> -+ -+<p>Component names (<code>simple-component-name</code>) -+may be either strings or symbols. -+ -+<h4 class="subsection">5.3.2 Component types</h4> -+ -+<p>Component type names, even if expressed as keywords, will be looked up -+by name in the current package and in the asdf package, if not found in -+the current package. So a component type <code>my-component-type</code>, in -+the current package <code>my-system-asd</code> can be specified as -+<code>:my-component-type</code>, or <code>my-component-type</code>. -+ -+ <p><code>system</code> and its subclasses are <em>not</em> -+allowed as component types for such children components. -+ -+<h4 class="subsection">5.3.3 System class names</h4> -+ -+<p>A system class name will be looked up -+in the same way as a Component type (see above), -+except that only <code>system</code> and its subclasses are allowed. -+Typically, one will not need to specify a system -+class name, unless using a non-standard system class defined in some -+ASDF extension, typically loaded through <code>DEFSYSTEM-DEPENDS-ON</code>, -+see below. For such class names in the ASDF package, we recommend that -+the <code>:class</code> option be specified using a keyword symbol, such as -+ -+<pre class="example"> :class :MY-NEW-SYSTEM-SUBCLASS -+</pre> -+ <p>This practice will ensure that package name conflicts are avoided. -+Otherwise, the symbol <code>MY-NEW-SYSTEM-SUBCLASS</code> will be read into -+the current package <em>before</em> it has been exported from the ASDF -+extension loaded by <code>:defsystem-depends-on</code>, causing a name -+conflict in the current package. -+ -+<h4 class="subsection">5.3.4 Defsystem depends on</h4> -+ -+<p><a name="index-g_t_003adefsystem_002ddepends_002don-20"></a> -+The <code>:defsystem-depends-on</code> option to <code>defsystem</code> allows the -+programmer to specify another ASDF-defined system or set of systems that -+must be loaded <em>before</em> the system definition is processed. -+Typically this is used to load an ASDF extension that is used in the -+system definition. -+ -+<h4 class="subsection">5.3.5 Weakly depends on</h4> -+ -+<p><a name="index-g_t_003aweakly_002ddepends_002don-21"></a> -+We do <em>NOT</em> recommend you use this feature. -+If you are tempted to write a system <var>foo</var> -+that weakly-depends-on a system <var>bar</var>, -+we recommend that you should instead -+write system <var>foo</var> in a parametric way, -+and offer some special variable and/or some hook to specialize its behavior; -+then you should write a system <var>foo+bar</var> -+that does the hooking of things together. -+ -+ <p>The (deprecated) <code>:weakly-depends-on</code> option to <code>defsystem</code> -+allows the programmer to specify another ASDF-defined system or set of systems -+that ASDF should <em>try</em> to load, -+but need not load in order to be successful. -+Typically this is used if there are a number of systems -+that, if present, could provide additional functionality, -+but which are not necessary for basic function. -+ -+ <p>Currently, although it is specified to be an option only to <code>defsystem</code>, -+this option is accepted at any component, but it probably -+only makes sense at the <code>defsystem</code> level. -+Programmers are cautioned not -+to use this component option except at the <code>defsystem</code> level, as -+this anomalous behavior may be removed without warning. -+ -+ <p>Finally, you might look into the <code>asdf-system-connections</code> extension, -+that will let you define additional code to be loaded -+when two systems are simultaneously loaded. -+It may or may not be considered good style, but at least it can be used -+in a way that has deterministic behavior independent of load order, -+unlike <code>weakly-depends-on</code>. -+ -+<h4 class="subsection">5.3.6 Pathname specifiers</h4> -+ -+<p><a name="index-pathname-specifiers-22"></a> -+A pathname specifier (<code>pathname-specifier</code>) -+may be a pathname, a string or a symbol. -+When no pathname specifier is given for a component, -+which is the usual case, the component name itself is used. -+ -+ <p>If a string is given, which is the usual case, -+the string will be interpreted as a Unix-style pathname -+where <code>/</code> characters will be interpreted as directory separators. -+Usually, Unix-style relative pathnames are used -+(i.e. not starting with <code>/</code>, as opposed to absolute pathnames); -+they are relative to the path of the parent component. -+Finally, depending on the <code>component-type</code>, -+the pathname may be interpreted as either a file or a directory, -+and if it's a file, -+a file type may be added corresponding to the <code>component-type</code>, -+or else it will be extracted from the string itself (if applicable). -+ -+ <p>For instance, the <code>component-type</code> <code>:module</code> -+wants a directory pathname, and so a string <code>"foo/bar"</code> -+will be interpreted as the pathname <samp><span class="file">#p"foo/bar/"</span></samp>. -+On the other hand, the <code>component-type</code> <code>:file</code> -+wants a file of type <code>lisp</code>, and so a string <code>"foo/bar"</code> -+will be interpreted as the pathname <samp><span class="file">#p"foo/bar.lisp"</span></samp>, -+and a string <code>"foo/bar.quux"</code> -+will be interpreted as the pathname <samp><span class="file">#p"foo/bar.quux.lisp"</span></samp>. -+Finally, the <code>component-type</code> <code>:static-file</code> -+wants a file without specifying a type, and so a string <code>"foo/bar"</code> -+will be interpreted as the pathname <samp><span class="file">#p"foo/bar"</span></samp>, -+and a string <code>"foo/bar.quux"</code> -+will be interpreted as the pathname <samp><span class="file">#p"foo/bar.quux"</span></samp>. -+ -+ <p>ASDF does not interpret the string <code>".."</code> to designate the parent -+directory. This string will be passed through to the underlying -+operating system for interpretation. We <em>believe</em> that this will -+work on all platforms where ASDF is deployed, but do not guarantee this -+behavior. A pathname object with a relative directory component of -+<code>:up</code> or <code>:back</code> is the only guaranteed way to specify a -+parent directory. -+ -+ <p>If a symbol is given, it will be translated into a string, -+and downcased in the process. -+The downcasing of symbols is unconventional, -+but was selected after some consideration. -+Observations suggest that the type of systems we want to support -+either have lowercase as customary case (Unix, Mac, windows) -+or silently convert lowercase to uppercase (lpns), -+so this makes more sense than attempting to use <code>:case :common</code> -+as argument to <code>make-pathname</code>, -+which is reported not to work on some implementations. -+ -+ <p>Pathname objects may be given to override the path for a component. -+Such objects are typically specified using reader macros such as <code>#p</code> -+or <code>#.(make-pathname ...)</code>. -+Note however, that <code>#p...</code> is a shorthand for <code>#.(parse-namestring ...)</code> -+and that the behavior of <code>parse-namestring</code> is completely non-portable, -+unless you are using Common Lisp <code>logical-pathname</code>s -+(see <a href="#The-defsystem-grammar">Using logical pathnames</a>, below). -+Pathnames made with <code>#.(make-pathname ...)</code> -+can usually be done more easily with the string syntax above. -+The only case that you really need a pathname object is to override -+the component-type default file type for a given component. -+Therefore, pathname objects should only rarely be used. -+Unhappily, ASDF 1 didn't properly support -+parsing component names as strings specifying paths with directories, -+and the cumbersome <code>#.(make-pathname ...)</code> syntax had to be used. -+An alternative to <code>#.</code> read-time evaluation is to use -+<code>(eval `(defsystem ... ,pathname ...))</code>. -+ -+ <p>Note that when specifying pathname objects, -+ASDF does not do any special interpretation of the pathname -+influenced by the component type, unlike the procedure for -+pathname-specifying strings. -+On the one hand, you have to be careful to provide a pathname that correctly -+fulfills whatever constraints are required from that component type -+(e.g. naming a directory or a file with appropriate type); -+on the other hand, you can circumvent the file type that would otherwise -+be forced upon you if you were specifying a string. -+ -+<h4 class="subsection">5.3.7 Version specifiers</h4> -+ -+<p><a name="index-version-specifiers-23"></a><a name="index-g_t_003aversion-24"></a> -+Version specifiers are parsed as period-separated lists of integers. I.e., in the example, -+<code>0.2.1</code> is to be interpreted, roughly speaking, as <code>(0 2 1)</code>. -+In particular, version <code>0.2.1</code> is interpreted the same as -+<code>0.0002.1</code> and is strictly version-less-than version <code>0.20.1</code>, -+even though the two are the same when interpreted as decimal fractions. -+ -+ <p>System definers are encouraged to use version identifiers of the form -+<var>x</var>.<var>y</var>.<var>z</var> for major version, minor version (compatible -+API) and patch level. -+ -+ <p>See <a href="#Common-attributes-of-components">Common attributes of components</a>. -+ -+<h4 class="subsection">5.3.8 Using logical pathnames</h4> -+ -+<p><a name="index-logical-pathnames-25"></a> -+We do not generally recommend the use of logical pathnames, -+especially not so to newcomers to Common Lisp. -+However, we do support the use of logical pathnames by old timers, -+when such is their preference. -+ -+ <p>To use logical pathnames, -+you will have to provide a pathname object as a <code>:pathname</code> specifier -+to components that use it, using such syntax as -+<code>#p"LOGICAL-HOST:absolute;path;to;component.lisp"</code>. -+ -+ <p>You only have to specify such logical pathname -+for your system or some top-level component. -+Sub-components' relative pathnames, -+specified using the string syntax for names, -+will be properly merged with the pathnames of their parents. -+The specification of a logical pathname host however is <em>not</em> -+otherwise directly supported in the ASDF syntax -+for pathname specifiers as strings. -+ -+ <p>The <code>asdf-output-translation</code> layer will -+avoid trying to resolve and translate logical pathnames. -+The advantage of this is that -+you can define yourself what translations you want to use -+with the logical pathname facility. -+The disadvantage is that if you do not define such translations, -+any system that uses logical pathnames will behave differently under -+asdf-output-translations than other systems you use. -+ -+ <p>If you wish to use logical pathnames you will have to configure the -+translations yourself before they may be used. -+ASDF currently provides no specific support -+for defining logical pathname translations. -+ -+ <p>Note that the reasons we do not recommend logical pathnames are that -+(1) there is no portable way to set up logical pathnames before they are used, -+(2) logical pathnames are limited to only portably use -+a single character case, digits and hyphens. -+While you can solve the first issue on your own, -+describing how to do it on each of fifteen implementations supported by ASDF -+is more than we can document. -+As for the second issue, mind that the limitation is notably enforced on SBCL, -+and that you therefore can't portably violate the limitations -+but must instead define some encoding of your own and add individual mappings -+to name physical pathnames that do not fit the restrictions. -+This can notably be a problem when your Lisp files are part of a larger project -+in which it is common to name files or directories in a way that -+includes the version numbers of supported protocols, -+or in which files are shared with software written -+in different programming languages where conventions include the use of -+underscores, dots or CamelCase in pathnames. -+ -+<h4 class="subsection">5.3.9 Serial dependencies</h4> -+ -+<p><a name="index-serial-dependencies-26"></a> -+If the <code>:serial t</code> option is specified for a module, -+ASDF will add dependencies for each child component, -+on all the children textually preceding it. -+This is done as if by <code>:depends-on</code>. -+ -+<pre class="lisp"> :serial t -+ :components ((:file "a") (:file "b") (:file "c")) -+</pre> -+ <p>is equivalent to -+ -+<pre class="lisp"> :components ((:file "a") -+ (:file "b" :depends-on ("a")) -+ (:file "c" :depends-on ("a" "b"))) -+</pre> -+ <h4 class="subsection">5.3.10 Source location</h4> -+ -+<p>The <code>:pathname</code> option is optional in all cases for systems -+defined via <code>defsystem</code>, -+and in the usual case the user is recommended not to supply it. -+ -+ <p>Instead, ASDF follows a hairy set of rules that are designed so that -+ <ol type=1 start=1> -+<li><code>find-system</code> -+will load a system from disk -+and have its pathname default to the right place. -+ -+ <li>This pathname information will not be overwritten with -+<code>*default-pathname-defaults*</code> -+(which could be somewhere else altogether) -+if the user loads up the <samp><span class="file">.asd</span></samp> file into his editor -+and interactively re-evaluates that form. -+ </ol> -+ -+ <p>If a system is being loaded for the first time, -+its top-level pathname will be set to: -+ -+ <ul> -+<li>The host/device/directory parts of <code>*load-truename*</code>, -+if it is bound. -+<li><code>*default-pathname-defaults*</code>, otherwise. -+</ul> -+ -+ <p>If a system is being redefined, the top-level pathname will be -+ -+ <ul> -+<li>changed, if explicitly supplied or obtained from <code>*load-truename*</code> -+(so that an updated source location is reflected in the system definition) -+ -+ <li>changed if it had previously been set from <code>*default-pathname-defaults*</code> -+ -+ <li>left as before, if it had previously been set from <code>*load-truename*</code> -+and <code>*load-truename*</code> is currently unbound -+(so that a developer can evaluate a <code>defsystem</code> form -+from within an editor without clobbering its source location) -+</ul> -+ -+<h4 class="subsection">5.3.11 if-feature option</h4> -+ -+<p>This option allows you to specify a feature expression to be evaluated -+as if by <code>#+</code> to conditionally include a component in your build. -+If the expression is false, the component is dropped -+as well as any dependency pointing to it. -+As compared to using <code>#+</code> which is expanded at read-time, -+this allows you to have an object in your component hierarchy -+that can be used for manipulations beside building your project. -+This option was added in ASDF 3. -+ -+<h4 class="subsection">5.3.12 if-component-dep-fails option</h4> -+ -+<p>This option was removed in ASDF 3. -+Its semantics was limited in purpose and dubious to explain, -+and its implementation was breaking a hole into the ASDF object model. -+Please use the <code>if-feature</code> option instead. -+ -+<p><a name="Other-code-in-.asd-files"></a> -+<a name="Other-code-in-_002easd-files"></a> -+ -+<h3 class="section">5.4 Other code in .asd files</h3> -+ -+<p>Files containing <code>defsystem</code> forms -+are regular Lisp files that are executed by <code>load</code>. -+Consequently, you can put whatever Lisp code you like into these files -+(e.g., code that examines the compile-time environment -+and adds appropriate features to <code>*features*</code>). -+However, some conventions should be followed, -+so that users can control certain details of execution -+of the Lisp in <samp><span class="file">.asd</span></samp> files: -+ -+ <ul> -+<li>Any informative output -+(other than warnings and errors, -+which are the condition system's to dispose of) -+should be sent to the standard CL stream <code>*standard-output*</code>, -+so that users can easily control the disposition -+of output from ASDF operations. -+</ul> -+ -+<p><a name="The-object-model-of-ASDF"></a> -+ -+<!-- node-name, next, previous, up --> -+<h2 class="chapter">6 The object model of ASDF</h2> -+ -+<p>ASDF is designed in an object-oriented way from the ground up. -+Both a system's structure and the operations that can be performed on systems -+follow a extensible protocol. -+ -+ <p>This allows the addition of behaviours: -+for example, <code>cffi</code> adds support of special FFI description files -+to interface with C libraries and of wrapper files to embed C code in Lisp; -+<code>abcl-jar</code> supports creating Java JAR archives in ABCL; -+and <code>poiu</code> supports for compiling code in parallel using background processes. -+ -+ <p>This chapter deals with <code>component</code>s and <code>operation</code>s. -+ -+ <p>A <code>component</code> represents an individual source file or a group of source files, -+and the things that get transformed into. -+A <code>system</code> is a component at the top level of the component hierarchy. -+A <code>source-file</code> is a component representing a single source-file -+and the successive output files into which it is transformed. -+A <code>module</code> is an intermediate component itself grouping several other components, -+themselves source-files or further modules. -+ -+ <p>An <code>Operation</code> represents a transformation that can be performed on a component, -+turning them from source files to intermediate results to final outputs. -+ -+ <p>A pair of an <code>operation</code> and a <code>component</code> is called an <code>action</code>. -+An <code>action</code> represents a particular build step to be <code>perform</code>ed, -+after all its dependencies have been fulfilled. -+In the ASDF model, actions depend on other actions. -+The term <em>action</em> itself was used by Kent Pitman in his old article, -+but was only used by ASDF hackers starting with the ASDF 2; -+but the concept is ubiquitous since the very beginning of ASDF 1, -+though previously implicit. -+ -+ <p>Then, there are many <em>functions</em> available -+to users, extenders and implementers of ASDF -+to use, define or implement the activities -+that are part of building your software. -+Though they manipulate <code>action</code>s, -+most of these functions do not take as an argument -+a reified pair (a CONS cell) of an operation and a component; -+instead, they usually take two separate arguments, -+which allows to take advantage of the power CLOS-style multiple dispatch -+for fun and profit. -+ -+ <p>There are many <em>hooks</em> in which to add functionality, -+by customizing the behavior of existing <em>functions</em>. -+ -+ <p>Last but not least is the notion of <em>dependency</em> between two actions. -+The structure of dependencies between actions is -+a directed <em>dependency graph</em>. -+ASDF is invoked by being told to <em>operate</em> -+with some <em>operation</em> on some toplevel <em>system</em>; -+it will then <em>traverse</em> the graph and build a <em>plan</em> -+that follows its structure. -+To be successfully buildable, this graph of actions but be acyclic. -+If, as a user, extender or implementer of ASDF, you fail -+to keep the dependency graph without cycles, -+ASDF will fail loudly as it eventually finds one. -+To clearly distinguish the direction of dependencies, -+ASDF 3 uses the words <em>requiring</em> and <em>required</em> -+as applied to an action depending on the other: -+the requiring action <code>depends-on</code> the completion of all required actions -+before it may itself be <code>perform</code>ed. -+ -+ <p>Using the <code>defsystem</code> syntax, users may easily express -+direct dependencies along the graph of the object hierarchy: -+between a component and its parent, its children, and its siblings. -+By defining custom CLOS methods, you can express more elaborate dependencies as you wish. -+Most common operations, such as <code>load-op</code>, <code>compile-op</code> or <code>load-source-op</code> -+are automatically propagate “downward” the component hierarchy and are “covariant” with it: -+to act the operation on the parent module, you must first act it on all the children components, -+with the action on the parent being parent of the action on each child. -+Other operations, such as <code>prepare-op</code> and <code>prepare-source-op</code> -+(introduced in ASDF 3) are automatically propagated “upward” the component hierarchy -+and are “contravariant” with it: -+to perform the operation of preparing for compilation of a child component, -+you must perform the operation of preparing for compilation of its parent component, and so on, -+ensuring that all the parent's dependencies are (compiled and) loaded -+before the child component may be compiled and loaded. -+Yet other operations, such as <code>test-op</code> or <code>load-fasl-op</code> -+remain at the system level, and are not propagated along the hierarchy, -+but instead do something global on the system. -+ -+<p><a name="Operations"></a> -+ -+<!-- node-name, next, previous, up --> -+<h3 class="section">6.1 Operations</h3> -+ -+<p><a name="index-operation-27"></a> -+An <dfn>operation</dfn> object of the appropriate type is instantiated -+whenever the user wants to do something with a system like -+ -+ <ul> -+<li>compile all its files -+<li>load the files into a running lisp environment -+<li>copy its source files somewhere else -+</ul> -+ -+ <p>Operations can be invoked directly, or examined -+to see what their effects would be without performing them. -+There are a bunch of methods specialised on operation and component type -+that actually do the grunt work. -+ -+ <p>The operation object contains whatever state is relevant for this purpose -+(perhaps a list of visited nodes, for example) -+but primarily is a nice thing to specialise operation methods on -+and easier than having them all be <code>EQL</code> methods. -+ -+ <p>Operations are invoked on systems via <code>operate</code>. -+<a name="operate"></a> -+ -+<div class="defun"> -+— Generic function: <code>operate</code><var> operation system &rest initargs &key </var><code>force</code> <code>force-not</code> <code>verbose</code><var> &allow-other-keys<a name="index-g_t_0040code_007boperate_007d-28"></a></var><br> -+— Generic function: <code>oos</code><var> operation system &rest initargs &key &allow-other-keys<a name="index-g_t_0040code_007boos_007d-29"></a></var><br> -+<blockquote><p><code>operate</code> invokes <var>operation</var> on <var>system</var>. -+<code>oos</code> is a synonym for <code>operate</code>. -+ -+ <p><var>operation</var> is a symbol that is passed, along with the supplied -+<var>initargs</var>, to <code>make-instance</code> to create the operation object. -+<var>system</var> is a system designator. -+ -+ <p>The <var>initargs</var> are passed to the <code>make-instance</code> call -+when creating the operation object. -+Note that dependencies may cause the operation -+to invoke other operations on the system or its components: -+the new operations will be created -+with the same <var>initargs</var> as the original one. -+ -+ <p>If <var>force</var> is <code>:all</code>, then all systems -+are forced to be recompiled even if not modified since last compilation. -+If <var>force</var> is <code>t</code>, then only the system being loaded -+is forced to be recompiled even if not modified since last compilation, -+but other systems are not affected. -+If <var>force</var> is a list, then it specifies a list of systems that -+are forced to be recompiled even if not modified since last compilation. -+If <var>force-not</var> is <code>:all</code>, then all systems -+are forced not to be recompiled even if modified since last compilation. -+If <var>force-not</var> is <code>t</code>, then only the system being loaded -+is forced not to be recompiled even if modified since last compilation, -+but other systems are not affected. -+If <var>force-not</var> is a list, then it specifies a list of systems that -+are forced not to be recompiled even if modified since last compilation. -+<var>force</var> takes precedences over <var>force-not</var>; -+both of them apply to systems that are dependencies and were already compiled. -+ -+ <p>To see what <code>operate</code> would do, you can use: -+ <pre class="example"> (asdf::traverse (make-instance operation-class initargs ...) (find-system system-name)) -+</pre> -+ </blockquote></div> -+ -+<p><a name="Predefined-operations-of-ASDF"></a> -+ -+<!-- node-name, next, previous, up --> -+<h4 class="subsection">6.1.1 Predefined operations of ASDF</h4> -+ -+<p>All the operations described in this section are in the <code>asdf</code> package. -+They are invoked via the <code>operate</code> generic function. -+ -+<pre class="lisp"> (asdf:operate 'asdf:<var>operation-name</var> :<var>system-name</var> {<var>operation-options ...</var>}) -+</pre> -+ <div class="defun"> -+— Operation: <code>compile-op</code><var> &key </var><code>proclamations</code><var><a name="index-g_t_0040code_007bcompile_002dop_007d-30"></a></var><br> -+<blockquote> -+ <p>This operation compiles the specified component. -+If proclamations are supplied, they will be proclaimed. -+This is a good place to specify optimization settings. -+ -+ <p>When creating a new component type, -+you should provide methods for <code>compile-op</code>. -+ -+ <p>When <code>compile-op</code> is invoked, -+component dependencies often cause some parts of the system -+to be loaded as well as compiled. -+Invoking <code>compile-op</code> -+does not necessarily load all the parts of the system, though; -+use <code>load-op</code> to load a system. -+</p></blockquote></div> -+ -+<div class="defun"> -+— Operation: <code>load-op</code><var> &key </var><code>proclamations</code><var><a name="index-g_t_0040code_007bload_002dop_007d-31"></a></var><br> -+<blockquote> -+ <p>This operation loads a system. -+ -+ <p>The default methods for <code>load-op</code> compile files before loading them. -+For parity, your own methods on new component types should probably do so too. -+</p></blockquote></div> -+ -+<div class="defun"> -+— Operation: <code>parent-load-op</code><var> &key </var><code>proclamations</code><var><a name="index-g_t_0040code_007bparent_002dload_002dop_007d-32"></a></var><br> -+<blockquote> -+ <p>This operation ensures that the dependencies -+of a module, and its parent, and so on, are loaded (as per <code>load-op</code>) -+before the components within that module may be operated upon. -+ -+ <p>By default, all operations depend on this <code>parent-operation</code> -+for actions on components to depend on this “parent operation” being acted on the parent. -+ -+ <p>The default methods for <code>load-op</code> compile files before loading them. -+For parity, your own methods on new component types should probably do so too. -+</p></blockquote></div> -+ -+<div class="defun"> -+— Operation: <code>load-source-op</code><var><a name="index-g_t_0040code_007bload_002dsource_002dop_007d-33"></a></var><br> -+<blockquote> -+ <p>This operation will load the source for the files in a module -+even if the source files have been compiled. -+Systems sometimes have knotty dependencies -+which require that sources are loaded -+before they can be compiled. -+This is how you do that. -+ -+ <p>If you are creating a component type, -+you need to implement this operation — at least, where meaningful. -+</p></blockquote></div> -+ -+ <p><a name="test_002dop"></a> -+ -+<div class="defun"> -+— Operation: <code>test-op</code><var><a name="index-g_t_0040code_007btest_002dop_007d-34"></a></var><br> -+<blockquote> -+ <p>This operation will perform some tests on the module. -+The default method will do nothing. -+The default dependency is to require -+<code>load-op</code> to be performed on the module first. -+The default <code>operation-done-p</code> is that the operation is <em>never</em> done -+— -+we assume that if you invoke the <code>test-op</code>, -+you want to test the system, even if you have already done so. -+ -+ <p>The results of this operation are not defined by ASDF. -+It has proven difficult to define how the test operation -+should signal its results to the user -+in a way that is compatible with all of the various test libraries -+and test techniques in use in the community. -+ -+ <p>People typically define <code>test-op</code> methods like thus: -+ <pre class="example"> (defmethod perform ((o asdf:test-op) (s (eql (asdf:find-system <var>:mysystem</var>)))) -+ (asdf:load-system <var>:mysystem</var>) -+ (eval (read-from-string "(some expression that runs the tests)")) -+ t) -+</pre> -+ </blockquote></div> -+ -+<div class="defun"> -+— Operation: <code>load-fasl-op</code><var><a name="index-g_t_0040code_007bload_002dfasl_002dop_007d-35"></a></var><br> -+<blockquote> -+ <p>This operation will load and create if need be -+a single fasl file for all the files in each loaded system. -+(Its compilation-only equivalent is <code>asdf::fasl-op</code>.) -+ -+ <p>Once you have created such a fasl, -+you can use <code>precompiled-system</code> to deliver it in a way -+that is compatible with clients having asdf dependencies -+on your system whether it is distributed as source of as a single binary. -+ -+ <p>On your build platform, you run something like that: -+ <pre class="example"> <code>(asdf:operate 'load-fasl-op </code><var>:mysystem</var><code>)</code> -+</pre> -+ <p>And on your delivery platform, a form like this is evaluated -+in a prologue or at some point before you save your image: -+ <pre class="example"> (defsystem :mysystem :class :precompiled-system -+ :fasl (some expression that will evaluate to a pathname)) -+</pre> -+ <p>Of course, <em>before</em> you define such systems, -+you should not forget to <code>(asdf:clear-configuration)</code>. -+ -+ <p><code>load-fasl-op</code> is available on all actively supported Lisp implementations, -+and on those implementations only, and only since ASDF 3. -+This functionality was previously available for select implementations, -+as part of a separate system <code>asdf-bundle</code>, -+itself descended from <code>asdf-ecl</code>. -+</p></blockquote></div> -+ -+<!-- @deffn Operation test-system-version @Akey minimum --> -+<!-- Asks the system whether it satisfies a version requirement. --> -+<!-- The default method accepts a string, which is expected to contain of a --> -+<!-- number of integers separated by #\. characters. The method is not --> -+<!-- recursive. The component satisfies the version dependency if it has --> -+<!-- the same major number as required and each of its sub-versions is --> -+<!-- greater than or equal to the sub-version number required. --> -+<!-- @lisp --> -+<!-- (defun version-satisfies (x y) --> -+<!-- (labels ((bigger (x y) --> -+<!-- (cond ((not y) t) --> -+<!-- ((not x) nil) --> -+<!-- ((> (car x) (car y)) t) --> -+<!-- ((= (car x) (car y)) --> -+<!-- (bigger (cdr x) (cdr y)))))) --> -+<!-- (and (= (car x) (car y)) --> -+<!-- (or (not (cdr y)) (bigger (cdr x) (cdr y)))))) --> -+<!-- @end lisp --> -+<!-- If that doesn't work for your system, you can override it. I hope --> -+<!-- you have as much fun writing the new method as @verb{|#lisp|} did --> -+<!-- reimplementing this one. --> -+<!-- @end deffn --> -+<!-- @deffn Operation feature-dependent-op --> -+<!-- An instance of @code{feature-dependent-op} will ignore any components --> -+<!-- which have a @code{features} attribute, unless the feature combination --> -+<!-- it designates is satisfied by @code{*features*}. This operation is --> -+<!-- not intended to be instantiated directly, but other operations may --> -+<!-- inherit from it. --> -+<!-- @end deffn --> -+<p><a name="Creating-new-operations"></a> -+ -+<!-- node-name, next, previous, up --> -+<h4 class="subsection">6.1.2 Creating new operations</h4> -+ -+<p>ASDF was designed to be extensible in an object-oriented fashion. -+To teach ASDF new tricks, a programmer can implement the behaviour he wants -+by creating a subclass of <code>operation</code>. -+ -+ <p>ASDF's pre-defined operations are in no way “privileged”, -+but it is requested that developers never use the <code>asdf</code> package -+for operations they develop themselves. -+The rationale for this rule is that we don't want to establish a -+“global asdf operation name registry”, -+but also want to avoid name clashes. -+ -+ <p>An operation must provide methods for the following generic functions -+when invoked with an object of type <code>source-file</code>: -+<em>FIXME describe this better</em> -+ -+ <ul> -+<li><code>input-files</code> -+ASDF has a pretty clever default <code>input-files</code> mechanism. -+You only need create a method if there are multiple ultimate input files, -+and/or the bottom one doesn't depend -+on the <code>component-pathname</code> of the component. -+ -+ <li><code>output-files</code> -+The <code>output-files</code> method determines where the method will put its files. -+It returns two values, a list of pathnames, and a boolean. -+If the boolean is <code>T</code> then the pathnames are marked -+not be translated by enclosing <code>:around</code> methods. -+If the boolean is <code>NIL</code> then enclosing <code>:around</code> methods -+may translate these pathnames, e.g. to ensure object files -+are somehow stored in some implementation-dependent cache. -+ -+ <li><code>perform</code> -+The <code>perform</code> method must call <code>output-files</code> -+to find out where to put its files, -+because the user is allowed to override. -+<li><code>output-files</code> -+for local policy <code>explain</code> -+ -+ <li><code>operation-done-p</code> -+You only need to define a method on that function -+if you can detect conditions that invalidate previous runs of the operation, -+even though no filesystem timestamp has changed, -+in which case you return <code>nil</code> (the default is <code>t</code>). -+ -+ <p>For instance, the method for <code>test-op</code> always returns <code>nil</code>, -+so that tests are always run afresh. -+Of course, the <code>test-op</code> for your system could depend -+on a deterministically repeatable <code>test-report-op</code>, -+and just read the results from the report files. -+ -+ <li><code>component-depends-on</code> -+When you add new operations, you probably need to explain -+how they relate to loading, compiling, testing, etc., -+in terms of dependencies between actions. -+ -+ <p>That's where you typically define methods on <code>component-depends-on</code>. -+Your method will take as arguments -+some properly specialized operation -+and a component denoting a current action, -+and return a list of entries, -+denoting the children actions that the current action depends on. -+The format of entries is described below. -+ -+ <p>It is <em>strongly</em> advised that -+you should always append the results of <code>(call-next-method)</code> -+to the results of your method, -+or “interesting” failures will likely occur, -+unless you're a true specialist of ASDF internals. -+ -+ <p>Each entry returned by <code>component-depends-on</code> is itself a list. -+ -+ <p>The first element of an entry is the name of an operation: -+a symbol that you can use with <code>make-instance</code> -+(ASDF will instead use with <code>asdf::make-sub-operation</code>), -+to create a related operation for use in a build plan. -+For instance, <code>load-op</code> and <code>compile-op</code> -+are common such names, denoting the respective operations. -+ -+ <p>The rest of an entry is a list of identifiers -+each denote a component such that -+the pair of the previous operation and this component -+is a children action of current action. -+ -+ <p>Identifiers follow the <code>defsystem</code> grammar -+previously documented. -+The main format for identifiers is a string or symbol -+(that will be downcase as per <code>coerce-name</code>), -+and looked up against the sibling list of the parent module's children components, -+as per <code>find-component</code>. -+As a special case, <code>nil</code> denotes the parent itself. -+Other syntaxes are allowed, for instance to specify a component with a version. -+ -+ </ul> -+ -+ <p>Operations that print output should send that output to the standard -+CL stream <code>*standard-output*</code>, as the Lisp compiler and loader do. -+ -+<p><a name="Components"></a> -+ -+<!-- node-name, next, previous, up --> -+<h3 class="section">6.2 Components</h3> -+ -+<p><a name="index-component-36"></a><a name="index-system-37"></a><a name="index-system-designator-38"></a><a name="index-g_t_002asystem_002ddefinition_002dsearch_002dfunctions_002a-39"></a> -+A <dfn>component</dfn> represents a source file or -+(recursively) a collection of components. -+A <dfn>system</dfn> is (roughly speaking) a top-level component -+that can be found via <code>find-system</code>. -+ -+ <p>A <dfn>system designator</dfn> is a string or symbol -+and behaves just like any other component name -+(including with regard to the case conversion rules for component names). -+ -+<div class="defun"> -+— Function: <b>find-system</b><var> system-designator &optional </var>(<var>error-p t</var>)<var><a name="index-find_002dsystem-40"></a></var><br> -+<blockquote> -+ <p>Given a system designator, <code>find-system</code> finds and returns a system. -+If no system is found, an error of type -+<code>missing-component</code> is thrown, -+or <code>nil</code> is returned if <code>error-p</code> is false. -+ -+ <p>To find and update systems, <code>find-system</code> funcalls each element -+in the <code>*system-definition-search-functions*</code> list, -+expecting a pathname to be returned, or a system object, -+from which a pathname may be extracted, and that will be registered. -+The resulting pathname (if any) is loaded -+if one of the following conditions is true: -+ -+ <ul> -+<li>there is no system of that name in memory -+<li>the pathname is different from that which was previously loaded -+<li>the file's <code>last-modified</code> time exceeds the <code>last-modified</code> time -+of the system in memory -+</ul> -+ -+ <p>When system definitions are loaded from <samp><span class="file">.asd</span></samp> files, -+a new scratch package is created for them to load into, -+so that different systems do not overwrite each others operations. -+The user may also wish to (and is recommended to) -+include <code>defpackage</code> and <code>in-package</code> forms -+in his system definition files, however, -+so that they can be loaded manually if need be. -+ -+ <p>The default value of <code>*system-definition-search-functions*</code> -+is a list of two functions. -+The first function looks in each of the directories given -+by evaluating members of <code>*central-registry*</code> -+for a file whose name is the name of the system and whose type is <samp><span class="file">asd</span></samp>. -+The first such file is returned, -+whether or not it turns out to actually define the appropriate system. -+The second function does something similar, -+for the directories specified in the <code>source-registry</code>. -+Hence, it is strongly advised to define a system -+<var>foo</var> in the corresponding file <var>foo.asd</var>. -+</p></blockquote></div> -+ -+<p><a name="Common-attributes-of-components"></a> -+ -+<!-- node-name, next, previous, up --> -+<h4 class="subsection">6.2.1 Common attributes of components</h4> -+ -+<p>All components, regardless of type, have the following attributes. -+All attributes except <code>name</code> are optional. -+ -+<h5 class="subsubsection">6.2.1.1 Name</h5> -+ -+<p>A component name is a string or a symbol. -+If a symbol, its name is taken and lowercased. -+ -+ <p>Unless overridden by a <code>:pathname</code> attribute, -+the name will be interpreted as a pathname specifier according -+to a Unix-style syntax. -+See <a href="#The-defsystem-grammar">Pathname specifiers</a>. -+ -+<h5 class="subsubsection">6.2.1.2 Version identifier</h5> -+ -+<p><a name="index-version_002dsatisfies-41"></a><a name="index-g_t_003aversion-42"></a> -+This optional attribute is used by the generic function -+<code>version-satisfies</code>, which tests to see if <code>:version</code> -+dependencies are satisfied. -+the version should be a string of integers separated by dots, -+for example ‘<samp><span class="samp">1.0.11</span></samp>’. -+For more information on the semantics of version specifiers, see <a href="#The-defsystem-grammar">The defsystem grammar</a>. -+ -+<!-- This optional attribute is intended to be used by the @code{test-system-version} operation. --> -+<!-- @xref{Predefined operations of ASDF}. --> -+<!-- @emph{Nota Bene}: --> -+<!-- This operation, planned for ASDF 1, --> -+<!-- is still not implemented yet as of ASDF 3. --> -+<!-- Don't hold your breath. --> -+<h5 class="subsubsection">6.2.1.3 Required features</h5> -+ -+<p><em>FIXME: This subsection seems to contradict the -+</em><code>defsystem</code><em> grammar subsection, -+which doesn't provide any obvious way to specify required features. -+Furthermore, in 2009, discussions on the -+<a href="http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel">asdf-devel mailing list</a> -+suggested that the specification of required features may be broken, -+and that no one may have been using them for a while. -+Please contact the -+<a href="http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel">asdf-devel mailing list</a> -+if you are interested in getting this features feature fixed.</em> -+ -+ <p>Traditionally defsystem users have used reader conditionals -+to include or exclude specific per-implementation files. -+This means that any single implementation cannot read the entire system, -+which becomes a problem if it doesn't wish to compile it, -+but instead for example to create an archive file containing all the sources, -+as it will omit to process the system-dependent sources for other systems. -+ -+ <p>Each component in an asdf system may therefore specify features using -+the same syntax as <code>#+</code> does, and it will (somehow) be ignored for -+certain operations unless the feature conditional is a member of -+<code>*features*</code>. -+ -+<h5 class="subsubsection">6.2.1.4 Dependencies</h5> -+ -+<p>This attribute specifies dependencies of the component on its siblings. -+It is optional but often necessary. -+ -+ <p>There is an excitingly complicated relationship between the initarg -+and the method that you use to ask about dependencies -+ -+ <p>Dependencies are between (operation component) pairs. -+In your initargs for the component, you can say -+ -+<pre class="lisp"> :in-order-to ((compile-op (load-op "a" "b") (compile-op "c")) -+ (load-op (load-op "foo"))) -+</pre> -+ <p>This means the following things: -+ <ul> -+<li>before performing compile-op on this component, we must perform -+load-op on <var>a</var> and <var>b</var>, and compile-op on <var>c</var>, -+<li>before performing <code>load-op</code>, we have to load <var>foo</var> -+</ul> -+ -+ <p>The syntax is approximately -+ -+<pre class="verbatim">(this-op @{(other-op required-components)@}+) -+ -+simple-component-name := string -+ | symbol -+ -+required-components := simple-component-name -+ | (required-components required-components) -+ -+component-name := simple-component-name -+ | (:version simple-component-name minimum-version-object) -+</pre> -+ -+ <p>Side note: -+ -+ <p>This is on a par with what ACL defsystem does. -+mk-defsystem is less general: it has an implied dependency -+ -+<pre class="verbatim"> for all source file x, (load x) depends on (compile x) -+</pre> -+ -+ <p>and using a <code>:depends-on</code> argument to say that <var>b</var> depends on -+<var>a</var> <em>actually</em> means that -+ -+<pre class="verbatim"> (compile b) depends on (load a) -+</pre> -+ -+ <p>This is insufficient for e.g. the McCLIM system, which requires that -+all the files are loaded before any of them can be compiled ] -+ -+ <p>End side note -+ -+ <p>In ASDF, the dependency information for a given component and operation -+can be queried using <code>(component-depends-on operation component)</code>, -+which returns a list -+ -+<pre class="lisp"> ((load-op "a") (load-op "b") (compile-op "c") ...) -+</pre> -+ <p><code>component-depends-on</code> can be subclassed for more specific -+component/operation types: these need to <code>(call-next-method)</code> -+and append the answer to their dependency, unless -+they have a good reason for completely overriding the default dependencies. -+ -+ <p>If it weren't for CLISP, we'd be using <code>LIST</code> method -+combination to do this transparently. -+But, we need to support CLISP. -+If you have the time for some CLISP hacking, -+I'm sure they'd welcome your fixes. -+<!-- Doesn't CLISP now support LIST method combination? --> -+ -+ <p>See the discussion of the semantics of <code>:version</code> in the defsystem -+grammar. -+ -+<!-- FIXME: Should have cross-reference to "Version specifiers" in the --> -+<!-- defsystem grammar, but the cross-referencing is so broken by --> -+<!-- insufficient node breakdown that I have not put one in. --> -+<h5 class="subsubsection">6.2.1.5 pathname</h5> -+ -+<p>This attribute is optional and if absent (which is the usual case), -+the component name will be used. -+ -+ <p>See <a href="#The-defsystem-grammar">Pathname specifiers</a>, -+for an explanation of how this attribute is interpreted. -+ -+ <p>Note that the <code>defsystem</code> macro (used to create a “top-level” system) -+does additional processing to set the filesystem location of -+the top component in that system. -+This is detailed elsewhere. See <a href="#Defining-systems-with-defsystem">Defining systems with defsystem</a>. -+ -+<h5 class="subsubsection">6.2.1.6 properties</h5> -+ -+<p>This attribute is optional. -+ -+ <p>Packaging systems often require information about files or systems -+in addition to that specified by ASDF's pre-defined component attributes. -+Programs that create vendor packages out of ASDF systems therefore -+have to create “placeholder” information to satisfy these systems. -+Sometimes the creator of an ASDF system may know the additional -+information and wish to provide it directly. -+ -+ <p><code>(component-property component property-name)</code> and -+associated <code>setf</code> method will allow -+the programmatic update of this information. -+Property names are compared as if by <code>EQL</code>, -+so use symbols or keywords or something. -+ -+<p><a name="Pre-defined-subclasses-of-component"></a> -+<a name="Pre_002ddefined-subclasses-of-component"></a> -+ -+<!-- node-name, next, previous, up --> -+<h4 class="subsection">6.2.2 Pre-defined subclasses of component</h4> -+ -+<div class="defun"> -+— Component: <b>source-file</b><var><a name="index-source_002dfile-43"></a></var><br> -+<blockquote> -+ <p>A source file is any file that the system does not know how to -+generate from other components of the system. -+ -+ <p>Note that this is not necessarily the same thing as -+“a file containing data that is typically fed to a compiler”. -+If a file is generated by some pre-processor stage -+(e.g. a <samp><span class="file">.h</span></samp> file from <samp><span class="file">.h.in</span></samp> by autoconf) -+then it is not, by this definition, a source file. -+Conversely, we might have a graphic file -+that cannot be automatically regenerated, -+or a proprietary shared library that we received as a binary: -+these do count as source files for our purposes. -+ -+ <p>Subclasses of source-file exist for various languages. -+<em>FIXME: describe these.</em> -+</p></blockquote></div> -+ -+<div class="defun"> -+— Component: <b>module</b><var><a name="index-module-44"></a></var><br> -+<blockquote> -+ <p>A module is a collection of sub-components. -+ -+ <p>A module component has the following extra initargs: -+ -+ <ul> -+<li><code>:components</code> the components contained in this module -+ -+ <li><code>:default-component-class</code> -+All children components which don't specify their class explicitly -+are inferred to be of this type. -+ -+ <li><code>:if-component-dep-fails</code> -+This attribute was removed in ASDF 3. Do not use it. -+Use <code>:if-feature</code> instead. -+ -+ <li><code>:serial</code> When this attribute is set, -+each subcomponent of this component is assumed to depend on all subcomponents -+before it in the list given to <code>:components</code>, i.e. -+all of them are loaded before a compile or load operation is performed on it. -+ -+ </ul> -+ -+ <p>The default operation knows how to traverse a module, so -+most operations will not need to provide methods specialised on modules. -+ -+ <p><code>module</code> may be subclassed to represent components such as -+foreign-language linked libraries or archive files. -+</p></blockquote></div> -+ -+<div class="defun"> -+— Component: <b>system</b><var><a name="index-system-45"></a></var><br> -+<blockquote> -+ <p><code>system</code> is a subclass of <code>module</code>. -+ -+ <p>A system is a module with a few extra attributes for documentation -+purposes; these are given elsewhere. -+See <a href="#The-defsystem-grammar">The defsystem grammar</a>. -+ -+ <p>Users can create new classes for their systems: -+the default <code>defsystem</code> macro takes a <code>:class</code> keyword argument. -+</p></blockquote></div> -+ -+<p><a name="Creating-new-component-types"></a> -+ -+<!-- node-name, next, previous, up --> -+<h4 class="subsection">6.2.3 Creating new component types</h4> -+ -+<p>New component types are defined by subclassing one of the existing -+component classes and specializing methods on the new component class. -+ -+ <p><em>FIXME: this should perhaps be explained more throughly, -+not only by example ...</em> -+ -+ <p>As an example, suppose we have some implementation-dependent -+functionality that we want to isolate -+in one subdirectory per Lisp implementation our system supports. -+We create a subclass of -+<code>cl-source-file</code>: -+ -+<pre class="lisp"> (defclass unportable-cl-source-file (cl-source-file) -+ ()) -+</pre> -+ <p>Function <code>asdf:implementation-type</code> (exported since 2.014.14) -+gives us the name of the subdirectory. -+All that's left is to define how to calculate the pathname -+of an <code>unportable-cl-source-file</code>. -+ -+<pre class="lisp"> (defmethod component-pathname ((component unportable-cl-source-file)) -+ (merge-pathnames* -+ (coerce-pathname (format nil "~(~A~)/" (asdf:implementation-type))) -+ (call-next-method))) -+</pre> -+ <p>The new component type is used in a <code>defsystem</code> form in this way: -+ -+<pre class="lisp"> (defsystem :foo -+ :components -+ ((:file "packages") -+ ... -+ (:unportable-cl-source-file "threads" -+ :depends-on ("packages" ...)) -+ ... -+ ) -+</pre> -+ <p><a name="Functions"></a> -+ -+<!-- node-name, next, previous, up --> -+<h3 class="section">6.3 Functions</h3> -+ -+<p><a name="index-version_002dsatisfies-46"></a> -+ -+<div class="defun"> -+— version-satisfies: <var>version</var><var> version-spec<a name="index-g_t_0040var_007bversion_007d-47"></a></var><br> -+<blockquote><p>Does <var>version</var> satisfy the <var>version-spec</var>. A generic function. -+ASDF provides built-in methods for <var>version</var> being a -+<code>component</code> or <code>string</code>. <var>version-spec</var> should be a -+string. -+ -+ <p>In the wild, we typically see version numbering only on components of -+type <code>system</code>. -+ -+ <p>For more information about how <code>version-satisfies</code> interprets -+version strings and specifications, see <a href="#The-defsystem-grammar">The defsystem grammar</a> and -+<a href="#Common-attributes-of-components">Common attributes of components</a>. -+</p></blockquote></div> -+ -+<p><a name="Controlling-where-ASDF-searches-for-systems"></a> -+ -+<!-- node-name, next, previous, up --> -+<h2 class="chapter">7 Controlling where ASDF searches for systems</h2> -+ -+<h3 class="section">7.1 Configurations</h3> -+ -+<p>Configurations specify paths where to find system files. -+ -+ <ol type=1 start=1> -+ -+ <li>The search registry may use some hardcoded wrapping registry specification. -+This allows some implementations (notably SBCL) to specify where to find -+some special implementation-provided systems that -+need to precisely match the version of the implementation itself. -+ -+ <li>An application may explicitly initialize the source-registry configuration -+using the configuration API -+(see <a href="#Controlling-where-ASDF-searches-for-systems">Configuration API</a>, below) -+in which case this takes precedence. -+It may itself compute this configuration from the command-line, -+from a script, from its own configuration file, etc. -+ -+ <li>The source registry will be configured from -+the environment variable <code>CL_SOURCE_REGISTRY</code> if it exists. -+ -+ <li>The source registry will be configured from -+user configuration file -+<samp><span class="file">$XDG_CONFIG_DIRS/common-lisp/source-registry.conf</span></samp> -+(which defaults to -+<samp><span class="file">~/.config/common-lisp/source-registry.conf</span></samp>) -+if it exists. -+ -+ <li>The source registry will be configured from -+user configuration directory -+<samp><span class="file">$XDG_CONFIG_DIRS/common-lisp/source-registry.conf.d/</span></samp> -+(which defaults to -+<samp><span class="file">~/.config/common-lisp/source-registry.conf.d/</span></samp>) -+if it exists. -+ -+ <li>The source registry will be configured from -+system configuration file -+<samp><span class="file">/etc/common-lisp/source-registry.conf</span></samp> -+if it exists/ -+ -+ <li>The source registry will be configured from -+system configuration directory -+<samp><span class="file">/etc/common-lisp/source-registry.conf.d/</span></samp> -+if it exists. -+ -+ <li>The source registry will be configured from a default configuration. -+This configuration may allow for implementation-specific systems -+to be found, for systems to be found the current directory -+(at the time that the configuration is initialized) as well as -+<code>:directory</code> entries for <samp><span class="file">$XDG_DATA_DIRS/common-lisp/systems/</span></samp> and -+<code>:tree</code> entries for <samp><span class="file">$XDG_DATA_DIRS/common-lisp/source/</span></samp>. -+For instance, SBCL will include directories for its contribs -+when it can find them; it will look for them where SBCL was installed, -+or at the location specified by the <code>SBCL_HOME</code> environment variable. -+ -+ </ol> -+ -+ <p>Each of these configurations is specified as an s-expression -+in a trivial domain-specific language (defined below). -+Additionally, a more shell-friendly syntax is available -+for the environment variable (defined yet below). -+ -+ <p>Each of these configurations is only used if the previous -+configuration explicitly or implicitly specifies that it -+includes its inherited configuration. -+ -+ <p>Additionally, some implementation-specific directories -+may be automatically prepended to whatever directories are specified -+in configuration files, no matter if the last one inherits or not. -+ -+<h3 class="section">7.2 Truenames and other dangers</h3> -+ -+<p>One great innovation of the original ASDF was its ability to leverage -+<code>CL:TRUENAME</code> to locate where your source code was and where to build it, -+allowing for symlink farms as a simple but effective configuration mechanism -+that is easy to control programmatically. -+ASDF 3 still supports this configuration style, and it is enabled by default; -+however we recommend you instead use -+our source-registry configuration mechanism described below, -+because it is easier to setup in a portable way across users and implementations. -+ -+ <p>Addtionally, some people dislike truename, -+either because it is very slow on their system, or -+because they are using content-addressed storage where the truename of a file -+is related to a digest of its individual contents, -+and not to other files in the same intended project. -+For these people, ASDF 3 allows to eschew the <code>TRUENAME</code> mechanism, -+by setting the variable <var>asdf:*resolve-symlinks*</var> to <code>NIL</code>. -+ -+ <p>PS: Yes, if you haven't read Vernor Vinge's short but great classic -+“True Names... and Other Dangers” then you're in for a treat. -+ -+<h3 class="section">7.3 XDG base directory</h3> -+ -+<p>Note that we purport to respect the XDG base directory specification -+as to where configuration files are located, -+where data files are located, -+where output file caches are located. -+Mentions of XDG variables refer to that document. -+ -+ <p><a href="http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html">http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html</a> -+ -+ <p>This specification allows the user to specify some environment variables -+to customize how applications behave to his preferences. -+ -+ <p>On Windows platforms, when not using Cygwin, -+instead of the XDG base directory specification, -+we try to use folder configuration from the registry regarding -+<code>Common AppData</code> and similar directories. -+Since support for querying the Windows registry -+is not possible to do in reasonable amounts of portable Common Lisp code, -+ASDF 3 relies on the environment variables that Windows usually exports. -+ -+<h3 class="section">7.4 Backward Compatibility</h3> -+ -+<p>For backward compatibility as well as to provide a practical backdoor for hackers, -+ASDF will first search for <code>.asd</code> files in the directories specified in -+<code>asdf:*central-registry*</code> -+before it searches in the source registry above. -+ -+ <p>See <a href="#Configuring-ASDF">Configuring ASDF to find your systems — old style</a>. -+ -+ <p>By default, <code>asdf:*central-registry*</code> will be empty. -+ -+ <p>This old mechanism will therefore not affect you if you don't use it, -+but will take precedence over the new mechanism if you do use it. -+ -+<h3 class="section">7.5 Configuration DSL</h3> -+ -+<p>Here is the grammar of the s-expression (SEXP) DSL for source-registry -+configuration: -+ -+<!-- FIXME: This is too wide for happy compilation into pdf. --> -+<pre class="example"> ;; A configuration is a single SEXP starting with keyword :source-registry -+ ;; followed by a list of directives. -+ CONFIGURATION := (:source-registry DIRECTIVE ...) -+ -+ ;; A directive is one of the following: -+ DIRECTIVE := -+ ;; INHERITANCE DIRECTIVE: -+ ;; Your configuration expression MUST contain -+ ;; exactly one of either of these: -+ :inherit-configuration | ; splices inherited configuration (often specified last) -+ :ignore-inherited-configuration | ; drop inherited configuration (specified anywhere) -+ -+ ;; forward compatibility directive (since ASDF 2.011.4), useful when -+ ;; you want to use new configuration features but have to bootstrap a -+ ;; the newer required ASDF from an older release that doesn't sport said features: -+ :ignore-invalid-entries | ; drops subsequent invalid entries instead of erroring out -+ -+ ;; add a single directory to be scanned (no recursion) -+ (:directory DIRECTORY-PATHNAME-DESIGNATOR) | -+ -+ ;; add a directory hierarchy, recursing but excluding specified patterns -+ (:tree DIRECTORY-PATHNAME-DESIGNATOR) | -+ -+ ;; override the defaults for exclusion patterns -+ (:exclude EXCLUSION-PATTERN ...) | -+ ;; augment the defaults for exclusion patterns -+ (:also-exclude EXCLUSION-PATTERN ...) | -+ ;; Note that the scope of a an exclude pattern specification is -+ ;; the rest of the current configuration expression or file. -+ -+ ;; splice the parsed contents of another config file -+ (:include REGULAR-FILE-PATHNAME-DESIGNATOR) | -+ -+ ;; This directive specifies that some default must be spliced. -+ :default-registry -+ -+ REGULAR-FILE-PATHNAME-DESIGNATOR := PATHNAME-DESIGNATOR ;; interpreted as a file -+ DIRECTORY-PATHNAME-DESIGNATOR := PATHNAME-DESIGNATOR ;; interpreted as a directory name -+ -+ PATHNAME-DESIGNATOR := -+ NIL | ;; Special: skip this entry. -+ ABSOLUTE-COMPONENT-DESIGNATOR ;; see pathname DSL -+ -+ EXCLUSION-PATTERN := a string without wildcards, that will be matched exactly -+ against the name of a any subdirectory in the directory component -+ of a path. e.g. <code>"_darcs"</code> will match <samp><span class="file">#p"/foo/bar/_darcs/src/bar.asd"</span></samp> -+</pre> -+ <p>Pathnames are designated using another DSL, -+shared with the output-translations configuration DSL below. -+The DSL is resolved by the function <code>asdf::resolve-location</code>, -+to be documented and exported at some point in the future. -+ -+<pre class="example"> ABSOLUTE-COMPONENT-DESIGNATOR := -+ (ABSOLUTE-COMPONENT-DESIGNATOR RELATIVE-COMPONENT-DESIGNATOR ...) | -+ STRING | ;; namestring (better be absolute or bust, directory assumed where applicable). -+ ;; In output-translations, directory is assumed and **/*.*.* added if it's last. -+ ;; On MCL, a MacOSX-style POSIX namestring (for MacOS9 style, use #p"..."); -+ ;; Note that none of the above applies to strings used in *central-registry*, -+ ;; which doesn't use this DSL: they are processed as normal namestrings. -+ ;; however, you can compute what you put in the *central-registry* -+ ;; based on the results of say (asdf::resolve-location "/Users/fare/cl/cl-foo/") -+ PATHNAME | ;; pathname (better be an absolute path, or bust) -+ ;; In output-translations, unless followed by relative components, -+ ;; it better have appropriate wildcards, as in **/*.*.* -+ :HOME | ;; designates the user-homedir-pathname ~/ -+ :USER-CACHE | ;; designates the default location for the user cache -+ :HERE | ;; designates the location of the configuration file -+ ;; (or *default-pathname-defaults*, if invoked interactively) -+ :ROOT ;; magic, for output-translations source only: paths that are relative -+ ;; to the root of the source host and device -+ ;; Not valid anymore: :SYSTEM-CACHE (was a security hazard) -+ -+ RELATIVE-COMPONENT-DESIGNATOR := -+ (RELATIVE-COMPONENT-DESIGNATOR RELATIVE-COMPONENT-DESIGNATOR ...) | -+ STRING | ;; relative directory pathname as interpreted by coerce-pathname. -+ ;; In output translations, if last component, **/*.*.* is added -+ PATHNAME | ;; pathname; unless last component, directory is assumed. -+ :IMPLEMENTATION | ;; directory based on implementation, e.g. sbcl-1.0.45-linux-x64 -+ :IMPLEMENTATION-TYPE | ;; a directory based on lisp-implementation-type only, e.g. sbcl -+ :DEFAULT-DIRECTORY | ;; a relativized version of the default directory -+ :*/ | ;; any direct subdirectory (since ASDF 2.011.4) -+ :**/ | ;; any recursively inferior subdirectory (since ASDF 2.011.4) -+ :*.*.* | ;; any file (since ASDF 2.011.4) -+ ;; Not supported (anymore): :UID and :USERNAME -+</pre> -+ <p>For instance, as a simple case, my <samp><span class="file">~/.config/common-lisp/source-registry.conf</span></samp>, -+which is the default place ASDF looks for this configuration, once contained: -+<pre class="example"> (:source-registry -+ (:tree (:home "cl")) ;; will expand to e.g. "/home/joeluser/cl/" -+ :inherit-configuration) -+</pre> -+ <h3 class="section">7.6 Configuration Directories</h3> -+ -+<p>Configuration directories consist in files each containing -+a list of directives without any enclosing <code>(:source-registry ...)</code> form. -+The files will be sorted by namestring as if by <code>string<</code> and -+the lists of directives of these files with be concatenated in order. -+An implicit <code>:inherit-configuration</code> will be included -+at the <em>end</em> of the list. -+ -+ <p>This allows for packaging software that has file granularity -+(e.g. Debian's <code>dpkg</code> or some future version of <code>clbuild</code>) -+to easily include configuration information about distributed software. -+ -+ <p>The convention is that, for sorting purposes, -+the names of files in such a directory begin with two digits -+that determine the order in which these entries will be read. -+Also, the type of these files is conventionally <code>"conf"</code> -+and as a limitation to some implementations (e.g. GNU clisp), -+the type cannot be <code>NIL</code>. -+ -+ <p>Directories may be included by specifying a directory pathname -+or namestring in an <code>:include</code> directive, e.g.: -+ -+<pre class="example"> (:include "/foo/bar/") -+</pre> -+ <p>Hence, to achieve the same effect as -+my example <samp><span class="file">~/.config/common-lisp/source-registry.conf</span></samp> above, -+I could simply create a file -+<samp><span class="file">~/.config/common-lisp/source-registry.conf.d/33-home-fare-cl.conf</span></samp> -+alone in its directory with the following contents: -+<pre class="example"> (:tree "/home/fare/cl/") -+</pre> -+ <h4 class="subsection">7.6.1 The :here directive</h4> -+ -+<p>The <code>:here</code> directive is an absolute pathname designator that -+refers to the directory containing the configuration file currently -+being processed. -+ -+ <p>The <code>:here</code> directive is intended to simplify the delivery of -+complex CL systems, and for easy configuration of projects shared through -+revision control systems, in accordance with our design principle that -+each participant should be able to provide all and only the information -+available to him or her. -+ -+ <p>Consider a person X who has set up the source code repository for a -+complex project with a master directory <samp><span class="file">dir/</span></samp>. Ordinarily, one -+might simply have the user add a directive that would look something -+like this: -+<pre class="example"> (:tree "path/to/dir") -+</pre> -+ <p>But what if X knows that there are very large subtrees -+under dir that are filled with, e.g., Java source code, image files for -+icons, etc.? All of the asdf system definitions are contained in the -+subdirectories <samp><span class="file">dir/src/lisp/</span></samp> and <samp><span class="file">dir/extlib/lisp/</span></samp>, and -+these are the only directories that should be searched. -+ -+ <p>In this case, X can put into <samp><span class="file">dir/</span></samp> a file <samp><span class="file">asdf.conf</span></samp> that -+contains the following: -+<pre class="example"> (:source-registry -+ (:tree (:here "src/lisp/")) -+ (:tree (:here "extlib/lisp")) -+ (:directory (:here "outlier/"))) -+</pre> -+ <p>Then when someone else (call her Y) checks out a copy of this -+repository, she need only add -+<pre class="example"> (:include "/path/to/my/checkout/directory/asdf.conf") -+</pre> -+ <p>to one of her previously-existing asdf source location configuration -+files, or invoke <code>initialize-source-registry</code> with a configuration -+form containing that s-expression. ASDF will find the .conf file that X -+has provided, and then set up source locations within the working -+directory according to X's (relative) instructions. -+ -+<h3 class="section">7.7 Shell-friendly syntax for configuration</h3> -+ -+<p>When considering environment variable <code>CL_SOURCE_REGISTRY</code> -+ASDF will skip to next configuration if it's an empty string. -+It will <code>READ</code> the string as a SEXP in the DSL -+if it begins with a paren <code>(</code> -+and it will be interpreted much like <code>TEXINPUTS</code> -+list of paths, where -+ -+ <p>* paths are separated -+ by a <code>:</code> (colon) on Unix platforms (including cygwin), -+ by a <code>;</code> (semicolon) on other platforms (mainly, Windows). -+ -+ <p>* each entry is a directory to add to the search path. -+ -+ <p>* if the entry ends with a double slash <code>//</code> -+ then it instead indicates a tree in the subdirectories -+ of which to recurse. -+ -+ <p>* if the entry is the empty string (which may only appear once), -+ then it indicates that the inherited configuration should be -+ spliced there. -+ -+<h3 class="section">7.8 Search Algorithm</h3> -+ -+<p><a name="index-g_t_002adefault_002dsource_002dregistry_002dexclusions_002a-48"></a> -+In case that isn't clear, the semantics of the configuration is that -+when searching for a system of a given name, -+directives are processed in order. -+ -+ <p>When looking in a directory, if the system is found, the search succeeds, -+otherwise it continues. -+ -+ <p>When looking in a tree, if one system is found, the search succeeds. -+If multiple systems are found, the consequences are unspecified: -+the search may succeed with any of the found systems, -+or an error may be raised. -+ASDF currently returns the first system found, -+XCVB currently raised an error. -+If none is found, the search continues. -+ -+ <p>Exclude statements specify patterns of subdirectories -+the systems from which to ignore. -+Typically you don't want to use copies of files kept by such -+version control systems as Darcs. -+Exclude statements are not propagated to further included or inherited -+configuration files or expressions; -+instead the defaults are reset around every configuration statement -+to the default defaults from <code>asdf::*default-source-registry-exclusions*</code>. -+ -+ <p>Include statements cause the search to recurse with the path specifications -+from the file specified. -+ -+ <p>An inherit-configuration statement cause the search to recurse with the path -+specifications from the next configuration -+(see <a href="#Controlling-where-ASDF-searches-for-systems">Configurations</a> above). -+ -+<h3 class="section">7.9 Caching Results</h3> -+ -+<p>The implementation is allowed to either eagerly compute the information -+from the configurations and file system, or to lazily re-compute it -+every time, or to cache any part of it as it goes. -+To explicitly flush any information cached by the system, use the API below. -+ -+<h3 class="section">7.10 Configuration API</h3> -+ -+<p>The specified functions are exported from your build system's package. -+Thus for ASDF the corresponding functions are in package ASDF, -+and for XCVB the corresponding functions are in package XCVB. -+ -+<div class="defun"> -+— Function: <b>initialize-source-registry</b><var> &optional PARAMETER<a name="index-initialize_002dsource_002dregistry-49"></a></var><br> -+<blockquote><p> will read the configuration and initialize all internal variables. -+ You may extend or override configuration -+ from the environment and configuration files -+ with the given <var>PARAMETER</var>, which can be -+ <code>NIL</code> (no configuration override), -+ or a SEXP (in the SEXP DSL), -+ a string (as in the string DSL), -+ a pathname (of a file or directory with configuration), -+ or a symbol (fbound to function that when called returns one of the above). -+</p></blockquote></div> -+ -+<div class="defun"> -+— Function: <b>clear-source-registry</b><var><a name="index-clear_002dsource_002dregistry-50"></a></var><br> -+<blockquote><p> undoes any source registry configuration -+ and clears any cache for the search algorithm. -+ You might want to call this function -+ (or better, <code>clear-configuration</code>) -+ before you dump an image that would be resumed -+ with a different configuration, -+ and return an empty configuration. -+ Note that this does not include clearing information about -+ systems defined in the current image, only about -+ where to look for systems not yet defined. -+</p></blockquote></div> -+ -+<div class="defun"> -+— Function: <b>ensure-source-registry</b><var> &optional PARAMETER<a name="index-ensure_002dsource_002dregistry-51"></a></var><br> -+<blockquote><p> checks whether a source registry has been initialized. -+ If not, initialize it with the given <var>PARAMETER</var>. -+</p></blockquote></div> -+ -+ <p>Every time you use ASDF's <code>find-system</code>, or -+anything that uses it (such as <code>operate</code>, <code>load-system</code>, etc.), -+<code>ensure-source-registry</code> is called with parameter NIL, -+which the first time around causes your configuration to be read. -+If you change a configuration file, -+you need to explicitly <code>initialize-source-registry</code> again, -+or maybe simply to <code>clear-source-registry</code> (or <code>clear-configuration</code>) -+which will cause the initialization to happen next time around. -+ -+<h3 class="section">7.11 Status</h3> -+ -+<p>This mechanism is vastly successful, and we have declared -+that <code>asdf:*central-registry*</code> is not recommended anymore, -+though we will continue to support it. -+All hooks into implementation-specific search mechanisms -+have been integrated in the <code>wrapping-source-registry</code> -+that everyone uses implicitly. -+ -+<h3 class="section">7.12 Rejected ideas</h3> -+ -+<p>Alternatives I considered and rejected included: -+ -+ <ol type=1 start=1> -+<li>Keep <code>asdf:*central-registry*</code> as the master with its current semantics, -+ and somehow the configuration parser expands the new configuration -+ language into a expanded series of directories of subdirectories to -+ lookup, pre-recursing through specified hierarchies. This is kludgy, -+ and leaves little space of future cleanups and extensions. -+ -+ <li>Keep <code>asdf:*central-registry*</code> remains the master but extend its semantics -+ in completely new ways, so that new kinds of entries may be implemented -+ as a recursive search, etc. This seems somewhat backwards. -+ -+ <li>Completely remove <code>asdf:*central-registry*</code> -+ and break backwards compatibility. -+ Hopefully this will happen in a few years after everyone migrate to -+ a better ASDF and/or to XCVB, but it would be very bad to do it now. -+ -+ <li>Replace <code>asdf:*central-registry*</code> by a symbol-macro with appropriate magic -+ when you dereference it or setf it. Only the new variable with new -+ semantics is handled by the new search procedure. -+ Complex and still introduces subtle semantic issues. -+ </ol> -+ -+ <p>I've been suggested the below features, but have rejected them, -+for the sake of keeping ASDF no more complex than strictly necessary. -+ -+ <ul> -+<li> More syntactic sugar: synonyms for the configuration directives, such as -+ <code>(:add-directory X)</code> for <code>(:directory X)</code>, or <code>(:add-directory-hierarchy X)</code> -+ or <code>(:add-directory X :recurse t)</code> for <code>(:tree X)</code>. -+ -+ <li> The possibility to register individual files instead of directories. -+ -+ <li> Integrate Xach Beane's tilde expander into the parser, -+ or something similar that is shell-friendly or shell-compatible. -+ I'd rather keep ASDF minimal. But maybe this precisely keeps it -+ minimal by removing the need for evaluated entries that ASDF has? -+ i.e. uses of <code>USER-HOMEDIR-PATHNAME</code> and <code>$SBCL_HOME</code> -+ Hopefully, these are already superseded by the <code>:default-registry</code> -+ -+ <li> Using the shell-unfriendly syntax <code>/**</code> instead of <code>//</code> to specify recursion -+ down a filesystem tree in the environment variable. -+ It isn't that Lisp friendly either. -+</ul> -+ -+<h3 class="section">7.13 TODO</h3> -+ -+ <ul> -+<li>Add examples -+</ul> -+ -+<h3 class="section">7.14 Credits for the source-registry</h3> -+ -+<p>Thanks a lot to Stelian Ionescu for the initial idea. -+ -+ <p>Thanks to Rommel Martinez for the initial implementation attempt. -+ -+ <p>All bad design ideas and implementation bugs are to mine, not theirs. -+But so are good design ideas and elegant implementation tricks. -+ -+ <p>— Francois-Rene Rideau <a href="mailto:fare@tunes.org">fare@tunes.org</a>, Mon, 22 Feb 2010 00:07:33 -0500 -+ -+<p><a name="Controlling-where-ASDF-saves-compiled-files"></a> -+ -+<!-- node-name, next, previous, up --> -+<h2 class="chapter">8 Controlling where ASDF saves compiled files</h2> -+ -+<p><a name="index-asdf_002doutput_002dtranslations-52"></a><a name="index-ASDF_005fOUTPUT_005fTRANSLATIONS-53"></a> -+Each Common Lisp implementation has its own format -+for compiled files (fasls for short, short for “fast loading”). -+If you use multiple implementations -+(or multiple versions of the same implementation), -+you'll soon find your source directories -+littered with various <samp><span class="file">fasl</span></samp>s, <samp><span class="file">dfsl</span></samp>s, <samp><span class="file">cfsl</span></samp>s and so on. -+Worse yet, some implementations use the same file extension -+while changing formats from version to version (or platform to platform) -+which means that you'll have to recompile binaries -+as you switch from one implementation to the next. -+ -+ <p>Since ASDF 2, ASDF includes the <code>asdf-output-translations</code> facility -+to mitigate the problem. -+ -+<h3 class="section">8.1 Configurations</h3> -+ -+<p>Configurations specify mappings from input locations to output locations. -+Once again we rely on the XDG base directory specification for configuration. -+See <a href="#Controlling-where-ASDF-searches-for-systems">XDG base directory</a>. -+ -+ <ol type=1 start=1> -+ -+ <li>Some hardcoded wrapping output translations configuration may be used. -+This allows special output translations (or usually, invariant directories) -+to be specified corresponding to the similar special entries in the source registry. -+ -+ <li>An application may explicitly initialize the output-translations -+configuration using the Configuration API -+in which case this takes precedence. -+(see <a href="#Controlling-where-ASDF-saves-compiled-files">Configuration API</a>.) -+It may itself compute this configuration from the command-line, -+from a script, from its own configuration file, etc. -+ -+ <li>The source registry will be configured from -+the environment variable <code>ASDF_OUTPUT_TRANSLATIONS</code> if it exists. -+ -+ <li>The source registry will be configured from -+user configuration file -+<samp><span class="file">$XDG_CONFIG_DIRS/common-lisp/asdf-output-translations.conf</span></samp> -+(which defaults to -+<samp><span class="file">~/.config/common-lisp/asdf-output-translations.conf</span></samp>) -+if it exists. -+ -+ <li>The source registry will be configured from -+user configuration directory -+<samp><span class="file">$XDG_CONFIG_DIRS/common-lisp/asdf-output-translations.conf.d/</span></samp> -+(which defaults to -+<samp><span class="file">~/.config/common-lisp/asdf-output-translations.conf.d/</span></samp>) -+if it exists. -+ -+ <li>The source registry will be configured from -+system configuration file -+<samp><span class="file">/etc/common-lisp/asdf-output-translations.conf</span></samp> -+if it exists. -+ -+ <li>The source registry will be configured from -+system configuration directory -+<samp><span class="file">/etc/common-lisp/asdf-output-translations.conf.d/</span></samp> -+if it exists. -+ -+ </ol> -+ -+ <p>Each of these configurations is specified as a SEXP -+in a trival domain-specific language (defined below). -+Additionally, a more shell-friendly syntax is available -+for the environment variable (defined yet below). -+ -+ <p>Each of these configurations is only used if the previous -+configuration explicitly or implicitly specifies that it -+includes its inherited configuration. -+ -+ <p>Note that by default, a per-user cache is used for output files. -+This allows the seamless use of shared installations of software -+between several users, and takes files out of the way of the developers -+when they browse source code, -+at the expense of taking a small toll when developers have to clean up -+output files and find they need to get familiar with output-translations first. -+ -+<h3 class="section">8.2 Backward Compatibility</h3> -+ -+<p><a name="index-ASDF_002dBINARY_002dLOCATIONS-compatibility-54"></a> -+ -+ <p>We purposefully do NOT provide backward compatibility with earlier versions of -+<code>ASDF-Binary-Locations</code> (8 Sept 2009), -+<code>common-lisp-controller</code> (7.0) or -+<code>cl-launch</code> (2.35), -+each of which had similar general capabilities. -+The previous APIs of these programs were not designed -+for configuration by the end-user -+in an easy way with configuration files. -+Recent versions of same packages use -+the new <code>asdf-output-translations</code> API as defined below: -+<code>common-lisp-controller</code> (7.2) and <code>cl-launch</code> (3.000). -+<code>ASDF-Binary-Locations</code> is fully superseded and not to be used anymore. -+ -+ <p>This incompatibility shouldn't inconvenience many people. -+Indeed, few people use and customize these packages; -+these few people are experts who can trivially adapt to the new configuration. -+Most people are not experts, could not properly configure these features -+(except inasmuch as the default configuration of -+<code>common-lisp-controller</code> and/or <code>cl-launch</code> -+might have been doing the right thing for some users), -+and yet will experience software that “just works”, -+as configured by the system distributor, or by default. -+ -+ <p>Nevertheless, if you are a fan of <code>ASDF-Binary-Locations</code>, -+we provide a limited emulation mode: -+ -+<div class="defun"> -+— Function: <b>enable-asdf-binary-locations-compatibility</b><var> &key centralize-lisp-binaries default-toplevel-directory include-per-user-information map-all-source-files source-to-target-mappings<a name="index-enable_002dasdf_002dbinary_002dlocations_002dcompatibility-55"></a></var><br> -+<blockquote><p>This function will initialize the new <code>asdf-output-translations</code> facility in a way -+that emulates the behavior of the old <code>ASDF-Binary-Locations</code> facility. -+Where you would previously set global variables -+<var>*centralize-lisp-binaries*</var>, -+<var>*default-toplevel-directory*</var>, -+<var>*include-per-user-information*</var>, -+<var>*map-all-source-files*</var> or <var>*source-to-target-mappings*</var> -+you will now have to pass the same values as keyword arguments to this function. -+Note however that as an extension the <code>:source-to-target-mappings</code> keyword argument -+will accept any valid pathname designator for <code>asdf-output-translations</code> -+instead of just strings and pathnames. -+</p></blockquote></div> -+ -+ <p>If you insist, you can also keep using the old <code>ASDF-Binary-Locations</code> -+(the one available as an extension to load of top of ASDF, -+not the one built into a few old versions of ASDF), -+but first you must disable <code>asdf-output-translations</code> -+with <code>(asdf:disable-output-translations)</code>, -+or you might experience “interesting” issues. -+ -+ <p>Also, note that output translation is enabled by default. -+To disable it, use <code>(asdf:disable-output-translations)</code>. -+ -+<h3 class="section">8.3 Configuration DSL</h3> -+ -+<p>Here is the grammar of the SEXP DSL -+for <code>asdf-output-translations</code> configuration: -+ -+<pre class="verbatim">;; A configuration is single SEXP starting with keyword :source-registry -+;; followed by a list of directives. -+CONFIGURATION := (:output-translations DIRECTIVE ...) -+ -+;; A directive is one of the following: -+DIRECTIVE := -+ ;; INHERITANCE DIRECTIVE: -+ ;; Your configuration expression MUST contain -+ ;; exactly one of either of these: -+ :inherit-configuration | ; splices inherited configuration (often specified last) -+ :ignore-inherited-configuration | ; drop inherited configuration (specified anywhere) -+ -+ ;; forward compatibility directive (since ASDF 2.011.4), useful when -+ ;; you want to use new configuration features but have to bootstrap a -+ ;; the newer required ASDF from an older release that doesn't sport said features: -+ :ignore-invalid-entries | ; drops subsequent invalid entries instead of erroring out -+ -+ ;; include a configuration file or directory -+ (:include PATHNAME-DESIGNATOR) | -+ -+ ;; enable global cache in ~/.common-lisp/cache/sbcl-1.0.45-linux-amd64/ or something. -+ :enable-user-cache | -+ ;; Disable global cache. Map / to / -+ :disable-cache | -+ -+ ;; add a single directory to be scanned (no recursion) -+ (DIRECTORY-DESIGNATOR DIRECTORY-DESIGNATOR) -+ -+ ;; use a function to return the translation of a directory designator -+ (DIRECTORY-DESIGNATOR (:function TRANSLATION-FUNCTION)) -+ -+DIRECTORY-DESIGNATOR := -+ NIL | ;; As source: skip this entry. As destination: same as source -+ T | ;; as source matches anything, as destination leaves pathname unmapped. -+ ABSOLUTE-COMPONENT-DESIGNATOR ;; same as in the source-registry language -+ -+TRANSLATION-FUNCTION := -+ SYMBOL | ;; symbol of a function that takes two arguments, -+ ;; the pathname to be translated and the matching DIRECTORY-DESIGNATOR -+ LAMBDA ;; A form which evalutates to a function taking two arguments consisting of -+ ;; the pathname to be translated and the matching DIRECTORY-DESIGNATOR -+ -+</pre> -+ -+ <p>Relative components better be either relative -+or subdirectories of the path before them, or bust. -+ -+ <p>The last component, if not a pathname, is notionally completed by <samp><span class="file">/**/*.*</span></samp>. -+You can specify more fine-grained patterns -+by using a pathname object as the last component -+e.g. <samp><span class="file">#p"some/path/**/foo*/bar-*.fasl"</span></samp> -+ -+ <p>You may use <code>#+features</code> to customize the configuration file. -+ -+ <p>The second designator of a mapping may be <code>NIL</code>, indicating that files are not mapped -+to anything but themselves (same as if the second designator was the same as the first). -+ -+ <p>When the first designator is <code>t</code>, -+the mapping always matches. -+When the first designator starts with <code>:root</code>, -+the mapping matches any host and device. -+In either of these cases, if the second designator -+isn't <code>t</code> and doesn't start with <code>:root</code>, -+then strings indicating the host and pathname are somehow copied -+in the beginning of the directory component of the source pathname -+before it is translated. -+ -+ <p>When the second designator is <code>t</code>, the mapping is the identity. -+When the second designator starts with <code>:root</code>, -+the mapping preserves the host and device of the original pathname. -+Notably, this allows you to map files -+to a subdirectory of the whichever directory the file is in. -+Though the syntax is not quite as easy to use as we'd like, -+you can have an (source destination) mapping entry such as follows -+in your configuration file, -+or you may use <code>enable-asdf-binary-locations-compatibility</code> -+with <code>:centralize-lisp-binaries nil</code> -+which will do the same thing internally for you: -+<pre class="verbatim"> #.(let ((wild-subdir (make-pathname :directory '(:relative :wild-inferiors))) -+ (wild-file (make-pathname :name :wild :version :wild :type :wild))) -+ `((:root ,wild-subdir ,wild-file) ;; Or using the implicit wildcard, just :root -+ (:root ,wild-subdir :implementation ,wild-file))) -+</pre> -+Starting with ASDF 2.011.4, you can use the simpler: -+ <code>`(:root (:root :**/ :implementation :*.*.*))</code> -+ -+ <p><code>:include</code> statements cause the search to recurse with the path specifications -+from the file specified. -+ -+ <p>If the <code>translate-pathname</code> mechanism cannot achieve a desired -+translation, the user may provide a function which provides the -+required algorithim. Such a translation function is specified by -+supplying a list as the second <code>directory-designator</code> -+the first element of which is the keyword <code>:function</code>, -+and the second element of which is -+either a symbol which designates a function or a lambda expression. -+The function designated by the second argument must take two arguments, -+the first being the pathname of the source file, -+the second being the wildcard that was matched. -+The result of the function invocation should be the translated pathname. -+ -+ <p>An <code>:inherit-configuration</code> statement cause the search to recurse with the path -+specifications from the next configuration. -+See <a href="#Controlling-where-ASDF-saves-compiled-files">Configurations</a>, above. -+ -+ <ul> -+<li><code>:enable-user-cache</code> is the same as <code>(t :user-cache)</code>. -+<li><code>:disable-cache</code> is the same as <code>(t t)</code>. -+<li><code>:user-cache</code> uses the contents of variable <code>asdf::*user-cache*</code> -+which by default is the same as using -+<code>(:home ".cache" "common-lisp" :implementation)</code>. -+<li><code>:system-cache</code> uses the contents of variable <code>asdf::*system-cache*</code> -+which by default is the same as using -+<code>("/var/cache/common-lisp" :uid :implementation-type)</code> -+(on Unix and cygwin), or something semi-sensible on Windows. -+</ul> -+ -+<h3 class="section">8.4 Configuration Directories</h3> -+ -+<p>Configuration directories consist in files each contains -+a list of directives without any enclosing -+<code>(:output-translations ...)</code> form. -+The files will be sorted by namestring as if by <code>string<</code> and -+the lists of directives of these files with be concatenated in order. -+An implicit <code>:inherit-configuration</code> will be included -+at the <em>end</em> of the list. -+ -+ <p>This allows for packaging software that has file granularity -+(e.g. Debian's <samp><span class="command">dpkg</span></samp> or some future version of <samp><span class="command">clbuild</span></samp>) -+to easily include configuration information about software being distributed. -+ -+ <p>The convention is that, for sorting purposes, -+the names of files in such a directory begin with two digits -+that determine the order in which these entries will be read. -+Also, the type of these files is conventionally <code>"conf"</code> -+and as a limitation of some implementations, the type cannot be <code>NIL</code>. -+ -+ <p>Directories may be included by specifying a directory pathname -+or namestring in an <code>:include</code> directive, e.g.: -+<pre class="verbatim"> (:include "/foo/bar/") -+</pre> -+ -+<h3 class="section">8.5 Shell-friendly syntax for configuration</h3> -+ -+<p>When considering environment variable <code>ASDF_OUTPUT_TRANSLATIONS</code> -+ASDF will skip to next configuration if it's an empty string. -+It will <code>READ</code> the string as an SEXP in the DSL -+if it begins with a paren <code>(</code> -+and it will be interpreted as a list of directories. -+Directories should come by pairs, indicating a mapping directive. -+Entries are separated -+by a <code>:</code> (colon) on Unix platforms (including cygwin), -+by a <code>;</code> (semicolon) on other platforms (mainly, Windows). -+ -+ <p>The magic empty entry, -+if it comes in what would otherwise be the first entry in a pair, -+indicates the splicing of inherited configuration. -+If it comes as the second entry in a pair, -+it indicates that the directory specified first is to be left untranslated -+(which has the same effect as if the directory had been repeated). -+ -+<h3 class="section">8.6 Semantics of Output Translations</h3> -+ -+<p>From the specified configuration, -+a list of mappings is extracted in a straightforward way: -+mappings are collected in order, recursing through -+included or inherited configuration as specified. -+To this list is prepended some implementation-specific mappings, -+and is appended a global default. -+ -+ <p>The list is then compiled to a mapping table as follows: -+for each entry, in order, resolve the first designated directory -+into an actual directory pathname for source locations. -+If no mapping was specified yet for that location, -+resolve the second designated directory to an output location directory -+add a mapping to the table mapping the source location to the output location, -+and add another mapping from the output location to itself -+(unless a mapping already exists for the output location). -+ -+ <p>Based on the table, a mapping function is defined, -+mapping source pathnames to output pathnames: -+given a source pathname, locate the longest matching prefix -+in the source column of the mapping table. -+Replace that prefix by the corresponding output column -+in the same row of the table, and return the result. -+If no match is found, return the source pathname. -+(A global default mapping the filesystem root to itself -+may ensure that there will always be a match, -+with same fall-through semantics). -+ -+<h3 class="section">8.7 Caching Results</h3> -+ -+<p>The implementation is allowed to either eagerly compute the information -+from the configurations and file system, or to lazily re-compute it -+every time, or to cache any part of it as it goes. -+To explicitly flush any information cached by the system, use the API below. -+ -+<h3 class="section">8.8 Output location API</h3> -+ -+<p>The specified functions are exported from package ASDF. -+ -+<div class="defun"> -+— Function: <b>initialize-output-translations</b><var> &optional PARAMETER<a name="index-initialize_002doutput_002dtranslations-56"></a></var><br> -+<blockquote><p> will read the configuration and initialize all internal variables. -+ You may extend or override configuration -+ from the environment and configuration files -+ with the given <var>PARAMETER</var>, which can be -+ <code>NIL</code> (no configuration override), -+ or a SEXP (in the SEXP DSL), -+ a string (as in the string DSL), -+ a pathname (of a file or directory with configuration), -+ or a symbol (fbound to function that when called returns one of the above). -+</p></blockquote></div> -+ -+<div class="defun"> -+— Function: <b>disable-output-translations</b><var><a name="index-disable_002doutput_002dtranslations-57"></a></var><br> -+<blockquote><p> will initialize output translations in a way -+ that maps every pathname to itself, -+ effectively disabling the output translation facility. -+</p></blockquote></div> -+ -+<div class="defun"> -+— Function: <b>clear-output-translations</b><var><a name="index-clear_002doutput_002dtranslations-58"></a></var><br> -+<blockquote><p> undoes any output translation configuration -+ and clears any cache for the mapping algorithm. -+ You might want to call this function -+ (or better, <code>clear-configuration</code>) -+ before you dump an image that would be resumed -+ with a different configuration, -+ and return an empty configuration. -+ Note that this does not include clearing information about -+ systems defined in the current image, only about -+ where to look for systems not yet defined. -+</p></blockquote></div> -+ -+<div class="defun"> -+— Function: <b>ensure-output-translations</b><var> &optional PARAMETER<a name="index-ensure_002doutput_002dtranslations-59"></a></var><br> -+<blockquote><p> checks whether output translations have been initialized. -+ If not, initialize them with the given <var>PARAMETER</var>. -+ This function will be called before any attempt to operate on a system. -+</p></blockquote></div> -+ -+<div class="defun"> -+— Function: <b>apply-output-translations</b><var> PATHNAME<a name="index-apply_002doutput_002dtranslations-60"></a></var><br> -+<blockquote><p> Applies the configured output location translations to <var>PATHNAME</var> -+ (calls <code>ensure-output-translations</code> for the translations). -+</p></blockquote></div> -+ -+ <p>Every time you use ASDF's <code>output-files</code>, or -+anything that uses it (that may compile, such as <code>operate</code>, <code>perform</code>, etc.), -+<code>ensure-output-translations</code> is called with parameter NIL, -+which the first time around causes your configuration to be read. -+If you change a configuration file, -+you need to explicitly <code>initialize-output-translations</code> again, -+or maybe <code>clear-output-translations</code> (or <code>clear-configuration</code>), -+which will cause the initialization to happen next time around. -+ -+<h3 class="section">8.9 Credits for output translations</h3> -+ -+<p>Thanks a lot to Bjorn Lindberg and Gary King for <code>ASDF-Binary-Locations</code>, -+and to Peter van Eynde for <code>Common Lisp Controller</code>. -+ -+ <p>All bad design ideas and implementation bugs are to mine, not theirs. -+But so are good design ideas and elegant implementation tricks. -+ -+ <p>— Francois-Rene Rideau <a href="mailto:fare@tunes.org">fare@tunes.org</a> -+ -+<!-- @section Default locations --> -+<!-- @findex output-files-for-system-and-operation --> -+<!-- The default binary location for each Lisp implementation --> -+<!-- is a subdirectory of each source directory. --> -+<!-- To account for different Lisps, Operating Systems, Implementation versions, --> -+<!-- and so on, ASDF borrows code from SLIME --> -+<!-- to create reasonable custom directory names. --> -+<!-- Here are some examples: --> -+<!-- @itemize --> -+<!-- @item --> -+<!-- SBCL, version 1.0.45 on Mac OS X for Intel: @code{sbcl-1.0.45-darwin-x86} --> -+<!-- @item --> -+<!-- Franz Allegro, version 8.0, ANSI Common Lisp: @code{allegro-8.0a-macosx-x86} --> -+<!-- @item --> -+<!-- Franz Allegro, version 8.1, Modern (case sensitive) Common Lisp: @code{allegro-8.1m-macosx-x86} --> -+<!-- @end itemize --> -+<!-- By default, all output file pathnames will be relocated --> -+<!-- to some thus-named subdirectory of @file{~/.cache/common-lisp/}. --> -+<!-- See the document @file{README.asdf-output-translations} --> -+<!-- for a full specification on how to configure @code{asdf-output-translations}. --> -+<p><a name="Error-handling"></a> -+ -+<!-- node-name, next, previous, up --> -+<h2 class="chapter">9 Error handling</h2> -+ -+<p><a name="index-SYSTEM_002dDEFINITION_002dERROR-61"></a><a name="index-OPERATION_002dERROR-62"></a> -+ -+<h3 class="section">9.1 ASDF errors</h3> -+ -+<p>If ASDF detects an incorrect system definition, it will signal a generalised instance of -+<code>SYSTEM-DEFINITION-ERROR</code>. -+ -+ <p>Operations may go wrong (for example when source files contain errors). -+These are signalled using generalised instances of -+<code>OPERATION-ERROR</code>. -+ -+<h3 class="section">9.2 Compilation error and warning handling</h3> -+ -+<p><a name="index-g_t_002acompile_002dfile_002dwarnings_002dbehaviour_002a-63"></a><a name="index-g_t_002acompile_002dfile_002derrors_002dbehavior_002a-64"></a> -+ASDF checks for warnings and errors when a file is compiled. -+The variables <var>*compile-file-warnings-behaviour*</var> and -+<var>*compile-file-errors-behavior*</var> -+control the handling of any such events. -+The valid values for these variables are -+<code>:error</code>, <code>:warn</code>, and <code>:ignore</code>. -+ -+<p><a name="Miscellaneous-additional-functionality"></a> -+ -+<!-- node-name, next, previous, up --> -+<h2 class="chapter">10 Miscellaneous additional functionality</h2> -+ -+<p>ASDF includes several additional features that are generally -+useful for system definition and development. -+ -+<h3 class="section">10.1 Controlling file compilation</h3> -+ -+<p>When declaring a component (system, module, file), -+you can specify a keyword argument <code>:around-compile function</code>. -+If left unspecified (and therefore unbound), -+the value will be inherited from the parent component if any, -+or with a default of <code>nil</code> -+if no value is specified in any transitive parent. -+ -+ <p>The argument must be a either <code>nil</code>, a fbound symbol, -+a lambda-expression (e.g. <code>(lambda (thunk) ...(funcall thunk ...) ...)</code>) -+a function object (e.g. using <code>#.#'</code> but that's discouraged -+because it prevents the introspection done by e.g. asdf-dependency-grovel), -+or a string that when <code>read</code> yields a symbol or a lambda-expression. -+<code>nil</code> means the normal compile-file function will be called. -+A non-nil value designates a function of one argument -+that will be called with a function that will -+invoke <code>compile-file*</code> with various arguments; -+the around-compile hook may supply additional keyword arguments -+to pass to that call to <code>compile-file*</code>. -+ -+ <p>One notable argument that is heeded by <code>compile-file*</code> is -+<code>:compile-check</code>, -+a function called when the compilation was otherwise a success, -+with the same arguments as <code>compile-file</code>; -+the function shall return true if the compilation -+and its resulting compiled file respected all system-specific invariants, -+and false (<code>nil</code>) if it broke any of those invariants; -+it may issue warnings or errors before it returns <code>nil</code>. -+(NB: The ability to pass such extra flags -+is only available starting with ASDF 2.22.3.) -+This feature is notably exercised by asdf-finalizers. -+ -+ <p>By using a string, you may reference -+a function, symbol and/or package -+that will only be created later during the build, but -+isn't yet present at the time the defsystem form is evaluated. -+However, if your entire system is using such a hook, you may have to -+explicitly override the hook with <code>nil</code> for all the modules and files -+that are compiled before the hook is defined. -+ -+ <p>Using this hook, you may achieve such effects as: -+locally renaming packages, -+binding <var>*readtables*</var> and other syntax-controlling variables, -+handling warnings and other conditions, -+proclaiming consistent optimization settings, -+saving code coverage information, -+maintaining meta-data about compilation timings, -+setting gensym counters and PRNG seeds and other sources of non-determinism, -+overriding the source-location and/or timestamping systems, -+checking that some compile-time side-effects were properly balanced, -+etc. -+ -+ <p>Note that there is no around-load hook. This is on purpose. -+Some implementations such as ECL, GCL or MKCL link object files, -+which allows for no such hook. -+Other implementations allow for concatenating FASL files, -+which doesn't allow for such a hook either. -+We aim to discourage something that's not portable, -+and has some dubious impact on performance and semantics -+even when it is possible. -+Things you might want to do with an around-load hook -+are better done around-compile, -+though it may at times require some creativity -+(see e.g. the <code>package-renaming</code> system). -+ -+<h3 class="section">10.2 Controlling source file character encoding</h3> -+ -+<p>Starting with ASDF 2.21, components accept a <code>:encoding</code> option -+so authors may specify which character encoding should be used -+to read and evaluate their source code. -+When left unspecified, the encoding is inherited -+from the parent module or system; -+if no encoding is specified at any point, -+the default <code>:autodetect</code> is assumed. -+By default, only <code>:default</code>, <code>:utf-8</code> -+and <code>:autodetect</code> are accepted. -+<code>:autodetect</code>, the default, calls -+<code>*encoding-detection-hook*</code> which by default always returns -+<code>*default-encoding*</code> which itself defaults to <code>:default</code>. -+ -+ <p>In other words, there now are plenty of extension hooks, but -+by default ASDF follows the backwards compatible behavior -+of using whichever <code>:default</code> encoding your implementation uses, -+which itself may or may not vary based on environment variables -+and other locale settings. -+In practice this means that only source code that only uses ASCII -+is guaranteed to be read the same on all implementations -+independently from any user setting. -+ -+ <p>Additionally, for backward-compatibility with older versions of ASDF -+and/or with implementations that do not support unicode and its many encodings, -+you may want to use -+the reader conditionals <code>#+asdf-unicode #+asdf-unicode</code> -+to protect any <code>:encoding </code><em>encoding</em> statement -+as <code>:asdf-unicode</code> will be present in <code>*features*</code> -+only if you're using a recent ASDF -+on an implementation that supports unicode. -+We recommend that you avoid using unprotected <code>:encoding</code> specifications -+until after ASDF 2.21 or later becomes widespread, hopefully by the end of 2012. -+ -+ <p>While it offers plenty of hooks for extension, -+and one such extension is being developed (see below), -+ASDF itself only recognizes one encoding beside <code>:default</code>, -+and that is <code>:utf-8</code>, which is the <em>de facto</em> standard, -+already used by the vast majority of libraries that use more than ASCII. -+On implementations that do not support unicode, -+the feature <code>:asdf-unicode</code> is absent, and -+the <code>:default</code> external-format is used -+to read even source files declared as <code>:utf-8</code>. -+On these implementations, non-ASCII characters -+intended to be read as one CL character -+may thus end up being read as multiple CL characters. -+In most cases, this shouldn't affect the software's semantics: -+comments will be skipped just the same, strings with be read and printed -+with slightly different lengths, symbol names will be accordingly longer, -+but none of it should matter. -+But a few systems that actually depend on unicode characters -+may fail to work properly, or may work in a subtly different way. -+See for instance <code>lambda-reader</code>. -+ -+ <p>We invite you to embrace UTF-8 -+as the encoding for non-ASCII characters starting today, -+even without any explicit specification in your <code>.asd</code> files. -+Indeed, on some implementations and configurations, -+UTF-8 is already the <code>:default</code>, -+and loading your code may cause errors if it is encoded in anything but UTF-8. -+Therefore, even with the legacy behavior, -+non-UTF-8 is guaranteed to break for some users, -+whereas UTF-8 is pretty much guaranteed not to break anywhere -+(provided you do <em>not</em> use a BOM), -+although it might be read incorrectly on some implementations. -+In the future, we intend to make <code>:utf-8</code> -+the default value of <code>*default-encoding*</code>, -+to be enforced everywhere, so at least the code is guaranteed -+to be read correctly everywhere it can be. -+ -+ <p>If you need non-standard character encodings for your source code, -+use the extension system <code>asdf-encodings</code>, by specifying -+<code>:defsystem-depends-on (:asdf-encodings)</code> in your <code>defsystem</code>. -+This extension system will register support for more encodings using the -+<code>*encoding-external-format-hook*</code> facility, -+so you can explicitly specify <code>:encoding :latin1</code> -+in your <code>.asd</code> file. -+Using the <code>*encoding-detection-hook*</code> it will also -+eventually implement some autodetection of a file's encoding -+from an emacs-style <code>-*- mode: lisp ; coding: latin1 -*-</code> declaration, -+or otherwise based on an analysis of octet patterns in the file. -+At this point, asdf-encoding only supports the encodings -+that are supported as part of your implementation. -+Since the list varies depending on implementations, -+we once again recommend you use <code>:utf-8</code> everywhere, -+which is the most portable (next is <code>:latin1</code>). -+ -+ <p>If you're not using a version of Quicklisp that has it, -+you may get the source for <code>asdf-encodings</code> using git: -+<kbd>git clone git://common-lisp.net/projects/asdf/asdf-encodings.git</kbd> -+or -+<kbd>git clone ssh://common-lisp.net/project/asdf/git/asdf-encodings.git</kbd>. -+You can also browse the repository on -+<a href="http://common-lisp.net/gitweb?p=projects/asdf/asdf-encodings.git">http://common-lisp.net/gitweb?p=projects/asdf/asdf-encodings.git</a>. -+ -+ <p>In the future, we intend to change the default <code>*default-encoding*</code> -+to <code>:utf-8</code>, which is already the de facto standard -+for most libraries that use non-ASCII characters: -+utf-8 works everywhere and was backhandedly enforced by -+a lot of people using SBCL and utf-8 and sending reports to authors -+so they make their packages compatible. -+A survey showed only about a handful few libraries -+are incompatible with non-UTF-8, and then, only in comments, -+and we believe that authors will adopt UTF-8 when prompted. -+See the April 2012 discussion on the asdf-devel mailing-list. -+For backwards compatibility with users who insist on a non-UTF-8 encoding, -+but cannot immediately transition to using <code>asdf-encodings</code> -+(maybe because it isn't ready), it will still be possible to use -+the <code>:encoding :default</code> option in your <code>defsystem</code> form -+to restore the behavior of ASDF 2.20 and earlier. -+This shouldn't be required in libraries, -+because user pressure as mentioned above will already have pushed -+library authors towards using UTF-8; -+but authors of end-user programs might care. -+ -+ <p>When you use <code>asdf-encodings</code>, any further loaded <code>.asd</code> file -+will use the autodetection algorithm to determine its encoding; -+yet if you depend on this detection happening, -+you may want to explicitly load <code>asdf-encodings</code> early in your build, -+for by the time you can use <code>:defsystem-depends-on</code>, -+it is already too late to load it. -+In practice, this means that the <code>*default-encoding*</code> -+is usually used for <code>.asd</code> files. -+Currently, this defaults to <code>:default</code> for backwards compatibility, -+and that means that you shouldn't rely on non-ASCII characters in a .asd file. -+Since component (path)names are the only real data in these files, -+and non-ASCII characters are not very portable for file names, -+this isn't too much of an issue. -+We still encourage you to use either plain ASCII or UTF-8 -+in <code>.asd</code> files, -+as we intend to make <code>:utf-8</code> the default encoding in the future. -+This might matter, for instance, in meta-data about author's names. -+ -+<h3 class="section">10.3 Miscellaneous Functions</h3> -+ -+<p>Most of these functions are not exported by ASDF anymore, -+but only used for private purposes of ASDF. -+Please use ASDF-UTILS for the same functions exported from a stable library. -+ -+<div class="defun"> -+— Function: <b>coerce-pathname</b><var> name &key type defaults<a name="index-coerce_002dpathname-65"></a></var><br> -+<blockquote> -+ <p>This function (available starting with ASDF 2.012.11) -+takes an argument, and portably interprets it as a pathname. -+If the argument <var>name</var> is a pathname or <code>nil</code>, it is passed through; -+if it's a symbol, it's interpreted as a string by downcasing it; -+if it's a string, it is first separated using <code>/</code> into substrings; -+the leading substrings denote subdirectories of a relative pathname. -+If <var>type</var> is <code>:directory</code> or the string ends with <code>/</code>, -+the last substring is also a subdirectory; -+if <var>type</var> is a string, it is used as the type of the pathname, and -+the last substring is the name component of the pathname; -+if <var>type</var> is <code>nil</code>, the last substring specifies both name and type components -+of the pathname, with the last <code>.</code> separating them, or only the name component -+if there's no last <code>.</code> or if there is only one dot and it's the first character. -+The host, device and version components come from <var>defaults</var>, which defaults to -+<var>*default-pathname-defaults*</var>; but that shouldn't matter if you use <code>merge-pathnames*</code>. -+ -+ </blockquote></div> -+ -+<div class="defun"> -+— Function: <b>merge-pathnames*</b><var> &key specified defaults<a name="index-merge_002dpathnames_002a-66"></a></var><br> -+<blockquote> -+ <p>This function is a replacement for <code>merge-pathnames</code> that uses the host and device -+from the <var>defaults</var> rather than the <var>specified</var> pathname when the latter -+is a relative pathname. This allows ASDF and its users to create and use relative pathnames -+without having to know beforehand what are the host and device -+of the absolute pathnames they are relative to. -+ -+ </blockquote></div> -+ -+<div class="defun"> -+— Function: <b>system-relative-pathname</b><var> system name &key type<a name="index-system_002drelative_002dpathname-67"></a></var><br> -+<blockquote> -+ <p>It's often handy to locate a file relative to some system. -+The <code>system-relative-pathname</code> function meets this need. -+ -+ <p>It takes two mandatory arguments <var>system</var> and <var>name</var> -+and a keyword argument <var>type</var>: -+<var>system</var> is name of a system, whereas <var>name</var> and optionally <var>type</var> -+specify a relative pathname, interpreted like a component pathname specifier -+by <code>coerce-pathname</code>. See <a href="#The-defsystem-grammar">Pathname specifiers</a>. -+ -+ <p>It returns a pathname built from the location of the system's -+source directory and the relative pathname. For example: -+ -+ <pre class="lisp"> > (asdf:system-relative-pathname 'cl-ppcre "regex.data") -+ #P"/repository/other/cl-ppcre/regex.data" -+</pre> -+ </blockquote></div> -+ -+<div class="defun"> -+— Function: <b>system-source-directory</b><var> system-designator<a name="index-system_002dsource_002ddirectory-68"></a></var><br> -+<blockquote> -+ <p>ASDF does not provide a turnkey solution for locating -+data (or other miscellaneous) files -+that are distributed together with the source code of a system. -+Programmers can use <code>system-source-directory</code> to find such files. -+Returns a pathname object. -+The <var>system-designator</var> may be a string, symbol, or ASDF system object. -+</p></blockquote></div> -+ -+<div class="defun"> -+— Function: <b>clear-system</b><var> system-designator<a name="index-clear_002dsystem-69"></a></var><br> -+<blockquote> -+ <p>It is sometimes useful to force recompilation of a previously loaded system. -+In these cases, it may be useful to <code>(asdf:clear-system :foo)</code> -+to remove the system from the table of currently loaded systems; -+the next time the system <code>foo</code> or one that depends on it is re-loaded, -+<code>foo</code> will then be loaded again. -+Alternatively, you could touch <code>foo.asd</code> or -+remove the corresponding fasls from the output file cache. -+(It was once conceived that one should provide -+a list of systems the recompilation of which to force -+as the <code>:force</code> keyword argument to <code>load-system</code>; -+but this has never worked, and though the feature was fixed in ASDF 2.000, -+it remains <code>cerror</code>'ed out as nobody ever used it.) -+ -+ <p>Note that this does not and cannot by itself undo the previous loading -+of the system. Common Lisp has no provision for such an operation, -+and its reliance on irreversible side-effects to global datastructures -+makes such a thing impossible in the general case. -+If the software being re-loaded is not conceived with hot upgrade in mind, -+this re-loading may cause many errors, warnings or subtle silent problems, -+as packages, generic function signatures, structures, types, macros, constants, etc. -+are being redefined incompatibly. -+It is up to the user to make sure that reloading is possible and has the desired effect. -+In some cases, extreme measures such as recursively deleting packages, -+unregistering symbols, defining methods on <code>update-instance-for-redefined-class</code> -+and much more are necessary for reloading to happen smoothly. -+ASDF itself goes through notable pains to make such a hot upgrade possible -+with respect to its own code, and what it does is ridiculously complex; -+look at the beginning of <samp><span class="file">asdf.lisp</span></samp> to see what it does. -+</p></blockquote></div> -+ -+<div class="defun"> -+— Function: <b>run-program</b><var><a name="index-run_002dprogram-70"></a></var><br> -+<blockquote> -+ <p>run-program takes a <var>COMMAND</var> argument that is either -+a list of a program path and its arguments, -+or a string to be executed by a shell. -+It spawns the command, waits for it to return, -+verifies that it exited cleanly (unless told not too below), -+and optionally captures and processes its output. -+It accepts many keyword arguments to configure its behavior. -+ -+ <p><code>output</code> is its most important argument; -+it specifies how the output is captured and processed. -+If it is <code>nil</code>, then the output is not captured. -+If it is <code>:interactive</code>, then -+input and output are inherited from the current process, -+which the subprocess can control until it exits. -+Otherwise, the output is captured and redirected to a stream, -+and processed by <code>slurp-input-stream</code> with the object as first argument. -+See below. -+ -+ <p><code>element-type</code> and <code>external-format</code> are passed on -+to your Lisp implementation, when available, for creation of the output stream. -+ -+ <p><code>force-shell</code> forces evaluation of the command through a shell, -+even if it was passed as a list rather than a string. -+ -+ <p><code>ignore-error-status</code> causes <code>run-program</code> -+to not raise an error if the spawned program exits in error. -+Following POSIX convention, an error is anything but -+a normal exit with status code zero. -+ -+ <p>run-program works on all platforms supported by ASDF, except Genera. -+ -+ </blockquote></div> -+ -+<div class="defun"> -+— Function: <b>slurp-input-stream</b><var><a name="index-slurp_002dinput_002dstream-71"></a></var><br> -+<blockquote> -+ <p>It's a generic function of two arguments, a target object and an input stream, -+and accepting keyword arguments. -+Predefined methods based on the target object are as follow: -+ -+ <p>If the object is a function, the function is called with the stream as argument. -+ -+ <p>If the object is a cons, its first element is applied to its rest appended by -+a list of the input stream. -+ -+ <p>If the object is an output stream, the contents of the input stream are copied to it. -+If the linewise argument is provided, copying happens line by line, -+and an optional prefix is printed before each line. -+Otherwise, copying happen based on a buffer of size buffer-size, -+using the element-type. -+ -+ <p>If the object is 'string or :string, the content is captured into a string -+of the given element-type. -+ -+ <p>If the object is :lines, the content is captured as a list of strings, -+one per line, without line ending. If the count argument is provided, -+it is a maximum count of lines to be read. -+ -+ <p>If the object is :line, the content is capture as with :lines above, -+and then its sub-object is extracted with the path argument, -+which defaults to 0, extracting the first line. -+A number will extract the corresponding line. -+See the documentation for asdf-driver:sub-object. -+ -+ <p>If the object is :forms, the content is captured as a list of S-expressions, -+as read by the Lisp reader. -+If the count argument is provided, -+it is a maximum count of lines to be read. -+We recommend you control the syntax with such macro as -+asdf-driver:with-safe-io-syntax. -+ -+ <p>If the object is :form, the content is capture as with :forms above, -+and then its sub-object is extracted with the path argument, -+which defaults to 0, extracting the first form. -+A number will extract the corresponding form. -+See the documentation for asdf-driver:sub-object. -+We recommend you control the syntax with such macro as -+asdf-driver:with-safe-io-syntax. -+ -+ </blockquote></div> -+ -+<div class="defun"> -+— Function: <b>run-shell-command</b><var><a name="index-run_002dshell_002dcommand-72"></a></var><br> -+<blockquote> -+ <p>This function is obsolete and present only for the sake of backwards-compatibility: -+“If it's not backwards, it's not compatible”. We strongly discourage its use. -+Its current behavior is only well-defined on Unix platforms -+(which include MacOS X and cygwin). On Windows, anything goes. -+The following documentation is only for the purpose of your migrating away from it -+in a way that preserves semantics. -+ -+ <p>Instead we recommend the use <code>run-program</code> above -+available as part of ASDF since ASDF 3. -+ -+ <p><code>run-shell-command</code> takes as arguments a <code>format</code> control-string -+and arguments to be passed to <code>format</code> after this control-string -+to produce a string. -+This string is a command that will be evaluated with a POSIX shell if possible; -+yet, on Windows, some implementations will use CMD.EXE, -+while others (like SBCL) will make an attempt at invoking a POSIX shell -+(and fail if it is not present). -+</p></blockquote></div> -+ -+<p><a name="Getting-the-latest-version"></a> -+ -+<!-- node-name, next, previous, up --> -+<h2 class="chapter">11 Getting the latest version</h2> -+ -+<p>Decide which version you want. -+The <code>master</code> branch is where development happens; -+its <code>HEAD</code> is usually OK, including the latest fixes and portability tweaks, -+but an occasional regression may happen despite our (limited) test suite. -+ -+ <p>The <code>release</code> branch is what cautious people should be using; -+it has usually been tested more, and releases are cut at a point -+where there isn't any known unresolved issue. -+ -+ <p>You may get the ASDF source repository using git: -+<kbd>git clone git://common-lisp.net/projects/asdf/asdf.git</kbd> -+ -+ <p>You will find the above referenced tags in this repository. -+You can also browse the repository on -+<a href="http://common-lisp.net/gitweb?p=projects/asdf/asdf.git">http://common-lisp.net/gitweb?p=projects/asdf/asdf.git</a>. -+ -+ <p>Discussion of ASDF development is conducted on the -+mailing list -+<kbd>asdf-devel@common-lisp.net</kbd>. -+<a href="http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel">http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel</a> -+ -+<p><a name="FAQ"></a> -+ -+<!-- node-name, next, previous, up --> -+<h2 class="chapter">12 FAQ</h2> -+ -+<h3 class="section">12.1 “Where do I report a bug?”</h3> -+ -+<p>ASDF bugs are tracked on launchpad: <a href="https://launchpad.net/asdf">https://launchpad.net/asdf</a>. -+ -+ <p>If you're unsure about whether something is a bug, or for general discussion, -+use the <a href="http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel">asdf-devel mailing list</a> -+ -+<h3 class="section">12.2 “What has changed between ASDF 1 and ASDF 2?”</h3> -+ -+<h4 class="subsection">12.2.1 What are ASDF 1 and ASDF 2?</h4> -+ -+<p>On May 31st 2010, we have released ASDF 2. -+ASDF 2 refers to release 2.000 and later. -+(Releases between 1.656 and 1.728 were development releases for ASDF 2.) -+ASDF 1 to any release earlier than 1.369 or so. -+If your ASDF doesn't sport a version, it's an old ASDF 1. -+ -+ <p>ASDF 2 and its release candidates push -+<code>:asdf2</code> onto <code>*features*</code> so that if you are writing -+ASDF-dependent code you may check for this feature -+to see if the new API is present. -+<em>All</em> versions of ASDF should have the <code>:asdf</code> feature. -+ -+ <p>Additionally, all versions of ASDF 2 -+define a function <code>(asdf:asdf-version)</code> you may use to query the version; -+and the source code of recent versions of ASDF 2 features the version number -+prominently on the second line of its source code. -+ -+ <p>If you are experiencing problems or limitations of any sort with ASDF 1, -+we recommend that you should upgrade to ASDF 2, -+or whatever is the latest release. -+ -+<h4 class="subsection">12.2.2 ASDF can portably name files in subdirectories</h4> -+ -+<p>Common Lisp namestrings are not portable, -+except maybe for logical pathnamestrings, -+that themselves have various limitations and require a lot of setup -+that is itself ultimately non-portable. -+ -+ <p>In ASDF 1, the only portable ways to refer to pathnames inside systems and components -+were very awkward, using <code>#.(make-pathname ...)</code> and -+<code>#.(merge-pathnames ...)</code>. -+Even the above were themselves were inadequate in the general case -+due to host and device issues, unless horribly complex patterns were used. -+Plenty of simple cases that looked portable actually weren't, -+leading to much confusion and greavance. -+ -+ <p>ASDF 2 implements its own portable syntax for strings as pathname specifiers. -+Naming files within a system definition becomes easy and portable again. -+See <a href="#Miscellaneous-additional-functionality">asdf:system-relative-pathname</a>, -+<code>merge-pathnames*</code>, -+<code>coerce-pathname</code>. -+ -+ <p>On the other hand, there are places where systems used to accept namestrings -+where you must now use an explicit pathname object: -+<code>(defsystem ... :pathname "LOGICAL-HOST:PATH;TO;SYSTEM;" ...)</code> -+must now be written with the <code>#p</code> syntax: -+<code>(defsystem ... :pathname #p"LOGICAL-HOST:PATH;TO;SYSTEM;" ...)</code> -+ -+ <p>See <a href="#The-defsystem-grammar">Pathname specifiers</a>. -+ -+<h4 class="subsection">12.2.3 Output translations</h4> -+ -+<p>A popular feature added to ASDF was output pathname translation: -+<code>asdf-binary-locations</code>, <code>common-lisp-controller</code>, -+<code>cl-launch</code> and other hacks were all implementing it in ways -+both mutually incompatible and difficult to configure. -+ -+ <p>Output pathname translation is essential to share -+source directories of portable systems across multiple implementations -+or variants thereof, -+or source directories of shared installations of systems across multiple users, -+or combinations of the above. -+ -+ <p>In ASDF 2, a standard mechanism is provided for that, -+<code>asdf-output-translations</code>, -+with sensible defaults, adequate configuration languages, -+a coherent set of configuration files and hooks, -+and support for non-Unix platforms. -+ -+ <p>See <a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a>. -+ -+<h4 class="subsection">12.2.4 Source Registry Configuration</h4> -+ -+<p>Configuring ASDF used to require special magic -+to be applied just at the right moment, -+between the moment ASDF is loaded and the moment it is used, -+in a way that is specific to the user, -+the implementation he is using and the application he is building. -+ -+ <p>This made for awkward configuration files and startup scripts -+that could not be shared between users, managed by administrators -+or packaged by distributions. -+ -+ <p>ASDF 2 provides a well-documented way to configure ASDF, -+with sensible defaults, adequate configuration languages, -+and a coherent set of configuration files and hooks. -+ -+ <p>We believe it's a vast improvement because it decouples -+application distribution from library distribution. -+The application writer can avoid thinking where the libraries are, -+and the library distributor (dpkg, clbuild, advanced user, etc.) -+can configure them once and for every application. -+Yet settings can be easily overridden where needed, -+so whoever needs control has exactly as much as required. -+ -+ <p>At the same time, ASDF 2 remains compatible -+with the old magic you may have in your build scripts -+(using <code>*central-registry*</code> and -+<code>*system-definition-search-functions*</code>) -+to tailor the ASDF configuration to your build automation needs, -+and also allows for new magic, simpler and more powerful magic. -+ -+ <p>See <a href="#Controlling-where-ASDF-searches-for-systems">Controlling where ASDF searches for systems</a>. -+ -+<h4 class="subsection">12.2.5 Usual operations are made easier to the user</h4> -+ -+<p>In ASDF 1, you had to use the awkward syntax -+<code>(asdf:oos 'asdf:load-op :foo)</code> -+to load a system, -+and similarly for <code>compile-op</code>, <code>test-op</code>. -+ -+ <p>In ASDF 2, you can use shortcuts for the usual operations: -+<code>(asdf:load-system :foo)</code>, and -+similarly for <code>compile-system</code>, <code>test-system</code>. -+ -+<h4 class="subsection">12.2.6 Many bugs have been fixed</h4> -+ -+<p>The following issues and many others have been fixed: -+ -+ <ul> -+<li>The infamous TRAVERSE function has been revamped completely -+between ASDF 1 and ASDF 2, with many bugs squashed. -+In particular, dependencies were not correctly propagated -+across modules but now are. -+It has been completely rewritten many times over -+between ASDF 2.000 and ASDF 3, -+with fundamental issues in the original model being fixed. -+Timestamps were not propagated at all, and now are. -+The internal model of how actions depend on each other -+is now both consistent and complete. -+The :version and -+the :force (system1 .. systemN) feature have been fixed. -+ -+ <li>Performance has been notably improved for large systems -+(say with thousands of components) by using -+hash-tables instead of linear search, -+and linear-time list accumulation -+instead of quadratic-time recursive appends. -+ -+ <li>Many features used to not be portable, -+especially where pathnames were involved. -+Windows support was notably quirky because of such non-portability. -+ -+ <li>The internal test suite used to massively fail on many implementations. -+While still incomplete, it now fully passes -+on all implementations supported by the test suite, -+except for GCL (due to GCL bugs). -+ -+ <li>Support was lacking for some implementations. -+ABCL and GCL were notably wholly broken. -+ECL extensions were not integrated with ASDF release. -+ -+ <li>The documentation was grossly out of date. -+ -+ </ul> -+ -+<h4 class="subsection">12.2.7 ASDF itself is versioned</h4> -+ -+<p>Between new features, old bugs fixed, and new bugs introduced, -+there were various releases of ASDF in the wild, -+and no simple way to check which release had which feature set. -+People using or writing systems had to either make worst-case assumptions -+as to what features were available and worked, -+or take great pains to have the correct version of ASDF installed. -+ -+ <p>With ASDF 2, we provide a new stable set of working features -+that everyone can rely on from now on. -+Use <code>#+asdf2</code> to detect presence of ASDF 2, -+<code>(asdf:version-satisfies (asdf:asdf-version) "2.345.67")</code> -+to check the availability of a version no earlier than required. -+ -+<h4 class="subsection">12.2.8 ASDF can be upgraded</h4> -+ -+<p>When an old version of ASDF was loaded, -+it was very hard to upgrade ASDF in your current image -+without breaking everything. -+Instead you had to exit the Lisp process and -+somehow arrange to start a new one from a simpler image. -+Something that can't be done from within Lisp, -+making automation of it difficult, -+which compounded with difficulty in configuration, -+made the task quite hard. -+Yet as we saw before, the task would have been required -+to not have to live with the worst case or non-portable -+subset of ASDF features. -+ -+ <p>With ASDF 2, it is easy to upgrade -+from ASDF 2 to later versions from within Lisp, -+and not too hard to upgrade from ASDF 1 to ASDF 2 from within Lisp. -+We support hot upgrade of ASDF and any breakage is a bug -+that we will do our best to fix. -+There are still limitations on upgrade, though, -+most notably the fact that after you upgrade ASDF, -+you must also reload or upgrade all ASDF extensions. -+ -+<h4 class="subsection">12.2.9 Decoupled release cycle</h4> -+ -+<p>When vendors were releasing their Lisp implementations with ASDF, -+they had to basically never change version -+because neither upgrade nor downgrade was possible -+without breaking something for someone, -+and no obvious upgrade path was visible and recommendable. -+ -+ <p>With ASDF 2, upgrade is possible, easy and can be recommended. -+This means that vendors can safely ship a recent version of ASDF, -+confident that if a user isn't fully satisfied, -+he can easily upgrade ASDF and deal -+with a supported recent version of it. -+This means that release cycles will be causally decoupled, -+the practical consequence of which will mean faster convergence -+towards the latest version for everyone. -+ -+<h4 class="subsection">12.2.10 Pitfalls of the transition to ASDF 2</h4> -+ -+<p>The main pitfalls in upgrading to ASDF 2 seem to be related -+to the output translation mechanism. -+ -+ <ul> -+<li>Output translations is enabled by default. This may surprise some users, -+most of them in pleasant way (we hope), a few of them in an unpleasant way. -+It is trivial to disable output translations. -+See <a href="#FAQ">“How can I wholly disable the compiler output cache?”</a>. -+ -+ <li>Some systems in the large have been known -+not to play well with output translations. -+They were relatively easy to fix. -+Once again, it is also easy to disable output translations, -+or to override its configuration. -+ -+ <li>The new ASDF output translations are incompatible with ASDF-Binary-Locations. -+They replace A-B-L, and there is compatibility mode to emulate -+your previous A-B-L configuration. -+See <code>enable-asdf-binary-locations-compatibility</code> in -+see <a href="#Controlling-where-ASDF-saves-compiled-files">Backward Compatibility</a>. -+But thou shalt not load ABL on top of ASDF 2. -+ -+ </ul> -+ -+ <p>Other issues include the following: -+ -+ <ul> -+<li>ASDF pathname designators are now specified -+in places where they were unspecified, -+and a few small adjustments have to be made to some non-portable defsystems. -+Notably, in the <code>:pathname</code> argument -+to a <code>defsystem</code> and its components, -+a logical pathname (or implementation-dependent hierarchical pathname) -+must now be specified with <code>#p</code> syntax -+where the namestring might have previously sufficed; -+moreover when evaluation is desired <code>#.</code> must be used, -+where it wasn't necessary in the toplevel <code>:pathname</code> argument -+(but necessary in other <code>:pathname</code> arguments). -+ -+ <li>There is a slight performance bug, notably on SBCL, -+when initially searching for <samp><span class="file">asd</span></samp> files, -+the implicit <code>(directory "/configured/path/**/*.asd")</code> -+for every configured path <code>(:tree "/configured/path/")</code> -+in your <code>source-registry</code> configuration can cause a slight pause. -+Try to <code>(time (asdf:initialize-source-registry))</code> -+to see how bad it is or isn't on your system. -+If you insist on not having this pause, -+you can avoid the pause by overriding the default source-registry configuration -+and not use any deep <code>:tree</code> entry but only <code>:directory</code> entries -+or shallow <code>:tree</code> entries. -+Or you can fix your implementation to not be quite that slow -+when recursing through directories. -+<em>Update</em>: This performance bug fixed the hard way in 2.010. -+ -+ <li>On Windows, only LispWorks supports proper default configuration pathnames -+based on the Windows registry. -+Other implementations make do with environment variables, -+that you may have to define yourself -+if you're using an older version of Windows. -+Windows support is somewhat less tested than Unix support. -+Please help report and fix bugs. -+<em>Update</em>: As of ASDF 2.21, all implementations -+should now use the same proper default configuration pathnames -+and they should actually work, though they haven't all been tested. -+ -+ <li>The mechanism by which one customizes a system so that Lisp files -+may use a different extension from the default <samp><span class="file">.lisp</span></samp> has changed. -+Previously, the pathname for a component -+was lazily computed when operating on a system, -+and you would -+<code>(defmethod source-file-type ((component cl-source-file) (system (eql (find-system 'foo)))) -+ (declare (ignorable component system)) "lis")</code>. -+Now, the pathname for a component is eagerly computed when defining the system, -+and instead you will <code>(defclass cl-source-file.lis (cl-source-file) ((type :initform "lis")))</code> -+and use <code>:default-component-class cl-source-file.lis</code> -+as argument to <code>defsystem</code>, -+as detailed in a see <a href="#FAQ">How do I create a system definition where all the source files have a .cl extension?</a> below. -+ -+ <p><a name="index-source_002dfile_002dtype-73"></a> -+ -+ </ul> -+ -+<h3 class="section">12.3 Issues with installing the proper version of ASDF</h3> -+ -+<h4 class="subsection">12.3.1 “My Common Lisp implementation comes with an outdated version of ASDF. What to do?”</h4> -+ -+<p>We recommend you upgrade ASDF. -+See <a href="#Loading-ASDF">Upgrading ASDF</a>. -+ -+ <p>If this does not work, it is a bug, and you should report it. -+See <a href="#FAQ">report-bugs</a>. -+In the meantime, you can load <samp><span class="file">asdf.lisp</span></samp> directly. -+See <a href="#Loading-ASDF">Loading an otherwise installed ASDF</a>. -+ -+<h4 class="subsection">12.3.2 “I'm a Common Lisp implementation vendor. When and how should I upgrade ASDF?”</h4> -+ -+<p>Since ASDF 2, -+it should always be a good time to upgrade to a recent version of ASDF. -+You may consult with the maintainer for which specific version they recommend, -+but the latest <code>release</code> should be correct. -+We trust you to thoroughly test it with your implementation -+before you release it. -+If there are any issues with the current release, -+it's a bug that you should report upstream and that we will fix ASAP. -+ -+ <p>As to how to include ASDF, we recommend the following: -+ -+ <ul> -+<li>If ASDF isn't loaded yet, then <code>(require "asdf")</code> -+should load the version of ASDF that is bundled with your system. -+If possible so should <code>(require "ASDF")</code>. -+You may have it load some other version configured by the user, -+if you allow such configuration. -+ -+ <li>If your system provides a mechanism to hook into <code>CL:REQUIRE</code>, -+then it would be nice to add ASDF to this hook the same way that -+ABCL, CCL, CLISP, CMUCL, ECL, SBCL and SCL do it. -+Please send us appropriate code to this end. -+ -+ <li>You may, like SBCL, have ASDF be implicitly used to require systems -+that are bundled with your Lisp distribution. -+If you do have a few magic systems that come with your implementation -+in a precompiled way such that one should only use the binary version -+that goes with your distribution, like SBCL does, -+then you should add them in the beginning of <code>wrapping-source-registry</code>. -+ -+ <li>If you have magic systems as above, like SBCL does, -+then we explicitly ask you to <em>NOT</em> distribute -+<samp><span class="file">asdf.asd</span></samp> as part of those magic systems. -+You should still include the file <samp><span class="file">asdf.lisp</span></samp> in your source distribution -+and precompile it in your binary distribution, -+but <samp><span class="file">asdf.asd</span></samp> if included at all, -+should be secluded from the magic systems, -+in a separate file hierarchy. -+Alternatively, you may provide the system -+after renaming it and its <samp><span class="file">.asd</span></samp> file to e.g. -+<code>asdf-ecl</code> and <samp><span class="file">asdf-ecl.asd</span></samp>, or -+<code>sb-asdf</code> and <samp><span class="file">sb-asdf.asd</span></samp>. -+Indeed, if you made <samp><span class="file">asdf.asd</span></samp> a magic system, -+then users would no longer be able to upgrade ASDF using ASDF itself -+to some version of their preference that -+they maintain independently from your Lisp distribution. -+ -+ <li>If you do not have any such magic systems, or have other non-magic systems -+that you want to bundle with your implementation, -+then you may add them to the <code>wrapping-source-registry</code>, -+and you are welcome to include <samp><span class="file">asdf.asd</span></samp> amongst them. -+Non-magic systems should be at the back of the <code>wrapping-source-registry</code> -+while magic systems are at the front. -+ -+ <li>Please send us upstream any patches you make to ASDF itself, -+so we can merge them back in for the benefit of your users -+when they upgrade to the upstream version. -+ -+ </ul> -+ -+<h3 class="section">12.4 Issues with configuring ASDF</h3> -+ -+<h4 class="subsection">12.4.1 “How can I customize where fasl files are stored?”</h4> -+ -+<p>See <a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a>. -+ -+ <p>Note that in the past there was an add-on to ASDF called -+<code>ASDF-binary-locations</code>, developed by Gary King. -+That add-on has been merged into ASDF proper, -+then superseded by the <code>asdf-output-translations</code> facility. -+ -+ <p>Note that use of <code>asdf-output-translations</code> -+can interfere with one aspect of your systems -+— if your system uses <code>*load-truename*</code> to find files -+(e.g., if you have some data files stored with your program), -+then the relocation that this ASDF customization performs -+is likely to interfere. -+Use <code>asdf:system-relative-pathname</code> to locate a file -+in the source directory of some system, and -+use <code>asdf:apply-output-translations</code> to locate a file -+whose pathname has been translated by the facility. -+ -+<h4 class="subsection">12.4.2 “How can I wholly disable the compiler output cache?”</h4> -+ -+<p>To permanently disable the compiler output cache -+for all future runs of ASDF, you can: -+ -+<pre class="example"> mkdir -p ~/.config/common-lisp/asdf-output-translations.conf.d/ -+ echo ':disable-cache' > ~/.config/common-lisp/asdf-output-translations.conf.d/99-disable-cache.conf -+</pre> -+ <p>This assumes that you didn't otherwise configure the ASDF files -+(if you did, edit them again), -+and don't somehow override the configuration at runtime -+with a shell variable (see below) or some other runtime command -+(e.g. some call to <code>asdf:initialize-output-translations</code>). -+ -+ <p>To disable the compiler output cache in Lisp processes -+run by your current shell, try (assuming <code>bash</code> or <code>zsh</code>) -+(on Unix and cygwin only): -+ -+<pre class="example"> export ASDF_OUTPUT_TRANSLATIONS=/: -+</pre> -+ <p>To disable the compiler output cache just in the current Lisp process, -+use (after loading ASDF but before using it): -+ -+<pre class="example"> (asdf:disable-output-translations) -+</pre> -+ <h3 class="section">12.5 Issues with using and extending ASDF to define systems</h3> -+ -+<h4 class="subsection">12.5.1 “How can I cater for unit-testing in my system?”</h4> -+ -+<p>ASDF provides a predefined test operation, <code>test-op</code>. -+See <a href="#Predefined-operations-of-ASDF">test-op</a>. -+The test operation, however, is largely left to the system definer to specify. -+<code>test-op</code> has been -+a topic of considerable discussion on the -+<a href="http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel">asdf-devel mailing list</a>, -+and on the -+<a href="https://launchpad.net/asdf">launchpad bug-tracker</a>. -+ -+ <p>Here are some guidelines: -+ -+ <ul> -+<li>For a given system, <var>foo</var>, you will want to define a corresponding -+test system, such as <var>foo-test</var>. The reason that you will want this -+separate system is that ASDF does not out of the box supply components -+that are conditionally loaded. So if you want to have source files -+(with the test definitions) that will not be loaded except when testing, -+they should be put elsewhere. -+ -+ <li>The <var>foo-test</var> system can be defined in an asd file of its own or -+together with <var>foo</var>. An aesthetic preference against cluttering up -+the filesystem with extra asd files should be balanced against the -+question of whether one might want to directly load <var>foo-test</var>. -+Typically one would not want to do this except in early stages of -+debugging. -+ -+ <li>Record that testing is implemented by <var>foo-test</var>. For example: -+ <pre class="example"> (defsystem <var>foo</var> -+ :in-order-to ((test-op (test-op <var>foo-test</var>))) -+ ....) -+ -+ (defsystem <var>foo-test</var> -+ :depends-on (<var>foo</var> <var>my-test-library</var> ...) -+ ....) -+</pre> -+ </ul> -+ -+ <p>This procedure will allow you to support users who do not wish to -+install your test framework. -+ -+ <p>One oddity of ASDF is that <code>operate</code> (see <a href="#Operations">operate</a>) -+does not return a value. So in current versions of ASDF there is no -+reliable programmatic means of determining whether or not a set of tests -+has passed, or which tests have failed. The user must simply read the -+console output. This limitation has been the subject of much -+discussion. -+ -+<h4 class="subsection">12.5.2 “How can I cater for documentation generation in my system?”</h4> -+ -+<p>The ASDF developers are currently working to add a <code>doc-op</code> -+to the set of predefined ASDF operations. -+See <a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a>. -+See also <a href="https://bugs.launchpad.net/asdf/+bug/479470">https://bugs.launchpad.net/asdf/+bug/479470</a>. -+ -+<h4 class="subsection">12.5.3 “How can I maintain non-Lisp (e.g. C) source files?”</h4> -+ -+<p>See <code>cffi</code>'s <code>cffi-grovel</code>. -+ -+ <p><a name="report_002dbugs"></a> -+ -+<h4 class="subsection">12.5.4 “I want to put my module's files at the top level. How do I do this?”</h4> -+ -+<p>By default, the files contained in an asdf module go -+in a subdirectory with the same name as the module. -+However, this can be overridden by adding a <code>:pathname ""</code> argument -+to the module description. -+For example, here is how it could be done -+in the spatial-trees ASDF system definition for ASDF 2: -+ -+<pre class="example"> (asdf:defsystem :spatial-trees -+ :components -+ ((:module base -+ :pathname "" -+ :components -+ ((:file "package") -+ (:file "basedefs" :depends-on ("package")) -+ (:file "rectangles" :depends-on ("package")))) -+ (:module tree-impls -+ :depends-on (base) -+ :pathname "" -+ :components -+ ((:file "r-trees") -+ (:file "greene-trees" :depends-on ("r-trees")) -+ (:file "rstar-trees" :depends-on ("r-trees")) -+ (:file "rplus-trees" :depends-on ("r-trees")) -+ (:file "x-trees" :depends-on ("r-trees" "rstar-trees")))) -+ (:module viz -+ :depends-on (base) -+ :pathname "" -+ :components -+ ((:static-file "spatial-tree-viz.lisp"))) -+ (:module tests -+ :depends-on (base) -+ :pathname "" -+ :components -+ ((:static-file "spatial-tree-test.lisp"))) -+ (:static-file "LICENCE") -+ (:static-file "TODO"))) -+</pre> -+ <p>All of the files in the <code>tree-impls</code> module are at the top level, -+instead of in a <samp><span class="file">tree-impls/</span></samp> subdirectory. -+ -+ <p>Note that the argument to <code>:pathname</code> can be either a pathname object or a string. -+A pathname object can be constructed with the <samp><span class="file">#p"foo/bar/"</span></samp> syntax, -+but this is discouraged because the results of parsing a namestring are not portable. -+A pathname can only be portably constructed with such syntax as -+<code>#.(make-pathname :directory '(:relative "foo" "bar"))</code>, -+and similarly the current directory can only be portably specified as -+<code>#.(make-pathname :directory '(:relative))</code>. -+However, as of ASDF 2, you can portably use a string to denote a pathname. -+The string will be parsed as a <code>/</code>-separated path from the current directory, -+such that the empty string <code>""</code> denotes the current directory, and -+<code>"foo/bar"</code> (no trailing <code>/</code> required in the case of modules) -+portably denotes the same subdirectory as above. -+When files are specified, the last <code>/</code>-separated component is interpreted -+either as the name component of a pathname -+(if the component class specifies a pathname type), -+or as a name component plus optional dot-separated type component -+(if the component class doesn't specifies a pathname type). -+ -+<h4 class="subsection">12.5.5 How do I create a system definition where all the source files have a .cl extension?</h4> -+ -+<p>Starting with ASDF 2.014.14, you may just pass -+the builtin class <code>cl-source-file.cl</code> as -+the <code>:default-component-class</code> argument to <code>defsystem</code>: -+ -+<pre class="lisp"> (defsystem my-cl-system -+ :default-component-class cl-source-file.cl -+ ...) -+</pre> -+ <p>Another builtin class <code>cl-source-file.lsp</code> is offered -+for files ending in <samp><span class="file">.lsp</span></samp>. -+ -+ <p>If you want to use a different extension -+for which ASDF doesn't provide builtin support, -+or want to support versions of ASDF -+earlier than 2.014.14 (but later than 2.000), -+you can define a class as follows: -+ -+<pre class="lisp"> ;; Prologue: make sure we're using a sane package. -+ (defpackage :my-asdf-extension -+ (:use :asdf :common-lisp) -+ (:export #:cl-source-file.lis)) -+ (in-package :my-asdf-extension) -+ -+ (defclass cl-source-file.lis (cl-source-file) -+ ((type :initform "lis"))) -+</pre> -+ <p>Then you can use it as follows: -+<pre class="lisp"> (defsystem my-cl-system -+ :default-component-class my-asdf-extension:cl-source-file.lis -+ ...) -+</pre> -+ <p>Of course, if you're in the same package, e.g. in the same file, -+you won't need to use the package qualifier before <code>cl-source-file.lis</code>. -+Actually, if all you're doing is defining this class -+and using it in the same file without other fancy definitions, -+you might skip package complications: -+ -+<pre class="lisp"> (in-package :asdf) -+ (defclass cl-source-file.lis (cl-source-file) -+ ((type :initform "lis"))) -+ (defsystem my-cl-system -+ :default-component-class cl-source-file.lis -+ ...) -+</pre> -+ <p>It is possible to achieve the same effect -+in a way that supports both ASDF 1 and ASDF 2, -+but really, friends don't let friends use ASDF 1. -+Please upgrade to ASDF 3. -+In short, though: do same as above, but -+<em>before</em> you use the class in a <code>defsystem</code>, -+you also define the following method: -+ -+<pre class="lisp"> (defmethod source-file-type ((f cl-source-file.lis) (s system)) -+ (declare (ignorable f s)) -+ "lis") -+</pre> -+ <!-- FIXME: Add a FAQ about how to use a new system class... --> -+<p><a name="TODO-list"></a> -+ -+<!-- node-name, next, previous, up --> -+<h2 class="chapter">13 TODO list</h2> -+ -+<p>Here is an old list of things to do, -+in addition to the bugs that are now tracked on launchpad: -+<a href="https://launchpad.net/asdf">https://launchpad.net/asdf</a>. -+ -+<h3 class="section">13.1 Outstanding spec questions, things to add</h3> -+ -+<p>** packaging systems -+ -+ <p>*** manual page component? -+ -+ <p>** style guide for .asd files -+ -+ <p>You should either use keywords or be careful -+with the package that you evaluate defsystem forms in. -+Otherwise <code>(defsystem partition ...)</code> -+being read in the <code>cl-user</code> package -+will intern a <code>cl-user:partition</code> symbol, -+which will then collide with the <code>partition:partition</code> symbol. -+ -+ <p>Actually there's a hairier packages problem to think about too. -+<code>in-order-to</code> is not a keyword: -+if you read <code>defsystem</code> forms in a package that doesn't use ASDF, -+odd things might happen. -+ -+ <p>** extending defsystem with new options -+ -+ <p>You might not want to write a whole parser, -+but just to add options to the existing syntax. -+Reinstate <code>parse-option</code> or something akin. -+ -+ <p>** Diagnostics -+ -+ <p>A “dry run” of an operation can be made with the following form: -+ -+<pre class="lisp"> (let ((asdf::*verbose-out* *standard-output*)) -+ (loop :for (op . comp) :in -+ (asdf::traverse (make-instance '<operation-name> :force t) -+ (asdf:find-system <system-name>)) -+ :do (asdf:explain op comp))) -+</pre> -+ <p>This uses unexported symbols. -+What would be a nice interface for this functionality? -+ -+<h3 class="section">13.2 Missing bits in implementation</h3> -+ -+<p>** reuse the same scratch package whenever a system is reloaded from disk -+ -+ <p>Have a package ASDF-USER instead of all these temporary packages? -+ -+ <p>** proclamations probably aren't -+ -+ <p>** A revert function -+ -+ <p>Other possible interface: have a “revert” function akin to <code>make clean</code>. -+ -+<pre class="lisp"> (asdf:revert 'asdf:compile-op 'araneida) -+</pre> -+ <p>would delete any files produced by <code>(compile-system :araneida)</code>. -+Of course, it wouldn't be able to do much about stuff in the image itself. -+ -+ <p>How would this work? -+ -+ <p><code>traverse</code> -+ -+ <p>There's a difference between a module's dependencies (peers) -+and its components (children). -+Perhaps there's a similar difference in operations? -+For example, <code>(load "use") depends-on (load "macros")</code> is a peer, -+whereas <code>(load "use") depends-on (compile "use")</code> -+is more of a “subservient” relationship. -+ -+<p><a name="Inspiration"></a> -+ -+<!-- node-name, next, previous, up --> -+<h2 class="chapter">14 Inspiration</h2> -+ -+<h3 class="section">14.1 mk-defsystem (defsystem-3.x)</h3> -+ -+<p>We aim to solve basically the same problems as <code>mk-defsystem</code> does. -+However, our architecture for extensibility -+better exploits CL language features (and is documented), -+and we intend to be portable rather than just widely-ported. -+No slight on the <code>mk-defsystem</code> authors and maintainers is intended here; -+that implementation has the unenviable task -+of supporting pre-ANSI implementations, which is no longer necessary. -+ -+ <p>The surface defsystem syntax of asdf is more-or-less compatible with -+<code>mk-defsystem</code>, except that we do not support -+the <code>source-foo</code> and <code>binary-foo</code> prefixes -+for separating source and binary files, and -+we advise the removal of all options to specify pathnames. -+ -+ <p>The <code>mk-defsystem</code> code for topologically sorting -+a module's dependency list was very useful. -+ -+<h3 class="section">14.2 defsystem-4 proposal</h3> -+ -+<p>Marco and Peter's proposal for defsystem 4 served as the driver for -+many of the features in here. Notable differences are: -+ -+ <ul> -+<li>We don't specify output files or output file extensions -+as part of the system. -+ -+ <p>If you want to find out what files an operation would create, -+ask the operation. -+ -+ <li>We don't deal with CL packages -+ -+ <p>If you want to compile in a particular package, use an <code>in-package</code> form -+in that file (ilisp / SLIME will like you more if you do this anyway) -+ -+ <li>There is no proposal here that <code>defsystem</code> does version control. -+ -+ <p>A system has a given version which can be used to check dependencies, -+but that's all. -+</ul> -+ -+ <p>The defsystem 4 proposal tends to look more at the external features, -+whereas this one centres on a protocol for system introspection. -+ -+<h3 class="section">14.3 kmp's “The Description of Large Systems”, MIT AI Memo 801</h3> -+ -+<p>Available in updated-for-CL form on the web at -+<a href="http://nhplace.com/kent/Papers/Large-Systems.html">http://nhplace.com/kent/Papers/Large-Systems.html</a> -+ -+ <p>In our implementation we borrow kmp's overall <code>PROCESS-OPTIONS</code> -+and concept to deal with creating component trees -+from <code>defsystem</code> surface syntax. -+[ this is not true right now, though it used to be and -+probably will be again soon ] -+ -+<!-- --> -+<p><a name="Concept-Index"></a> -+ -+<h2 class="unnumbered">Concept Index</h2> -+ -+<ul class="index-cp" compact> -+<li><a href="#index-g_t_003aasdf-5">:asdf</a>: <a href="#Introduction">Introduction</a></li> -+<li><a href="#index-g_t_003aasdf2-6">:asdf2</a>: <a href="#Introduction">Introduction</a></li> -+<li><a href="#index-g_t_003aasdf3-7">:asdf3</a>: <a href="#Introduction">Introduction</a></li> -+<li><a href="#index-g_t_003adefsystem_002ddepends_002don-20">:defsystem-depends-on</a>: <a href="#The-defsystem-grammar">The defsystem grammar</a></li> -+<li><a href="#index-g_t_003aversion-42">:version</a>: <a href="#Common-attributes-of-components">Common attributes of components</a></li> -+<li><a href="#index-g_t_003aversion-24">:version</a>: <a href="#The-defsystem-grammar">The defsystem grammar</a></li> -+<li><a href="#index-g_t_003aversion-19">:version</a>: <a href="#The-defsystem-form">The defsystem form</a></li> -+<li><a href="#index-g_t_003aweakly_002ddepends_002don-21">:weakly-depends-on</a>: <a href="#The-defsystem-grammar">The defsystem grammar</a></li> -+<li><a href="#index-ASDF-versions-4">ASDF versions</a>: <a href="#Introduction">Introduction</a></li> -+<li><a href="#index-ASDF_002dBINARY_002dLOCATIONS-compatibility-54">ASDF-BINARY-LOCATIONS compatibility</a>: <a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a></li> -+<li><a href="#index-asdf_002doutput_002dtranslations-52">asdf-output-translations</a>: <a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a></li> -+<li><a href="#index-ASDF_002drelated-features-1">ASDF-related features</a>: <a href="#Introduction">Introduction</a></li> -+<li><a href="#index-component-36">component</a>: <a href="#Components">Components</a></li> -+<li><a href="#index-link-farm-9">link farm</a>: <a href="#Loading-ASDF">Loading ASDF</a></li> -+<li><a href="#index-logical-pathnames-25">logical pathnames</a>: <a href="#The-defsystem-grammar">The defsystem grammar</a></li> -+<li><a href="#index-operation-27">operation</a>: <a href="#Operations">Operations</a></li> -+<li><a href="#index-pathname-specifiers-22">pathname specifiers</a>: <a href="#The-defsystem-grammar">The defsystem grammar</a></li> -+<li><a href="#index-serial-dependencies-26">serial dependencies</a>: <a href="#The-defsystem-grammar">The defsystem grammar</a></li> -+<li><a href="#index-system-37">system</a>: <a href="#Components">Components</a></li> -+<li><a href="#index-system-designator-38">system designator</a>: <a href="#Components">Components</a></li> -+<li><a href="#index-system-directory-designator-14">system directory designator</a>: <a href="#Loading-ASDF">Loading ASDF</a></li> -+<li><a href="#index-Testing-for-ASDF-3">Testing for ASDF</a>: <a href="#Introduction">Introduction</a></li> -+<li><a href="#index-version-specifiers-23">version specifiers</a>: <a href="#The-defsystem-grammar">The defsystem grammar</a></li> -+ </ul><p><a name="Function-and-Class-Index"></a> -+ -+<h2 class="unnumbered">Function and Class Index</h2> -+ -+ -+ -+<ul class="index-fn" compact> -+<li><a href="#index-apply_002doutput_002dtranslations-60"><code>apply-output-translations</code></a>: <a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a></li> -+<li><a href="#index-clear_002dconfiguration-18"><code>clear-configuration</code></a>: <a href="#Using-ASDF">Using ASDF</a></li> -+<li><a href="#index-clear_002doutput_002dtranslations-58"><code>clear-output-translations</code></a>: <a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a></li> -+<li><a href="#index-clear_002doutput_002dtranslations-17"><code>clear-output-translations</code></a>: <a href="#Configuring-ASDF">Configuring ASDF</a></li> -+<li><a href="#index-clear_002dsource_002dregistry-50"><code>clear-source-registry</code></a>: <a href="#Controlling-where-ASDF-searches-for-systems">Controlling where ASDF searches for systems</a></li> -+<li><a href="#index-clear_002dsystem-69"><code>clear-system</code></a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> -+<li><a href="#index-coerce_002dpathname-65"><code>coerce-pathname</code></a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> -+<li><a href="#index-g_t_0040code_007bcompile_002dop_007d-30"><code>compile-op</code></a>: <a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a></li> -+<li><a href="#index-compile_002dsystem-12"><code>compile-system</code></a>: <a href="#Loading-ASDF">Loading ASDF</a></li> -+<li><a href="#index-disable_002doutput_002dtranslations-57"><code>disable-output-translations</code></a>: <a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a></li> -+<li><a href="#index-enable_002dasdf_002dbinary_002dlocations_002dcompatibility-55"><code>enable-asdf-binary-locations-compatibility</code></a>: <a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a></li> -+<li><a href="#index-ensure_002doutput_002dtranslations-59"><code>ensure-output-translations</code></a>: <a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a></li> -+<li><a href="#index-ensure_002dsource_002dregistry-51"><code>ensure-source-registry</code></a>: <a href="#Controlling-where-ASDF-searches-for-systems">Controlling where ASDF searches for systems</a></li> -+<li><a href="#index-find_002dsystem-40"><code>find-system</code></a>: <a href="#Components">Components</a></li> -+<li><a href="#index-initialize_002doutput_002dtranslations-56"><code>initialize-output-translations</code></a>: <a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a></li> -+<li><a href="#index-initialize_002dsource_002dregistry-49"><code>initialize-source-registry</code></a>: <a href="#Controlling-where-ASDF-searches-for-systems">Controlling where ASDF searches for systems</a></li> -+<li><a href="#index-g_t_0040code_007bload_002dfasl_002dop_007d-35"><code>load-fasl-op</code></a>: <a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a></li> -+<li><a href="#index-g_t_0040code_007bload_002dop_007d-31"><code>load-op</code></a>: <a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a></li> -+<li><a href="#index-g_t_0040code_007bload_002dsource_002dop_007d-33"><code>load-source-op</code></a>: <a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a></li> -+<li><a href="#index-load_002dsystem-10"><code>load-system</code></a>: <a href="#Loading-ASDF">Loading ASDF</a></li> -+<li><a href="#index-merge_002dpathnames_002a-66"><code>merge-pathnames*</code></a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> -+<li><a href="#index-module-44"><code>module</code></a>: <a href="#Pre_002ddefined-subclasses-of-component">Pre-defined subclasses of component</a></li> -+<li><a href="#index-g_t_0040code_007boos_007d-29"><code>oos</code></a>: <a href="#Operations">Operations</a></li> -+<li><a href="#index-oos-16"><code>oos</code></a>: <a href="#Loading-ASDF">Loading ASDF</a></li> -+<li><a href="#index-g_t_0040code_007boperate_007d-28"><code>operate</code></a>: <a href="#Operations">Operations</a></li> -+<li><a href="#index-operate-15"><code>operate</code></a>: <a href="#Loading-ASDF">Loading ASDF</a></li> -+<li><a href="#index-OPERATION_002dERROR-62"><code>OPERATION-ERROR</code></a>: <a href="#Error-handling">Error handling</a></li> -+<li><a href="#index-g_t_0040code_007bparent_002dload_002dop_007d-32"><code>parent-load-op</code></a>: <a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a></li> -+<li><a href="#index-require_002dsystem-11"><code>require-system</code></a>: <a href="#Loading-ASDF">Loading ASDF</a></li> -+<li><a href="#index-run_002dprogram-70"><code>run-program</code></a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> -+<li><a href="#index-run_002dshell_002dcommand-72"><code>run-shell-command</code></a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> -+<li><a href="#index-slurp_002dinput_002dstream-71"><code>slurp-input-stream</code></a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> -+<li><a href="#index-source_002dfile-43"><code>source-file</code></a>: <a href="#Pre_002ddefined-subclasses-of-component">Pre-defined subclasses of component</a></li> -+<li><a href="#index-source_002dfile_002dtype-73"><code>source-file-type</code></a>: <a href="#FAQ">FAQ</a></li> -+<li><a href="#index-system-45"><code>system</code></a>: <a href="#Pre_002ddefined-subclasses-of-component">Pre-defined subclasses of component</a></li> -+<li><a href="#index-SYSTEM_002dDEFINITION_002dERROR-61"><code>SYSTEM-DEFINITION-ERROR</code></a>: <a href="#Error-handling">Error handling</a></li> -+<li><a href="#index-system_002drelative_002dpathname-67"><code>system-relative-pathname</code></a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> -+<li><a href="#index-system_002dsource_002ddirectory-68"><code>system-source-directory</code></a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> -+<li><a href="#index-g_t_0040code_007btest_002dop_007d-34"><code>test-op</code></a>: <a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a></li> -+<li><a href="#index-test_002dsystem-13"><code>test-system</code></a>: <a href="#Loading-ASDF">Loading ASDF</a></li> -+<li><a href="#index-g_t_0040var_007bversion_007d-47"><var>version</var></a>: <a href="#Functions">Functions</a></li> -+<li><a href="#index-version_002dsatisfies-46"><code>version-satisfies</code></a>: <a href="#Functions">Functions</a></li> -+<li><a href="#index-version_002dsatisfies-41"><code>version-satisfies</code></a>: <a href="#Common-attributes-of-components">Common attributes of components</a></li> -+ </ul><p><a name="Variable-Index"></a> -+ -+<h2 class="unnumbered">Variable Index</h2> -+ -+ -+ -+<ul class="index-vr" compact> -+<li><a href="#index-g_t_002acentral_002dregistry_002a-8"><code>*central-registry*</code></a>: <a href="#Loading-ASDF">Loading ASDF</a></li> -+<li><a href="#index-g_t_002acompile_002dfile_002derrors_002dbehavior_002a-64"><code>*compile-file-errors-behavior*</code></a>: <a href="#Error-handling">Error handling</a></li> -+<li><a href="#index-g_t_002acompile_002dfile_002dwarnings_002dbehaviour_002a-63"><code>*compile-file-warnings-behaviour*</code></a>: <a href="#Error-handling">Error handling</a></li> -+<li><a href="#index-g_t_002adefault_002dsource_002dregistry_002dexclusions_002a-48"><code>*default-source-registry-exclusions*</code></a>: <a href="#Controlling-where-ASDF-searches-for-systems">Controlling where ASDF searches for systems</a></li> -+<li><a href="#index-g_t_002afeatures_002a-2"><code>*features*</code></a>: <a href="#Introduction">Introduction</a></li> -+<li><a href="#index-g_t_002asystem_002ddefinition_002dsearch_002dfunctions_002a-39"><code>*system-definition-search-functions*</code></a>: <a href="#Components">Components</a></li> -+<li><a href="#index-ASDF_005fOUTPUT_005fTRANSLATIONS-53"><code>ASDF_OUTPUT_TRANSLATIONS</code></a>: <a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a></li> -+ </ul><div class="footnote"> -+<hr> -+<a name="texinfo-footnotes-in-document"></a><h4>Footnotes</h4><p class="footnote"><small>[<a name="fn-1" href="#fnd-1">1</a>]</small> -+It is possible to further customize -+the system definition file search. -+That's considered advanced use, and covered later: -+search forward for -+<code>*system-definition-search-functions*</code>. -+See <a href="#Defining-systems-with-defsystem">Defining systems with defsystem</a>.</p> -+ -+ <p class="footnote"><small>[<a name="fn-2" href="#fnd-2">2</a>]</small> -+ASDF will indeed call <code>EVAL</code> on each entry. -+It will also skip entries that evaluate to <code>NIL</code>. -+ -+ <p>Strings and pathname objects are self-evaluating, -+in which case the <code>EVAL</code> step does nothing; -+but you may push arbitrary SEXP onto the central registry, -+that will be evaluated to compute e.g. things that depend -+on the value of shell variables or the identity of the user. -+ -+ <p>The variable <code>asdf:*central-registry*</code> is thus a list of -+“system directory designators”. -+A <dfn>system directory designator</dfn> is a form -+which will be evaluated whenever a system is to be found, -+and must evaluate to a directory to look in. -+By “directory” here, we mean -+“designator for a pathname with a supplied DIRECTORY component”. -+</p> -+ -+ <p class="footnote"><small>[<a name="fn-3" href="#fnd-3">3</a>]</small> -+It is possible, though almost never necessary, to override this behaviour.</p> -+ -+ <hr></div> -+ -+</body></html> -+ ---- /dev/null -+++ cl-asdf-3.0.0/doc/asdf.info -@@ -0,0 +1,3960 @@ -+This is asdf.info, produced by makeinfo version 4.13 from asdf.texinfo. -+ -+INFO-DIR-SECTION Software development -+START-INFO-DIR-ENTRY -+* asdf: (asdf). Another System Definition Facility (for Common Lisp) -+END-INFO-DIR-ENTRY -+ -+ This manual describes ASDF, a system definition facility for Common -+Lisp programs and libraries. -+ -+ You can find the latest version of this manual at -+`http://common-lisp.net/project/asdf/asdf.html'. -+ -+ ASDF Copyright (C) 2001-2013 Daniel Barlow and contributors. -+ -+ This manual Copyright (C) 2001-2013 Daniel Barlow and contributors. -+ -+ This manual revised (C) 2009-2013 Robert P. Goldman and -+Francois-Rene Rideau. -+ -+ Permission is hereby granted, free of charge, to any person obtaining -+a copy of this software and associated documentation files (the -+"Software"), to deal in the Software without restriction, including -+without limitation the rights to use, copy, modify, merge, publish, -+distribute, sublicense, and/or sell copies of the Software, and to -+permit persons to whom the Software is furnished to do so, subject to -+the following conditions: -+ -+ The above copyright notice and this permission notice shall be -+included in all copies or substantial portions of the Software. -+ -+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY -+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, -+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE -+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -+ -+ -+File: asdf.info, Node: Top, Next: Introduction, Prev: (dir), Up: (dir) -+ -+asdf: another system definition facility -+**************************************** -+ -+This manual describes ASDF, a system definition facility for Common -+Lisp programs and libraries. -+ -+ You can find the latest version of this manual at -+`http://common-lisp.net/project/asdf/asdf.html'. -+ -+ ASDF Copyright (C) 2001-2013 Daniel Barlow and contributors. -+ -+ This manual Copyright (C) 2001-2013 Daniel Barlow and contributors. -+ -+ This manual revised (C) 2009-2013 Robert P. Goldman and -+Francois-Rene Rideau. -+ -+ Permission is hereby granted, free of charge, to any person obtaining -+a copy of this software and associated documentation files (the -+"Software"), to deal in the Software without restriction, including -+without limitation the rights to use, copy, modify, merge, publish, -+distribute, sublicense, and/or sell copies of the Software, and to -+permit persons to whom the Software is furnished to do so, subject to -+the following conditions: -+ -+ The above copyright notice and this permission notice shall be -+included in all copies or substantial portions of the Software. -+ -+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY -+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, -+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE -+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -+ -+* Menu: -+ -+* Introduction:: -+* Loading ASDF:: -+* Configuring ASDF:: -+* Using ASDF:: -+* Defining systems with defsystem:: -+* The object model of ASDF:: -+* Controlling where ASDF searches for systems:: -+* Controlling where ASDF saves compiled files:: -+* Error handling:: -+* Miscellaneous additional functionality:: -+* Getting the latest version:: -+* FAQ:: -+* TODO list:: -+* Inspiration:: -+* Concept Index:: -+* Function and Class Index:: -+* Variable Index:: -+ -+ -+File: asdf.info, Node: Introduction, Next: Loading ASDF, Prev: Top, Up: Top -+ -+1 Introduction -+************** -+ -+ASDF is Another System Definition Facility: a tool for specifying how -+systems of Common Lisp software are comprised of components -+(sub-systems and files), and how to operate on these components in the -+right order so that they can be compiled, loaded, tested, etc. -+ -+ ASDF presents three faces: one for users of Common Lisp software who -+want to reuse other people's code, one for writers of Common Lisp -+software who want to specify how to build their systems, one for -+implementers of Common Lisp extensions who want to extend the build -+system. *Note Loading a system: Using ASDF, to learn how to use ASDF -+to load a system. *Note Defining systems with defsystem::, to learn -+how to define a system of your own. *Note The object model of ASDF::, -+for a description of the ASDF internals and how to extend ASDF. -+ -+ _Nota Bene_: We have released ASDF 2.000 on May 31st 2010, and ASDF -+3.0 on January 31st 2013. Releases of ASDF 2 and later have since then -+been included in all actively maintained CL implementations that used -+to bundle ASDF 1, plus some implementations that didn't use to, and has -+been made to work with all actively used CL implementations and a few -+more. *Note "What has changed between ASDF 1 and ASDF 2?": FAQ. -+Furthermore, it is possible to upgrade from ASDF 1 to ASDF 2 or ASDF 3 -+on the fly. For this reason, we have stopped supporting ASDF 1 and -+ASDF 2. If you are using ASDF 1 or ASDF 2 and are experiencing any -+kind of issues or limitations, we recommend you upgrade to ASDF 3 -- -+and we explain how to do that. *Note Loading ASDF::. -+ -+ Also note that ASDF is not to be confused with ASDF-Install. -+ASDF-Install is not part of ASDF, but a separate piece of software. -+ASDF-Install is also unmaintained and obsolete. We recommend you use -+Quicklisp instead, which works great and is being actively maintained. -+If you want to download software from version control instead of -+tarballs, so you may more easily modify it, we recommend clbuild. -+ -+ -+File: asdf.info, Node: Loading ASDF, Next: Configuring ASDF, Prev: Introduction, Up: Top -+ -+2 Loading ASDF -+************** -+ -+2.1 Loading a pre-installed ASDF -+================================ -+ -+Most recent Lisp implementations include a copy of ASDF 2, and soon -+ASDF 3. You can usually load this copy using Common Lisp's `require' -+function: -+ -+ (require "asdf") -+ -+ As of the writing of this manual, the following implementations -+provide ASDF 2 this way: abcl allegro ccl clisp cmucl ecl lispworks -+mkcl sbcl xcl. The following implementation doesn't provide it yet but -+will in an upcoming release: scl. The following implementations are -+obsolete, not actively maintained, and most probably will never bundle -+it: cormanlisp gcl genera mcl. -+ -+ If the implementation you are using doesn't provide ASDF 2 or ASDF 3, -+see *note Loading an otherwise installed ASDF: Loading ASDF. below. If -+that implementation is still actively maintained, you may also send a -+bug report to your Lisp vendor and complain about their failing to -+provide ASDF. -+ -+ NB: all implementations except clisp also accept `(require "ASDF")', -+`(require 'asdf)' and `(require :asdf)'. For portability's sake, you -+probably want to use `(require "asdf")'. -+ -+2.2 Checking whether ASDF is loaded -+=================================== -+ -+To check whether ASDF is properly loaded in your current Lisp image, -+you can run this form: -+ -+ (asdf:asdf-version) -+ -+ If it returns a string, that is the version of ASDF that is -+currently installed. -+ -+ If it raises an error, then either ASDF is not loaded, or you are -+using an old version of ASDF. -+ -+ You can check whether an old version is loaded by checking if the -+ASDF package is present. The form below will allow you to -+programmatically determine whether a recent version is loaded, an old -+version is loaded, or none at all: -+ -+ (when (find-package :asdf) -+ (let ((ver (symbol-value (or (find-symbol (string :*asdf-version*) :asdf) -+ (find-symbol (string :*asdf-revision*) :asdf))))) -+ (etypecase ver -+ (string ver) -+ (cons (with-output-to-string (s) -+ (loop for (n . m) on ver do (princ n s) (when m (princ "." s))))) -+ (null "1.0")))) -+ -+ If it returns `NIL' then ASDF is not installed. Otherwise it should -+return a string. If it returns `"1.0"', then it can actually be any -+version before 1.77 or so, or some buggy variant of 1.x. -+ -+ If you are experiencing problems with ASDF, please try upgrading to -+the latest released version, using the method below, before you contact -+us and raise an issue. -+ -+2.3 Upgrading ASDF -+================== -+ -+If your implementation provides ASDF 3 or later, you only need to -+`(require "asdf")': ASDF will automatically look whether an updated -+version of itself is available amongst the regularly configured -+systems, before it compiles anything else. See *note Configuring -+ASDF:: below. -+ -+ If your implementation does provide ASDF 2 or later, but not ASDF 3 -+or later, and you want to upgrade to a more recent version, you need to -+install and configure your ASDF as above, and additionally, you need to -+explicitly tell ASDF to load itself, right after you require your -+implementation's old ASDF 2: -+ -+ (require "asdf") -+ (asdf:load-system :asdf) -+ -+ If on the other hand, your implementation only provides an old ASDF, -+you will require a special configuration step and an old-style loading. -+Take special attention to not omit the trailing directory separator `/' -+at the end of your pathname: -+ -+ (require "asdf") -+ (push #p"/PATH/TO/NEW/ASDF/" asdf:*central-registry*) -+ (asdf:oos 'asdf:load-op :asdf) -+ -+ Note that ASDF 1 won't redirect its output files, or at least won't -+do it according to your usual ASDF 2 configuration. You therefore need -+write access on the directory where you install the new ASDF, and make -+sure you're not using it for multiple mutually incompatible -+implementations. At worst, you may have to have multiple copies of the -+new ASDF, e.g. one per implementation installation, to avoid clashes. -+Note that to our knowledge all implementations that provide ASDF -+provide ASDF 2 in their latest release, so you may want to upgrade your -+implementation rather than go through that hoop. -+ -+ Finally, if you are using an unmaintained implementation that does -+not provide ASDF at all, see *note Loading an otherwise installed ASDF: -+Loading ASDF. below. -+ -+ Note that there are some limitations to upgrading ASDF: -+ * Previously loaded ASDF extension becomes invalid, and will need to -+ be reloaded. This applies to e.g. CFFI-Grovel, or to hacks used -+ by ironclad, etc. Since it isn't possible to automatically detect -+ what extensions are present that need to be invalidated, ASDF will -+ actually invalidate all previously loaded systems when it is -+ loaded on top of a different ASDF version, starting with ASDF -+ 2.014.8 (as far as releases go, 2.015); and it will automatically -+ attempt this self-upgrade as its very first step starting with -+ ASDF 3. -+ -+ * For this an many other reasons, it important reason to load, -+ configure and upgrade ASDF (if needed) as one of the very first -+ things done by your build and startup scripts. Until all -+ implementations provide ASDF 3 or later, it is safer if you -+ upgrade ASDF and its extensions as a special step at the very -+ beginning of whatever script you are running, before you start -+ using ASDF to load anything else; even afterwards, it is still a -+ good idea, to avoid having to load and reload code twice as it -+ gets invalidated. -+ -+ * Until all implementations provide ASDF 3 or later, it is unsafe to -+ upgrade ASDF as part of loading a system that depends on a more -+ recent version of ASDF, since the new one might shadow the old one -+ while the old one is running, and the running old one will be -+ confused when extensions are loaded into the new one. In the -+ meantime, we recommend that your systems should _not_ specify -+ `:depends-on (:asdf)', or `:depends-on ((:version :asdf "2.010"))', -+ but instead that they check that a recent enough ASDF is installed, -+ with such code as: -+ (unless (or #+asdf2 (asdf:version-satisfies -+ (asdf:asdf-version) *required-asdf-version*)) -+ (error "FOO requires ASDF ~A or later." *required-asdf-version*)) -+ -+ * Until all implementations provide ASDF 3 or later, it is unsafe -+ for a system to transitively depend on ASDF and not directly -+ depend on ASDF; if any of the system you use either depends-on -+ asdf, system-depends-on asdf, or transitively does, you should -+ also do as well. -+ -+2.4 Loading an otherwise installed ASDF -+======================================= -+ -+If your implementation doesn't include ASDF, if for some reason the -+upgrade somehow fails, does not or cannot apply to your case, you will -+have to install the file `asdf.lisp' somewhere and load it with: -+ -+ (load "/path/to/your/installed/asdf.lisp") -+ -+ The single file `asdf.lisp' is all you normally need to use ASDF. -+ -+ You can extract this file from latest release tarball on the ASDF -+website (http://common-lisp.net/project/asdf/). If you are daring and -+willing to report bugs, you can get the latest and greatest version of -+ASDF from its git repository. *Note Getting the latest version::. -+ -+ For maximum convenience you might want to have ASDF loaded whenever -+you start your Lisp implementation, for example by loading it from the -+startup script or dumping a custom core -- check your Lisp -+implementation's manual for details. -+ -+ -+File: asdf.info, Node: Configuring ASDF, Next: Using ASDF, Prev: Loading ASDF, Up: Top -+ -+3 Configuring ASDF -+****************** -+ -+3.1 Configuring ASDF to find your systems -+========================================= -+ -+So it may compile and load your systems, ASDF must be configured to find -+the `.asd' files that contain system definitions. -+ -+ Since ASDF 2, the preferred way to configure where ASDF finds your -+systems is the `source-registry' facility, fully described in its own -+chapter of this manual. *Note Controlling where ASDF searches for -+systems::. -+ -+ The default location for a user to install Common Lisp software is -+under `~/.local/share/common-lisp/source/'. If you install software -+there (it can be a symlink), you don't need further configuration. If -+you're installing software yourself at a location that isn't standard, -+you have to tell ASDF where you installed it. See below. If you're -+using some tool to install software (e.g. Quicklisp), the authors of -+that tool should already have configured ASDF. -+ -+ The simplest way to add a path to your search path, say -+`/home/luser/.asd-link-farm/' is to create the directory -+`~/.config/common-lisp/source-registry.conf.d/' and there create a file -+with any name of your choice, and with the type `conf', for instance -+`42-asd-link-farm.conf' containing the line: -+ -+ `(:directory "/home/luser/.asd-link-farm/")' -+ -+ If you want all the subdirectories under `/home/luser/lisp/' to be -+recursively scanned for `.asd' files, instead use: -+ -+ `(:tree "/home/luser/lisp/")' -+ -+ Note that your Operating System distribution or your system -+administrator may already have configured system-managed libraries for -+you. -+ -+ The required `.conf' extension allows you to have disabled files or -+editor backups (ending in `~'), and works portably (for instance, it is -+a pain to allow both empty and non-empty extension on CLISP). Excluded -+are files the name of which start with a `.' character. It is -+customary to start the filename with two digits that specify the order -+in which the directories will be scanned. -+ -+ ASDF will automatically read your configuration the first time you -+try to find a system. You can reset the source-registry configuration -+with: -+ -+ (asdf:clear-source-registry) -+ -+ And you probably should do so before you dump your Lisp image, if -+the configuration may change between the machine where you save it at -+the time you save it and the machine you resume it at the time you -+resume it. Actually, you should use `(asdf:clear-configuration)' -+before you dump your Lisp image, which includes the above. -+ -+3.2 Configuring ASDF to find your systems -- old style -+====================================================== -+ -+The old way to configure ASDF to find your systems is by `push'ing -+directory pathnames onto the variable `asdf:*central-registry*'. -+ -+ You must configure this variable between the time you load ASDF and -+the time you first try to use it. Loading and configuring ASDF -+presumably happen as part of some initialization script that builds or -+starts your Common Lisp software system. (For instance, some SBCL -+users used to put it in their `~/.sbclrc'.) -+ -+ The `asdf:*central-registry*' is empty by default in ASDF 2 or ASDF -+3, but is still supported for compatibility with ASDF 1. When used, it -+takes precedence over the above source-registry(1). -+ -+ For instance, if you wanted ASDF to find the `.asd' file -+`/home/me/src/foo/foo.asd' your initialization script could after it -+loads ASDF with `(require "asdf")' configure it with: -+ -+ (push "/home/me/src/foo/" asdf:*central-registry*) -+ -+ Note the trailing slash: when searching for a system, ASDF will -+evaluate each entry of the central registry and coerce the result to a -+pathname(2) at which point the presence of the trailing directory name -+separator is necessary to tell Lisp that you're discussing a directory -+rather than a file. -+ -+ Typically, however, there are a lot of `.asd' files, and a common -+idiom was to have to put a bunch of _symbolic links_ to `.asd' files in -+a common directory and push _that_ directory (the "link farm") to the -+`asdf:*central-registry*' instead of pushing each of the many involved -+directories to the `asdf:*central-registry*'. ASDF knows how to follow -+such _symlinks_ to the actual file location when resolving the paths of -+system components (on Windows, you can use Windows shortcuts instead of -+POSIX symlinks; if you try aliases under MacOS, we are curious to hear -+about your experience). -+ -+ For example, if `#p"/home/me/cl/systems/"' (note the trailing slash) -+is a member of `*central-registry*', you could set up the system FOO -+for loading with asdf with the following commands at the shell: -+ -+ $ cd /home/me/cl/systems/ -+ $ ln -s ~/src/foo/foo.asd . -+ -+ This old style for configuring ASDF is not recommended for new users, -+but it is supported for old users, and for users who want to -+programmatically control what directories are added to the ASDF search -+path. -+ -+3.3 Configuring where ASDF stores object files -+============================================== -+ -+ASDF lets you configure where object files will be stored. Sensible -+defaults are provided and you shouldn't normally have to worry about it. -+ -+ This allows the same source code repository may be shared between -+several versions of several Common Lisp implementations, between -+several users using different compilation options and without write -+privileges on shared source directories, etc. This also allows to keep -+source directories uncluttered by plenty of object files. -+ -+ Starting with ASDF 2, the `asdf-output-translations' facility was -+added to ASDF itself, that controls where object files will be stored. -+This facility is fully described in a chapter of this manual, *note -+Controlling where ASDF saves compiled files::. -+ -+ The simplest way to add a translation to your search path, say from -+`/foo/bar/baz/quux/' to `/where/i/want/my/fasls/' is to create the -+directory `~/.config/common-lisp/asdf-output-translations.conf.d/' and -+there create a file with any name of your choice and the type `conf', -+for instance `42-bazquux.conf' containing the line: -+ -+ `("/foo/bar/baz/quux/" "/where/i/want/my/fasls/")' -+ -+ To disable output translations for source under a given directory, -+say `/toto/tata/' you can create a file `40-disable-toto.conf' with the -+line: -+ -+ `("/toto/tata/")' -+ -+ To wholly disable output translations for all directories, you can -+create a file `00-disable.conf' with the line: -+ -+ `(t t)' -+ -+ Note that your Operating System distribution or your system -+administrator may already have configured translations for you. In -+absence of any configuration, the default is to redirect everything -+under an implementation-dependent subdirectory of -+`~/.cache/common-lisp/'. *Note Controlling where ASDF searches for -+systems::, for full details. -+ -+ The required `.conf' extension allows you to have disabled files or -+editor backups (ending in `~'), and works portably (for instance, it is -+a pain to allow both empty and non-empty extension on CLISP). Excluded -+are files the name of which start with a `.' character. It is -+customary to start the filename with two digits that specify the order -+in which the directories will be scanned. -+ -+ ASDF will automatically read your configuration the first time you -+try to find a system. You can reset the source-registry configuration -+with: -+ -+ (asdf:clear-output-translations) -+ -+ And you probably should do so before you dump your Lisp image, if -+the configuration may change between the machine where you save it at -+the time you save it and the machine you resume it at the time you -+resume it. (Once again, you should use `(asdf:clear-configuration)' -+before you dump your Lisp image, which includes the above.) -+ -+ Finally note that before ASDF 2, other ASDF add-ons offered the same -+functionality, each in subtly different and incompatible ways: -+ASDF-Binary-Locations, cl-launch, common-lisp-controller. -+ASDF-Binary-Locations is now not needed anymore and should not be used. -+cl-launch 3.000 and common-lisp-controller 7.2 have been updated to -+just delegate this functionality to ASDF. -+ -+ ---------- Footnotes ---------- -+ -+ (1) It is possible to further customize the system definition file -+search. That's considered advanced use, and covered later: search -+forward for `*system-definition-search-functions*'. *Note Defining -+systems with defsystem::. -+ -+ (2) ASDF will indeed call `EVAL' on each entry. It will also skip -+entries that evaluate to `NIL'. -+ -+ Strings and pathname objects are self-evaluating, in which case the -+`EVAL' step does nothing; but you may push arbitrary SEXP onto the -+central registry, that will be evaluated to compute e.g. things that -+depend on the value of shell variables or the identity of the user. -+ -+ The variable `asdf:*central-registry*' is thus a list of "system -+directory designators". A "system directory designator" is a form -+which will be evaluated whenever a system is to be found, and must -+evaluate to a directory to look in. By "directory" here, we mean -+"designator for a pathname with a supplied DIRECTORY component". -+ -+ -+File: asdf.info, Node: Using ASDF, Next: Defining systems with defsystem, Prev: Configuring ASDF, Up: Top -+ -+3.4 Resetting Configuration -+=========================== -+ -+When you dump and restore an image, or when you tweak your -+configuration, you may want to reset the ASDF configuration. For that -+you may use the following function: -+ -+ -- Function: clear-configuration -+ undoes any ASDF configuration, regarding source-registry or -+ output-translations. -+ -+ If you use SBCL, CMUCL or SCL, you may use this snippet so that the -+ASDF configuration be cleared automatically as you dump an image: -+ -+ #+(or cmu sbcl scl) -+ (pushnew 'clear-configuration -+ #+(or cmu scl) ext:*before-save-initializations* -+ #+sbcl sb-ext:*save-hooks*) -+ -+ For compatibility with all Lisp implementations, however, you might -+want instead your build script to explicitly call -+`(asdf:clear-configuration)' at an appropriate moment before dumping. -+ -+4 Using ASDF -+************ -+ -+4.1 Loading a system -+==================== -+ -+The system FOO is loaded (and compiled, if necessary) by evaluating the -+following Lisp form: -+ -+ (asdf:load-system :FOO) -+ -+ On some implementations (namely recent versions of ABCL, Allegro CL, -+Clozure CL, CMUCL, ECL, GNU CLISP, LispWorks, MKCL, SBCL and XCL), ASDF -+hooks into the `CL:REQUIRE' facility and you can just use: -+ -+ (require :FOO) -+ -+ In older versions of ASDF, you needed to use `(asdf:oos -+'asdf:load-op :FOO)'. If your ASDF is too old to provide -+`asdf:load-system' though we recommend that you upgrade to ASDF 3. -+*Note Loading an otherwise installed ASDF: Loading ASDF. -+ -+ Note the name of a system is specified as a string or a symbol, -+typically a keyword. If a symbol (including a keyword), its name is -+taken and lowercased. The name must be a suitable value for the -+`:name' initarg to `make-pathname' in whatever filesystem the system is -+to be found. The lower-casing-symbols behaviour is unconventional, but -+was selected after some consideration. Observations suggest that the -+type of systems we want to support either have lowercase as customary -+case (unix, mac, windows) or silently convert lowercase to uppercase -+(lpns), so this makes more sense than attempting to use `:case :common', -+which is reported not to work on some implementations -+ -+4.2 Other Operations -+==================== -+ -+ASDF provides three commands for the most common system operations: -+`load-system', `compile-system' or `test-system'. It also provides -+`require-system', a version of `load-system' that skips trying to -+update systems that are already loaded. -+ -+ Because ASDF is an extensible system for defining _operations_ on -+_components_, it also provides a generic function `operate' (which is -+usually abbreviated by `oos'). You'll use `oos' whenever you want to -+do something beyond compiling, loading and testing. -+ -+ Output from ASDF and ASDF extensions are supposed to be sent to the -+CL stream `*standard-output*', and so rebinding that stream around -+calls to `asdf:operate' should redirect all output from ASDF operations. -+ -+ Reminder: before ASDF can operate on a system, however, it must be -+able to find and load that system's definition. *Note Configuring ASDF -+to find your systems: Configuring ASDF. -+ -+ For the advanced users, note that `require-system' calls -+`load-system' with keyword arguments `:force-not (loaded-systems)'. -+`loaded-systems' returns a list of the names of loaded systems. -+`load-system' applies `operate' with the operation from -+`*load-system-operation*', which by default is `load-op', the system, -+and any provided keyword arguments. -+ -+4.3 Summary -+=========== -+ -+To use ASDF: -+ -+ * Load ASDF itself into your Lisp image, either through `(require -+ "asdf")' or else through `(load "/path/to/asdf.lisp")'. -+ -+ * Make sure ASDF can find system definitions thanks to proper -+ source-registry configuration. -+ -+ * Load a system with `(asdf:load-system :my-system)' or use some -+ other operation on some system of your choice. -+ -+ -+4.4 Moving on -+============= -+ -+That's all you need to know to use ASDF to load systems written by -+others. The rest of this manual deals with writing system definitions -+for Common Lisp software you write yourself, including how to extend -+ASDF to define new operation and component types. -+ -+ -+File: asdf.info, Node: Defining systems with defsystem, Next: The object model of ASDF, Prev: Using ASDF, Up: Top -+ -+5 Defining systems with defsystem -+********************************* -+ -+This chapter describes how to use asdf to define systems and develop -+software. -+ -+* Menu: -+ -+* The defsystem form:: -+* A more involved example:: -+* The defsystem grammar:: -+* Other code in .asd files:: -+ -+ -+File: asdf.info, Node: The defsystem form, Next: A more involved example, Prev: Defining systems with defsystem, Up: Defining systems with defsystem -+ -+5.1 The defsystem form -+====================== -+ -+Systems can be constructed programmatically by instantiating components -+using `make-instance'. Most of the time, however, it is much more -+practical to use a static `defsystem' form. This section begins with -+an example of a system definition, then gives the full grammar of -+`defsystem'. -+ -+ Let's look at a simple system. This is a complete file that would -+usually be saved as `hello-lisp.asd': -+ -+ (in-package :asdf) -+ -+ (defsystem "hello-lisp" -+ :description "hello-lisp: a sample Lisp system." -+ :version "0.2.1" -+ :author "Joe User <joe@example.com>" -+ :licence "Public Domain" -+ :components ((:file "packages") -+ (:file "macros" :depends-on ("packages")) -+ (:file "hello" :depends-on ("macros")))) -+ -+ Some notes about this example: -+ -+ * The file starts with an `in-package' form to use package `asdf'. -+ You could instead start your definition by using a qualified name -+ `asdf:defsystem'. -+ -+ * If in addition to simply using `defsystem', you are going to -+ define functions, create ASDF extension, globally bind symbols, -+ etc., it is recommended that to avoid namespace pollution between -+ systems, you should create your own package for that purpose, for -+ instance replacing the above `(in-package :asdf)' with: -+ -+ (defpackage :foo-system -+ (:use :cl :asdf)) -+ -+ (in-package :foo-system) -+ -+ * The `defsystem' form defines a system named `hello-lisp' that -+ contains three source files: `packages', `macros' and `hello'. -+ -+ * The file `macros' depends on `packages' (presumably because the -+ package it's in is defined in `packages'), and the file `hello' -+ depends on `macros' (and hence, transitively on `packages'). This -+ means that ASDF will compile and load `packages' and `macros' -+ before starting the compilation of file `hello'. -+ -+ * The files are located in the same directory as the file with the -+ system definition. ASDF resolves symbolic links (or Windows -+ shortcuts) before loading the system definition file and stores -+ its location in the resulting system(1). This is a good thing -+ because the user can move the system sources without having to -+ edit the system definition. -+ -+ * Make sure you know how the `:version' numbers will be parsed! They -+ are parsed as period-separated lists of integers. I.e., in the -+ example, `0.2.1' is to be interpreted, roughly speaking, as `(0 2 -+ 1)'. In particular, version `0.2.1' is interpreted the same as -+ `0.0002.1' and is strictly version-less-than version `0.20.1', -+ even though the two are the same when interpreted as decimal -+ fractions. Instead of a string representing the version, the -+ `:version' argument can be an expression that is resolved to such -+ a string using the following trivial domain-specific language: in -+ addition to being a literal string, it can be an expression of the -+ form `(:read-file-form <pathname-or-string> :at -+ <access-at-specifier>)', which will be resolved by reading a form -+ in the specified pathname (read as a subpathname of the current -+ system if relative or a unix-namestring). You may use an -+ access-at specifier with the (optional) :at keyword, by default -+ the specifier is 0, meaning the first form is returned. -+ -+ -+ ---------- Footnotes ---------- -+ -+ (1) It is possible, though almost never necessary, to override this -+behaviour. -+ -+ -+File: asdf.info, Node: A more involved example, Next: The defsystem grammar, Prev: The defsystem form, Up: Defining systems with defsystem -+ -+5.2 A more involved example -+=========================== -+ -+Let's illustrate some more involved uses of `defsystem' via a slightly -+convoluted example: -+ -+ (defsystem "foo" -+ :version "1.0.0" -+ :components ((:module "mod" -+ :components ((:file "bar") -+ (:file"baz") -+ (:file "quux")) -+ :perform (compile-op :after (op c) -+ (do-something c)) -+ :explain (compile-op :after (op c) -+ (explain-something c))) -+ (:file "blah"))) -+ -+ The `:module' component named `"mod"' is a collection of three files, -+which will be located in a subdirectory of the main code directory named -+`mod' (this location can be overridden; see the discussion of the -+`:pathname' option in *note The defsystem grammar::). -+ -+ The method-form tokens provide a shorthand for defining methods on -+particular components. This part -+ -+ :perform (compile-op :after (op c) -+ (do-something c)) -+ :explain (compile-op :after (op c) -+ (explain-something c)) -+ -+ has the effect of -+ -+ (defmethod perform :after ((op compile-op) (c (eql ...))) -+ (do-something c)) -+ (defmethod explain :after ((op compile-op) (c (eql ...))) -+ (explain-something c)) -+ -+ where `...' is the component in question. In this case `...' would -+expand to something like -+ -+ (find-component (find-system "foo") "mod") -+ -+ For more details on the syntax of such forms, see *note The -+defsystem grammar::. For more details on what these methods do, *note -+Operations:: in *note The object model of ASDF::. -+ -+ -+File: asdf.info, Node: The defsystem grammar, Next: Other code in .asd files, Prev: A more involved example, Up: Defining systems with defsystem -+ -+5.3 The defsystem grammar -+========================= -+ -+ system-definition := ( defsystem system-designator SYSTEM-OPTION* ) -+ -+ system-option := :defsystem-depends-on system-list -+ | :weakly-depends-on SYSTEM-LIST -+ | :class class-name (see discussion below) -+ | module-option -+ | option -+ -+ module-option := :components component-list -+ | :serial [ t | nil ] -+ -+ option := -+ | :pathname pathname-specifier -+ | :default-component-class class-name -+ | :perform method-form -+ | :explain method-form -+ | :output-files method-form -+ | :operation-done-p method-form -+ | :if-feature feature-expression -+ | :depends-on ( DEPENDENCY-DEF* ) -+ | :in-order-to ( DEPENDENCY+ ) -+ -+ -+ system-list := ( SIMPLE-COMPONENT-NAME* ) -+ -+ component-list := ( COMPONENT-DEF* ) -+ -+ component-def := ( component-type simple-component-name OPTION* ) -+ -+ component-type := :module | :file | :static-file | other-component-type -+ -+ other-component-type := symbol-by-name (*note Component types: The defsystem grammar.) -+ -+ dependency-def := simple-component-name -+ | ( :feature name ) -+ | ( :version simple-component-name version-specifier) -+ -+ dependency := (dependent-op REQUIREMENT+) -+ requirement := (required-op REQUIRED-COMPONENT+) -+ | (feature feature-name) -+ dependent-op := operation-name -+ required-op := operation-name | feature -+ -+ simple-component-name := string -+ | symbol -+ -+ pathname-specifier := pathname | string | symbol -+ -+ method-form := (operation-name qual lambda-list &rest body) -+ qual := method qualifier -+ -+ component-dep-fail-option := :fail | :try-next | :ignore -+ -+ feature-expression := keyword | (:and FEATURE-EXPRESSION*) -+ | (:or FEATURE-EXPRESSION*) | (:not FEATURE-EXPRESSION) -+ -+5.3.1 Component names -+--------------------- -+ -+Component names (`simple-component-name') may be either strings or -+symbols. -+ -+5.3.2 Component types -+--------------------- -+ -+Component type names, even if expressed as keywords, will be looked up -+by name in the current package and in the asdf package, if not found in -+the current package. So a component type `my-component-type', in the -+current package `my-system-asd' can be specified as -+`:my-component-type', or `my-component-type'. -+ -+ `system' and its subclasses are _not_ allowed as component types for -+such children components. -+ -+5.3.3 System class names -+------------------------ -+ -+A system class name will be looked up in the same way as a Component -+type (see above), except that only `system' and its subclasses are -+allowed. Typically, one will not need to specify a system class name, -+unless using a non-standard system class defined in some ASDF -+extension, typically loaded through `DEFSYSTEM-DEPENDS-ON', see below. -+For such class names in the ASDF package, we recommend that the -+`:class' option be specified using a keyword symbol, such as -+ -+ :class :MY-NEW-SYSTEM-SUBCLASS -+ -+ This practice will ensure that package name conflicts are avoided. -+Otherwise, the symbol `MY-NEW-SYSTEM-SUBCLASS' will be read into the -+current package _before_ it has been exported from the ASDF extension -+loaded by `:defsystem-depends-on', causing a name conflict in the -+current package. -+ -+5.3.4 Defsystem depends on -+-------------------------- -+ -+The `:defsystem-depends-on' option to `defsystem' allows the programmer -+to specify another ASDF-defined system or set of systems that must be -+loaded _before_ the system definition is processed. Typically this is -+used to load an ASDF extension that is used in the system definition. -+ -+5.3.5 Weakly depends on -+----------------------- -+ -+We do _NOT_ recommend you use this feature. If you are tempted to -+write a system FOO that weakly-depends-on a system BAR, we recommend -+that you should instead write system FOO in a parametric way, and offer -+some special variable and/or some hook to specialize its behavior; then -+you should write a system FOO+BAR that does the hooking of things -+together. -+ -+ The (deprecated) `:weakly-depends-on' option to `defsystem' allows -+the programmer to specify another ASDF-defined system or set of systems -+that ASDF should _try_ to load, but need not load in order to be -+successful. Typically this is used if there are a number of systems -+that, if present, could provide additional functionality, but which are -+not necessary for basic function. -+ -+ Currently, although it is specified to be an option only to -+`defsystem', this option is accepted at any component, but it probably -+only makes sense at the `defsystem' level. Programmers are cautioned -+not to use this component option except at the `defsystem' level, as -+this anomalous behavior may be removed without warning. -+ -+ Finally, you might look into the `asdf-system-connections' extension, -+that will let you define additional code to be loaded when two systems -+are simultaneously loaded. It may or may not be considered good style, -+but at least it can be used in a way that has deterministic behavior -+independent of load order, unlike `weakly-depends-on'. -+ -+5.3.6 Pathname specifiers -+------------------------- -+ -+A pathname specifier (`pathname-specifier') may be a pathname, a string -+or a symbol. When no pathname specifier is given for a component, -+which is the usual case, the component name itself is used. -+ -+ If a string is given, which is the usual case, the string will be -+interpreted as a Unix-style pathname where `/' characters will be -+interpreted as directory separators. Usually, Unix-style relative -+pathnames are used (i.e. not starting with `/', as opposed to absolute -+pathnames); they are relative to the path of the parent component. -+Finally, depending on the `component-type', the pathname may be -+interpreted as either a file or a directory, and if it's a file, a file -+type may be added corresponding to the `component-type', or else it -+will be extracted from the string itself (if applicable). -+ -+ For instance, the `component-type' `:module' wants a directory -+pathname, and so a string `"foo/bar"' will be interpreted as the -+pathname `#p"foo/bar/"'. On the other hand, the `component-type' -+`:file' wants a file of type `lisp', and so a string `"foo/bar"' will -+be interpreted as the pathname `#p"foo/bar.lisp"', and a string -+`"foo/bar.quux"' will be interpreted as the pathname -+`#p"foo/bar.quux.lisp"'. Finally, the `component-type' `:static-file' -+wants a file without specifying a type, and so a string `"foo/bar"' -+will be interpreted as the pathname `#p"foo/bar"', and a string -+`"foo/bar.quux"' will be interpreted as the pathname `#p"foo/bar.quux"'. -+ -+ ASDF does not interpret the string `".."' to designate the parent -+directory. This string will be passed through to the underlying -+operating system for interpretation. We _believe_ that this will work -+on all platforms where ASDF is deployed, but do not guarantee this -+behavior. A pathname object with a relative directory component of -+`:up' or `:back' is the only guaranteed way to specify a parent -+directory. -+ -+ If a symbol is given, it will be translated into a string, and -+downcased in the process. The downcasing of symbols is unconventional, -+but was selected after some consideration. Observations suggest that -+the type of systems we want to support either have lowercase as -+customary case (Unix, Mac, windows) or silently convert lowercase to -+uppercase (lpns), so this makes more sense than attempting to use -+`:case :common' as argument to `make-pathname', which is reported not -+to work on some implementations. -+ -+ Pathname objects may be given to override the path for a component. -+Such objects are typically specified using reader macros such as `#p' -+or `#.(make-pathname ...)'. Note however, that `#p...' is a shorthand -+for `#.(parse-namestring ...)' and that the behavior of -+`parse-namestring' is completely non-portable, unless you are using -+Common Lisp `logical-pathname's (*note Using logical pathnames: The -+defsystem grammar, below). Pathnames made with `#.(make-pathname ...)' -+can usually be done more easily with the string syntax above. The only -+case that you really need a pathname object is to override the -+component-type default file type for a given component. Therefore, -+pathname objects should only rarely be used. Unhappily, ASDF 1 didn't -+properly support parsing component names as strings specifying paths -+with directories, and the cumbersome `#.(make-pathname ...)' syntax had -+to be used. An alternative to `#.' read-time evaluation is to use -+`(eval `(defsystem ... ,pathname ...))'. -+ -+ Note that when specifying pathname objects, ASDF does not do any -+special interpretation of the pathname influenced by the component -+type, unlike the procedure for pathname-specifying strings. On the one -+hand, you have to be careful to provide a pathname that correctly -+fulfills whatever constraints are required from that component type -+(e.g. naming a directory or a file with appropriate type); on the other -+hand, you can circumvent the file type that would otherwise be forced -+upon you if you were specifying a string. -+ -+5.3.7 Version specifiers -+------------------------ -+ -+Version specifiers are parsed as period-separated lists of integers. -+I.e., in the example, `0.2.1' is to be interpreted, roughly speaking, -+as `(0 2 1)'. In particular, version `0.2.1' is interpreted the same as -+`0.0002.1' and is strictly version-less-than version `0.20.1', even -+though the two are the same when interpreted as decimal fractions. -+ -+ System definers are encouraged to use version identifiers of the form -+X.Y.Z for major version, minor version (compatible API) and patch level. -+ -+ *Note Common attributes of components::. -+ -+5.3.8 Using logical pathnames -+----------------------------- -+ -+We do not generally recommend the use of logical pathnames, especially -+not so to newcomers to Common Lisp. However, we do support the use of -+logical pathnames by old timers, when such is their preference. -+ -+ To use logical pathnames, you will have to provide a pathname object -+as a `:pathname' specifier to components that use it, using such syntax -+as `#p"LOGICAL-HOST:absolute;path;to;component.lisp"'. -+ -+ You only have to specify such logical pathname for your system or -+some top-level component. Sub-components' relative pathnames, -+specified using the string syntax for names, will be properly merged -+with the pathnames of their parents. The specification of a logical -+pathname host however is _not_ otherwise directly supported in the ASDF -+syntax for pathname specifiers as strings. -+ -+ The `asdf-output-translation' layer will avoid trying to resolve and -+translate logical pathnames. The advantage of this is that you can -+define yourself what translations you want to use with the logical -+pathname facility. The disadvantage is that if you do not define such -+translations, any system that uses logical pathnames will behave -+differently under asdf-output-translations than other systems you use. -+ -+ If you wish to use logical pathnames you will have to configure the -+translations yourself before they may be used. ASDF currently provides -+no specific support for defining logical pathname translations. -+ -+ Note that the reasons we do not recommend logical pathnames are that -+(1) there is no portable way to set up logical pathnames before they -+are used, (2) logical pathnames are limited to only portably use a -+single character case, digits and hyphens. While you can solve the -+first issue on your own, describing how to do it on each of fifteen -+implementations supported by ASDF is more than we can document. As for -+the second issue, mind that the limitation is notably enforced on SBCL, -+and that you therefore can't portably violate the limitations but must -+instead define some encoding of your own and add individual mappings to -+name physical pathnames that do not fit the restrictions. This can -+notably be a problem when your Lisp files are part of a larger project -+in which it is common to name files or directories in a way that -+includes the version numbers of supported protocols, or in which files -+are shared with software written in different programming languages -+where conventions include the use of underscores, dots or CamelCase in -+pathnames. -+ -+5.3.9 Serial dependencies -+------------------------- -+ -+If the `:serial t' option is specified for a module, ASDF will add -+dependencies for each child component, on all the children textually -+preceding it. This is done as if by `:depends-on'. -+ -+ :serial t -+ :components ((:file "a") (:file "b") (:file "c")) -+ -+ is equivalent to -+ -+ :components ((:file "a") -+ (:file "b" :depends-on ("a")) -+ (:file "c" :depends-on ("a" "b"))) -+ -+5.3.10 Source location -+---------------------- -+ -+The `:pathname' option is optional in all cases for systems defined via -+`defsystem', and in the usual case the user is recommended not to -+supply it. -+ -+ Instead, ASDF follows a hairy set of rules that are designed so that -+ 1. `find-system' will load a system from disk and have its pathname -+ default to the right place. -+ -+ 2. This pathname information will not be overwritten with -+ `*default-pathname-defaults*' (which could be somewhere else -+ altogether) if the user loads up the `.asd' file into his editor -+ and interactively re-evaluates that form. -+ -+ If a system is being loaded for the first time, its top-level -+pathname will be set to: -+ -+ * The host/device/directory parts of `*load-truename*', if it is -+ bound. -+ -+ * `*default-pathname-defaults*', otherwise. -+ -+ If a system is being redefined, the top-level pathname will be -+ -+ * changed, if explicitly supplied or obtained from `*load-truename*' -+ (so that an updated source location is reflected in the system -+ definition) -+ -+ * changed if it had previously been set from -+ `*default-pathname-defaults*' -+ -+ * left as before, if it had previously been set from -+ `*load-truename*' and `*load-truename*' is currently unbound (so -+ that a developer can evaluate a `defsystem' form from within an -+ editor without clobbering its source location) -+ -+5.3.11 if-feature option -+------------------------ -+ -+This option allows you to specify a feature expression to be evaluated -+as if by `#+' to conditionally include a component in your build. If -+the expression is false, the component is dropped as well as any -+dependency pointing to it. As compared to using `#+' which is expanded -+at read-time, this allows you to have an object in your component -+hierarchy that can be used for manipulations beside building your -+project. This option was added in ASDF 3. -+ -+5.3.12 if-component-dep-fails option -+------------------------------------ -+ -+This option was removed in ASDF 3. Its semantics was limited in -+purpose and dubious to explain, and its implementation was breaking a -+hole into the ASDF object model. Please use the `if-feature' option -+instead. -+ -+ -+File: asdf.info, Node: Other code in .asd files, Prev: The defsystem grammar, Up: Defining systems with defsystem -+ -+5.4 Other code in .asd files -+============================ -+ -+Files containing `defsystem' forms are regular Lisp files that are -+executed by `load'. Consequently, you can put whatever Lisp code you -+like into these files (e.g., code that examines the compile-time -+environment and adds appropriate features to `*features*'). However, -+some conventions should be followed, so that users can control certain -+details of execution of the Lisp in `.asd' files: -+ -+ * Any informative output (other than warnings and errors, which are -+ the condition system's to dispose of) should be sent to the -+ standard CL stream `*standard-output*', so that users can easily -+ control the disposition of output from ASDF operations. -+ -+ -+File: asdf.info, Node: The object model of ASDF, Next: Controlling where ASDF searches for systems, Prev: Defining systems with defsystem, Up: Top -+ -+6 The object model of ASDF -+************************** -+ -+ASDF is designed in an object-oriented way from the ground up. Both a -+system's structure and the operations that can be performed on systems -+follow a extensible protocol. -+ -+ This allows the addition of behaviours: for example, `cffi' adds -+support of special FFI description files to interface with C libraries -+and of wrapper files to embed C code in Lisp; `abcl-jar' supports -+creating Java JAR archives in ABCL; and `poiu' supports for compiling -+code in parallel using background processes. -+ -+ This chapter deals with `component's and `operation's. -+ -+ A `component' represents an individual source file or a group of -+source files, and the things that get transformed into. A `system' is -+a component at the top level of the component hierarchy. A -+`source-file' is a component representing a single source-file and the -+successive output files into which it is transformed. A `module' is an -+intermediate component itself grouping several other components, -+themselves source-files or further modules. -+ -+ An `Operation' represents a transformation that can be performed on -+a component, turning them from source files to intermediate results to -+final outputs. -+ -+ A pair of an `operation' and a `component' is called an `action'. -+An `action' represents a particular build step to be `perform'ed, after -+all its dependencies have been fulfilled. In the ASDF model, actions -+depend on other actions. The term _action_ itself was used by Kent -+Pitman in his old article, but was only used by ASDF hackers starting -+with the ASDF 2; but the concept is ubiquitous since the very beginning -+of ASDF 1, though previously implicit. -+ -+ Then, there are many _functions_ available to users, extenders and -+implementers of ASDF to use, define or implement the activities that -+are part of building your software. Though they manipulate `action's, -+most of these functions do not take as an argument a reified pair (a -+CONS cell) of an operation and a component; instead, they usually take -+two separate arguments, which allows to take advantage of the power -+CLOS-style multiple dispatch for fun and profit. -+ -+ There are many _hooks_ in which to add functionality, by customizing -+the behavior of existing _functions_. -+ -+ Last but not least is the notion of _dependency_ between two actions. -+The structure of dependencies between actions is a directed _dependency -+graph_. ASDF is invoked by being told to _operate_ with some -+_operation_ on some toplevel _system_; it will then _traverse_ the -+graph and build a _plan_ that follows its structure. To be -+successfully buildable, this graph of actions but be acyclic. If, as a -+user, extender or implementer of ASDF, you fail to keep the dependency -+graph without cycles, ASDF will fail loudly as it eventually finds one. -+To clearly distinguish the direction of dependencies, ASDF 3 uses the -+words _requiring_ and _required_ as applied to an action depending on -+the other: the requiring action `depends-on' the completion of all -+required actions before it may itself be `perform'ed. -+ -+ Using the `defsystem' syntax, users may easily express direct -+dependencies along the graph of the object hierarchy: between a -+component and its parent, its children, and its siblings. By defining -+custom CLOS methods, you can express more elaborate dependencies as you -+wish. Most common operations, such as `load-op', `compile-op' or -+`load-source-op' are automatically propagate "downward" the component -+hierarchy and are "covariant" with it: to act the operation on the -+parent module, you must first act it on all the children components, -+with the action on the parent being parent of the action on each child. -+Other operations, such as `prepare-op' and `prepare-source-op' -+(introduced in ASDF 3) are automatically propagated "upward" the -+component hierarchy and are "contravariant" with it: to perform the -+operation of preparing for compilation of a child component, you must -+perform the operation of preparing for compilation of its parent -+component, and so on, ensuring that all the parent's dependencies are -+(compiled and) loaded before the child component may be compiled and -+loaded. Yet other operations, such as `test-op' or `load-fasl-op' -+remain at the system level, and are not propagated along the hierarchy, -+but instead do something global on the system. -+ -+* Menu: -+ -+* Operations:: -+* Components:: -+* Functions:: -+ -+ -+File: asdf.info, Node: Operations, Next: Components, Prev: The object model of ASDF, Up: The object model of ASDF -+ -+6.1 Operations -+============== -+ -+An "operation" object of the appropriate type is instantiated whenever -+the user wants to do something with a system like -+ -+ * compile all its files -+ -+ * load the files into a running lisp environment -+ -+ * copy its source files somewhere else -+ -+ Operations can be invoked directly, or examined to see what their -+effects would be without performing them. There are a bunch of methods -+specialised on operation and component type that actually do the grunt -+work. -+ -+ The operation object contains whatever state is relevant for this -+purpose (perhaps a list of visited nodes, for example) but primarily is -+a nice thing to specialise operation methods on and easier than having -+them all be `EQL' methods. -+ -+ Operations are invoked on systems via `operate'. -+ -+ -- Generic function: `operate' OPERATION SYSTEM &rest INITARGS &key -+ `force' `force-not' `verbose' &allow-other-keys -+ -- Generic function: `oos' OPERATION SYSTEM &rest INITARGS &key -+ &allow-other-keys -+ `operate' invokes OPERATION on SYSTEM. `oos' is a synonym for -+ `operate'. -+ -+ OPERATION is a symbol that is passed, along with the supplied -+ INITARGS, to `make-instance' to create the operation object. -+ SYSTEM is a system designator. -+ -+ The INITARGS are passed to the `make-instance' call when creating -+ the operation object. Note that dependencies may cause the -+ operation to invoke other operations on the system or its -+ components: the new operations will be created with the same -+ INITARGS as the original one. -+ -+ If FORCE is `:all', then all systems are forced to be recompiled -+ even if not modified since last compilation. If FORCE is `t', -+ then only the system being loaded is forced to be recompiled even -+ if not modified since last compilation, but other systems are not -+ affected. If FORCE is a list, then it specifies a list of systems -+ that are forced to be recompiled even if not modified since last -+ compilation. If FORCE-NOT is `:all', then all systems are forced -+ not to be recompiled even if modified since last compilation. If -+ FORCE-NOT is `t', then only the system being loaded is forced not -+ to be recompiled even if modified since last compilation, but -+ other systems are not affected. If FORCE-NOT is a list, then it -+ specifies a list of systems that are forced not to be recompiled -+ even if modified since last compilation. FORCE takes precedences -+ over FORCE-NOT; both of them apply to systems that are -+ dependencies and were already compiled. -+ -+ To see what `operate' would do, you can use: -+ (asdf::traverse (make-instance operation-class initargs ...) (find-system system-name)) -+ -+ -+* Menu: -+ -+* Predefined operations of ASDF:: -+* Creating new operations:: -+ -+ -+File: asdf.info, Node: Predefined operations of ASDF, Next: Creating new operations, Prev: Operations, Up: Operations -+ -+6.1.1 Predefined operations of ASDF -+----------------------------------- -+ -+All the operations described in this section are in the `asdf' package. -+They are invoked via the `operate' generic function. -+ -+ (asdf:operate 'asdf:OPERATION-NAME :SYSTEM-NAME {OPERATION-OPTIONS ...}) -+ -+ -- Operation: `compile-op' &key `proclamations' -+ This operation compiles the specified component. If proclamations -+ are supplied, they will be proclaimed. This is a good place to -+ specify optimization settings. -+ -+ When creating a new component type, you should provide methods for -+ `compile-op'. -+ -+ When `compile-op' is invoked, component dependencies often cause -+ some parts of the system to be loaded as well as compiled. -+ Invoking `compile-op' does not necessarily load all the parts of -+ the system, though; use `load-op' to load a system. -+ -+ -- Operation: `load-op' &key `proclamations' -+ This operation loads a system. -+ -+ The default methods for `load-op' compile files before loading -+ them. For parity, your own methods on new component types should -+ probably do so too. -+ -+ -- Operation: `parent-load-op' &key `proclamations' -+ This operation ensures that the dependencies of a module, and its -+ parent, and so on, are loaded (as per `load-op') before the -+ components within that module may be operated upon. -+ -+ By default, all operations depend on this `parent-operation' for -+ actions on components to depend on this "parent operation" being -+ acted on the parent. -+ -+ The default methods for `load-op' compile files before loading -+ them. For parity, your own methods on new component types should -+ probably do so too. -+ -+ -- Operation: `load-source-op' -+ This operation will load the source for the files in a module even -+ if the source files have been compiled. Systems sometimes have -+ knotty dependencies which require that sources are loaded before -+ they can be compiled. This is how you do that. -+ -+ If you are creating a component type, you need to implement this -+ operation -- at least, where meaningful. -+ -+ -- Operation: `test-op' -+ This operation will perform some tests on the module. The default -+ method will do nothing. The default dependency is to require -+ `load-op' to be performed on the module first. The default -+ `operation-done-p' is that the operation is _never_ done -- we -+ assume that if you invoke the `test-op', you want to test the -+ system, even if you have already done so. -+ -+ The results of this operation are not defined by ASDF. It has -+ proven difficult to define how the test operation should signal -+ its results to the user in a way that is compatible with all of -+ the various test libraries and test techniques in use in the -+ community. -+ -+ People typically define `test-op' methods like thus: -+ (defmethod perform ((o asdf:test-op) (s (eql (asdf:find-system :MYSYSTEM)))) -+ (asdf:load-system :MYSYSTEM) -+ (eval (read-from-string "(some expression that runs the tests)")) -+ t) -+ -+ -- Operation: `load-fasl-op' -+ This operation will load and create if need be a single fasl file -+ for all the files in each loaded system. (Its compilation-only -+ equivalent is `asdf::fasl-op'.) -+ -+ Once you have created such a fasl, you can use -+ `precompiled-system' to deliver it in a way that is compatible -+ with clients having asdf dependencies on your system whether it is -+ distributed as source of as a single binary. -+ -+ On your build platform, you run something like that: -+ `(asdf:operate 'load-fasl-op :MYSYSTEM)' -+ -+ And on your delivery platform, a form like this is evaluated in a -+ prologue or at some point before you save your image: -+ (defsystem :mysystem :class :precompiled-system -+ :fasl (some expression that will evaluate to a pathname)) -+ -+ Of course, _before_ you define such systems, you should not forget -+ to `(asdf:clear-configuration)'. -+ -+ `load-fasl-op' is available on all actively supported Lisp -+ implementations, and on those implementations only, and only since -+ ASDF 3. This functionality was previously available for select -+ implementations, as part of a separate system `asdf-bundle', -+ itself descended from `asdf-ecl'. -+ -+ -+File: asdf.info, Node: Creating new operations, Prev: Predefined operations of ASDF, Up: Operations -+ -+6.1.2 Creating new operations -+----------------------------- -+ -+ASDF was designed to be extensible in an object-oriented fashion. To -+teach ASDF new tricks, a programmer can implement the behaviour he wants -+by creating a subclass of `operation'. -+ -+ ASDF's pre-defined operations are in no way "privileged", but it is -+requested that developers never use the `asdf' package for operations -+they develop themselves. The rationale for this rule is that we don't -+want to establish a "global asdf operation name registry", but also -+want to avoid name clashes. -+ -+ An operation must provide methods for the following generic functions -+when invoked with an object of type `source-file': _FIXME describe this -+better_ -+ -+ * `input-files' ASDF has a pretty clever default `input-files' -+ mechanism. You only need create a method if there are multiple -+ ultimate input files, and/or the bottom one doesn't depend on the -+ `component-pathname' of the component. -+ -+ * `output-files' The `output-files' method determines where the -+ method will put its files. It returns two values, a list of -+ pathnames, and a boolean. If the boolean is `T' then the -+ pathnames are marked not be translated by enclosing `:around' -+ methods. If the boolean is `NIL' then enclosing `:around' methods -+ may translate these pathnames, e.g. to ensure object files are -+ somehow stored in some implementation-dependent cache. -+ -+ * `perform' The `perform' method must call `output-files' to find -+ out where to put its files, because the user is allowed to -+ override. -+ -+ * `output-files' for local policy `explain' -+ -+ * `operation-done-p' You only need to define a method on that -+ function if you can detect conditions that invalidate previous -+ runs of the operation, even though no filesystem timestamp has -+ changed, in which case you return `nil' (the default is `t'). -+ -+ For instance, the method for `test-op' always returns `nil', so -+ that tests are always run afresh. Of course, the `test-op' for -+ your system could depend on a deterministically repeatable -+ `test-report-op', and just read the results from the report files. -+ -+ * `component-depends-on' When you add new operations, you probably -+ need to explain how they relate to loading, compiling, testing, -+ etc., in terms of dependencies between actions. -+ -+ That's where you typically define methods on -+ `component-depends-on'. Your method will take as arguments some -+ properly specialized operation and a component denoting a current -+ action, and return a list of entries, denoting the children -+ actions that the current action depends on. The format of entries -+ is described below. -+ -+ It is _strongly_ advised that you should always append the results -+ of `(call-next-method)' to the results of your method, or -+ "interesting" failures will likely occur, unless you're a true -+ specialist of ASDF internals. -+ -+ Each entry returned by `component-depends-on' is itself a list. -+ -+ The first element of an entry is the name of an operation: a -+ symbol that you can use with `make-instance' (ASDF will instead -+ use with `asdf::make-sub-operation'), to create a related -+ operation for use in a build plan. For instance, `load-op' and -+ `compile-op' are common such names, denoting the respective -+ operations. -+ -+ The rest of an entry is a list of identifiers each denote a -+ component such that the pair of the previous operation and this -+ component is a children action of current action. -+ -+ Identifiers follow the `defsystem' grammar previously documented. -+ The main format for identifiers is a string or symbol (that will -+ be downcase as per `coerce-name'), and looked up against the -+ sibling list of the parent module's children components, as per -+ `find-component'. As a special case, `nil' denotes the parent -+ itself. Other syntaxes are allowed, for instance to specify a -+ component with a version. -+ -+ -+ Operations that print output should send that output to the standard -+CL stream `*standard-output*', as the Lisp compiler and loader do. -+ -+ -+File: asdf.info, Node: Components, Next: Functions, Prev: Operations, Up: The object model of ASDF -+ -+6.2 Components -+============== -+ -+A "component" represents a source file or (recursively) a collection of -+components. A "system" is (roughly speaking) a top-level component -+that can be found via `find-system'. -+ -+ A "system designator" is a string or symbol and behaves just like -+any other component name (including with regard to the case conversion -+rules for component names). -+ -+ -- Function: find-system system-designator &optional (error-p t) -+ Given a system designator, `find-system' finds and returns a -+ system. If no system is found, an error of type -+ `missing-component' is thrown, or `nil' is returned if `error-p' -+ is false. -+ -+ To find and update systems, `find-system' funcalls each element in -+ the `*system-definition-search-functions*' list, expecting a -+ pathname to be returned, or a system object, from which a pathname -+ may be extracted, and that will be registered. The resulting -+ pathname (if any) is loaded if one of the following conditions is -+ true: -+ -+ * there is no system of that name in memory -+ -+ * the pathname is different from that which was previously -+ loaded -+ -+ * the file's `last-modified' time exceeds the `last-modified' -+ time of the system in memory -+ -+ When system definitions are loaded from `.asd' files, a new -+ scratch package is created for them to load into, so that -+ different systems do not overwrite each others operations. The -+ user may also wish to (and is recommended to) include `defpackage' -+ and `in-package' forms in his system definition files, however, so -+ that they can be loaded manually if need be. -+ -+ The default value of `*system-definition-search-functions*' is a -+ list of two functions. The first function looks in each of the -+ directories given by evaluating members of `*central-registry*' -+ for a file whose name is the name of the system and whose type is -+ `asd'. The first such file is returned, whether or not it turns -+ out to actually define the appropriate system. The second -+ function does something similar, for the directories specified in -+ the `source-registry'. Hence, it is strongly advised to define a -+ system FOO in the corresponding file FOO.ASD. -+ -+* Menu: -+ -+* Common attributes of components:: -+* Pre-defined subclasses of component:: -+* Creating new component types:: -+ -+ -+File: asdf.info, Node: Common attributes of components, Next: Pre-defined subclasses of component, Prev: Components, Up: Components -+ -+6.2.1 Common attributes of components -+------------------------------------- -+ -+All components, regardless of type, have the following attributes. All -+attributes except `name' are optional. -+ -+6.2.1.1 Name -+............ -+ -+A component name is a string or a symbol. If a symbol, its name is -+taken and lowercased. -+ -+ Unless overridden by a `:pathname' attribute, the name will be -+interpreted as a pathname specifier according to a Unix-style syntax. -+*Note Pathname specifiers: The defsystem grammar. -+ -+6.2.1.2 Version identifier -+.......................... -+ -+This optional attribute is used by the generic function -+`version-satisfies', which tests to see if `:version' dependencies are -+satisfied. the version should be a string of integers separated by -+dots, for example `1.0.11'. For more information on the semantics of -+version specifiers, see *note The defsystem grammar::. -+ -+6.2.1.3 Required features -+......................... -+ -+_FIXME: This subsection seems to contradict the `defsystem' grammar -+subsection, which doesn't provide any obvious way to specify required -+features. Furthermore, in 2009, discussions on the asdf-devel mailing -+list (http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel) -+suggested that the specification of required features may be broken, -+and that no one may have been using them for a while. Please contact -+the asdf-devel mailing list -+(http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel) if you are -+interested in getting this features feature fixed._ -+ -+ Traditionally defsystem users have used reader conditionals to -+include or exclude specific per-implementation files. This means that -+any single implementation cannot read the entire system, which becomes -+a problem if it doesn't wish to compile it, but instead for example to -+create an archive file containing all the sources, as it will omit to -+process the system-dependent sources for other systems. -+ -+ Each component in an asdf system may therefore specify features using -+the same syntax as `#+' does, and it will (somehow) be ignored for -+certain operations unless the feature conditional is a member of -+`*features*'. -+ -+6.2.1.4 Dependencies -+.................... -+ -+This attribute specifies dependencies of the component on its siblings. -+It is optional but often necessary. -+ -+ There is an excitingly complicated relationship between the initarg -+and the method that you use to ask about dependencies -+ -+ Dependencies are between (operation component) pairs. In your -+initargs for the component, you can say -+ -+ :in-order-to ((compile-op (load-op "a" "b") (compile-op "c")) -+ (load-op (load-op "foo"))) -+ -+ This means the following things: -+ * before performing compile-op on this component, we must perform -+ load-op on A and B, and compile-op on C, -+ -+ * before performing `load-op', we have to load FOO -+ -+ The syntax is approximately -+ -+(this-op @{(other-op required-components)@}+) -+ -+simple-component-name := string -+ | symbol -+ -+required-components := simple-component-name -+ | (required-components required-components) -+ -+component-name := simple-component-name -+ | (:version simple-component-name minimum-version-object) -+ -+ Side note: -+ -+ This is on a par with what ACL defsystem does. mk-defsystem is less -+general: it has an implied dependency -+ -+ for all source file x, (load x) depends on (compile x) -+ -+ and using a `:depends-on' argument to say that B depends on A -+_actually_ means that -+ -+ (compile b) depends on (load a) -+ -+ This is insufficient for e.g. the McCLIM system, which requires that -+all the files are loaded before any of them can be compiled ] -+ -+ End side note -+ -+ In ASDF, the dependency information for a given component and -+operation can be queried using `(component-depends-on operation -+component)', which returns a list -+ -+ ((load-op "a") (load-op "b") (compile-op "c") ...) -+ -+ `component-depends-on' can be subclassed for more specific -+component/operation types: these need to `(call-next-method)' and -+append the answer to their dependency, unless they have a good reason -+for completely overriding the default dependencies. -+ -+ If it weren't for CLISP, we'd be using `LIST' method combination to -+do this transparently. But, we need to support CLISP. If you have the -+time for some CLISP hacking, I'm sure they'd welcome your fixes. -+ -+ See the discussion of the semantics of `:version' in the defsystem -+grammar. -+ -+6.2.1.5 pathname -+................ -+ -+This attribute is optional and if absent (which is the usual case), the -+component name will be used. -+ -+ *Note Pathname specifiers: The defsystem grammar, for an explanation -+of how this attribute is interpreted. -+ -+ Note that the `defsystem' macro (used to create a "top-level" system) -+does additional processing to set the filesystem location of the top -+component in that system. This is detailed elsewhere. *Note Defining -+systems with defsystem::. -+ -+6.2.1.6 properties -+.................. -+ -+This attribute is optional. -+ -+ Packaging systems often require information about files or systems -+in addition to that specified by ASDF's pre-defined component -+attributes. Programs that create vendor packages out of ASDF systems -+therefore have to create "placeholder" information to satisfy these -+systems. Sometimes the creator of an ASDF system may know the -+additional information and wish to provide it directly. -+ -+ `(component-property component property-name)' and associated `setf' -+method will allow the programmatic update of this information. -+Property names are compared as if by `EQL', so use symbols or keywords -+or something. -+ -+* Menu: -+ -+* Pre-defined subclasses of component:: -+* Creating new component types:: -+ -+ -+File: asdf.info, Node: Pre-defined subclasses of component, Next: Creating new component types, Prev: Common attributes of components, Up: Components -+ -+6.2.2 Pre-defined subclasses of component -+----------------------------------------- -+ -+ -- Component: source-file -+ A source file is any file that the system does not know how to -+ generate from other components of the system. -+ -+ Note that this is not necessarily the same thing as "a file -+ containing data that is typically fed to a compiler". If a file -+ is generated by some pre-processor stage (e.g. a `.h' file from -+ `.h.in' by autoconf) then it is not, by this definition, a source -+ file. Conversely, we might have a graphic file that cannot be -+ automatically regenerated, or a proprietary shared library that we -+ received as a binary: these do count as source files for our -+ purposes. -+ -+ Subclasses of source-file exist for various languages. _FIXME: -+ describe these._ -+ -+ -- Component: module -+ A module is a collection of sub-components. -+ -+ A module component has the following extra initargs: -+ -+ * `:components' the components contained in this module -+ -+ * `:default-component-class' All children components which -+ don't specify their class explicitly are inferred to be of -+ this type. -+ -+ * `:if-component-dep-fails' This attribute was removed in ASDF -+ 3. Do not use it. Use `:if-feature' instead. -+ -+ * `:serial' When this attribute is set, each subcomponent of -+ this component is assumed to depend on all subcomponents -+ before it in the list given to `:components', i.e. all of -+ them are loaded before a compile or load operation is -+ performed on it. -+ -+ -+ The default operation knows how to traverse a module, so most -+ operations will not need to provide methods specialised on modules. -+ -+ `module' may be subclassed to represent components such as -+ foreign-language linked libraries or archive files. -+ -+ -- Component: system -+ `system' is a subclass of `module'. -+ -+ A system is a module with a few extra attributes for documentation -+ purposes; these are given elsewhere. *Note The defsystem -+ grammar::. -+ -+ Users can create new classes for their systems: the default -+ `defsystem' macro takes a `:class' keyword argument. -+ -+ -+File: asdf.info, Node: Creating new component types, Prev: Pre-defined subclasses of component, Up: Components -+ -+6.2.3 Creating new component types -+---------------------------------- -+ -+New component types are defined by subclassing one of the existing -+component classes and specializing methods on the new component class. -+ -+ _FIXME: this should perhaps be explained more throughly, not only by -+example ..._ -+ -+ As an example, suppose we have some implementation-dependent -+functionality that we want to isolate in one subdirectory per Lisp -+implementation our system supports. We create a subclass of -+`cl-source-file': -+ -+ (defclass unportable-cl-source-file (cl-source-file) -+ ()) -+ -+ Function `asdf:implementation-type' (exported since 2.014.14) gives -+us the name of the subdirectory. All that's left is to define how to -+calculate the pathname of an `unportable-cl-source-file'. -+ -+ (defmethod component-pathname ((component unportable-cl-source-file)) -+ (merge-pathnames* -+ (coerce-pathname (format nil "~(~A~)/" (asdf:implementation-type))) -+ (call-next-method))) -+ -+ The new component type is used in a `defsystem' form in this way: -+ -+ (defsystem :foo -+ :components -+ ((:file "packages") -+ ... -+ (:unportable-cl-source-file "threads" -+ :depends-on ("packages" ...)) -+ ... -+ ) -+ -+ -+File: asdf.info, Node: Functions, Prev: Components, Up: The object model of ASDF -+ -+6.3 Functions -+============= -+ -+ -- version-satisfies: VERSION VERSION-SPEC -+ Does VERSION satisfy the VERSION-SPEC. A generic function. ASDF -+ provides built-in methods for VERSION being a `component' or -+ `string'. VERSION-SPEC should be a string. -+ -+ In the wild, we typically see version numbering only on components -+ of type `system'. -+ -+ For more information about how `version-satisfies' interprets -+ version strings and specifications, *note The defsystem grammar:: -+ and *note Common attributes of components::. -+ -+ -+File: asdf.info, Node: Controlling where ASDF searches for systems, Next: Controlling where ASDF saves compiled files, Prev: The object model of ASDF, Up: Top -+ -+7 Controlling where ASDF searches for systems -+********************************************* -+ -+7.1 Configurations -+================== -+ -+Configurations specify paths where to find system files. -+ -+ 1. The search registry may use some hardcoded wrapping registry -+ specification. This allows some implementations (notably SBCL) to -+ specify where to find some special implementation-provided systems -+ that need to precisely match the version of the implementation -+ itself. -+ -+ 2. An application may explicitly initialize the source-registry -+ configuration using the configuration API (*note Configuration -+ API: Controlling where ASDF searches for systems, below) in which -+ case this takes precedence. It may itself compute this -+ configuration from the command-line, from a script, from its own -+ configuration file, etc. -+ -+ 3. The source registry will be configured from the environment -+ variable `CL_SOURCE_REGISTRY' if it exists. -+ -+ 4. The source registry will be configured from user configuration file -+ `$XDG_CONFIG_DIRS/common-lisp/source-registry.conf' (which -+ defaults to `~/.config/common-lisp/source-registry.conf') if it -+ exists. -+ -+ 5. The source registry will be configured from user configuration -+ directory `$XDG_CONFIG_DIRS/common-lisp/source-registry.conf.d/' -+ (which defaults to `~/.config/common-lisp/source-registry.conf.d/') -+ if it exists. -+ -+ 6. The source registry will be configured from system configuration -+ file `/etc/common-lisp/source-registry.conf' if it exists/ -+ -+ 7. The source registry will be configured from system configuration -+ directory `/etc/common-lisp/source-registry.conf.d/' if it exists. -+ -+ 8. The source registry will be configured from a default -+ configuration. This configuration may allow for -+ implementation-specific systems to be found, for systems to be -+ found the current directory (at the time that the configuration is -+ initialized) as well as `:directory' entries for -+ `$XDG_DATA_DIRS/common-lisp/systems/' and `:tree' entries for -+ `$XDG_DATA_DIRS/common-lisp/source/'. For instance, SBCL will -+ include directories for its contribs when it can find them; it -+ will look for them where SBCL was installed, or at the location -+ specified by the `SBCL_HOME' environment variable. -+ -+ -+ Each of these configurations is specified as an s-expression in a -+trivial domain-specific language (defined below). Additionally, a more -+shell-friendly syntax is available for the environment variable -+(defined yet below). -+ -+ Each of these configurations is only used if the previous -+configuration explicitly or implicitly specifies that it includes its -+inherited configuration. -+ -+ Additionally, some implementation-specific directories may be -+automatically prepended to whatever directories are specified in -+configuration files, no matter if the last one inherits or not. -+ -+7.2 Truenames and other dangers -+=============================== -+ -+One great innovation of the original ASDF was its ability to leverage -+`CL:TRUENAME' to locate where your source code was and where to build -+it, allowing for symlink farms as a simple but effective configuration -+mechanism that is easy to control programmatically. ASDF 3 still -+supports this configuration style, and it is enabled by default; -+however we recommend you instead use our source-registry configuration -+mechanism described below, because it is easier to setup in a portable -+way across users and implementations. -+ -+ Addtionally, some people dislike truename, either because it is very -+slow on their system, or because they are using content-addressed -+storage where the truename of a file is related to a digest of its -+individual contents, and not to other files in the same intended -+project. For these people, ASDF 3 allows to eschew the `TRUENAME' -+mechanism, by setting the variable ASDF:*RESOLVE-SYMLINKS* to `NIL'. -+ -+ PS: Yes, if you haven't read Vernor Vinge's short but great classic -+"True Names... and Other Dangers" then you're in for a treat. -+ -+7.3 XDG base directory -+====================== -+ -+Note that we purport to respect the XDG base directory specification as -+to where configuration files are located, where data files are located, -+where output file caches are located. Mentions of XDG variables refer -+to that document. -+ -+`http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html' -+ -+ This specification allows the user to specify some environment -+variables to customize how applications behave to his preferences. -+ -+ On Windows platforms, when not using Cygwin, instead of the XDG base -+directory specification, we try to use folder configuration from the -+registry regarding `Common AppData' and similar directories. Since -+support for querying the Windows registry is not possible to do in -+reasonable amounts of portable Common Lisp code, ASDF 3 relies on the -+environment variables that Windows usually exports. -+ -+7.4 Backward Compatibility -+========================== -+ -+For backward compatibility as well as to provide a practical backdoor -+for hackers, ASDF will first search for `.asd' files in the directories -+specified in `asdf:*central-registry*' before it searches in the source -+registry above. -+ -+ *Note Configuring ASDF to find your systems -- old style: -+Configuring ASDF. -+ -+ By default, `asdf:*central-registry*' will be empty. -+ -+ This old mechanism will therefore not affect you if you don't use it, -+but will take precedence over the new mechanism if you do use it. -+ -+7.5 Configuration DSL -+===================== -+ -+Here is the grammar of the s-expression (SEXP) DSL for source-registry -+configuration: -+ -+ ;; A configuration is a single SEXP starting with keyword :source-registry -+ ;; followed by a list of directives. -+ CONFIGURATION := (:source-registry DIRECTIVE ...) -+ -+ ;; A directive is one of the following: -+ DIRECTIVE := -+ ;; INHERITANCE DIRECTIVE: -+ ;; Your configuration expression MUST contain -+ ;; exactly one of either of these: -+ :inherit-configuration | ; splices inherited configuration (often specified last) -+ :ignore-inherited-configuration | ; drop inherited configuration (specified anywhere) -+ -+ ;; forward compatibility directive (since ASDF 2.011.4), useful when -+ ;; you want to use new configuration features but have to bootstrap a -+ ;; the newer required ASDF from an older release that doesn't sport said features: -+ :ignore-invalid-entries | ; drops subsequent invalid entries instead of erroring out -+ -+ ;; add a single directory to be scanned (no recursion) -+ (:directory DIRECTORY-PATHNAME-DESIGNATOR) | -+ -+ ;; add a directory hierarchy, recursing but excluding specified patterns -+ (:tree DIRECTORY-PATHNAME-DESIGNATOR) | -+ -+ ;; override the defaults for exclusion patterns -+ (:exclude EXCLUSION-PATTERN ...) | -+ ;; augment the defaults for exclusion patterns -+ (:also-exclude EXCLUSION-PATTERN ...) | -+ ;; Note that the scope of a an exclude pattern specification is -+ ;; the rest of the current configuration expression or file. -+ -+ ;; splice the parsed contents of another config file -+ (:include REGULAR-FILE-PATHNAME-DESIGNATOR) | -+ -+ ;; This directive specifies that some default must be spliced. -+ :default-registry -+ -+ REGULAR-FILE-PATHNAME-DESIGNATOR := PATHNAME-DESIGNATOR ;; interpreted as a file -+ DIRECTORY-PATHNAME-DESIGNATOR := PATHNAME-DESIGNATOR ;; interpreted as a directory name -+ -+ PATHNAME-DESIGNATOR := -+ NIL | ;; Special: skip this entry. -+ ABSOLUTE-COMPONENT-DESIGNATOR ;; see pathname DSL -+ -+ EXCLUSION-PATTERN := a string without wildcards, that will be matched exactly -+ against the name of a any subdirectory in the directory component -+ of a path. e.g. `"_darcs"' will match `#p"/foo/bar/_darcs/src/bar.asd"' -+ -+ Pathnames are designated using another DSL, shared with the -+output-translations configuration DSL below. The DSL is resolved by -+the function `asdf::resolve-location', to be documented and exported at -+some point in the future. -+ -+ ABSOLUTE-COMPONENT-DESIGNATOR := -+ (ABSOLUTE-COMPONENT-DESIGNATOR RELATIVE-COMPONENT-DESIGNATOR ...) | -+ STRING | ;; namestring (better be absolute or bust, directory assumed where applicable). -+ ;; In output-translations, directory is assumed and **/*.*.* added if it's last. -+ ;; On MCL, a MacOSX-style POSIX namestring (for MacOS9 style, use #p"..."); -+ ;; Note that none of the above applies to strings used in *central-registry*, -+ ;; which doesn't use this DSL: they are processed as normal namestrings. -+ ;; however, you can compute what you put in the *central-registry* -+ ;; based on the results of say (asdf::resolve-location "/Users/fare/cl/cl-foo/") -+ PATHNAME | ;; pathname (better be an absolute path, or bust) -+ ;; In output-translations, unless followed by relative components, -+ ;; it better have appropriate wildcards, as in **/*.*.* -+ :HOME | ;; designates the user-homedir-pathname ~/ -+ :USER-CACHE | ;; designates the default location for the user cache -+ :HERE | ;; designates the location of the configuration file -+ ;; (or *default-pathname-defaults*, if invoked interactively) -+ :ROOT ;; magic, for output-translations source only: paths that are relative -+ ;; to the root of the source host and device -+ ;; Not valid anymore: :SYSTEM-CACHE (was a security hazard) -+ -+ RELATIVE-COMPONENT-DESIGNATOR := -+ (RELATIVE-COMPONENT-DESIGNATOR RELATIVE-COMPONENT-DESIGNATOR ...) | -+ STRING | ;; relative directory pathname as interpreted by coerce-pathname. -+ ;; In output translations, if last component, **/*.*.* is added -+ PATHNAME | ;; pathname; unless last component, directory is assumed. -+ :IMPLEMENTATION | ;; directory based on implementation, e.g. sbcl-1.0.45-linux-x64 -+ :IMPLEMENTATION-TYPE | ;; a directory based on lisp-implementation-type only, e.g. sbcl -+ :DEFAULT-DIRECTORY | ;; a relativized version of the default directory -+ :*/ | ;; any direct subdirectory (since ASDF 2.011.4) -+ :**/ | ;; any recursively inferior subdirectory (since ASDF 2.011.4) -+ :*.*.* | ;; any file (since ASDF 2.011.4) -+ ;; Not supported (anymore): :UID and :USERNAME -+ -+ For instance, as a simple case, my -+`~/.config/common-lisp/source-registry.conf', which is the default -+place ASDF looks for this configuration, once contained: -+ (:source-registry -+ (:tree (:home "cl")) ;; will expand to e.g. "/home/joeluser/cl/" -+ :inherit-configuration) -+ -+7.6 Configuration Directories -+============================= -+ -+Configuration directories consist in files each containing a list of -+directives without any enclosing `(:source-registry ...)' form. The -+files will be sorted by namestring as if by `string<' and the lists of -+directives of these files with be concatenated in order. An implicit -+`:inherit-configuration' will be included at the _end_ of the list. -+ -+ This allows for packaging software that has file granularity (e.g. -+Debian's `dpkg' or some future version of `clbuild') to easily include -+configuration information about distributed software. -+ -+ The convention is that, for sorting purposes, the names of files in -+such a directory begin with two digits that determine the order in -+which these entries will be read. Also, the type of these files is -+conventionally `"conf"' and as a limitation to some implementations -+(e.g. GNU clisp), the type cannot be `NIL'. -+ -+ Directories may be included by specifying a directory pathname or -+namestring in an `:include' directive, e.g.: -+ -+ (:include "/foo/bar/") -+ -+ Hence, to achieve the same effect as my example -+`~/.config/common-lisp/source-registry.conf' above, I could simply -+create a file -+`~/.config/common-lisp/source-registry.conf.d/33-home-fare-cl.conf' -+alone in its directory with the following contents: -+ (:tree "/home/fare/cl/") -+ -+7.6.1 The :here directive -+------------------------- -+ -+The `:here' directive is an absolute pathname designator that refers to -+the directory containing the configuration file currently being -+processed. -+ -+ The `:here' directive is intended to simplify the delivery of -+complex CL systems, and for easy configuration of projects shared -+through revision control systems, in accordance with our design -+principle that each participant should be able to provide all and only -+the information available to him or her. -+ -+ Consider a person X who has set up the source code repository for a -+complex project with a master directory `dir/'. Ordinarily, one might -+simply have the user add a directive that would look something like -+this: -+ (:tree "path/to/dir") -+ But what if X knows that there are very large subtrees under dir -+that are filled with, e.g., Java source code, image files for icons, -+etc.? All of the asdf system definitions are contained in the -+subdirectories `dir/src/lisp/' and `dir/extlib/lisp/', and these are -+the only directories that should be searched. -+ -+ In this case, X can put into `dir/' a file `asdf.conf' that contains -+the following: -+ (:source-registry -+ (:tree (:here "src/lisp/")) -+ (:tree (:here "extlib/lisp")) -+ (:directory (:here "outlier/"))) -+ -+ Then when someone else (call her Y) checks out a copy of this -+repository, she need only add -+ (:include "/path/to/my/checkout/directory/asdf.conf") -+ to one of her previously-existing asdf source location configuration -+files, or invoke `initialize-source-registry' with a configuration form -+containing that s-expression. ASDF will find the .conf file that X has -+provided, and then set up source locations within the working directory -+according to X's (relative) instructions. -+ -+7.7 Shell-friendly syntax for configuration -+=========================================== -+ -+When considering environment variable `CL_SOURCE_REGISTRY' ASDF will -+skip to next configuration if it's an empty string. It will `READ' the -+string as a SEXP in the DSL if it begins with a paren `(' and it will -+be interpreted much like `TEXINPUTS' list of paths, where -+ -+ * paths are separated by a `:' (colon) on Unix platforms -+(including cygwin), by a `;' (semicolon) on other platforms (mainly, -+Windows). -+ -+ * each entry is a directory to add to the search path. -+ -+ * if the entry ends with a double slash `//' then it instead -+indicates a tree in the subdirectories of which to recurse. -+ -+ * if the entry is the empty string (which may only appear once), -+then it indicates that the inherited configuration should be -+spliced there. -+ -+7.8 Search Algorithm -+==================== -+ -+In case that isn't clear, the semantics of the configuration is that -+when searching for a system of a given name, directives are processed -+in order. -+ -+ When looking in a directory, if the system is found, the search -+succeeds, otherwise it continues. -+ -+ When looking in a tree, if one system is found, the search succeeds. -+If multiple systems are found, the consequences are unspecified: the -+search may succeed with any of the found systems, or an error may be -+raised. ASDF currently returns the first system found, XCVB currently -+raised an error. If none is found, the search continues. -+ -+ Exclude statements specify patterns of subdirectories the systems -+from which to ignore. Typically you don't want to use copies of files -+kept by such version control systems as Darcs. Exclude statements are -+not propagated to further included or inherited configuration files or -+expressions; instead the defaults are reset around every configuration -+statement to the default defaults from -+`asdf::*default-source-registry-exclusions*'. -+ -+ Include statements cause the search to recurse with the path -+specifications from the file specified. -+ -+ An inherit-configuration statement cause the search to recurse with -+the path specifications from the next configuration (*note -+Configurations: Controlling where ASDF searches for systems. above). -+ -+7.9 Caching Results -+=================== -+ -+The implementation is allowed to either eagerly compute the information -+from the configurations and file system, or to lazily re-compute it -+every time, or to cache any part of it as it goes. To explicitly flush -+any information cached by the system, use the API below. -+ -+7.10 Configuration API -+====================== -+ -+The specified functions are exported from your build system's package. -+Thus for ASDF the corresponding functions are in package ASDF, and for -+XCVB the corresponding functions are in package XCVB. -+ -+ -- Function: initialize-source-registry &optional PARAMETER -+ will read the configuration and initialize all internal variables. -+ You may extend or override configuration from the environment -+ and configuration files with the given PARAMETER, which can be -+ `NIL' (no configuration override), or a SEXP (in the SEXP DSL), -+ a string (as in the string DSL), a pathname (of a file or -+ directory with configuration), or a symbol (fbound to function -+ that when called returns one of the above). -+ -+ -- Function: clear-source-registry -+ undoes any source registry configuration and clears any cache -+ for the search algorithm. You might want to call this function -+ (or better, `clear-configuration') before you dump an image -+ that would be resumed with a different configuration, and -+ return an empty configuration. Note that this does not include -+ clearing information about systems defined in the current -+ image, only about where to look for systems not yet defined. -+ -+ -- Function: ensure-source-registry &optional PARAMETER -+ checks whether a source registry has been initialized. If not, -+ initialize it with the given PARAMETER. -+ -+ Every time you use ASDF's `find-system', or anything that uses it -+(such as `operate', `load-system', etc.), `ensure-source-registry' is -+called with parameter NIL, which the first time around causes your -+configuration to be read. If you change a configuration file, you need -+to explicitly `initialize-source-registry' again, or maybe simply to -+`clear-source-registry' (or `clear-configuration') which will cause the -+initialization to happen next time around. -+ -+7.11 Status -+=========== -+ -+This mechanism is vastly successful, and we have declared that -+`asdf:*central-registry*' is not recommended anymore, though we will -+continue to support it. All hooks into implementation-specific search -+mechanisms have been integrated in the `wrapping-source-registry' that -+everyone uses implicitly. -+ -+7.12 Rejected ideas -+=================== -+ -+Alternatives I considered and rejected included: -+ -+ 1. Keep `asdf:*central-registry*' as the master with its current -+ semantics, and somehow the configuration parser expands the new -+ configuration language into a expanded series of directories of -+ subdirectories to lookup, pre-recursing through specified -+ hierarchies. This is kludgy, and leaves little space of future -+ cleanups and extensions. -+ -+ 2. Keep `asdf:*central-registry*' remains the master but extend its -+ semantics in completely new ways, so that new kinds of entries -+ may be implemented as a recursive search, etc. This seems -+ somewhat backwards. -+ -+ 3. Completely remove `asdf:*central-registry*' and break backwards -+ compatibility. Hopefully this will happen in a few years after -+ everyone migrate to a better ASDF and/or to XCVB, but it would -+ be very bad to do it now. -+ -+ 4. Replace `asdf:*central-registry*' by a symbol-macro with -+ appropriate magic when you dereference it or setf it. Only the -+ new variable with new semantics is handled by the new search -+ procedure. Complex and still introduces subtle semantic issues. -+ -+ I've been suggested the below features, but have rejected them, for -+the sake of keeping ASDF no more complex than strictly necessary. -+ -+ * More syntactic sugar: synonyms for the configuration directives, -+ such as `(:add-directory X)' for `(:directory X)', or -+ `(:add-directory-hierarchy X)' or `(:add-directory X :recurse -+ t)' for `(:tree X)'. -+ -+ * The possibility to register individual files instead of -+ directories. -+ -+ * Integrate Xach Beane's tilde expander into the parser, or -+ something similar that is shell-friendly or shell-compatible. -+ I'd rather keep ASDF minimal. But maybe this precisely keeps it -+ minimal by removing the need for evaluated entries that ASDF has? -+ i.e. uses of `USER-HOMEDIR-PATHNAME' and `$SBCL_HOME' -+ Hopefully, these are already superseded by the `:default-registry' -+ -+ * Using the shell-unfriendly syntax `/**' instead of `//' to -+ specify recursion down a filesystem tree in the environment -+ variable. It isn't that Lisp friendly either. -+ -+7.13 TODO -+========= -+ -+ * Add examples -+ -+7.14 Credits for the source-registry -+==================================== -+ -+Thanks a lot to Stelian Ionescu for the initial idea. -+ -+ Thanks to Rommel Martinez for the initial implementation attempt. -+ -+ All bad design ideas and implementation bugs are to mine, not theirs. -+But so are good design ideas and elegant implementation tricks. -+ -+ -- Francois-Rene Rideau <fare@tunes.org>, Mon, 22 Feb 2010 00:07:33 -+-0500 -+ -+ -+File: asdf.info, Node: Controlling where ASDF saves compiled files, Next: Error handling, Prev: Controlling where ASDF searches for systems, Up: Top -+ -+8 Controlling where ASDF saves compiled files -+********************************************* -+ -+Each Common Lisp implementation has its own format for compiled files -+(fasls for short, short for "fast loading"). If you use multiple -+implementations (or multiple versions of the same implementation), -+you'll soon find your source directories littered with various `fasl's, -+`dfsl's, `cfsl's and so on. Worse yet, some implementations use the -+same file extension while changing formats from version to version (or -+platform to platform) which means that you'll have to recompile binaries -+as you switch from one implementation to the next. -+ -+ Since ASDF 2, ASDF includes the `asdf-output-translations' facility -+to mitigate the problem. -+ -+8.1 Configurations -+================== -+ -+Configurations specify mappings from input locations to output -+locations. Once again we rely on the XDG base directory specification -+for configuration. *Note XDG base directory: Controlling where ASDF -+searches for systems. -+ -+ 1. Some hardcoded wrapping output translations configuration may be -+ used. This allows special output translations (or usually, -+ invariant directories) to be specified corresponding to the -+ similar special entries in the source registry. -+ -+ 2. An application may explicitly initialize the output-translations -+ configuration using the Configuration API in which case this takes -+ precedence. (*note Configuration API: Controlling where ASDF -+ saves compiled files.) It may itself compute this configuration -+ from the command-line, from a script, from its own configuration -+ file, etc. -+ -+ 3. The source registry will be configured from the environment -+ variable `ASDF_OUTPUT_TRANSLATIONS' if it exists. -+ -+ 4. The source registry will be configured from user configuration file -+ `$XDG_CONFIG_DIRS/common-lisp/asdf-output-translations.conf' -+ (which defaults to -+ `~/.config/common-lisp/asdf-output-translations.conf') if it -+ exists. -+ -+ 5. The source registry will be configured from user configuration -+ directory -+ `$XDG_CONFIG_DIRS/common-lisp/asdf-output-translations.conf.d/' -+ (which defaults to -+ `~/.config/common-lisp/asdf-output-translations.conf.d/') if it -+ exists. -+ -+ 6. The source registry will be configured from system configuration -+ file `/etc/common-lisp/asdf-output-translations.conf' if it exists. -+ -+ 7. The source registry will be configured from system configuration -+ directory `/etc/common-lisp/asdf-output-translations.conf.d/' if -+ it exists. -+ -+ -+ Each of these configurations is specified as a SEXP in a trival -+domain-specific language (defined below). Additionally, a more -+shell-friendly syntax is available for the environment variable -+(defined yet below). -+ -+ Each of these configurations is only used if the previous -+configuration explicitly or implicitly specifies that it includes its -+inherited configuration. -+ -+ Note that by default, a per-user cache is used for output files. -+This allows the seamless use of shared installations of software -+between several users, and takes files out of the way of the developers -+when they browse source code, at the expense of taking a small toll -+when developers have to clean up output files and find they need to get -+familiar with output-translations first. -+ -+8.2 Backward Compatibility -+========================== -+ -+We purposefully do NOT provide backward compatibility with earlier -+versions of `ASDF-Binary-Locations' (8 Sept 2009), -+`common-lisp-controller' (7.0) or `cl-launch' (2.35), each of which had -+similar general capabilities. The previous APIs of these programs were -+not designed for configuration by the end-user in an easy way with -+configuration files. Recent versions of same packages use the new -+`asdf-output-translations' API as defined below: -+`common-lisp-controller' (7.2) and `cl-launch' (3.000). -+`ASDF-Binary-Locations' is fully superseded and not to be used anymore. -+ -+ This incompatibility shouldn't inconvenience many people. Indeed, -+few people use and customize these packages; these few people are -+experts who can trivially adapt to the new configuration. Most people -+are not experts, could not properly configure these features (except -+inasmuch as the default configuration of `common-lisp-controller' -+and/or `cl-launch' might have been doing the right thing for some -+users), and yet will experience software that "just works", as -+configured by the system distributor, or by default. -+ -+ Nevertheless, if you are a fan of `ASDF-Binary-Locations', we -+provide a limited emulation mode: -+ -+ -- Function: enable-asdf-binary-locations-compatibility &key -+ centralize-lisp-binaries default-toplevel-directory -+ include-per-user-information map-all-source-files -+ source-to-target-mappings -+ This function will initialize the new `asdf-output-translations' -+ facility in a way that emulates the behavior of the old -+ `ASDF-Binary-Locations' facility. Where you would previously set -+ global variables *CENTRALIZE-LISP-BINARIES*, -+ *DEFAULT-TOPLEVEL-DIRECTORY*, *INCLUDE-PER-USER-INFORMATION*, -+ *MAP-ALL-SOURCE-FILES* or *SOURCE-TO-TARGET-MAPPINGS* you will now -+ have to pass the same values as keyword arguments to this function. -+ Note however that as an extension the `:source-to-target-mappings' -+ keyword argument will accept any valid pathname designator for -+ `asdf-output-translations' instead of just strings and pathnames. -+ -+ If you insist, you can also keep using the old -+`ASDF-Binary-Locations' (the one available as an extension to load of -+top of ASDF, not the one built into a few old versions of ASDF), but -+first you must disable `asdf-output-translations' with -+`(asdf:disable-output-translations)', or you might experience -+"interesting" issues. -+ -+ Also, note that output translation is enabled by default. To -+disable it, use `(asdf:disable-output-translations)'. -+ -+8.3 Configuration DSL -+===================== -+ -+Here is the grammar of the SEXP DSL for `asdf-output-translations' -+configuration: -+ -+;; A configuration is single SEXP starting with keyword :source-registry -+;; followed by a list of directives. -+CONFIGURATION := (:output-translations DIRECTIVE ...) -+ -+;; A directive is one of the following: -+DIRECTIVE := -+ ;; INHERITANCE DIRECTIVE: -+ ;; Your configuration expression MUST contain -+ ;; exactly one of either of these: -+ :inherit-configuration | ; splices inherited configuration (often specified last) -+ :ignore-inherited-configuration | ; drop inherited configuration (specified anywhere) -+ -+ ;; forward compatibility directive (since ASDF 2.011.4), useful when -+ ;; you want to use new configuration features but have to bootstrap a -+ ;; the newer required ASDF from an older release that doesn't sport said features: -+ :ignore-invalid-entries | ; drops subsequent invalid entries instead of erroring out -+ -+ ;; include a configuration file or directory -+ (:include PATHNAME-DESIGNATOR) | -+ -+ ;; enable global cache in ~/.common-lisp/cache/sbcl-1.0.45-linux-amd64/ or something. -+ :enable-user-cache | -+ ;; Disable global cache. Map / to / -+ :disable-cache | -+ -+ ;; add a single directory to be scanned (no recursion) -+ (DIRECTORY-DESIGNATOR DIRECTORY-DESIGNATOR) -+ -+ ;; use a function to return the translation of a directory designator -+ (DIRECTORY-DESIGNATOR (:function TRANSLATION-FUNCTION)) -+ -+DIRECTORY-DESIGNATOR := -+ NIL | ;; As source: skip this entry. As destination: same as source -+ T | ;; as source matches anything, as destination leaves pathname unmapped. -+ ABSOLUTE-COMPONENT-DESIGNATOR ;; same as in the source-registry language -+ -+TRANSLATION-FUNCTION := -+ SYMBOL | ;; symbol of a function that takes two arguments, -+ ;; the pathname to be translated and the matching DIRECTORY-DESIGNATOR -+ LAMBDA ;; A form which evalutates to a function taking two arguments consisting of -+ ;; the pathname to be translated and the matching DIRECTORY-DESIGNATOR -+ -+ Relative components better be either relative or subdirectories of -+the path before them, or bust. -+ -+ The last component, if not a pathname, is notionally completed by -+`/**/*.*'. You can specify more fine-grained patterns by using a -+pathname object as the last component e.g. -+`#p"some/path/**/foo*/bar-*.fasl"' -+ -+ You may use `#+features' to customize the configuration file. -+ -+ The second designator of a mapping may be `NIL', indicating that -+files are not mapped to anything but themselves (same as if the second -+designator was the same as the first). -+ -+ When the first designator is `t', the mapping always matches. When -+the first designator starts with `:root', the mapping matches any host -+and device. In either of these cases, if the second designator isn't -+`t' and doesn't start with `:root', then strings indicating the host -+and pathname are somehow copied in the beginning of the directory -+component of the source pathname before it is translated. -+ -+ When the second designator is `t', the mapping is the identity. -+When the second designator starts with `:root', the mapping preserves -+the host and device of the original pathname. Notably, this allows you -+to map files to a subdirectory of the whichever directory the file is -+in. Though the syntax is not quite as easy to use as we'd like, you -+can have an (source destination) mapping entry such as follows in your -+configuration file, or you may use -+`enable-asdf-binary-locations-compatibility' with -+`:centralize-lisp-binaries nil' which will do the same thing internally -+for you: -+ #.(let ((wild-subdir (make-pathname :directory '(:relative :wild-inferiors))) -+ (wild-file (make-pathname :name :wild :version :wild :type :wild))) -+ `((:root ,wild-subdir ,wild-file) ;; Or using the implicit wildcard, just :root -+ (:root ,wild-subdir :implementation ,wild-file))) -+ Starting with ASDF 2.011.4, you can use the simpler: ``(:root (:root -+:**/ :implementation :*.*.*))' -+ -+ `:include' statements cause the search to recurse with the path -+specifications from the file specified. -+ -+ If the `translate-pathname' mechanism cannot achieve a desired -+translation, the user may provide a function which provides the -+required algorithim. Such a translation function is specified by -+supplying a list as the second `directory-designator' the first element -+of which is the keyword `:function', and the second element of which is -+either a symbol which designates a function or a lambda expression. -+The function designated by the second argument must take two arguments, -+the first being the pathname of the source file, the second being the -+wildcard that was matched. The result of the function invocation -+should be the translated pathname. -+ -+ An `:inherit-configuration' statement cause the search to recurse -+with the path specifications from the next configuration. *Note -+Configurations: Controlling where ASDF saves compiled files, above. -+ -+ * `:enable-user-cache' is the same as `(t :user-cache)'. -+ -+ * `:disable-cache' is the same as `(t t)'. -+ -+ * `:user-cache' uses the contents of variable `asdf::*user-cache*' -+ which by default is the same as using `(:home ".cache" -+ "common-lisp" :implementation)'. -+ -+ * `:system-cache' uses the contents of variable -+ `asdf::*system-cache*' which by default is the same as using -+ `("/var/cache/common-lisp" :uid :implementation-type)' (on Unix -+ and cygwin), or something semi-sensible on Windows. -+ -+8.4 Configuration Directories -+============================= -+ -+Configuration directories consist in files each contains a list of -+directives without any enclosing `(:output-translations ...)' form. -+The files will be sorted by namestring as if by `string<' and the lists -+of directives of these files with be concatenated in order. An -+implicit `:inherit-configuration' will be included at the _end_ of the -+list. -+ -+ This allows for packaging software that has file granularity (e.g. -+Debian's `dpkg' or some future version of `clbuild') to easily include -+configuration information about software being distributed. -+ -+ The convention is that, for sorting purposes, the names of files in -+such a directory begin with two digits that determine the order in -+which these entries will be read. Also, the type of these files is -+conventionally `"conf"' and as a limitation of some implementations, -+the type cannot be `NIL'. -+ -+ Directories may be included by specifying a directory pathname or -+namestring in an `:include' directive, e.g.: -+ (:include "/foo/bar/") -+ -+8.5 Shell-friendly syntax for configuration -+=========================================== -+ -+When considering environment variable `ASDF_OUTPUT_TRANSLATIONS' ASDF -+will skip to next configuration if it's an empty string. It will -+`READ' the string as an SEXP in the DSL if it begins with a paren `(' -+and it will be interpreted as a list of directories. Directories -+should come by pairs, indicating a mapping directive. Entries are -+separated by a `:' (colon) on Unix platforms (including cygwin), by a -+`;' (semicolon) on other platforms (mainly, Windows). -+ -+ The magic empty entry, if it comes in what would otherwise be the -+first entry in a pair, indicates the splicing of inherited -+configuration. If it comes as the second entry in a pair, it indicates -+that the directory specified first is to be left untranslated (which -+has the same effect as if the directory had been repeated). -+ -+8.6 Semantics of Output Translations -+==================================== -+ -+From the specified configuration, a list of mappings is extracted in a -+straightforward way: mappings are collected in order, recursing through -+included or inherited configuration as specified. To this list is -+prepended some implementation-specific mappings, and is appended a -+global default. -+ -+ The list is then compiled to a mapping table as follows: for each -+entry, in order, resolve the first designated directory into an actual -+directory pathname for source locations. If no mapping was specified -+yet for that location, resolve the second designated directory to an -+output location directory add a mapping to the table mapping the source -+location to the output location, and add another mapping from the -+output location to itself (unless a mapping already exists for the -+output location). -+ -+ Based on the table, a mapping function is defined, mapping source -+pathnames to output pathnames: given a source pathname, locate the -+longest matching prefix in the source column of the mapping table. -+Replace that prefix by the corresponding output column in the same row -+of the table, and return the result. If no match is found, return the -+source pathname. (A global default mapping the filesystem root to -+itself may ensure that there will always be a match, with same -+fall-through semantics). -+ -+8.7 Caching Results -+=================== -+ -+The implementation is allowed to either eagerly compute the information -+from the configurations and file system, or to lazily re-compute it -+every time, or to cache any part of it as it goes. To explicitly flush -+any information cached by the system, use the API below. -+ -+8.8 Output location API -+======================= -+ -+The specified functions are exported from package ASDF. -+ -+ -- Function: initialize-output-translations &optional PARAMETER -+ will read the configuration and initialize all internal variables. -+ You may extend or override configuration from the environment -+ and configuration files with the given PARAMETER, which can be -+ `NIL' (no configuration override), or a SEXP (in the SEXP DSL), -+ a string (as in the string DSL), a pathname (of a file or -+ directory with configuration), or a symbol (fbound to function -+ that when called returns one of the above). -+ -+ -- Function: disable-output-translations -+ will initialize output translations in a way that maps every -+ pathname to itself, effectively disabling the output -+ translation facility. -+ -+ -- Function: clear-output-translations -+ undoes any output translation configuration and clears any -+ cache for the mapping algorithm. You might want to call this -+ function (or better, `clear-configuration') before you dump -+ an image that would be resumed with a different configuration, -+ and return an empty configuration. Note that this does not -+ include clearing information about systems defined in the -+ current image, only about where to look for systems not yet -+ defined. -+ -+ -- Function: ensure-output-translations &optional PARAMETER -+ checks whether output translations have been initialized. If -+ not, initialize them with the given PARAMETER. This function -+ will be called before any attempt to operate on a system. -+ -+ -- Function: apply-output-translations PATHNAME -+ Applies the configured output location translations to PATHNAME -+ (calls `ensure-output-translations' for the translations). -+ -+ Every time you use ASDF's `output-files', or anything that uses it -+(that may compile, such as `operate', `perform', etc.), -+`ensure-output-translations' is called with parameter NIL, which the -+first time around causes your configuration to be read. If you change -+a configuration file, you need to explicitly -+`initialize-output-translations' again, or maybe -+`clear-output-translations' (or `clear-configuration'), which will -+cause the initialization to happen next time around. -+ -+8.9 Credits for output translations -+=================================== -+ -+Thanks a lot to Bjorn Lindberg and Gary King for -+`ASDF-Binary-Locations', and to Peter van Eynde for `Common Lisp -+Controller'. -+ -+ All bad design ideas and implementation bugs are to mine, not theirs. -+But so are good design ideas and elegant implementation tricks. -+ -+ -- Francois-Rene Rideau <fare@tunes.org> -+ -+ -+File: asdf.info, Node: Error handling, Next: Miscellaneous additional functionality, Prev: Controlling where ASDF saves compiled files, Up: Top -+ -+9 Error handling -+**************** -+ -+9.1 ASDF errors -+=============== -+ -+If ASDF detects an incorrect system definition, it will signal a -+generalised instance of `SYSTEM-DEFINITION-ERROR'. -+ -+ Operations may go wrong (for example when source files contain -+errors). These are signalled using generalised instances of -+`OPERATION-ERROR'. -+ -+9.2 Compilation error and warning handling -+========================================== -+ -+ASDF checks for warnings and errors when a file is compiled. The -+variables *COMPILE-FILE-WARNINGS-BEHAVIOUR* and -+*COMPILE-FILE-ERRORS-BEHAVIOR* control the handling of any such events. -+The valid values for these variables are `:error', `:warn', and -+`:ignore'. -+ -+ -+File: asdf.info, Node: Miscellaneous additional functionality, Next: Getting the latest version, Prev: Error handling, Up: Top -+ -+10 Miscellaneous additional functionality -+***************************************** -+ -+ASDF includes several additional features that are generally useful for -+system definition and development. -+ -+10.1 Controlling file compilation -+================================= -+ -+When declaring a component (system, module, file), you can specify a -+keyword argument `:around-compile function'. If left unspecified (and -+therefore unbound), the value will be inherited from the parent -+component if any, or with a default of `nil' if no value is specified -+in any transitive parent. -+ -+ The argument must be a either `nil', a fbound symbol, a -+lambda-expression (e.g. `(lambda (thunk) ...(funcall thunk ...) ...)') -+a function object (e.g. using `#.#'' but that's discouraged because it -+prevents the introspection done by e.g. asdf-dependency-grovel), or a -+string that when `read' yields a symbol or a lambda-expression. `nil' -+means the normal compile-file function will be called. A non-nil value -+designates a function of one argument that will be called with a -+function that will invoke `compile-file*' with various arguments; the -+around-compile hook may supply additional keyword arguments to pass to -+that call to `compile-file*'. -+ -+ One notable argument that is heeded by `compile-file*' is -+`:compile-check', a function called when the compilation was otherwise -+a success, with the same arguments as `compile-file'; the function -+shall return true if the compilation and its resulting compiled file -+respected all system-specific invariants, and false (`nil') if it broke -+any of those invariants; it may issue warnings or errors before it -+returns `nil'. (NB: The ability to pass such extra flags is only -+available starting with ASDF 2.22.3.) This feature is notably -+exercised by asdf-finalizers. -+ -+ By using a string, you may reference a function, symbol and/or -+package that will only be created later during the build, but isn't yet -+present at the time the defsystem form is evaluated. However, if your -+entire system is using such a hook, you may have to explicitly override -+the hook with `nil' for all the modules and files that are compiled -+before the hook is defined. -+ -+ Using this hook, you may achieve such effects as: locally renaming -+packages, binding *READTABLES* and other syntax-controlling variables, -+handling warnings and other conditions, proclaiming consistent -+optimization settings, saving code coverage information, maintaining -+meta-data about compilation timings, setting gensym counters and PRNG -+seeds and other sources of non-determinism, overriding the -+source-location and/or timestamping systems, checking that some -+compile-time side-effects were properly balanced, etc. -+ -+ Note that there is no around-load hook. This is on purpose. Some -+implementations such as ECL, GCL or MKCL link object files, which -+allows for no such hook. Other implementations allow for concatenating -+FASL files, which doesn't allow for such a hook either. We aim to -+discourage something that's not portable, and has some dubious impact -+on performance and semantics even when it is possible. Things you -+might want to do with an around-load hook are better done -+around-compile, though it may at times require some creativity (see -+e.g. the `package-renaming' system). -+ -+10.2 Controlling source file character encoding -+=============================================== -+ -+Starting with ASDF 2.21, components accept a `:encoding' option so -+authors may specify which character encoding should be used to read and -+evaluate their source code. When left unspecified, the encoding is -+inherited from the parent module or system; if no encoding is specified -+at any point, the default `:autodetect' is assumed. By default, only -+`:default', `:utf-8' and `:autodetect' are accepted. `:autodetect', -+the default, calls `*encoding-detection-hook*' which by default always -+returns `*default-encoding*' which itself defaults to `:default'. -+ -+ In other words, there now are plenty of extension hooks, but by -+default ASDF follows the backwards compatible behavior of using -+whichever `:default' encoding your implementation uses, which itself -+may or may not vary based on environment variables and other locale -+settings. In practice this means that only source code that only uses -+ASCII is guaranteed to be read the same on all implementations -+independently from any user setting. -+ -+ Additionally, for backward-compatibility with older versions of ASDF -+and/or with implementations that do not support unicode and its many -+encodings, you may want to use the reader conditionals `#+asdf-unicode -+#+asdf-unicode' to protect any `:encoding _encoding_' statement as -+`:asdf-unicode' will be present in `*features*' only if you're using a -+recent ASDF on an implementation that supports unicode. We recommend -+that you avoid using unprotected `:encoding' specifications until after -+ASDF 2.21 or later becomes widespread, hopefully by the end of 2012. -+ -+ While it offers plenty of hooks for extension, and one such -+extension is being developed (see below), ASDF itself only recognizes -+one encoding beside `:default', and that is `:utf-8', which is the _de -+facto_ standard, already used by the vast majority of libraries that -+use more than ASCII. On implementations that do not support unicode, -+the feature `:asdf-unicode' is absent, and the `:default' -+external-format is used to read even source files declared as `:utf-8'. -+On these implementations, non-ASCII characters intended to be read as -+one CL character may thus end up being read as multiple CL characters. -+In most cases, this shouldn't affect the software's semantics: comments -+will be skipped just the same, strings with be read and printed with -+slightly different lengths, symbol names will be accordingly longer, -+but none of it should matter. But a few systems that actually depend -+on unicode characters may fail to work properly, or may work in a -+subtly different way. See for instance `lambda-reader'. -+ -+ We invite you to embrace UTF-8 as the encoding for non-ASCII -+characters starting today, even without any explicit specification in -+your `.asd' files. Indeed, on some implementations and configurations, -+UTF-8 is already the `:default', and loading your code may cause errors -+if it is encoded in anything but UTF-8. Therefore, even with the -+legacy behavior, non-UTF-8 is guaranteed to break for some users, -+whereas UTF-8 is pretty much guaranteed not to break anywhere (provided -+you do _not_ use a BOM), although it might be read incorrectly on some -+implementations. In the future, we intend to make `:utf-8' the default -+value of `*default-encoding*', to be enforced everywhere, so at least -+the code is guaranteed to be read correctly everywhere it can be. -+ -+ If you need non-standard character encodings for your source code, -+use the extension system `asdf-encodings', by specifying -+`:defsystem-depends-on (:asdf-encodings)' in your `defsystem'. This -+extension system will register support for more encodings using the -+`*encoding-external-format-hook*' facility, so you can explicitly -+specify `:encoding :latin1' in your `.asd' file. Using the -+`*encoding-detection-hook*' it will also eventually implement some -+autodetection of a file's encoding from an emacs-style `-*- mode: lisp -+; coding: latin1 -*-' declaration, or otherwise based on an analysis of -+octet patterns in the file. At this point, asdf-encoding only supports -+the encodings that are supported as part of your implementation. Since -+the list varies depending on implementations, we once again recommend -+you use `:utf-8' everywhere, which is the most portable (next is -+`:latin1'). -+ -+ If you're not using a version of Quicklisp that has it, you may get -+the source for `asdf-encodings' using git: `git clone -+git://common-lisp.net/projects/asdf/asdf-encodings.git' or `git clone -+ssh://common-lisp.net/project/asdf/git/asdf-encodings.git'. You can -+also browse the repository on -+`http://common-lisp.net/gitweb?p=projects/asdf/asdf-encodings.git'. -+ -+ In the future, we intend to change the default `*default-encoding*' -+to `:utf-8', which is already the de facto standard for most libraries -+that use non-ASCII characters: utf-8 works everywhere and was -+backhandedly enforced by a lot of people using SBCL and utf-8 and -+sending reports to authors so they make their packages compatible. A -+survey showed only about a handful few libraries are incompatible with -+non-UTF-8, and then, only in comments, and we believe that authors will -+adopt UTF-8 when prompted. See the April 2012 discussion on the -+asdf-devel mailing-list. For backwards compatibility with users who -+insist on a non-UTF-8 encoding, but cannot immediately transition to -+using `asdf-encodings' (maybe because it isn't ready), it will still be -+possible to use the `:encoding :default' option in your `defsystem' form -+to restore the behavior of ASDF 2.20 and earlier. This shouldn't be -+required in libraries, because user pressure as mentioned above will -+already have pushed library authors towards using UTF-8; but authors of -+end-user programs might care. -+ -+ When you use `asdf-encodings', any further loaded `.asd' file will -+use the autodetection algorithm to determine its encoding; yet if you -+depend on this detection happening, you may want to explicitly load -+`asdf-encodings' early in your build, for by the time you can use -+`:defsystem-depends-on', it is already too late to load it. In -+practice, this means that the `*default-encoding*' is usually used for -+`.asd' files. Currently, this defaults to `:default' for backwards -+compatibility, and that means that you shouldn't rely on non-ASCII -+characters in a .asd file. Since component (path)names are the only -+real data in these files, and non-ASCII characters are not very -+portable for file names, this isn't too much of an issue. We still -+encourage you to use either plain ASCII or UTF-8 in `.asd' files, as we -+intend to make `:utf-8' the default encoding in the future. This might -+matter, for instance, in meta-data about author's names. -+ -+10.3 Miscellaneous Functions -+============================ -+ -+Most of these functions are not exported by ASDF anymore, but only used -+for private purposes of ASDF. Please use ASDF-UTILS for the same -+functions exported from a stable library. -+ -+ -- Function: coerce-pathname name &key type defaults -+ This function (available starting with ASDF 2.012.11) takes an -+ argument, and portably interprets it as a pathname. If the -+ argument NAME is a pathname or `nil', it is passed through; if -+ it's a symbol, it's interpreted as a string by downcasing it; if -+ it's a string, it is first separated using `/' into substrings; -+ the leading substrings denote subdirectories of a relative -+ pathname. If TYPE is `:directory' or the string ends with `/', -+ the last substring is also a subdirectory; if TYPE is a string, it -+ is used as the type of the pathname, and the last substring is the -+ name component of the pathname; if TYPE is `nil', the last -+ substring specifies both name and type components of the pathname, -+ with the last `.' separating them, or only the name component if -+ there's no last `.' or if there is only one dot and it's the first -+ character. The host, device and version components come from -+ DEFAULTS, which defaults to *DEFAULT-PATHNAME-DEFAULTS*; but that -+ shouldn't matter if you use `merge-pathnames*'. -+ -+ -+ -- Function: merge-pathnames* &key specified defaults -+ This function is a replacement for `merge-pathnames' that uses the -+ host and device from the DEFAULTS rather than the SPECIFIED -+ pathname when the latter is a relative pathname. This allows ASDF -+ and its users to create and use relative pathnames without having -+ to know beforehand what are the host and device of the absolute -+ pathnames they are relative to. -+ -+ -+ -- Function: system-relative-pathname system name &key type -+ It's often handy to locate a file relative to some system. The -+ `system-relative-pathname' function meets this need. -+ -+ It takes two mandatory arguments SYSTEM and NAME and a keyword -+ argument TYPE: SYSTEM is name of a system, whereas NAME and -+ optionally TYPE specify a relative pathname, interpreted like a -+ component pathname specifier by `coerce-pathname'. *Note Pathname -+ specifiers: The defsystem grammar. -+ -+ It returns a pathname built from the location of the system's -+ source directory and the relative pathname. For example: -+ -+ > (asdf:system-relative-pathname 'cl-ppcre "regex.data") -+ #P"/repository/other/cl-ppcre/regex.data" -+ -+ -+ -- Function: system-source-directory system-designator -+ ASDF does not provide a turnkey solution for locating data (or -+ other miscellaneous) files that are distributed together with the -+ source code of a system. Programmers can use -+ `system-source-directory' to find such files. Returns a pathname -+ object. The SYSTEM-DESIGNATOR may be a string, symbol, or ASDF -+ system object. -+ -+ -- Function: clear-system system-designator -+ It is sometimes useful to force recompilation of a previously -+ loaded system. In these cases, it may be useful to -+ `(asdf:clear-system :foo)' to remove the system from the table of -+ currently loaded systems; the next time the system `foo' or one -+ that depends on it is re-loaded, `foo' will then be loaded again. -+ Alternatively, you could touch `foo.asd' or remove the -+ corresponding fasls from the output file cache. (It was once -+ conceived that one should provide a list of systems the -+ recompilation of which to force as the `:force' keyword argument -+ to `load-system'; but this has never worked, and though the -+ feature was fixed in ASDF 2.000, it remains `cerror''ed out as -+ nobody ever used it.) -+ -+ Note that this does not and cannot by itself undo the previous -+ loading of the system. Common Lisp has no provision for such an -+ operation, and its reliance on irreversible side-effects to global -+ datastructures makes such a thing impossible in the general case. -+ If the software being re-loaded is not conceived with hot upgrade -+ in mind, this re-loading may cause many errors, warnings or subtle -+ silent problems, as packages, generic function signatures, -+ structures, types, macros, constants, etc. are being redefined -+ incompatibly. It is up to the user to make sure that reloading is -+ possible and has the desired effect. In some cases, extreme -+ measures such as recursively deleting packages, unregistering -+ symbols, defining methods on `update-instance-for-redefined-class' -+ and much more are necessary for reloading to happen smoothly. -+ ASDF itself goes through notable pains to make such a hot upgrade -+ possible with respect to its own code, and what it does is -+ ridiculously complex; look at the beginning of `asdf.lisp' to see -+ what it does. -+ -+ -- Function: run-program -+ run-program takes a COMMAND argument that is either a list of a -+ program path and its arguments, or a string to be executed by a -+ shell. It spawns the command, waits for it to return, verifies -+ that it exited cleanly (unless told not too below), and optionally -+ captures and processes its output. It accepts many keyword -+ arguments to configure its behavior. -+ -+ `output' is its most important argument; it specifies how the -+ output is captured and processed. If it is `nil', then the output -+ is not captured. If it is `:interactive', then input and output -+ are inherited from the current process, which the subprocess can -+ control until it exits. Otherwise, the output is captured and -+ redirected to a stream, and processed by `slurp-input-stream' with -+ the object as first argument. See below. -+ -+ `element-type' and `external-format' are passed on to your Lisp -+ implementation, when available, for creation of the output stream. -+ -+ `force-shell' forces evaluation of the command through a shell, -+ even if it was passed as a list rather than a string. -+ -+ `ignore-error-status' causes `run-program' to not raise an error -+ if the spawned program exits in error. Following POSIX -+ convention, an error is anything but a normal exit with status -+ code zero. -+ -+ run-program works on all platforms supported by ASDF, except -+ Genera. -+ -+ -+ -- Function: slurp-input-stream -+ It's a generic function of two arguments, a target object and an -+ input stream, and accepting keyword arguments. Predefined methods -+ based on the target object are as follow: -+ -+ If the object is a function, the function is called with the -+ stream as argument. -+ -+ If the object is a cons, its first element is applied to its rest -+ appended by a list of the input stream. -+ -+ If the object is an output stream, the contents of the input -+ stream are copied to it. If the linewise argument is provided, -+ copying happens line by line, and an optional prefix is printed -+ before each line. Otherwise, copying happen based on a buffer of -+ size buffer-size, using the element-type. -+ -+ If the object is 'string or :string, the content is captured into -+ a string of the given element-type. -+ -+ If the object is :lines, the content is captured as a list of -+ strings, one per line, without line ending. If the count argument -+ is provided, it is a maximum count of lines to be read. -+ -+ If the object is :line, the content is capture as with :lines -+ above, and then its sub-object is extracted with the path argument, -+ which defaults to 0, extracting the first line. A number will -+ extract the corresponding line. See the documentation for -+ asdf-driver:sub-object. -+ -+ If the object is :forms, the content is captured as a list of -+ S-expressions, as read by the Lisp reader. If the count argument -+ is provided, it is a maximum count of lines to be read. We -+ recommend you control the syntax with such macro as -+ asdf-driver:with-safe-io-syntax. -+ -+ If the object is :form, the content is capture as with :forms -+ above, and then its sub-object is extracted with the path argument, -+ which defaults to 0, extracting the first form. A number will -+ extract the corresponding form. See the documentation for -+ asdf-driver:sub-object. We recommend you control the syntax with -+ such macro as asdf-driver:with-safe-io-syntax. -+ -+ -+ -- Function: run-shell-command -+ This function is obsolete and present only for the sake of -+ backwards-compatibility: "If it's not backwards, it's not -+ compatible". We strongly discourage its use. Its current behavior -+ is only well-defined on Unix platforms (which include MacOS X and -+ cygwin). On Windows, anything goes. The following documentation -+ is only for the purpose of your migrating away from it in a way -+ that preserves semantics. -+ -+ Instead we recommend the use `run-program' above available as part -+ of ASDF since ASDF 3. -+ -+ `run-shell-command' takes as arguments a `format' control-string -+ and arguments to be passed to `format' after this control-string -+ to produce a string. This string is a command that will be -+ evaluated with a POSIX shell if possible; yet, on Windows, some -+ implementations will use CMD.EXE, while others (like SBCL) will -+ make an attempt at invoking a POSIX shell (and fail if it is not -+ present). -+ -+ -+File: asdf.info, Node: Getting the latest version, Next: FAQ, Prev: Miscellaneous additional functionality, Up: Top -+ -+11 Getting the latest version -+***************************** -+ -+Decide which version you want. The `master' branch is where -+development happens; its `HEAD' is usually OK, including the latest -+fixes and portability tweaks, but an occasional regression may happen -+despite our (limited) test suite. -+ -+ The `release' branch is what cautious people should be using; it has -+usually been tested more, and releases are cut at a point where there -+isn't any known unresolved issue. -+ -+ You may get the ASDF source repository using git: `git clone -+git://common-lisp.net/projects/asdf/asdf.git' -+ -+ You will find the above referenced tags in this repository. You can -+also browse the repository on -+`http://common-lisp.net/gitweb?p=projects/asdf/asdf.git'. -+ -+ Discussion of ASDF development is conducted on the mailing list -+`asdf-devel@common-lisp.net'. -+`http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel' -+ -+ -+File: asdf.info, Node: FAQ, Next: TODO list, Prev: Getting the latest version, Up: Top -+ -+12 FAQ -+****** -+ -+12.1 "Where do I report a bug?" -+=============================== -+ -+ASDF bugs are tracked on launchpad: `https://launchpad.net/asdf'. -+ -+ If you're unsure about whether something is a bug, or for general -+discussion, use the asdf-devel mailing list -+(http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel) -+ -+12.2 "What has changed between ASDF 1 and ASDF 2?" -+================================================== -+ -+12.2.1 What are ASDF 1 and ASDF 2? -+---------------------------------- -+ -+On May 31st 2010, we have released ASDF 2. ASDF 2 refers to release -+2.000 and later. (Releases between 1.656 and 1.728 were development -+releases for ASDF 2.) ASDF 1 to any release earlier than 1.369 or so. -+If your ASDF doesn't sport a version, it's an old ASDF 1. -+ -+ ASDF 2 and its release candidates push `:asdf2' onto `*features*' so -+that if you are writing ASDF-dependent code you may check for this -+feature to see if the new API is present. _All_ versions of ASDF -+should have the `:asdf' feature. -+ -+ Additionally, all versions of ASDF 2 define a function -+`(asdf:asdf-version)' you may use to query the version; and the source -+code of recent versions of ASDF 2 features the version number -+prominently on the second line of its source code. -+ -+ If you are experiencing problems or limitations of any sort with -+ASDF 1, we recommend that you should upgrade to ASDF 2, or whatever is -+the latest release. -+ -+12.2.2 ASDF can portably name files in subdirectories -+----------------------------------------------------- -+ -+Common Lisp namestrings are not portable, except maybe for logical -+pathnamestrings, that themselves have various limitations and require a -+lot of setup that is itself ultimately non-portable. -+ -+ In ASDF 1, the only portable ways to refer to pathnames inside -+systems and components were very awkward, using `#.(make-pathname ...)' -+and `#.(merge-pathnames ...)'. Even the above were themselves were -+inadequate in the general case due to host and device issues, unless -+horribly complex patterns were used. Plenty of simple cases that -+looked portable actually weren't, leading to much confusion and -+greavance. -+ -+ ASDF 2 implements its own portable syntax for strings as pathname -+specifiers. Naming files within a system definition becomes easy and -+portable again. *Note asdf:system-relative-pathname: Miscellaneous -+additional functionality, `merge-pathnames*', `coerce-pathname'. -+ -+ On the other hand, there are places where systems used to accept -+namestrings where you must now use an explicit pathname object: -+`(defsystem ... :pathname "LOGICAL-HOST:PATH;TO;SYSTEM;" ...)' must now -+be written with the `#p' syntax: `(defsystem ... :pathname -+#p"LOGICAL-HOST:PATH;TO;SYSTEM;" ...)' -+ -+ *Note Pathname specifiers: The defsystem grammar. -+ -+12.2.3 Output translations -+-------------------------- -+ -+A popular feature added to ASDF was output pathname translation: -+`asdf-binary-locations', `common-lisp-controller', `cl-launch' and -+other hacks were all implementing it in ways both mutually incompatible -+and difficult to configure. -+ -+ Output pathname translation is essential to share source directories -+of portable systems across multiple implementations or variants thereof, -+or source directories of shared installations of systems across -+multiple users, or combinations of the above. -+ -+ In ASDF 2, a standard mechanism is provided for that, -+`asdf-output-translations', with sensible defaults, adequate -+configuration languages, a coherent set of configuration files and -+hooks, and support for non-Unix platforms. -+ -+ *Note Controlling where ASDF saves compiled files::. -+ -+12.2.4 Source Registry Configuration -+------------------------------------ -+ -+Configuring ASDF used to require special magic to be applied just at -+the right moment, between the moment ASDF is loaded and the moment it -+is used, in a way that is specific to the user, the implementation he -+is using and the application he is building. -+ -+ This made for awkward configuration files and startup scripts that -+could not be shared between users, managed by administrators or -+packaged by distributions. -+ -+ ASDF 2 provides a well-documented way to configure ASDF, with -+sensible defaults, adequate configuration languages, and a coherent set -+of configuration files and hooks. -+ -+ We believe it's a vast improvement because it decouples application -+distribution from library distribution. The application writer can -+avoid thinking where the libraries are, and the library distributor -+(dpkg, clbuild, advanced user, etc.) can configure them once and for -+every application. Yet settings can be easily overridden where needed, -+so whoever needs control has exactly as much as required. -+ -+ At the same time, ASDF 2 remains compatible with the old magic you -+may have in your build scripts (using `*central-registry*' and -+`*system-definition-search-functions*') to tailor the ASDF -+configuration to your build automation needs, and also allows for new -+magic, simpler and more powerful magic. -+ -+ *Note Controlling where ASDF searches for systems::. -+ -+12.2.5 Usual operations are made easier to the user -+--------------------------------------------------- -+ -+In ASDF 1, you had to use the awkward syntax `(asdf:oos 'asdf:load-op -+:foo)' to load a system, and similarly for `compile-op', `test-op'. -+ -+ In ASDF 2, you can use shortcuts for the usual operations: -+`(asdf:load-system :foo)', and similarly for `compile-system', -+`test-system'. -+ -+12.2.6 Many bugs have been fixed -+-------------------------------- -+ -+The following issues and many others have been fixed: -+ -+ * The infamous TRAVERSE function has been revamped completely -+ between ASDF 1 and ASDF 2, with many bugs squashed. In -+ particular, dependencies were not correctly propagated across -+ modules but now are. It has been completely rewritten many times -+ over between ASDF 2.000 and ASDF 3, with fundamental issues in the -+ original model being fixed. Timestamps were not propagated at -+ all, and now are. The internal model of how actions depend on -+ each other is now both consistent and complete. The :version and -+ the :force (system1 .. systemN) feature have been fixed. -+ -+ * Performance has been notably improved for large systems (say with -+ thousands of components) by using hash-tables instead of linear -+ search, and linear-time list accumulation instead of -+ quadratic-time recursive appends. -+ -+ * Many features used to not be portable, especially where pathnames -+ were involved. Windows support was notably quirky because of such -+ non-portability. -+ -+ * The internal test suite used to massively fail on many -+ implementations. While still incomplete, it now fully passes on -+ all implementations supported by the test suite, except for GCL -+ (due to GCL bugs). -+ -+ * Support was lacking for some implementations. ABCL and GCL were -+ notably wholly broken. ECL extensions were not integrated with -+ ASDF release. -+ -+ * The documentation was grossly out of date. -+ -+ -+12.2.7 ASDF itself is versioned -+------------------------------- -+ -+Between new features, old bugs fixed, and new bugs introduced, there -+were various releases of ASDF in the wild, and no simple way to check -+which release had which feature set. People using or writing systems -+had to either make worst-case assumptions as to what features were -+available and worked, or take great pains to have the correct version -+of ASDF installed. -+ -+ With ASDF 2, we provide a new stable set of working features that -+everyone can rely on from now on. Use `#+asdf2' to detect presence of -+ASDF 2, `(asdf:version-satisfies (asdf:asdf-version) "2.345.67")' to -+check the availability of a version no earlier than required. -+ -+12.2.8 ASDF can be upgraded -+--------------------------- -+ -+When an old version of ASDF was loaded, it was very hard to upgrade -+ASDF in your current image without breaking everything. Instead you -+had to exit the Lisp process and somehow arrange to start a new one -+from a simpler image. Something that can't be done from within Lisp, -+making automation of it difficult, which compounded with difficulty in -+configuration, made the task quite hard. Yet as we saw before, the -+task would have been required to not have to live with the worst case -+or non-portable subset of ASDF features. -+ -+ With ASDF 2, it is easy to upgrade from ASDF 2 to later versions -+from within Lisp, and not too hard to upgrade from ASDF 1 to ASDF 2 -+from within Lisp. We support hot upgrade of ASDF and any breakage is a -+bug that we will do our best to fix. There are still limitations on -+upgrade, though, most notably the fact that after you upgrade ASDF, you -+must also reload or upgrade all ASDF extensions. -+ -+12.2.9 Decoupled release cycle -+------------------------------ -+ -+When vendors were releasing their Lisp implementations with ASDF, they -+had to basically never change version because neither upgrade nor -+downgrade was possible without breaking something for someone, and no -+obvious upgrade path was visible and recommendable. -+ -+ With ASDF 2, upgrade is possible, easy and can be recommended. This -+means that vendors can safely ship a recent version of ASDF, confident -+that if a user isn't fully satisfied, he can easily upgrade ASDF and -+deal with a supported recent version of it. This means that release -+cycles will be causally decoupled, the practical consequence of which -+will mean faster convergence towards the latest version for everyone. -+ -+12.2.10 Pitfalls of the transition to ASDF 2 -+-------------------------------------------- -+ -+The main pitfalls in upgrading to ASDF 2 seem to be related to the -+output translation mechanism. -+ -+ * Output translations is enabled by default. This may surprise some -+ users, most of them in pleasant way (we hope), a few of them in an -+ unpleasant way. It is trivial to disable output translations. -+ *Note "How can I wholly disable the compiler output cache?": FAQ. -+ -+ * Some systems in the large have been known not to play well with -+ output translations. They were relatively easy to fix. Once -+ again, it is also easy to disable output translations, or to -+ override its configuration. -+ -+ * The new ASDF output translations are incompatible with -+ ASDF-Binary-Locations. They replace A-B-L, and there is -+ compatibility mode to emulate your previous A-B-L configuration. -+ See `enable-asdf-binary-locations-compatibility' in *note Backward -+ Compatibility: Controlling where ASDF saves compiled files. But -+ thou shalt not load ABL on top of ASDF 2. -+ -+ -+ Other issues include the following: -+ -+ * ASDF pathname designators are now specified in places where they -+ were unspecified, and a few small adjustments have to be made to -+ some non-portable defsystems. Notably, in the `:pathname' argument -+ to a `defsystem' and its components, a logical pathname (or -+ implementation-dependent hierarchical pathname) must now be -+ specified with `#p' syntax where the namestring might have -+ previously sufficed; moreover when evaluation is desired `#.' must -+ be used, where it wasn't necessary in the toplevel `:pathname' -+ argument (but necessary in other `:pathname' arguments). -+ -+ * There is a slight performance bug, notably on SBCL, when initially -+ searching for `asd' files, the implicit `(directory -+ "/configured/path/**/*.asd")' for every configured path `(:tree -+ "/configured/path/")' in your `source-registry' configuration can -+ cause a slight pause. Try to `(time -+ (asdf:initialize-source-registry))' to see how bad it is or isn't -+ on your system. If you insist on not having this pause, you can -+ avoid the pause by overriding the default source-registry -+ configuration and not use any deep `:tree' entry but only -+ `:directory' entries or shallow `:tree' entries. Or you can fix -+ your implementation to not be quite that slow when recursing -+ through directories. _Update_: This performance bug fixed the -+ hard way in 2.010. -+ -+ * On Windows, only LispWorks supports proper default configuration -+ pathnames based on the Windows registry. Other implementations -+ make do with environment variables, that you may have to define -+ yourself if you're using an older version of Windows. Windows -+ support is somewhat less tested than Unix support. Please help -+ report and fix bugs. _Update_: As of ASDF 2.21, all -+ implementations should now use the same proper default -+ configuration pathnames and they should actually work, though they -+ haven't all been tested. -+ -+ * The mechanism by which one customizes a system so that Lisp files -+ may use a different extension from the default `.lisp' has changed. -+ Previously, the pathname for a component was lazily computed when -+ operating on a system, and you would `(defmethod source-file-type -+ ((component cl-source-file) (system (eql (find-system 'foo)))) -+ (declare (ignorable component system)) "lis")'. Now, the pathname -+ for a component is eagerly computed when defining the system, and -+ instead you will `(defclass cl-source-file.lis (cl-source-file) -+ ((type :initform "lis")))' and use `:default-component-class -+ cl-source-file.lis' as argument to `defsystem', as detailed in a -+ *note How do I create a system definition where all the source -+ files have a .cl extension?: FAQ. below. -+ -+ -+12.3 Issues with installing the proper version of ASDF -+====================================================== -+ -+12.3.1 "My Common Lisp implementation comes with an outdated version of ASDF. What to do?" -+------------------------------------------------------------------------------------------ -+ -+We recommend you upgrade ASDF. *Note Upgrading ASDF: Loading ASDF. -+ -+ If this does not work, it is a bug, and you should report it. *Note -+report-bugs: FAQ. In the meantime, you can load `asdf.lisp' directly. -+*Note Loading an otherwise installed ASDF: Loading ASDF. -+ -+12.3.2 "I'm a Common Lisp implementation vendor. When and how should I upgrade ASDF?" -+------------------------------------------------------------------------------------- -+ -+Since ASDF 2, it should always be a good time to upgrade to a recent -+version of ASDF. You may consult with the maintainer for which -+specific version they recommend, but the latest `release' should be -+correct. We trust you to thoroughly test it with your implementation -+before you release it. If there are any issues with the current -+release, it's a bug that you should report upstream and that we will -+fix ASAP. -+ -+ As to how to include ASDF, we recommend the following: -+ -+ * If ASDF isn't loaded yet, then `(require "asdf")' should load the -+ version of ASDF that is bundled with your system. If possible so -+ should `(require "ASDF")'. You may have it load some other -+ version configured by the user, if you allow such configuration. -+ -+ * If your system provides a mechanism to hook into `CL:REQUIRE', -+ then it would be nice to add ASDF to this hook the same way that -+ ABCL, CCL, CLISP, CMUCL, ECL, SBCL and SCL do it. Please send us -+ appropriate code to this end. -+ -+ * You may, like SBCL, have ASDF be implicitly used to require systems -+ that are bundled with your Lisp distribution. If you do have a -+ few magic systems that come with your implementation in a -+ precompiled way such that one should only use the binary version -+ that goes with your distribution, like SBCL does, then you should -+ add them in the beginning of `wrapping-source-registry'. -+ -+ * If you have magic systems as above, like SBCL does, then we -+ explicitly ask you to _NOT_ distribute `asdf.asd' as part of those -+ magic systems. You should still include the file `asdf.lisp' in -+ your source distribution and precompile it in your binary -+ distribution, but `asdf.asd' if included at all, should be -+ secluded from the magic systems, in a separate file hierarchy. -+ Alternatively, you may provide the system after renaming it and -+ its `.asd' file to e.g. `asdf-ecl' and `asdf-ecl.asd', or -+ `sb-asdf' and `sb-asdf.asd'. Indeed, if you made `asdf.asd' a -+ magic system, then users would no longer be able to upgrade ASDF -+ using ASDF itself to some version of their preference that they -+ maintain independently from your Lisp distribution. -+ -+ * If you do not have any such magic systems, or have other non-magic -+ systems that you want to bundle with your implementation, then you -+ may add them to the `wrapping-source-registry', and you are -+ welcome to include `asdf.asd' amongst them. Non-magic systems -+ should be at the back of the `wrapping-source-registry' while -+ magic systems are at the front. -+ -+ * Please send us upstream any patches you make to ASDF itself, so we -+ can merge them back in for the benefit of your users when they -+ upgrade to the upstream version. -+ -+ -+12.4 Issues with configuring ASDF -+================================= -+ -+12.4.1 "How can I customize where fasl files are stored?" -+--------------------------------------------------------- -+ -+*Note Controlling where ASDF saves compiled files::. -+ -+ Note that in the past there was an add-on to ASDF called -+`ASDF-binary-locations', developed by Gary King. That add-on has been -+merged into ASDF proper, then superseded by the -+`asdf-output-translations' facility. -+ -+ Note that use of `asdf-output-translations' can interfere with one -+aspect of your systems -- if your system uses `*load-truename*' to find -+files (e.g., if you have some data files stored with your program), -+then the relocation that this ASDF customization performs is likely to -+interfere. Use `asdf:system-relative-pathname' to locate a file in the -+source directory of some system, and use -+`asdf:apply-output-translations' to locate a file whose pathname has -+been translated by the facility. -+ -+12.4.2 "How can I wholly disable the compiler output cache?" -+------------------------------------------------------------ -+ -+To permanently disable the compiler output cache for all future runs of -+ASDF, you can: -+ -+ mkdir -p ~/.config/common-lisp/asdf-output-translations.conf.d/ -+ echo ':disable-cache' > ~/.config/common-lisp/asdf-output-translations.conf.d/99-disable-cache.conf -+ -+ This assumes that you didn't otherwise configure the ASDF files (if -+you did, edit them again), and don't somehow override the configuration -+at runtime with a shell variable (see below) or some other runtime -+command (e.g. some call to `asdf:initialize-output-translations'). -+ -+ To disable the compiler output cache in Lisp processes run by your -+current shell, try (assuming `bash' or `zsh') (on Unix and cygwin only): -+ -+ export ASDF_OUTPUT_TRANSLATIONS=/: -+ -+ To disable the compiler output cache just in the current Lisp -+process, use (after loading ASDF but before using it): -+ -+ (asdf:disable-output-translations) -+ -+12.5 Issues with using and extending ASDF to define systems -+=========================================================== -+ -+12.5.1 "How can I cater for unit-testing in my system?" -+------------------------------------------------------- -+ -+ASDF provides a predefined test operation, `test-op'. *Note test-op: -+Predefined operations of ASDF. The test operation, however, is largely -+left to the system definer to specify. `test-op' has been a topic of -+considerable discussion on the asdf-devel mailing list -+(http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel), and on the -+launchpad bug-tracker (https://launchpad.net/asdf). -+ -+ Here are some guidelines: -+ -+ * For a given system, FOO, you will want to define a corresponding -+ test system, such as FOO-TEST. The reason that you will want this -+ separate system is that ASDF does not out of the box supply -+ components that are conditionally loaded. So if you want to have -+ source files (with the test definitions) that will not be loaded -+ except when testing, they should be put elsewhere. -+ -+ * The FOO-TEST system can be defined in an asd file of its own or -+ together with FOO. An aesthetic preference against cluttering up -+ the filesystem with extra asd files should be balanced against the -+ question of whether one might want to directly load FOO-TEST. -+ Typically one would not want to do this except in early stages of -+ debugging. -+ -+ * Record that testing is implemented by FOO-TEST. For example: -+ (defsystem FOO -+ :in-order-to ((test-op (test-op FOO-TEST))) -+ ....) -+ -+ (defsystem FOO-TEST -+ :depends-on (FOO MY-TEST-LIBRARY ...) -+ ....) -+ -+ This procedure will allow you to support users who do not wish to -+install your test framework. -+ -+ One oddity of ASDF is that `operate' (*note operate: Operations.) -+does not return a value. So in current versions of ASDF there is no -+reliable programmatic means of determining whether or not a set of tests -+has passed, or which tests have failed. The user must simply read the -+console output. This limitation has been the subject of much -+discussion. -+ -+12.5.2 "How can I cater for documentation generation in my system?" -+------------------------------------------------------------------- -+ -+The ASDF developers are currently working to add a `doc-op' to the set -+of predefined ASDF operations. *Note Predefined operations of ASDF::. -+See also `https://bugs.launchpad.net/asdf/+bug/479470'. -+ -+12.5.3 "How can I maintain non-Lisp (e.g. C) source files?" -+----------------------------------------------------------- -+ -+See `cffi''s `cffi-grovel'. -+ -+12.5.4 "I want to put my module's files at the top level. How do I do this?" -+----------------------------------------------------------------------------- -+ -+By default, the files contained in an asdf module go in a subdirectory -+with the same name as the module. However, this can be overridden by -+adding a `:pathname ""' argument to the module description. For -+example, here is how it could be done in the spatial-trees ASDF system -+definition for ASDF 2: -+ -+ (asdf:defsystem :spatial-trees -+ :components -+ ((:module base -+ :pathname "" -+ :components -+ ((:file "package") -+ (:file "basedefs" :depends-on ("package")) -+ (:file "rectangles" :depends-on ("package")))) -+ (:module tree-impls -+ :depends-on (base) -+ :pathname "" -+ :components -+ ((:file "r-trees") -+ (:file "greene-trees" :depends-on ("r-trees")) -+ (:file "rstar-trees" :depends-on ("r-trees")) -+ (:file "rplus-trees" :depends-on ("r-trees")) -+ (:file "x-trees" :depends-on ("r-trees" "rstar-trees")))) -+ (:module viz -+ :depends-on (base) -+ :pathname "" -+ :components -+ ((:static-file "spatial-tree-viz.lisp"))) -+ (:module tests -+ :depends-on (base) -+ :pathname "" -+ :components -+ ((:static-file "spatial-tree-test.lisp"))) -+ (:static-file "LICENCE") -+ (:static-file "TODO"))) -+ -+ All of the files in the `tree-impls' module are at the top level, -+instead of in a `tree-impls/' subdirectory. -+ -+ Note that the argument to `:pathname' can be either a pathname -+object or a string. A pathname object can be constructed with the -+`#p"foo/bar/"' syntax, but this is discouraged because the results of -+parsing a namestring are not portable. A pathname can only be portably -+constructed with such syntax as `#.(make-pathname :directory -+'(:relative "foo" "bar"))', and similarly the current directory can -+only be portably specified as `#.(make-pathname :directory -+'(:relative))'. However, as of ASDF 2, you can portably use a string -+to denote a pathname. The string will be parsed as a `/'-separated -+path from the current directory, such that the empty string `""' -+denotes the current directory, and `"foo/bar"' (no trailing `/' -+required in the case of modules) portably denotes the same subdirectory -+as above. When files are specified, the last `/'-separated component -+is interpreted either as the name component of a pathname (if the -+component class specifies a pathname type), or as a name component plus -+optional dot-separated type component (if the component class doesn't -+specifies a pathname type). -+ -+12.5.5 How do I create a system definition where all the source files have a .cl extension? -+------------------------------------------------------------------------------------------- -+ -+Starting with ASDF 2.014.14, you may just pass the builtin class -+`cl-source-file.cl' as the `:default-component-class' argument to -+`defsystem': -+ -+ (defsystem my-cl-system -+ :default-component-class cl-source-file.cl -+ ...) -+ -+ Another builtin class `cl-source-file.lsp' is offered for files -+ending in `.lsp'. -+ -+ If you want to use a different extension for which ASDF doesn't -+provide builtin support, or want to support versions of ASDF earlier -+than 2.014.14 (but later than 2.000), you can define a class as follows: -+ -+ ;; Prologue: make sure we're using a sane package. -+ (defpackage :my-asdf-extension -+ (:use :asdf :common-lisp) -+ (:export #:cl-source-file.lis)) -+ (in-package :my-asdf-extension) -+ -+ (defclass cl-source-file.lis (cl-source-file) -+ ((type :initform "lis"))) -+ -+ Then you can use it as follows: -+ (defsystem my-cl-system -+ :default-component-class my-asdf-extension:cl-source-file.lis -+ ...) -+ -+ Of course, if you're in the same package, e.g. in the same file, you -+won't need to use the package qualifier before `cl-source-file.lis'. -+Actually, if all you're doing is defining this class and using it in -+the same file without other fancy definitions, you might skip package -+complications: -+ -+ (in-package :asdf) -+ (defclass cl-source-file.lis (cl-source-file) -+ ((type :initform "lis"))) -+ (defsystem my-cl-system -+ :default-component-class cl-source-file.lis -+ ...) -+ -+ It is possible to achieve the same effect in a way that supports -+both ASDF 1 and ASDF 2, but really, friends don't let friends use ASDF -+1. Please upgrade to ASDF 3. In short, though: do same as above, but -+_before_ you use the class in a `defsystem', you also define the -+following method: -+ -+ (defmethod source-file-type ((f cl-source-file.lis) (s system)) -+ (declare (ignorable f s)) -+ "lis") -+ -+ -+File: asdf.info, Node: TODO list, Next: Inspiration, Prev: FAQ, Up: Top -+ -+13 TODO list -+************ -+ -+Here is an old list of things to do, in addition to the bugs that are -+now tracked on launchpad: `https://launchpad.net/asdf'. -+ -+13.1 Outstanding spec questions, things to add -+============================================== -+ -+** packaging systems -+ -+ *** manual page component? -+ -+ ** style guide for .asd files -+ -+ You should either use keywords or be careful with the package that -+you evaluate defsystem forms in. Otherwise `(defsystem partition ...)' -+being read in the `cl-user' package will intern a `cl-user:partition' -+symbol, which will then collide with the `partition:partition' symbol. -+ -+ Actually there's a hairier packages problem to think about too. -+`in-order-to' is not a keyword: if you read `defsystem' forms in a -+package that doesn't use ASDF, odd things might happen. -+ -+ ** extending defsystem with new options -+ -+ You might not want to write a whole parser, but just to add options -+to the existing syntax. Reinstate `parse-option' or something akin. -+ -+ ** Diagnostics -+ -+ A "dry run" of an operation can be made with the following form: -+ -+ (let ((asdf::*verbose-out* *standard-output*)) -+ (loop :for (op . comp) :in -+ (asdf::traverse (make-instance '<operation-name> :force t) -+ (asdf:find-system <system-name>)) -+ :do (asdf:explain op comp))) -+ -+ This uses unexported symbols. What would be a nice interface for -+this functionality? -+ -+13.2 Missing bits in implementation -+=================================== -+ -+** reuse the same scratch package whenever a system is reloaded from -+disk -+ -+ Have a package ASDF-USER instead of all these temporary packages? -+ -+ ** proclamations probably aren't -+ -+ ** A revert function -+ -+ Other possible interface: have a "revert" function akin to `make -+clean'. -+ -+ (asdf:revert 'asdf:compile-op 'araneida) -+ -+ would delete any files produced by `(compile-system :araneida)'. Of -+course, it wouldn't be able to do much about stuff in the image itself. -+ -+ How would this work? -+ -+ `traverse' -+ -+ There's a difference between a module's dependencies (peers) and its -+components (children). Perhaps there's a similar difference in -+operations? For example, `(load "use") depends-on (load "macros")' is -+a peer, whereas `(load "use") depends-on (compile "use")' is more of a -+"subservient" relationship. -+ -+ -+File: asdf.info, Node: Inspiration, Next: Concept Index, Prev: TODO list, Up: Top -+ -+14 Inspiration -+************** -+ -+14.1 mk-defsystem (defsystem-3.x) -+================================= -+ -+We aim to solve basically the same problems as `mk-defsystem' does. -+However, our architecture for extensibility better exploits CL language -+features (and is documented), and we intend to be portable rather than -+just widely-ported. No slight on the `mk-defsystem' authors and -+maintainers is intended here; that implementation has the unenviable -+task of supporting pre-ANSI implementations, which is no longer -+necessary. -+ -+ The surface defsystem syntax of asdf is more-or-less compatible with -+`mk-defsystem', except that we do not support the `source-foo' and -+`binary-foo' prefixes for separating source and binary files, and we -+advise the removal of all options to specify pathnames. -+ -+ The `mk-defsystem' code for topologically sorting a module's -+dependency list was very useful. -+ -+14.2 defsystem-4 proposal -+========================= -+ -+Marco and Peter's proposal for defsystem 4 served as the driver for -+many of the features in here. Notable differences are: -+ -+ * We don't specify output files or output file extensions as part of -+ the system. -+ -+ If you want to find out what files an operation would create, ask -+ the operation. -+ -+ * We don't deal with CL packages -+ -+ If you want to compile in a particular package, use an -+ `in-package' form in that file (ilisp / SLIME will like you more -+ if you do this anyway) -+ -+ * There is no proposal here that `defsystem' does version control. -+ -+ A system has a given version which can be used to check -+ dependencies, but that's all. -+ -+ The defsystem 4 proposal tends to look more at the external features, -+whereas this one centres on a protocol for system introspection. -+ -+14.3 kmp's "The Description of Large Systems", MIT AI Memo 801 -+============================================================== -+ -+Available in updated-for-CL form on the web at -+`http://nhplace.com/kent/Papers/Large-Systems.html' -+ -+ In our implementation we borrow kmp's overall `PROCESS-OPTIONS' and -+concept to deal with creating component trees from `defsystem' surface -+syntax. [ this is not true right now, though it used to be and -+probably will be again soon ] -+ -+ -+File: asdf.info, Node: Concept Index, Next: Function and Class Index, Prev: Inspiration, Up: Top -+ -+Concept Index -+************* -+ -+�[index�] -+* Menu: -+ -+* :asdf: Introduction. (line 6) -+* :asdf2: Introduction. (line 6) -+* :asdf3: Introduction. (line 6) -+* :defsystem-depends-on: The defsystem grammar. -+ (line 102) -+* :version <1>: Common attributes of components. -+ (line 22) -+* :version <2>: The defsystem grammar. -+ (line 209) -+* :version: The defsystem form. (line 76) -+* :weakly-depends-on: The defsystem grammar. -+ (line 110) -+* ASDF versions: Introduction. (line 6) -+* ASDF-BINARY-LOCATIONS compatibility: Controlling where ASDF saves compiled files. -+ (line 81) -+* asdf-output-translations: Controlling where ASDF saves compiled files. -+ (line 6) -+* ASDF-related features: Introduction. (line 6) -+* component: Components. (line 6) -+* link farm: Loading ASDF. (line 6) -+* logical pathnames: The defsystem grammar. -+ (line 223) -+* operation: Operations. (line 6) -+* pathname specifiers: The defsystem grammar. -+ (line 139) -+* serial dependencies: The defsystem grammar. -+ (line 269) -+* system: Components. (line 6) -+* system designator: Components. (line 6) -+* system directory designator: Loading ASDF. (line 6) -+* Testing for ASDF: Introduction. (line 6) -+* version specifiers: The defsystem grammar. -+ (line 209) -+ -+ -+File: asdf.info, Node: Function and Class Index, Next: Variable Index, Prev: Concept Index, Up: Top -+ -+Function and Class Index -+************************ -+ -+�[index�] -+* Menu: -+ -+* apply-output-translations: Controlling where ASDF saves compiled files. -+ (line 356) -+* clear-configuration: Using ASDF. (line 11) -+* clear-output-translations <1>: Controlling where ASDF saves compiled files. -+ (line 341) -+* clear-output-translations: Configuring ASDF. (line 114) -+* clear-source-registry: Controlling where ASDF searches for systems. -+ (line 372) -+* clear-system: Miscellaneous additional functionality. -+ (line 237) -+* coerce-pathname: Miscellaneous additional functionality. -+ (line 184) -+* compile-op: Predefined operations of ASDF. -+ (line 12) -+* compile-system: Loading ASDF. (line 6) -+* disable-output-translations: Controlling where ASDF saves compiled files. -+ (line 336) -+* enable-asdf-binary-locations-compatibility: Controlling where ASDF saves compiled files. -+ (line 107) -+* ensure-output-translations: Controlling where ASDF saves compiled files. -+ (line 351) -+* ensure-source-registry: Controlling where ASDF searches for systems. -+ (line 381) -+* find-system: Components. (line 15) -+* initialize-output-translations: Controlling where ASDF saves compiled files. -+ (line 327) -+* initialize-source-registry: Controlling where ASDF searches for systems. -+ (line 363) -+* load-fasl-op: Predefined operations of ASDF. -+ (line 74) -+* load-op: Predefined operations of ASDF. -+ (line 25) -+* load-source-op: Predefined operations of ASDF. -+ (line 45) -+* load-system: Loading ASDF. (line 6) -+* merge-pathnames*: Miscellaneous additional functionality. -+ (line 203) -+* module: Pre-defined subclasses of component. -+ (line 23) -+* oos <1>: Operations. (line 31) -+* oos: Loading ASDF. (line 6) -+* operate <1>: Operations. (line 29) -+* operate: Loading ASDF. (line 6) -+* OPERATION-ERROR: Error handling. (line 6) -+* parent-load-op: Predefined operations of ASDF. -+ (line 32) -+* require-system: Loading ASDF. (line 6) -+* run-program: Miscellaneous additional functionality. -+ (line 269) -+* run-shell-command: Miscellaneous additional functionality. -+ (line 344) -+* slurp-input-stream: Miscellaneous additional functionality. -+ (line 300) -+* source-file: Pre-defined subclasses of component. -+ (line 7) -+* source-file-type: FAQ. (line 287) -+* system: Pre-defined subclasses of component. -+ (line 50) -+* SYSTEM-DEFINITION-ERROR: Error handling. (line 6) -+* system-relative-pathname: Miscellaneous additional functionality. -+ (line 212) -+* system-source-directory: Miscellaneous additional functionality. -+ (line 229) -+* test-op: Predefined operations of ASDF. -+ (line 54) -+* test-system: Loading ASDF. (line 6) -+* VERSION: Functions. (line 7) -+* version-satisfies <1>: Functions. (line 6) -+* version-satisfies: Common attributes of components. -+ (line 22) -+ -+ -+File: asdf.info, Node: Variable Index, Prev: Function and Class Index, Up: Top -+ -+Variable Index -+************** -+ -+�[index�] -+* Menu: -+ -+* *central-registry*: Loading ASDF. (line 6) -+* *compile-file-errors-behavior*: Error handling. (line 19) -+* *compile-file-warnings-behaviour*: Error handling. (line 19) -+* *default-source-registry-exclusions*: Controlling where ASDF searches for systems. -+ (line 319) -+* *features*: Introduction. (line 6) -+* *system-definition-search-functions*: Components. (line 6) -+* ASDF_OUTPUT_TRANSLATIONS: Controlling where ASDF saves compiled files. -+ (line 6) -+ -+ -+ -+Tag Table: -+Node: Top1687 -+Node: Introduction3739 -+Node: Loading ASDF5819 -+Node: Configuring ASDF13441 -+Ref: Configuring ASDF-Footnote-121589 -+Ref: Configuring ASDF-Footnote-221821 -+Node: Using ASDF22534 -+Node: Defining systems with defsystem26818 -+Node: The defsystem form27204 -+Ref: The defsystem form-Footnote-130782 -+Node: A more involved example30865 -+Node: The defsystem grammar32911 -+Node: Other code in .asd files48068 -+Node: The object model of ASDF48909 -+Node: Operations53459 -+Ref: operate54369 -+Node: Predefined operations of ASDF56386 -+Ref: test-op58611 -+Node: Creating new operations60836 -+Node: Components65086 -+Node: Common attributes of components67568 -+Node: Pre-defined subclasses of component73369 -+Node: Creating new component types75730 -+Node: Functions77100 -+Node: Controlling where ASDF searches for systems77732 -+Node: Controlling where ASDF saves compiled files99371 -+Node: Error handling117256 -+Node: Miscellaneous additional functionality118088 -+Node: Getting the latest version137613 -+Node: FAQ138639 -+Ref: report-bugs160174 -+Node: TODO list165062 -+Node: Inspiration167463 -+Node: Concept Index169763 -+Node: Function and Class Index172291 -+Node: Variable Index177777 -+ -+End Tag Table ---- cl-asdf-3.0.0.orig/doc/asdf.texinfo -+++ cl-asdf-3.0.0/doc/asdf.texinfo -@@ -6,27 +6,21 @@ - - @c We use @&key, etc to escape & from TeX in lambda lists -- - @c so we need to define them for info as well. --@macro &allow-other-keys -+@macro AallowOtherKeys - &allow-other-keys - @end macro --@macro &optional -+@macro Aoptional - &optional - @end macro --@macro &rest -+@macro Arest - &rest - @end macro --@macro &key -+@macro Akey - &key - @end macro --@macro &body -+@macro Abody - &body - @end macro --@macro &curly --{ --@end macro --@macro &ylruc --} --@end macro - - @c for install-info - @dircategory Software development -@@ -1012,7 +1006,7 @@ simple-component-name := string - - pathname-specifier := pathname | string | symbol - --method-form := (operation-name qual lambda-list @&rest body) -+method-form := (operation-name qual lambda-list @Arest body) - qual := method qualifier - - component-dep-fail-option := :fail | :try-next | :ignore -@@ -1484,8 +1478,8 @@ and easier than having them all be @code - - Operations are invoked on systems via @code{operate}. - @anchor{operate} --@deffn {Generic function} @code{operate} @var{operation} @var{system} @&rest @var{initargs} @&key @code{force} @code{force-not} @code{verbose} @&allow-other-keys --@deffnx {Generic function} @code{oos} @var{operation} @var{system} @&rest @var{initargs} @&key @&allow-other-keys -+@deffn {Generic function} @code{operate} @var{operation} @var{system} @Arest @var{initargs} @Akey @code{force} @code{force-not} @code{verbose} @AallowOtherKeys -+@deffnx {Generic function} @code{oos} @var{operation} @var{system} @Arest @var{initargs} @Akey @AallowOtherKeys - @code{operate} invokes @var{operation} on @var{system}. - @code{oos} is a synonym for @code{operate}. - -@@ -1540,7 +1534,7 @@ They are invoked via the @code{operate} - (asdf:operate 'asdf:@var{operation-name} :@var{system-name} @{@var{operation-options ...}@}) - @end lisp - --@deffn Operation @code{compile-op} @&key @code{proclamations} -+@deffn Operation @code{compile-op} @Akey @code{proclamations} - - This operation compiles the specified component. - If proclamations are supplied, they will be proclaimed. -@@ -1557,7 +1551,7 @@ does not necessarily load all the parts - use @code{load-op} to load a system. - @end deffn - --@deffn Operation @code{load-op} @&key @code{proclamations} -+@deffn Operation @code{load-op} @Akey @code{proclamations} - - This operation loads a system. - -@@ -1565,7 +1559,7 @@ The default methods for @code{load-op} c - For parity, your own methods on new component types should probably do so too. - @end deffn - --@deffn Operation @code{parent-load-op} @&key @code{proclamations} -+@deffn Operation @code{parent-load-op} @Akey @code{proclamations} - - This operation ensures that the dependencies - of a module, and its parent, and so on, are loaded (as per @code{load-op}) -@@ -1652,7 +1646,7 @@ itself descended from @code{asdf-ecl}. - @end deffn - - --@c @deffn Operation test-system-version @&key minimum -+@c @deffn Operation test-system-version @Akey minimum - - @c Asks the system whether it satisfies a version requirement. - -@@ -2583,7 +2577,7 @@ The specified functions are exported fro - Thus for ASDF the corresponding functions are in package ASDF, - and for XCVB the corresponding functions are in package XCVB. - --@defun initialize-source-registry @&optional PARAMETER -+@defun initialize-source-registry @Aoptional PARAMETER - will read the configuration and initialize all internal variables. - You may extend or override configuration - from the environment and configuration files -@@ -2608,7 +2602,7 @@ and for XCVB the corresponding functions - where to look for systems not yet defined. - @end defun - --@defun ensure-source-registry @&optional PARAMETER -+@defun ensure-source-registry @Aoptional PARAMETER - checks whether a source registry has been initialized. - If not, initialize it with the given @var{PARAMETER}. - @end defun -@@ -2828,7 +2822,7 @@ as configured by the system distributor, - Nevertheless, if you are a fan of @code{ASDF-Binary-Locations}, - we provide a limited emulation mode: - --@defun enable-asdf-binary-locations-compatibility @&key centralize-lisp-binaries default-toplevel-directory include-per-user-information map-all-source-files source-to-target-mappings -+@defun enable-asdf-binary-locations-compatibility @Akey centralize-lisp-binaries default-toplevel-directory include-per-user-information map-all-source-files source-to-target-mappings - This function will initialize the new @code{asdf-output-translations} facility in a way - that emulates the behavior of the old @code{ASDF-Binary-Locations} facility. - Where you would previously set global variables -@@ -3071,7 +3065,7 @@ To explicitly flush any information cach - - The specified functions are exported from package ASDF. - --@defun initialize-output-translations @&optional PARAMETER -+@defun initialize-output-translations @Aoptional PARAMETER - will read the configuration and initialize all internal variables. - You may extend or override configuration - from the environment and configuration files -@@ -3102,7 +3096,7 @@ The specified functions are exported fro - where to look for systems not yet defined. - @end defun - --@defun ensure-output-translations @&optional PARAMETER -+@defun ensure-output-translations @Aoptional PARAMETER - checks whether output translations have been initialized. - If not, initialize them with the given @var{PARAMETER}. - This function will be called before any attempt to operate on a system. -@@ -3401,7 +3395,7 @@ Most of these functions are not exported - but only used for private purposes of ASDF. - Please use ASDF-UTILS for the same functions exported from a stable library. - --@defun coerce-pathname name @&key type defaults -+@defun coerce-pathname name @Akey type defaults - - This function (available starting with ASDF 2.012.11) - takes an argument, and portably interprets it as a pathname. -@@ -3421,7 +3415,7 @@ The host, device and version components - - @end defun - --@defun merge-pathnames* @&key specified defaults -+@defun merge-pathnames* @Akey specified defaults - - This function is a replacement for @code{merge-pathnames} that uses the host and device - from the @var{defaults} rather than the @var{specified} pathname when the latter -@@ -3431,7 +3425,7 @@ of the absolute pathnames they are relat - - @end defun - --@defun system-relative-pathname system name @&key type -+@defun system-relative-pathname system name @Akey type - - It's often handy to locate a file relative to some system. - The @code{system-relative-pathname} function meets this need. diff --git a/debian/patches/series b/debian/patches/series deleted file mode 100644 index c8e9a393ac3d7b00e287f1fb84959ee9962f0dd6..0000000000000000000000000000000000000000 --- a/debian/patches/series +++ /dev/null @@ -1 +0,0 @@ -Tweaks-for-a-debian-release-of-3.0.0 diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo index 0c02c2658a9bb4f8b61810277a814891cf78153c..13f07855d3109d7c42f0fca33bc9b80f7beb3cbe 100644 --- a/doc/asdf.texinfo +++ b/doc/asdf.texinfo @@ -863,22 +863,24 @@ without having to edit the system definition. @c defsystem grammar, but the cross-referencing is so broken by @c insufficient node breakdown that I have not put one in. @item -Make sure you know how the @code{:version} numbers will be parsed! They -are parsed as period-separated lists of integers. I.e., in the example, -@code{0.2.1} is to be interpreted, roughly speaking, as @code{(0 2 1)}. -In particular, version @code{0.2.1} is interpreted the same as -@code{0.0002.1} and is strictly version-less-than version @code{0.20.1}, +Make sure you know how the @code{:version} numbers will be parsed! +They are parsed as period-separated lists of integers. +I.e., in the example, @code{0.2.1} is to be interpreted, +roughly speaking, as @code{(0 2 1)}. +In particular, version @code{0.2.1} +is interpreted the same as @code{0.0002.1} and +is strictly version-less-than version @code{0.20.1}, even though the two are the same when interpreted as decimal fractions. Instead of a string representing the version, the @code{:version} argument can be an expression that is resolved to such a string using the following trivial domain-specific language: in addition to being a literal string, it can be an expression of the form @code{(:read-file-form <pathname-or-string> :at <access-at-specifier>)}, -which will be resolved by reading a form -in the specified pathname +which will be resolved by reading a form in the specified pathname (read as a subpathname of the current system if relative or a unix-namestring). -You may use an access-at specifier with the (optional) :at keyword, -by default the specifier is 0, meaning the first form is returned. +You may use a @code{uiop:access-at} specifier +with the (optional) @code{:at} keyword, +by default the specifier is @code{0}, meaning the first form is returned. @cindex :version @@ -1182,15 +1184,19 @@ be forced upon you if you were specifying a string. @cindex version specifiers @cindex :version -Version specifiers are parsed as period-separated lists of integers. I.e., in the example, -@code{0.2.1} is to be interpreted, roughly speaking, as @code{(0 2 1)}. -In particular, version @code{0.2.1} is interpreted the same as -@code{0.0002.1} and is strictly version-less-than version @code{0.20.1}, -even though the two are the same when interpreted as decimal fractions. +Version specifiers are strings to be parsed as period-separated lists of integers. +I.e., in the example, @code{"0.2.1"} is to be interpreted, +roughly speaking, as @code{(0 2 1)}. +In particular, version @code{"0.2.1"} is interpreted the same as @code{"0.0002.1"}, +though the latter is not canonical and may lead to a warning being issued. +Also, @code{"1.3"} and @code{"1.4"} are both strictly @code{uiop:version<} to @code{"1.30"}, +quite unlike what would have happened +had the version strings been interpreted as decimal fractions. System definers are encouraged to use version identifiers of the form -@var{x}.@var{y}.@var{z} for major version, minor version (compatible -API) and patch level. +@var{x}.@var{y}.@var{z} for +major version, minor version and patch level, +where significant API incompatibilities are signaled by an increased major number. @xref{Common attributes of components}. @@ -1342,10 +1348,15 @@ Please use the @code{if-feature} option instead. Files containing @code{defsystem} forms are regular Lisp files that are executed by @code{load}. -Consequently, you can put whatever Lisp code you like into these files -(e.g., code that examines the compile-time environment -and adds appropriate features to @code{*features*}). -However, some conventions should be followed, +Consequently, you can put whatever Lisp code you like into these files. +However, it is recommended to keep such forms to a minimal, +and to instead define @code{defsystem} extensions +that you use with @code{:defsystem-depends-on}. + +If however, you might insist on including code in the @code{.asd} file itself, +e.g., to examine and adjust the compile-time environment, +possibly adding appropriate features to @code{*features*}. +If so, here are some conventions we recommend you follow, so that users can control certain details of execution of the Lisp in @file{.asd} files: @@ -1646,43 +1657,6 @@ itself descended from @code{asdf-ecl}. @end deffn -@c @deffn Operation test-system-version @Akey minimum - -@c Asks the system whether it satisfies a version requirement. - -@c The default method accepts a string, which is expected to contain of a -@c number of integers separated by #\. characters. The method is not -@c recursive. The component satisfies the version dependency if it has -@c the same major number as required and each of its sub-versions is -@c greater than or equal to the sub-version number required. - -@c @lisp -@c (defun version-satisfies (x y) -@c (labels ((bigger (x y) -@c (cond ((not y) t) -@c ((not x) nil) -@c ((> (car x) (car y)) t) -@c ((= (car x) (car y)) -@c (bigger (cdr x) (cdr y)))))) -@c (and (= (car x) (car y)) -@c (or (not (cdr y)) (bigger (cdr x) (cdr y)))))) -@c @end lisp - -@c If that doesn't work for your system, you can override it. I hope -@c you have as much fun writing the new method as @verb{|#lisp|} did -@c reimplementing this one. -@c @end deffn - -@c @deffn Operation feature-dependent-op - -@c An instance of @code{feature-dependent-op} will ignore any components -@c which have a @code{features} attribute, unless the feature combination -@c it designates is satisfied by @code{*features*}. This operation is -@c not intended to be instantiated directly, but other operations may -@c inherit from it. - -@c @end deffn - @node Creating new operations, , Predefined operations of ASDF, Operations @comment node-name, next, previous, up @subsection Creating new operations @@ -1876,47 +1850,44 @@ to a Unix-style syntax. @findex version-satisfies @cindex :version -This optional attribute is used by the generic function -@code{version-satisfies}, which tests to see if @code{:version} -dependencies are satisfied. -the version should be a string of integers separated by dots, +This optional attribute specifies a version for the current component. +The version should typically be a string of integers separated by dots, for example @samp{1.0.11}. -For more information on the semantics of version specifiers, see @ref{The defsystem grammar}. - -@c This optional attribute is intended to be used by the @code{test-system-version} operation. -@c @xref{Predefined operations of ASDF}. -@c @emph{Nota Bene}: -@c This operation, planned for ASDF 1, -@c is still not implemented yet as of ASDF 3. -@c Don't hold your breath. +For more information on version specifiers, see @ref{The defsystem grammar}. +A version may then be queried by the generic function @code{version-satisfies}, +to see if @code{:version} dependencies are satisfied, +and when specifying dependencies, a constraint of minimal version to satisfy +can be specified using e.g. @code{(:version "mydepname" "1.0.11")}. +Note that in the wild, we typically see version numbering +only on components of type @code{system}. +Presumably it is much less useful within a given system, +wherein the library author is responsible to keep the various files in synch. @subsubsection Required features -@emph{FIXME: This subsection seems to contradict the -@code{defsystem} grammar subsection, -which doesn't provide any obvious way to specify required features. -Furthermore, in 2009, discussions on the -@url{http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel,asdf-devel mailing list} -suggested that the specification of required features may be broken, -and that no one may have been using them for a while. -Please contact the -@url{http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel,asdf-devel mailing list} -if you are interested in getting this features feature fixed.} - -Traditionally defsystem users have used reader conditionals +Traditionally defsystem users have used @code{#+} reader conditionals to include or exclude specific per-implementation files. This means that any single implementation cannot read the entire system, which becomes a problem if it doesn't wish to compile it, but instead for example to create an archive file containing all the sources, as it will omit to process the system-dependent sources for other systems. -Each component in an asdf system may therefore specify features using -the same syntax as @code{#+} does, and it will (somehow) be ignored for -certain operations unless the feature conditional is a member of -@code{*features*}. - +Each component in an asdf system may therefore specify using @code{:if-feature} +a feature expression using the same syntax as @code{#+} does, +such that any reference to the component will be ignored +during compilation, loading and/or linking if the expression evaluates to false. +Since the expression is read by the normal reader, +you must explicitly prefix your symbols with @code{:} so they be read as keywords; +this is as contrasted with the @code{#+} syntax +that implicitly reads symbols in the keyword package by default. + +For instance, @code{:if-feature (:and :x86 (:or :sbcl :cmu :scl))} specifies that +the given component is only to be compiled and loaded +when the implementation is SBCL, CMUCL or Scieneer CL on an x86 machine. +You can not write it as @code{:if-feature (and x86 (or sbcl cmu scl))} +since the symbols would presumably fail to be read as keywords. @subsubsection Dependencies @@ -1999,8 +1970,11 @@ If you have the time for some CLISP hacking, I'm sure they'd welcome your fixes. @c Doesn't CLISP now support LIST method combination? -See the discussion of the semantics of @code{:version} in the defsystem -grammar. +A minimal version can be specified for a component you depend on +(typically another system), by specifying @code{(:version "other-system" "1.2.3")} +instead of simply @code{"other-system"} as the dependency. +See the discussion of the semantics of @code{:version} +in the defsystem grammar. @c FIXME: Should have cross-reference to "Version specifiers" in the @c defsystem grammar, but the cross-referencing is so broken by @@ -2166,16 +2140,33 @@ The new component type is used in a @code{defsystem} form in this way: @deffn version-satisfies @var{version} @var{version-spec} Does @var{version} satisfy the @var{version-spec}. A generic function. -ASDF provides built-in methods for @var{version} being a -@code{component} or @code{string}. @var{version-spec} should be a -string. - -In the wild, we typically see version numbering only on components of -type @code{system}. - -For more information about how @code{version-satisfies} interprets -version strings and specifications, @pxref{The defsystem grammar} and +ASDF provides built-in methods for @var{version} being a @code{component} or @code{string}. +@var{version-spec} should be a string. +If it's a component, its version is extracted as a string before further processing. + +A version string satisfies the version-spec if after parsing, +the former is no older than the latter. +Therefore @code{"1.9.1"}, @code{"1.9.2"} and @code{"1.10"} all satisfy @code{"1.9.1"}, +but @code{"1.8.4"} or @code{"1.9"} do not. +For more information about how @code{version-satisfies} parses and interprets +version strings and specifications, +@pxref{The defsystem grammar} (version specifiers) and @ref{Common attributes of components}. + +Note that in versions of ASDF prior to 3.0.1, +including the entire ASDF 1 and ASDF 2 series, +@code{version-satisfies} would also require that the version and the version-spec +have the same major version number (the first integer in the list); +if the major version differed, the version would be considered as not matching the spec. +But that feature was not documented, therefore presumably not relied upon, +whereas it was a nuisance to several users. +Starting with ASDF 3.0.1, +@code{version-satisfies} does not treat the major version number specially, +and returns T simply if the first argument designates a version that isn't older +than the one specified as a second argument. +If needs be, the @code{(:version ...)} syntax for specifying dependencies +could be in the future extended to specify an exclusive upper bound for compatible versions +as well as an inclusive lower bound. @end deffn @node Controlling where ASDF searches for systems, Controlling where ASDF saves compiled files, The object model of ASDF, Top diff --git a/header.lisp b/header.lisp index f39556062f639f3ffb5b7a07181ed49024919927..8f809e02e29b93da30d63bf8f16c051b3f3c312d 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- -;;; This is ASDF 3.0.0: Another System Definition Facility. +;;; This is ASDF 3.0.1: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel@common-lisp.net>. diff --git a/test/test-utilities.script b/test/test-utilities.script index 48ac448f61cd17ee7a45f4f594f9edb184686603..affb1e5368ec2655f018faa3d97ecff83a68a5a3 100644 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -36,7 +36,7 @@ (assert (version-satisfies (asdf-version) "3.0")) (assert - (not (version-satisfies (asdf-version) "2.0"))) + (version-satisfies (asdf-version) "2.0")) (assert (version<= "2.0" (asdf-version))) (assert diff --git a/upgrade.lisp b/upgrade.lisp index 8f6e627609d2a9613757264940b77bf00d30628e..71c6c79c6a392a4af41e318b40d61f6d311ac352 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -52,7 +52,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO ;; "3.4.5.67" would be a development version in the official upstream of 3.4.5. ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5 ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67 - (asdf-version "3.0.0") + (asdf-version "3.0.1") (existing-version (asdf-version))) (setf *asdf-version* asdf-version) (when (and existing-version (not (equal asdf-version existing-version))) diff --git a/version.lisp-expr b/version.lisp-expr index b96657be7a03863c1d0c170c284450b2b9420b91..f6fd00b74556188238c40d61381a085e10c0557e 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1 +1 @@ -"3.0.0" +"3.0.1"