diff --git a/.gitignore b/.gitignore index 5fb9699049bc031545bf278c639b57465c3c4a50..04420abdafce6eb0bb152c783d405ef519cfb77b 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,5 @@ ? ?? -??? build doc/asdf/ diff --git a/Makefile b/Makefile index d0f47490fc3de5b4f67e616cc3e3097a1582f798..ef4890bf8e0ae092a37285cdf7d8d82e9b7841d7 100644 --- a/Makefile +++ b/Makefile @@ -54,12 +54,12 @@ load: build/asdf.lisp install: archive-copy bump-version: build/asdf.lisp - ./bin/bump-version + ./bin/asdf-builder bump-version archive: build/asdf.lisp #${SBCL} --userinit /dev/null --sysinit /dev/null --load bin/make-helper.lisp \ # --eval "(rewrite-license)" --eval "(quit)" - ./bin/make-tarball + ./bin/asdf-builder make-tarballs archive-copy: archive build/asdf.lisp git checkout release diff --git a/action.lisp b/action.lisp index be0abfd1954504d98b7586d4ba025f918d91fe2b..aae1ad5270bc5929333504557cc541a2458f96dc 100644 --- a/action.lisp +++ b/action.lisp @@ -92,7 +92,7 @@ You can put together sentences using this phrase.")) ;; For backward-compatibility reasons, a system inherits from module and is a child-component ;; so we must guard against this case. ASDF3: remove that. (defmethod component-depends-on ((o upward-operation) (c child-component)) - `(,@(if-bind (p (component-parent c)) `((,o ,p))) ,@(call-next-method))) + `(,@(if-let (p (component-parent c)) `((,o ,p))) ,@(call-next-method))) ;;;; Inputs, Outputs, and invisible dependencies diff --git a/asdf.asd b/asdf.asd index 34cc87f0b4f4fff632131f6da9e60d6ad236a1d9..b8967bb6863a1d0ffc1828a0754094caa3ebcf32 100644 --- a/asdf.asd +++ b/asdf.asd @@ -15,7 +15,7 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "2.26.111" ;; to be automatically updated by bin/bump-revision + :version "2.26.112" ;; to be automatically updated by bin/bump-revision :depends-on () :components ((:module "build" :components ((:file "asdf")))) :in-order-to (#+asdf2.27 (compile-op (monolithic-load-concatenated-source-op generate-asdf)))) diff --git a/bin/asdf-builder b/bin/asdf-builder new file mode 100755 index 0000000000000000000000000000000000000000..c6f4470e9e8e6d99d39439babee9beeff4865d1c --- /dev/null +++ b/bin/asdf-builder @@ -0,0 +1,243 @@ +":" ; exec sbcl --script "$0" "$@" ; exit # -*- Lisp -*- +;;;;; Really runs on any decent Common Lisp implementation + +(load (make-pathname :name "prelude" :type "lisp" :defaults *load-pathname*) + :verbose nil :print nil) + +(defpackage :asdf-builder (:use :cl :asdf/driver :asdf :fare-utils)) +(in-package :asdf-builder) + +(asdf-debug) + +(defun build-asdf () + ;; Make sure asdf.lisp is built. + (asdf:build-system :asdf/generate)) + + +;;; ASDF directory +(defvar *asdf-dir* + (ensure-pathname (system-relative-pathname :asdf ()) + :want-physical t :want-absolute t + :want-existing t :ensure-truename t)) +(defparameter /asdf-dir/ + (native-namestring *asdf-dir*)) +(defun apath (x &rest keys) (apply 'subpathname *asdf-dir* x keys)) + + +;;; build directory +(defparameter *build-dir* + (ensure-pathname + "build/" :defaults *asdf-dir* + :want-relative t :ensure-absolute t + :ensure-subpath t)) +(defparameter /build-dir/ + (native-namestring *build-dir*)) + +(defparameter *version* + (safe-read-file-form + (subpathname *asdf-dir* "version.lisp-expr"))) + +(defun enough-namestring! (base pathname) + (let ((e (enough-namestring base pathname))) + (assert (relative-pathname-p e)) + e)) + +(defun enough-namestrings (base pathnames) + (loop :with b = (ensure-pathname base :want-absolute t :want-directory t) + :for p :in pathnames + :collect (enough-namestring! p base))) + +(defun system-source-files (system) + (let* ((sys (find-system system)) + (dir (ensure-pathname + (system-source-directory sys) + :want-absolute t :want-directory t)) + (components + (operated-components + sys :other-systems nil + :goal-operation 'load-op + :keep-operation 'load-op + :keep-component 'file-component)) + (pathnames (mapcar 'component-pathname components))) + (enough-namestrings dir pathnames))) + +(defun tarname (name) (strcat name ".tar.gz")) + +(defun run-program* (x) + (format t "~A~%" x) + (run-program/ x)) + +(defun make-tarball-under-build (name base files) + (check-type name string) + (ensure-pathname base :want-absolute t :want-existing t :want-directory t) + (dolist (f files) + (check-type f string)) + (let* ((/base/ + (native-namestring + (ensure-pathname + base + :want-absolute t :want-directory t + :want-existing t :ensure-truename t))) + (destination + (ensure-pathname + name + :defaults *build-dir* + :want-relative t :ensure-absolute t + :ensure-subpath t :ensure-directory t)) + (/destination/ + (native-namestring destination)) + (/tarball/ + (native-namestring + (ensure-pathname + (tarname name) + :defaults *build-dir* + :want-relative t :ensure-absolute t + :ensure-subpath t :want-file t + :ensure-directories-exist t))) + (/files/ + (mapcar 'native-namestring files))) + (assert (< 6 (length (pathname-directory destination)))) + (when (probe-file* destination) + (error "Destination ~S already exists, not taking chances - you can delete it yourself." + destination)) + (ensure-directories-exist destination) + (run-program* (format nil "cd ~S && cp -lax --parents ~{~S ~} ~S" + /base/ /files/ /destination/)) + (run-program* (format nil "tar zcfC ~S ~S ~S/" + /tarball/ /build-dir/ name)) + (run-program* `("rm" "-rf" ,/destination/)))) + +(defun driver-files () + (list* "asdf-driver.asd" "version.lisp-expr" + (system-source-files :asdf-driver))) +(defun driver-name () + (format nil "asdf-driver-~A" *version*)) +(defun make-driver-tarball () + (make-tarball-under-build (driver-name) *asdf-dir* (driver-files))) + +(defun asdf-only-files () + (list* "asdf.asd" "version.lisp-expr" "header.lisp" + (system-source-files :asdf/generate))) +(defun asdf-only-name () + (format nil "asdf-only-~A" *version*)) +(defun make-asdf-only-tarball () + (make-tarball-under-build (asdf-only-name) *asdf-dir* (asdf-only-files))) + +(defun make-git-tarball () + (run-program* (format nil "cd ~S && tar zcf build/asdf-~A.tar.gz build/asdf.lisp $(git ls-files)" + /asdf-dir/ *version*))) + +(defun make-tarballs () + (make-driver-tarball) + (make-asdf-only-tarball) + (make-git-tarball)) + +(defparameter *versioned-files* + '(("version.lisp-expr" "\"" "\"") + ("asdf.asd" " :version \"" "\" ;; to be automatically updated by bin/bump-revision") + ("header.lisp" "This is ASDF " ": Another System Definition Facility.") + ("upgrade.lisp" " (asdf-version \"" "\")"))) + +(defparameter *version-file* + (apath "version.lisp-expr")) + +(defparameter *old-version* nil) +(defparameter *new-version* nil) + +(defun next-version (v) + (let ((pv (parse-version v 'error))) + (incf (third pv)) + (unparse-version pv))) + +(defun version-from-file () + (safe-read-file-form *version-file*)) + +(defun versions-from-args (&optional v1 v2) + (labels ((check (old new) + (parse-version old 'error) + (parse-version new 'error) + (values old new))) + (cond + ((and v1 v2) (check v1 v2)) + (v1 (check (version-from-file) v1)) + (t (let ((old (version-from-file))) + (check old (next-version old))))))) + +(deftype byte-vector () '(array (unsigned-byte 8) (*))) + +(defun maybe-replace-file (file transformer + &key (reader 'read-file-string) + (writer nil) (comparator 'equalp) + (external-format *utf-8-external-format*)) + (format t "Transforming file ~A... " (file-namestring file)) + (let* ((old-contents (funcall reader file)) + (new-contents (funcall transformer old-contents))) + (if (funcall comparator old-contents new-contents) + (format t "no changes needed!~%") + (let ((written-contents + (if writer + (with-output (s ()) + (funcall writer s new-contents)) + new-contents))) + (check-type written-contents (or string (byte-vector))) + (clobber-file-with-vector file written-contents :external-format external-format) + (format t "done.~%"))))) + +(defun version-transformer (new-version file prefix suffix &optional dont-warn) + (let* ((qprefix (cl-ppcre:quote-meta-chars prefix)) + (versionrx "([0-9]+(\\.[0-9]+)+)") + (qsuffix (cl-ppcre:quote-meta-chars suffix)) + (regex (strcat "(" qprefix ")(" versionrx ")(" qsuffix ")")) + (replacement + (constantly (strcat prefix new-version suffix)))) + (lambda (text) + (multiple-value-bind (new-text foundp) + (cl-ppcre:regex-replace regex text replacement) + (unless (or foundp dont-warn) + (warn "Missing version in ~A" (file-namestring file))) + (values new-text foundp))))) + +(defun transform-file (new-version file prefix suffix) + (maybe-replace-file (apath file) (version-transformer new-version file prefix suffix))) + +(defun transform-files (new-version) + (loop :for f :in *versioned-files* :do (apply 'transform-file new-version f))) + +(defun test-transform-file (new-version file prefix suffix) + (let ((lines (read-file-lines (apath file)))) + (dolist (l lines (progn (warn "Couldn't find a match in ~A" file) nil)) + (multiple-value-bind (new-text foundp) + (funcall (version-transformer new-version file prefix suffix t) l) + (when foundp + (format t "Found a match:~% ==> ~A~%Replacing with~% ==> ~A~%~%" + l new-text) + (return t)))))) + +(defun test-transform (new-version) + (apply 'test-transform-file new-version (first *versioned-files*))) + +(defun bump-version (&optional v1 v2) + (multiple-value-bind (old-version new-version) + (versions-from-args v1 v2) + (a "Bumping ASDF version from " old-version " to " new-version) + (transform-files new-version) + (a "Rebuilding ASDF with bumped version") + (build-asdf))) + +(defun git-version () + (first (run-program/ '("git" "describe" "--tags" "--match" "[0-9].[0-9][0-9]") :output :lines))) + + +;;;; Main entry point +(defun main (args) + (block nil + (unless args + (format t "No command provided~%") + (return)) + (if-let (sym (find-symbol* (string-upcase (first args)) :asdf-builder nil)) + (let ((results (multiple-value-list (apply sym (rest args))))) + (when results + (format t "~&Results:~%~{ ~S~%~}" results))) + (format t "Command ~A not found~%" (first args))))) + +(main *command-line-arguments*) diff --git a/bin/asdf-version b/bin/asdf-version deleted file mode 100755 index ea68aed25d3833c0389e5d6d170956421b165a4c..0000000000000000000000000000000000000000 --- a/bin/asdf-version +++ /dev/null @@ -1,11 +0,0 @@ -#!/bin/sh - -# write the highest tag to standard output -# exit code is 1 if it cannot be found - -tag=`git describe --tags --match '[0-9].[0-9][0-9]'` -if [ "$tag" == "" ]; then - exit 1 -fi -echo $tag -exit 0 diff --git a/bin/bump-version b/bin/bump-version deleted file mode 100755 index 77d88c321dfa2f8dde2ed00c217f8be9860ef63c..0000000000000000000000000000000000000000 --- a/bin/bump-version +++ /dev/null @@ -1,106 +0,0 @@ -#!/bin/sh -":" ; exec sbcl --script "$0" "$@" ; exit # -*- Lisp -*- -;;; Really runs on any decent Common Lisp implementation - -(load (make-pathname :name "prelude" :type "lisp" :defaults *load-pathname*) - :verbose nil :print nil) - -(in-package :fare-utils) - -(asdf-debug) - -(defparameter *versioned-files* - '(("version.lisp-expr" "\"" "\"") - ("asdf.asd" " :version \"" "\" ;; to be automatically updated by bin/bump-revision") - ("header.lisp" "This is ASDF " ": Another System Definition Facility.") - ("upgrade.lisp" " (asdf-version \"" "\")"))) - -(defvar *adir* (asdf:system-relative-pathname :asdf nil)) - -(defun afile (x) (subpathname *adir* x)) - -(defparameter *version-file* - (afile "version.lisp-expr")) - -(defparameter *old-version* nil) -(defparameter *new-version* nil) - -(defun next-version (v) - (let ((pv (parse-version v 'error))) - (incf (third pv)) - (unparse-version pv))) - -(defun version-from-file () - (safe-read-file-form *version-file*)) - -(defun versions-from-argv (argv) - (labels ((check (old new) - (parse-version old 'error) - (parse-version new 'error) - (values old new))) - (ecase (length argv) - ((2) (check (second argv) (first argv))) - ((1) (check (version-from-file) (first argv))) - ((0) (let ((old (version-from-file))) - (check old (next-version old))))))) - -(multiple-value-setq (*old-version* *new-version*) - (versions-from-argv *command-line-arguments*)) - -(a "Bumping ASDF version from " *old-version* " to " *new-version*) - -(deftype byte-vector () '(array (unsigned-byte 8) (*))) - -(defun maybe-replace-file (file transformer - &key (reader 'read-file-string) - (writer nil) (comparator 'equalp) - (external-format *utf-8-external-format*)) - (format t "Transforming file ~A... " (file-namestring file)) - (let* ((old-contents (funcall reader file)) - (new-contents (funcall transformer old-contents))) - (if (funcall comparator old-contents new-contents) - (format t "no changes needed!~%") - (let ((written-contents - (if writer - (with-output (s ()) - (funcall writer s new-contents)) - new-contents))) - (check-type written-contents (or string (byte-vector))) - (clobber-file-with-vector file written-contents :external-format external-format) - (format t "done.~%"))))) - -(defun version-transformer (new-version file prefix suffix &optional dont-warn) - (let* ((qprefix (cl-ppcre:quote-meta-chars prefix)) - (versionrx "([0-9]+(\\.[0-9]+)+)") - (qsuffix (cl-ppcre:quote-meta-chars suffix)) - (regex (strcat "(" qprefix ")(" versionrx ")(" qsuffix ")")) - (replacement - (constantly (strcat prefix new-version suffix)))) - (lambda (text) - (multiple-value-bind (new-text foundp) - (cl-ppcre:regex-replace regex text replacement) - (unless (or foundp dont-warn) - (warn "Missing version in ~A" (file-namestring file))) - (values new-text foundp))))) - -(defun transform-file (new-version file prefix suffix) - (maybe-replace-file (afile file) (version-transformer new-version file prefix suffix))) - -(defun transform-files () - (loop :for f :in *versioned-files* :do (apply 'transform-file *new-version* f))) - -(defun test-transform-file (new-version file prefix suffix) - (let ((lines (read-file-lines (afile file)))) - (dolist (l lines (progn (warn "Couldn't find a match in ~A" file) nil)) - (multiple-value-bind (new-text foundp) - (funcall (version-transformer new-version file prefix suffix t) l) - (when foundp - (format t "Found a match:~% ==> ~A~%Replacing with~% ==> ~A~%~%" - l new-text) - (return t)))))) -(defun z () (apply 'test-transform-file *new-version* (first *versioned-files*))) - -(transform-files) - -(a "Re-generate ASDF with bumped version") -(asdf:build-system :asdf/generate) diff --git a/bin/make-tarball b/bin/make-tarball deleted file mode 100755 index d74b721a88180e896b3b19f1c7025df89a283c19..0000000000000000000000000000000000000000 --- a/bin/make-tarball +++ /dev/null @@ -1,121 +0,0 @@ -":" ; exec sbcl --script "$0" "$@" ; exit # -*- Lisp -*- -;;;;; Really runs on any decent Common Lisp implementation - -(load (make-pathname :name "prelude" :type "lisp" :defaults *load-pathname*) - :verbose nil :print nil) - -;;;;; create tarball for the current version. - -(in-package :asdf) - -;;; Make sure asdf.lisp is built. -(asdf:build-system :asdf/generate) - -;;; ASDF directory -(defparameter *asdf-dir* - (ensure-pathname (system-relative-pathname :asdf ()) - :want-physical t :want-absolute t - :want-existing t :ensure-truename t)) -(defparameter /asdf-dir/ - (native-namestring *asdf-dir*)) - -;;; build directory -(defparameter *build-dir* - (ensure-pathname - "build/" :defaults *asdf-dir* - :want-relative t :ensure-absolute t - :ensure-subpath t)) -(defparameter /build-dir/ - (native-namestring *build-dir*)) - -(defparameter *version* - (safe-read-file-form - (subpathname *asdf-dir* "version.lisp-expr"))) - -(defparameter *asdf-driver* (format nil "asdf-driver-~A" *version*)) - -(defun enough-namestring! (base pathname) - (let ((e (enough-namestring base pathname))) - (assert (relative-pathname-p e)) - e)) - -(defun enough-namestrings (base pathnames) - (loop :with b = (ensure-pathname base :want-absolute t :want-directory t) - :for p :in pathnames - :collect (enough-namestring! p base))) - -(defun system-source-files (system) - (let* ((sys (find-system system)) - (dir (ensure-pathname - (system-source-directory sys) - :want-absolute t :want-directory t)) - (components - (operated-components - sys :other-systems nil - :goal-operation 'load-op - :keep-operation 'load-op - :keep-component 'file-component)) - (pathnames (mapcar 'component-pathname components))) - (enough-namestrings dir pathnames))) - -(defparameter *driver-files* - (list* "asdf-driver.asd" "version.lisp-expr" - (system-source-files :asdf-driver))) - -(defparameter *asdf-only* - (format nil "asdf-only-~A" *version*)) -(defparameter *asdf-only-files* - (list* "asdf.asd" "version.lisp-expr" - (system-source-files :asdf/generate))) - -(defun tarname (name) (strcat name ".tar.gz")) - -(defun run-program* (x) - (format t "~A~%" x) - (run-program/ x)) - -(defun make-tarball-under-build (name base files) - (check-type name string) - (ensure-pathname base :want-absolute t :want-existing t :want-directory t) - (dolist (f files) - (check-type f string)) - (let* ((/base/ - (native-namestring - (ensure-pathname - base - :want-absolute t :want-directory t - :want-existing t :ensure-truename t))) - (destination - (ensure-pathname - name - :defaults *build-dir* - :want-relative t :ensure-absolute t - :ensure-subpath t :ensure-directory t)) - (/destination/ - (native-namestring destination)) - (/tarball/ - (native-namestring - (ensure-pathname - (tarname name) - :defaults *build-dir* - :want-relative t :ensure-absolute t - :ensure-subpath t :want-file t - :ensure-directories-exist t))) - (/files/ - (mapcar 'native-namestring files))) - (assert (< 6 (length (pathname-directory destination)))) - (when (probe-file* destination) - (error "Destination ~S already exists, not taking chances - you can delete it yourself." - destination)) - (ensure-directories-exist destination) - (run-program* (format nil "cd ~S && cp -lax --parents ~{~S ~} ~S" - /base/ /files/ /destination/)) - (run-program* (format nil "tar zcvfC ~S ~S ~S/" - /tarball/ /build-dir/ name)) - (run-program* `("rm" "-rf" ,/destination/)))) - -(make-tarball-under-build *asdf-driver* *asdf-dir* *driver-files*) -(make-tarball-under-build *asdf-only* *asdf-dir* *asdf-only-files*) - -(run-program* (format nil "cd ~S && tar zcf build/asdf-~A.tar.gz build/asdf.lisp $(git ls-files)" - /asdf-dir/ *version*)) diff --git a/bin/prelude.lisp b/bin/prelude.lisp new file mode 100644 index 0000000000000000000000000000000000000000..94cc06a46218501d34b3dcd717d0bdb574696a48 --- /dev/null +++ b/bin/prelude.lisp @@ -0,0 +1,18 @@ +(setf *load-verbose* nil *load-print* nil + *compile-verbose* nil *compile-print* nil) + +(format t "Loading your implementation's ASDF... ~%") +(require :asdf) +(in-package :asdf) +#-asdf2 (error "Not ASDF2, you lose!") +(format t "Initializing the source registry... ~%") +(initialize-source-registry) +(format t "Upgrading to the latest ASDF... ~%") +(upgrade-asdf) +(format t "At ASDF ~A.~%" (asdf-version)) +(format t "Now loading some dependencies... ~%") +(load-systems :cl-ppcre :fare-utils) + +(format t "There we are!~%") +(restore-image) + diff --git a/bundle.lisp b/bundle.lisp index a95ff34087c08feb50fe35d60bd64efe39c423aa..615ddc49a2216f68b23d0d48015261ba576efc49 100644 --- a/bundle.lisp +++ b/bundle.lisp @@ -295,7 +295,7 @@ (defmethod component-depends-on :around ((o bundle-op) (c component)) (declare (ignorable o c)) - (if-bind (op (and (eq (type-of o) 'bundle-op) (component-bundle-operation c))) + (if-let (op (and (eq (type-of o) 'bundle-op) (component-bundle-operation c))) `((,op ,c)) (call-next-method))) diff --git a/component.lisp b/component.lisp index 723d0fa3b09209c4734242d9928c71ab6cde8382..8264e7bb41da4fa0ebd3249841b19045d5eb2538 100644 --- a/component.lisp +++ b/component.lisp @@ -121,7 +121,7 @@ another pathname in a degenerate way.")) (format stream "~{~S~^ ~}" (component-find-path c)))) (defmethod component-system ((component component)) - (if-bind (system (component-parent component)) + (if-let (system (component-parent component)) (component-system system) component)) diff --git a/configuration.lisp b/configuration.lisp index 124167557df6507032ff941cc4bf9ebf75970a1b..a3bc109a157d0498547cb0e1d2778889f34c3847 100644 --- a/configuration.lisp +++ b/configuration.lisp @@ -57,7 +57,7 @@ (cond ((os-unix-p) '(#p"/etc/common-lisp/")) ((os-windows-p) - (if-bind (it (subpathname* (get-folder-path :common-appdata) "common-lisp/config/")) + (if-let (it (subpathname* (get-folder-path :common-appdata) "common-lisp/config/")) (list it))))) (defun* in-first-directory (dirs x &key (direction :input)) diff --git a/find-system.lisp b/find-system.lisp index 118faae69ea46860aa8b9699f29fd1a87ba60bbd..2e15feccd8f16e03c38905ddaa2bf2bfe0816761 100644 --- a/find-system.lisp +++ b/find-system.lisp @@ -91,7 +91,7 @@ of which is a system object.") (asdf-message (compatfmt "~&~@<; ~@;Registering ~3i~_~A~@:>~%") system) (unless (eq system (cdr (gethash name *defined-systems*))) (setf (gethash name *defined-systems*) - (cons (if-bind (file (ignore-errors (system-source-file system))) + (cons (if-let (file (ignore-errors (system-source-file system))) (safe-file-write-date file)) system))))) diff --git a/header.lisp b/header.lisp index bbf1603d30a9c965af93c6018576f0c5e5460493..8fd81e6714e730dc2389431591c92a8926726d5d 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*- -;;; This is ASDF 2.26.111: Another System Definition Facility. +;;; This is ASDF 2.26.112: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel@common-lisp.net>. diff --git a/lisp-action.lisp b/lisp-action.lisp index 701df7131cbeb58a15119dcbd91c3414f6c40073..0ff933b2eeb2d5746c51c7256bffde133c044482 100644 --- a/lisp-action.lisp +++ b/lisp-action.lisp @@ -71,7 +71,7 @@ nil) (defmethod input-files ((o prepare-op) (s system)) (declare (ignorable o)) - (if-bind (it (system-source-file s)) (list it))) + (if-let (it (system-source-file s)) (list it))) ;;; compile-op (defmethod operation-description ((o compile-op) (c component)) @@ -158,7 +158,7 @@ (component-name c))) (perform (find-operation o 'compile-op) c))))) (defun* perform-lisp-load-fasl (o c) - (if-bind (fasl (first (input-files 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)) @@ -187,7 +187,7 @@ nil) (defmethod input-files ((o prepare-source-op) (s system)) (declare (ignorable o)) - (if-bind (it (system-source-file s)) (list it))) + (if-let (it (system-source-file s)) (list it))) (defmethod perform ((o prepare-source-op) (c component)) (declare (ignorable o c)) nil) diff --git a/os.lisp b/os.lisp index 7fa65913756a279bc7a2763c0be7f1d47a49a6d2..aab4a8de0adcc7cfc38fff59958e33a60b3ecc95 100644 --- a/os.lisp +++ b/os.lisp @@ -257,7 +257,7 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME" #+clozure #p"ccl:" #+(or ecl mkcl) #p"SYS:" #+gcl system::*system-directory* - #+sbcl (if-bind (it (find-symbol* :sbcl-homedir-pathname :sb-int nil)) + #+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) diff --git a/pathname.lisp b/pathname.lisp index ec8a46d4ff3910330d280cb51142e3c07db8fafd..b65f37de9c35cd91e90ce593888ffb454b1eee71 100644 --- a/pathname.lisp +++ b/pathname.lisp @@ -374,7 +374,7 @@ with given pathname and if it exists return its truename." (pathname (unless (wild-pathname-p p) #.(or #+(or allegro clozure cmu cormanlisp ecl lispworks mkcl sbcl scl) '(probe-file p) - #+clisp (if-bind (it (find-symbol* '#:probe-pathname :ext nil)) + #+clisp (if-let (it (find-symbol* '#:probe-pathname :ext nil)) `(ignore-errors (,it p))) #+gcl<2.7 '(or (probe-file p) diff --git a/plan.lisp b/plan.lisp index 26dd98bd380a9e0fb4537c8e645529c8b121ca59..2ed943b0287b38fbc6eda30143dbc4a30138f9a3 100644 --- a/plan.lisp +++ b/plan.lisp @@ -105,7 +105,7 @@ the action of OPERATION on COMPONENT in the PLAN")) (:documentation "Is this action valid to include amongst dependencies?")) (defmethod action-valid-p (plan operation (c component)) (declare (ignorable plan operation)) - (if-bind (it (component-if-feature c)) (featurep it) t)) + (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) @@ -140,7 +140,7 @@ the action of OPERATION on COMPONENT in the PLAN")) ;; In a distant future, safe-file-write-date and component-operation-time ;; shall also be parametrized by the plan, or by a second model object. (let* ((stamp-lookup #'(lambda (o c) - (if-bind (it (plan-action-status plan o c)) (action-stamp it) t))) + (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: diff --git a/upgrade.lisp b/upgrade.lisp index d216bf81c95bac05847657714edeb2ee1b638e34..37b4cc9269b42e4b10b3b602e0303f5d459f0714 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -23,8 +23,8 @@ (unless (let ((vs (find-symbol* 'version-satisfies :asdf nil)) (av (find-symbol* 'asdf-version :asdf nil))) (and vs av (funcall vs (funcall av) "2.26.59"))) - (if-bind (p (find-package :asdf)) - (do-symbols (s p) (when (home-package-p s p) (nuke-symbol s)))))) + (if-let (p (find-package :asdf)) + (do-symbols (s p) (when (home-package-p s p) (nuke-symbol s)))))) ;;; Special magic to detect if this is an upgrade @@ -45,7 +45,7 @@ ;; "2.345.6" would be a development version in the official upstream ;; "2.345.0.7" would be your seventh local modification of official release 2.345 ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6 - (asdf-version "2.26.111") + (asdf-version "2.26.112") (existing-asdf (find-class (find-symbol* :component :asdf nil) nil)) (existing-version *asdf-version*) (already-there (equal asdf-version existing-version))) diff --git a/utility.lisp b/utility.lisp index b8f8dc9b2e8a972934bdb913726d161231a59b7b..1fb95265a7442f743171c12acc719929c97b094f 100644 --- a/utility.lisp +++ b/utility.lisp @@ -9,7 +9,7 @@ ;; magic helper to define debugging functions: #:asdf-debug #:load-asdf-debug-utility #:*asdf-debug-utility* #:undefine-function #:undefine-functions #:defun* #:defgeneric* ;; (un)defining functions - #:if-bind ;; basic flow control + #:if-let ;; basic flow control #:while-collecting #:appendf #:length=n-p #:remove-keys #:remove-key ;; lists and plists #:emptyp ;; sequences #:first-char #:last-char #:split-string ;; strings @@ -89,9 +89,16 @@ ;;; Flow control -(defmacro if-bind ((var test) then &optional else) - `(let ((,var ,test)) (if ,var ,then ,else))) - +(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 (defmacro while-collecting ((&rest collectors) &body body) diff --git a/version.lisp-expr b/version.lisp-expr index 1d236db4d36fe02b70c9bd3335f0dfb13f423574..5e357126982a5a8d15e936215478f4bdd1bb1760 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1 +1 @@ -"2.26.111" +"2.26.112"