/contrib/quicklisp/setup.lisp
Lisp | 135 lines | 105 code | 18 blank | 12 comment | 5 complexity | bc380ac2e8296a67caba954802998bd4 MD5 | raw file
- (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* "2.26")
- ;;; 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)