136 lines
4.9 KiB
Common Lisp
136 lines
4.9 KiB
Common Lisp
(defpackage #:ql-setup
|
|
(:use #:cl)
|
|
(:export #:*quicklisp-home*
|
|
#:qmerge
|
|
#:qenough))
|
|
|
|
(in-package #:ql-setup)
|
|
|
|
(unless *load-truename*
|
|
(error "This file must be LOADed to set up quicklisp."))
|
|
|
|
(defvar *quicklisp-home*
|
|
(make-pathname :name nil :type nil
|
|
:defaults *load-truename*))
|
|
|
|
(defun qmerge (pathname)
|
|
"Return PATHNAME merged with the base Quicklisp directory."
|
|
(merge-pathnames pathname *quicklisp-home*))
|
|
|
|
(defun qenough (pathname)
|
|
(enough-namestring pathname *quicklisp-home*))
|
|
|
|
;;; ASDF is a hard requirement of quicklisp. Make sure it's either
|
|
;;; already loaded or load it from quicklisp's bundled version.
|
|
|
|
(defvar *required-asdf-version* "3.0")
|
|
|
|
;;; Put ASDF's fasls in a separate directory
|
|
|
|
(defun implementation-signature ()
|
|
"Return a string suitable for discriminating different
|
|
implementations, or similar implementations with possibly-incompatible
|
|
FASLs."
|
|
;; XXX Will this have problems with stuff like threads vs
|
|
;; non-threads fasls?
|
|
(let ((*print-pretty* nil))
|
|
(format nil "lisp-implementation-type: ~A~%~
|
|
lisp-implementation-version: ~A~%~
|
|
machine-type: ~A~%~
|
|
machine-version: ~A~%"
|
|
(lisp-implementation-type)
|
|
(lisp-implementation-version)
|
|
(machine-type)
|
|
(machine-version))))
|
|
|
|
(defun dumb-string-hash (string)
|
|
"Produce a six-character hash of STRING."
|
|
(let ((hash #xD13CCD13))
|
|
(loop for char across string
|
|
for value = (char-code char)
|
|
do
|
|
(setf hash (logand #xFFFFFFFF
|
|
(logxor (ash hash 5)
|
|
(ash hash -27)
|
|
value))))
|
|
(subseq (format nil "~(~36,6,'0R~)" (mod hash 88888901))
|
|
0 6)))
|
|
|
|
(defun asdf-fasl-pathname ()
|
|
"Return a pathname suitable for storing the ASDF FASL, separated
|
|
from ASDF FASLs from incompatible implementations. Also, save a file
|
|
in the directory with the implementation signature, if it doesn't
|
|
already exist."
|
|
(let* ((implementation-signature (implementation-signature))
|
|
(original-fasl (compile-file-pathname (qmerge "asdf.lisp")))
|
|
(fasl
|
|
(qmerge (make-pathname
|
|
:defaults original-fasl
|
|
:directory
|
|
(list :relative
|
|
"cache"
|
|
"asdf-fasls"
|
|
(dumb-string-hash implementation-signature)))))
|
|
(signature-file (merge-pathnames "signature.txt" fasl)))
|
|
(ensure-directories-exist fasl)
|
|
(unless (probe-file signature-file)
|
|
(with-open-file (stream signature-file :direction :output)
|
|
(write-string implementation-signature stream)))
|
|
fasl))
|
|
|
|
(defun ensure-asdf-loaded ()
|
|
"Try several methods to make sure that a sufficiently-new ASDF is
|
|
loaded: first try (require \"asdf\"), then loading the ASDF FASL, then
|
|
compiling asdf.lisp to a FASL and then loading it."
|
|
(let ((source (qmerge "asdf.lisp")))
|
|
(labels ((asdf-symbol (name)
|
|
(let ((asdf-package (find-package '#:asdf)))
|
|
(when asdf-package
|
|
(find-symbol (string name) asdf-package))))
|
|
(version-satisfies (version)
|
|
(let ((vs-fun (asdf-symbol '#:version-satisfies))
|
|
(vfun (asdf-symbol '#:asdf-version)))
|
|
(when (and vs-fun vfun
|
|
(fboundp vs-fun)
|
|
(fboundp vfun))
|
|
(funcall vs-fun (funcall vfun) version)))))
|
|
(block nil
|
|
(macrolet ((try (&body asdf-loading-forms)
|
|
`(progn
|
|
(handler-bind ((warning #'muffle-warning))
|
|
(ignore-errors
|
|
,@asdf-loading-forms))
|
|
(when (version-satisfies *required-asdf-version*)
|
|
(return t)))))
|
|
(try)
|
|
(try (require "asdf"))
|
|
(let ((fasl (asdf-fasl-pathname)))
|
|
(try (load fasl :verbose nil))
|
|
(try (load (compile-file source :verbose nil :output-file fasl))))
|
|
(error "Could not load ASDF ~S or newer" *required-asdf-version*))))))
|
|
|
|
(ensure-asdf-loaded)
|
|
|
|
;;;
|
|
;;; Quicklisp sometimes must upgrade ASDF. Ugrading ASDF will blow
|
|
;;; away existing ASDF methods, so e.g. FASL recompilation :around
|
|
;;; methods would be lost. This config file will make it possible to
|
|
;;; ensure ASDF can be configured before loading Quicklisp itself via
|
|
;;; ASDF. Thanks to Nikodemus Siivola for pointing out this issue.
|
|
;;;
|
|
|
|
(let ((asdf-init (probe-file (qmerge "asdf-config/init.lisp"))))
|
|
(when asdf-init
|
|
(with-simple-restart (skip "Skip loading ~S" asdf-init)
|
|
(load asdf-init :verbose nil :print nil))))
|
|
|
|
(push (qmerge "quicklisp/") asdf:*central-registry*)
|
|
|
|
(let ((*compile-print* nil)
|
|
(*compile-verbose* nil)
|
|
(*load-verbose* nil)
|
|
(*load-print* nil))
|
|
(asdf:oos 'asdf:load-op "quicklisp" :verbose nil))
|
|
|
|
(quicklisp:setup)
|