[asdf-devel] SBCL 1.0.49 / ASDF 2.015.3 doesn't load my asdf systems anymore

[Nikodemus Siivola]

On 11 June 2011 15:37, Nikodemus Siivola <nikodemus at random-state.net> wrote:

> SBCL fix coming up.

Pascal, does this fix things for you?

Cheers,

 -- nikodemus

(in-package :sb-impl)

(defun pathname-intersections (one two)
  (aver (logical-pathname-p one))
  (aver (logical-pathname-p two))
  (labels
      ((intersect-version (one two)
         (aver (typep one '(or null (member :newest :wild :unspecific)
                            integer)))
         (aver (typep two '(or null (member :newest :wild :unspecific)
                            integer)))
         (cond
           ((eq one :wild) two)
           ((eq two :wild) one)
           ((or (null one) (eq one :unspecific)) two)
           ((or (null two) (eq two :unspecific)) one)
           ((eql one two) one)
           (t nil)))
       (intersect-name/type (one two)
         (aver (typep one '(or null (member :wild :unspecific) string)))
         (aver (typep two '(or null (member :wild :unspecific) string)))
         (cond
           ((eq one :wild) two)
           ((eq two :wild) one)
           ((or (null one) (eq one :unspecific)) two)
           ((or (null two) (eq two :unspecific)) one)
           ((string= one two) one)
           (t (return-from pathname-intersections nil))))
       (intersect-directory (one two)
         (aver (typep one '(or null (member :wild :unspecific) list)))
         (aver (typep two '(or null (member :wild :unspecific) list)))
         (cond
           ((eq one :wild) two)
           ((eq two :wild) one)
           ((or (null one) (eq one :unspecific)) two)
           ((or (null two) (eq two :unspecific)) one)
           (t (aver (eq (car one) (car two)))
              (mapcar
               (lambda (x) (cons (car one) x))
               (intersect-directory-helper (cdr one) (cdr two)))))))
    (let ((version (intersect-version
                    (pathname-version one) (pathname-version two)))
          (name (intersect-name/type
                 (pathname-name one) (pathname-name two)))
          (type (intersect-name/type
                 (pathname-type one) (pathname-type two)))
          (host (pathname-host one)))
      (mapcar (lambda (d)
                (make-pathname :host host :name name :type type
                               :version version :directory d))
              (intersect-directory
               (pathname-directory one) (pathname-directory two))))))