2.26.122: Replace if-bind by if-let from alexandira.

Have one bigger lisp script to replace several shell scripts.

diff --git a/.gitignore b/.gitignore
index 5fb9699..04420ab 100644 (file)
--- a/.gitignore
+++ b/.gitignore
@@ -1,6 +1,5 @@
 ?
 ??
-???
 build
 
 doc/asdf/

diff --git a/Makefile b/Makefile
index d0f4749..ef4890b 100644 (file)
--- 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 be0abfd..aae1ad5 100644 (file)
--- 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 34cc87f..b8967bb 100644 (file)
--- 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 (executable)
index 0000000..c6f4470
--- /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 (executable)
index ea68aed..0000000
--- 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 (executable)
index 77d88c3..0000000
--- 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 (executable)
index d74b721..0000000
--- 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 (file)
index 0000000..94cc06a
--- /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 a95ff34..615ddc4 100644 (file)
--- 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 723d0fa..8264e7b 100644 (file)
--- 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 1241675..a3bc109 100644 (file)
--- 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 118faae..2e15fec 100644 (file)
--- 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 bbf1603..8fd81e6 100644 (file)
--- 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 701df71..0ff933b 100644 (file)
--- 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 7fa6591..aab4a8d 100644 (file)
--- 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 ec8a46d..b65f37d 100644 (file)
--- 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 26dd98b..2ed943b 100644 (file)
--- 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 d216bf8..37b4cc9 100644 (file)
--- 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 b8f8dc9..1fb9526 100644 (file)
--- 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 1d236db..5e35712 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -1 +1 @@
-"2.26.111"
+"2.26.112"