From 4fdb4e90ffbf8cafa4d81b3a8431b0475af3e87c Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Thu, 8 May 2014 07:19:48 -0400
Subject: [PATCH] Tweak the support scripts.

---
 bin/asdf-builder           | 154 ++++++++++++++++++++++++++++---------
 bin/install-asdf-as-module |  16 +++-
 2 files changed, 132 insertions(+), 38 deletions(-)

diff --git a/bin/asdf-builder b/bin/asdf-builder
index 97f31674..3fc1c226 100755
--- a/bin/asdf-builder
+++ b/bin/asdf-builder
@@ -1,52 +1,136 @@
 ":" ; exec sbcl --script "$0" "$@" ; exit # -*- Lisp -*-
 ;;;;; Really runs on any decent Common Lisp implementation
-;;; Can also be invoked by cl-launch 4: cl-launch "$0" "$@"
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-(setf *load-verbose* nil *load-print* nil
-      *compile-verbose* nil *compile-print* nil)
-
-(format t "Loading your implementation's ASDF... ~%")
-(ignore-errors (funcall 'require :asdf))
-(format t "~:[No ~;~]ASDF~:*~@[ ~A~] was provided~%"
-  (when (find-package :asdf)
-    (or (symbol-value (or (find-symbol (string :*asdf-version*) :asdf)
-                          (find-symbol (string :*asdf-revision*) :asdf)))
-        (string :1.x)))))
+;;;;; Can also be invoked by cl-launch 4: cl-launch "$0" "$@"
+
+;;; The code below exemplifies how to load and configure ASDF
+;;; as part of your own deterministic build.
+;;; See "User-configurable parts" for where you'd customize it to suit your build.
+;;;
+;;; Everything is MUCH simpler if you can assume your implementation has a recent-enough ASDF 3:
+;;; just (require "asdf"), then configure in a subsequent eval-when form,
+;;; so that you may use asdf: and uiop: prefix.
+;;;
+;;; To use the user-configured ASDF rather than a deterministic self-contained project build,
+;;; see instead how cl-launch 4.0.4 loads ASDF.
+
+(in-package :cl-user) ;; That's may be default, but let's make double sure and tell SLIME.
+
+;; Do everything in eval-when, so this works
+;; whether this file is being loaded directly or compiled first.
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (unless (member :asdf3.1 *features*)
-    (load (merge-pathnames "../build/asdf.lisp" *load-pathname*))))
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (unless (member :asdf3.1 *features*)
-    (error "Not ASDF 3.1, you lose!")))
+  (let ((required-asdf-version  "3.0.1") ;; This script wants ASDF 3 (and no beta release).
+        (verbose *load-verbose*))
+    (labels ((asdf-symbol (name)
+               (and (find-package :asdf) (find-symbol (string name) :asdf)))
+             (asdf-call (name &rest args)
+               (apply (asdf-symbol name) args))
+             (asdf-version ()
+               (when (find-package :asdf)
+                 (or (symbol-value (or (asdf-symbol '*asdf-version*)
+                                       (asdf-symbol '*asdf-revision*)))
+                     "1.0")))
+             (subpath (parent &key directory name type version)
+               ;; We need subpath here, because we can't yet assume ASDF 3 and its subpathname
+               (merge-pathnames (make-pathname :defaults parent
+                                               :directory (cons :relative directory)
+                                               :name name :type type :version version)
+                                parent))
+             (here-directory ()
+               (subpath (or *compile-file-truename* *load-truename*
+                            (truename *default-pathname-defaults*))))
+             (load-and-configure-asdf ()
+               ;; First, try to require ASDF from the implementation, if not already loaded.
+               ;; Most implementations provide ASDF 3.0, LispWorks still lags with ASDF 2.019,
+               ;; and some unmaintained implementations, or obsolete implementations or versions thereof
+               ;; only provide ASDF 2, ASDF 1, or don't provide ASDF.
+               ;; Note that CLISP is case-sensitive, so we need to specify a lowercase string,
+               ;; and not the keyword :asdf or symbol 'asdf; old CLISP versions that don't provide ASDF
+               ;; may error at compile-time if we call (require "asdf") directly.
+               (ignore-errors (funcall 'require "asdf"))
+               ;; If ASDF 2 isn't provided, load our ASDF from source.
+               ;; ASDF 1 is not enough, because it won't heed our project's output-translations.
+               ;; (Beside, no one serious provides ASDF 1 anymore.)
+               (unless (member :asdf2 *features*)
+                 (let ((asdf-lisp (asdf-lisp)))
+                   (if (probe-file asdf-lisp)
+                       (load asdf-lisp)
+                       (error "This Lisp implementation fails to provide ASDF 2 or later"))))
+               ;; Configure ASDF
+               (configure-asdf)
+               (let ((provided-version (asdf-version)))
+                 ;; Upgrade ASDF to what we configured it to be.
+                 (asdf-call 'load-system :asdf)
+                 ;; If the implementation-provided version was too old,
+                 ;; we need to re-configure, because old configuration may have been moved away.
+                 (unless (asdf-call 'version-satisfies provided-version "2.27")
+                   (configure-asdf)))
+               (unless (asdf-call 'version-satisfies (asdf-version) required-asdf-version)
+                 (error "This program needs ASDF ~A but could only find ASDF ~A"
+                        required-asdf-version (asdf-version))))
+
+             ;; User-configurable parts
+             (asdf-lisp ()
+               ;; Here, define where your Lisp source code hierarchy stores its copy of ASDF.
+               ;; In your project, that might be :directory '("libraries" "asdf" "build")
+               ;; Or NIL, if you don't do use any fancy ASDF feature, and
+               ;; trust your implementation to provide a recent enough copy.
+               (subpath (here-directory) :directory '(:back "build") :name "asdf" :type "lisp"))
+             (configure-asdf ()
+               (let* ((source-directory
+                        ;; Here, define the top of your Lisp source code hierarchy.
+                        ;; If you can assume an implementation that has ASDF 2 or later
+                        ;; (you should: all serious ones do), you might compute it based on
+                        ;;   (asdf-call 'getenv "MY_PROJECT_ROOT") instead of (here-directory).
+                        ;; If you can assume an implementation that has ASDF 3 or later
+                        ;; (you probably can: most serious ones do), you might use instead
+                        ;;   (asdf-call 'getenv-pathname "MY_PROJECT_ROOT"
+                        ;;     :want-absolute t :ensure-directory t)
+                        (subpath (here-directory) :directory '(:back)))
+                      (source-registry
+                        `(:source-registry
+                          (:tree ,source-directory)
+                          ;; In a fully controlled build, you'd :ignore-inherited-configuration instead:
+                          :inherit-configuration))
+                      (output-directory
+                        ;; There again, you might want to use some getenv variant.
+                        ;; Also, "fasls" might be redundant for your project.
+                        (subpath source-directory :directory '("build" "fasls")))
+                      (output-translations
+                        `(:output-translations
+                          ;; Segregate output by ABI.
+                          ;; You could replace "asdf" below by the name of your project,
+                          ;; or not need it at all if everything is under your source-directory.
+                          (,source-directory (,output-directory :implementation "asdf"))
+                          ;; In a fully controlled build, we shouldn't be using code outside
+                          ;; our source-directory, but in case we do, we still want to control the output,
+                          ;; and easily detect the fact by looking at this directory
+                          (t (,output-directory :implementation "root"))
+                          ;; The above should already cover all paths that we use;
+                          ;; we don't want user configuration to interfere with the build.
+                          :ignore-inherited-configuration)))
+                 ;; No more user-configurable parts below.
+                 (asdf-call 'initialize-source-registry source-registry)
+                 (asdf-call 'initialize-output-translations output-translations))))
+      ;; Configure the printer
+      (setf *print-readably* nil ; allegro 5.0 may bork without this
+            *print-level* nil)
+      ;; Hush the compiler and loader
+      (setf *load-verbose* nil *load-print* nil
+            *compile-verbose* nil *compile-print* nil)
+      ;; Load and configure ASDF
+      (load-and-configure-asdf))))
 
 (in-package :asdf)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-(defparameter *provided-version* (asdf-version))
-(format t "Initializing the source registry... ~%")
-(initialize-source-registry)
-(format t "Upgrading to the latest ASDF... ~%")
-(load-system :asdf))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (in-package :asdf)
-  (let ((ver (asdf-version)))
-    (if (equal ver *provided-version*)
-        (format t "Congratulations to your implementation for being up to date!~%")
-        (format t "Upgraded to ASDF ~A~%" ver)))
-  (format t "Now loading some dependencies... ~%")
   (load-systems :cl-ppcre :fare-utils :inferior-shell))
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (format t "There we are!~%")
-  (in-package :asdf))
-
 (unless (featurep :cl-launch) (restore-image))
 
 (defpackage :asdf-builder
   (:use :cl :uiop :asdf/operate :asdf :fare-utils :inferior-shell)
   (:shadow #:DBG))
+
 (in-package :asdf-builder)
 
 (uiop-debug)
diff --git a/bin/install-asdf-as-module b/bin/install-asdf-as-module
index 64bdfbe2..acf61fbd 100644
--- a/bin/install-asdf-as-module
+++ b/bin/install-asdf-as-module
@@ -12,9 +12,15 @@ This file requires cl-launch 4 and works on most implementations.
 It notably doesn't work on:
 * ABCL, that keeps ASDF in its jar, but that's OK because
  ABCL has a recent enough ASDF3 that is capable of upgrading itself.
+* On MKCL and ECL, more work is needed to take into account
+ the linkable variant of ASDF, that may be a .o or a .lib.
+ Also, MKCL now delivers UIOP separately from ASDF, which is great,
+ but requires support. Happily, both ECL and MKCL tend to sport
+ a recent ASDF 3, too.
 * GCL, that doesn't have a usable REQUIRE mechanism.
 * mocl, that doesn't support ASDF 3 yet.
 * Corman Lisp, RMCL, Genera, that are obsolete anyway.
+
 |#
 (ignore-errors (funcall 'require "asdf")) ;; Load the implementation-provided ASDF
 #-asdf2 (load (merge-pathnames ;; Fall back to loading ASDF manually
@@ -56,12 +62,16 @@ It notably doesn't work on:
                  #'> :key #'pathname-key)))
   #+(or clisp clozure cmu ecl gcl lispworks mkcl sbcl scl xcl)
   (compile-file-pathname (subpathname (truename (asdf-module-directory)) "asdf.lisp"))
-  #-(or allegro clisp clozure cmu ecl gcl lispworks mkcl sbcl scl xcl)
+  ;; ECL and MKCL not really supported at this point. See above.
+  #-(or allegro clisp clozure cmu gcl lispworks sbcl scl xcl)
   (error "Not implemented on ~A" (implementation-type)))
 
 (defun install-asdf-as-module ()
-  (let ((fasl (asdf-module-fasl)))
+  (let* ((fasl (asdf-module-fasl))
+         (orig (add-pathname-suffix fasl "-orig")))
     (ensure-directories-exist (translate-logical-pathname fasl))
-    (compile-file (subpathname *asdf-dir* "build/asdf.lisp") :output-file fasl)))
+    (when (and (probe-file* fasl) (not (probe-file* orig)))
+      (rename-file-overwriting-target fasl orig))
+    (compile-file* (subpathname *asdf-dir* "build/asdf.lisp") :output-file fasl)))
 
 (uiop:writeln (multiple-value-list (install-asdf-as-module)))
-- 
GitLab