Commit 2151ca1f authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Backport install-asdf-as-module, and with it load-asdf.lisp, from the minimakefile branch.

parent ca06ce49
......@@ -18,107 +18,8 @@
;; 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)
(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))))
(load (make-pathname :name "load-asdf" :type "lisp"
:defaults (or *load-pathname* *compile-file-pathname*))))
(in-package :asdf)
......
":" ; exec cl-launch "$0" "$@"
#| -*- Lisp -*-
":" ; exec cl-launch "$0" "$@" # -*- Lisp -*-
#|
Usage: make && cl-launch -l lispworks bin/install-asdf-as-module
Or make
sbcl # or otherwise start your Lisp
(load "bin/install-asdf-as-module")
This script will install the current version of ASDF
as a module pre-compiled for your implementation,
......@@ -17,17 +20,18 @@ It notably doesn't work on:
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.
* SBCL since 1.2.2 now like MKCL delivers UIOP separately from ASDF.
* 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
(make-pathname :name "asdf" :type "lisp" :version nil
:directory '(:relative :back "build") :defaults *load-pathname*)
*load-pathname*))
(asdf:load-system :asdf) ;; Upgrade to the latest ASDF3 (assumes you have it configured properly)
;;; Ensure we load and configure this particular ASDF
#-cl-launch
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (member :cl-launch *features*) ;; (not necessary if we're invoked via cl-launch)
(load (make-pathname
:name "load-asdf" :type "lisp" :defaults
(or *compile-file-truename* *load-truename* (truename *default-pathname-defaults*))))))
(in-package :asdf)
......@@ -36,7 +40,7 @@ It notably doesn't work on:
:want-physical t :want-absolute t
:want-existing t :truename t))
(defun asdf-module-directory ()
(defun module-directory ()
#+allegro #p"sys:code;"
#+clisp (subpathname custom:*lib-directory* "asdf/")
#+clozure #p"ccl:tools;"
......@@ -48,9 +52,9 @@ It notably doesn't work on:
#+scl #p"file://modules/"
#+xcl ext:*xcl-home*
#-(or allegro clisp clozure cmu ecl gcl lispworks mkcl sbcl scl xcl)
(error "asdf-module-directory not implemented on ~A" (implementation-type)))
(error "module-directory not implemented on ~A" (implementation-type)))
(defun asdf-module-fasl ()
(defun module-fasl (name)
#+allegro
(flet ((pathname-key (x)
(let ((type (pathname-type x)))
......@@ -58,20 +62,83 @@ It notably doesn't work on:
((and (stringp type) (every #'digit-char-p type)) (parse-integer type))
((equal type "fasl") 0)
(t -1)))))
(first (sort (directory (merge-pathnames* "asdf.*" (asdf-module-directory)))
(first (sort (directory (merge-pathnames* (strcat name ".*") (module-directory)))
#'> :key #'pathname-key)))
#+(or clisp clozure cmu ecl gcl lispworks mkcl sbcl scl xcl)
(compile-file-pathname (subpathname (truename (asdf-module-directory)) "asdf.lisp"))
;; ECL and MKCL not really supported at this point. See above.
#-(or allegro clisp clozure cmu gcl lispworks sbcl scl xcl)
(compile-file-pathname (subpathname (truename (module-directory)) name :type "lisp"))
#-(or allegro clisp clozure cmu ecl gcl lispworks mkcl sbcl scl xcl)
(error "Not implemented on ~A" (implementation-type)))
(defun uiop-module-fasl () (module-fasl "uiop"))
(defun asdf-module-fasl () (module-fasl "asdf"))
(defun object-file (name &optional (type :object))
#-(or ecl mkcl) (progn name type (assert nil))
#+ecl (compile-file-pathname name :type type)
#+mkcl (make-pathname :defaults name :type (bundle-pathname-type type)))
(defun call-with-file-replacement (file thunk)
(let ((orig (add-pathname-suffix file "-orig")))
(ensure-directories-exist (translate-logical-pathname file))
(when (and (probe-file* file) (not (probe-file* orig)))
(rename-file-overwriting-target file orig))
(funcall thunk)))
(defmacro with-file-replacement ((file) &body body)
`(call-with-file-replacement ,file (lambda () ,@body)))
(uiop:uiop-debug)
(defun install-asdf-as-module ()
(let* ((fasl (asdf-module-fasl))
(orig (add-pathname-suffix fasl "-orig")))
(ensure-directories-exist (translate-logical-pathname 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)))
(nest
(let* ((asdf.lisp (system-relative-pathname :asdf-tools "../build/asdf.lisp"))
(asdf.fasl (asdf-module-fasl))
#+(or ecl mkcl) (asdf.o (object-file asdf.fasl :object))
#+(or ecl mkcl) (asdf.a (object-file asdf.fasl :lib))))
(with-file-replacement (asdf.fasl))
#+(or ecl mkcl) (with-file-replacement (asdf.o))
#+(or ecl mkcl) (with-file-replacement (asdf.a))
(progn
(compile-file* asdf.lisp :output-file asdf.fasl
#+(or ecl mkcl) :object-file #+(or ecl mkcl) asdf.o)
#+(or ecl mkcl)
(create-image asdf.a (list asdf.o) :kind :lib))))
(defun install-uiop-and-asdf-as-modules ()
(let ((uiop.fasl (uiop-module-fasl)))
(with-file-replacement (uiop.fasl)
(operate 'compile-bundle-op "uiop")
(rename-file-overwriting-target (first (output-files 'compile-bundle-op "uiop")) uiop.fasl)
(load uiop.fasl))
#+(or ecl mkcl)
(let ((uiop.a (object-file asdf.fasl :lib)))
(with-file-replacement (uiop.a)
(operate 'lib-op "uiop")
(rename-file-overwriting-target (output-file 'lib-op "uiop") uiop.a)))
(nest
(let* ((asdf.fasl (asdf-module-fasl))
(asdf.lisp (make-pathname :type "lisp" :defaults asdf.fasl))
#+(or ecl mkcl) (asdf.o (object-file asdf.fasl :object))
#+(or ecl mkcl) (asdf.a (object-file asdf.fasl :lib))))
(with-file-replacement (asdf.lisp))
(with-file-replacement (asdf.fasl))
#+(or ecl mkcl) (with-file-replacement (asdf.o))
#+(or ecl mkcl) (with-file-replacement (asdf.a))
(progn
(with-output-file (o asdf.lisp :if-exists :rename-and-delete :if-does-not-exist :create)
(println "(cl:require \"uiop\")" o)
(dolist (c (component-children (find-system "asdf/defsystem")))
(with-input-file (i (component-pathname c))
(copy-stream-to-stream i o))))
(compile-file* asdf.lisp :output-file asdf.fasl
#+(or ecl mkcl) :object-file #+(or ecl mkcl) asdf.o)
#+(or ecl mkcl)
(create-image asdf.a (list asdf.o) :kind :lib)))))
(uiop:writeln (multiple-value-list (install-asdf-as-module)))
#+(or sbcl mkcl)
(progn (install-uiop-and-asdf-as-modules) (quit))
#+(or allegro clisp clozure cmu ecl gcl lispworks scl xcl)
(progn (install-asdf-as-module) (quit))
#+(or abcl cormanlisp genera mcl mocl)
(die 2 "Not supported on ~A" (implementation-type))
(error "What kind of implementation is THIS?")
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment