Use, don't duplicate, utilities from asdf.

diff --git a/base/macros.lisp b/base/macros.lisp
index 7e355d9..7e48e38 100644 (file)
--- a/base/macros.lisp
+++ b/base/macros.lisp
@@ -534,14 +534,6 @@ shall be declared with a serial dependency in system definitions.
 
 ;;; Collecting data
 
-(defmacro while-collecting ((&rest collectors) &body body)
-  (let ((vars (mapcar #'(lambda (x) (gensym (symbol-name x))) collectors))
-        (initial-values (mapcar (constantly nil) collectors)))
-    `(let ,(mapcar #'list vars initial-values)
-       (flet ,(mapcar #'(lambda (c v) `(,c (x) (push x ,v))) collectors vars)
-         ,@body
-         (values ,@(mapcar #'(lambda (v) `(nreverse ,v)) vars))))))
-
 (defmacro fluid-let* (bindings &body body)
   (cond
     (bindings

diff --git a/filesystem/pathnames.lisp b/filesystem/pathnames.lisp
index a95885c..d38a0cf 100644 (file)
--- a/filesystem/pathnames.lisp
+++ b/filesystem/pathnames.lisp
@@ -14,52 +14,9 @@
 (defvar +back-path+ (make-pathname :directory '(:relative :back))
   "logical parent path")
 
-(defun pathname-directory-pathname (pathname)
-  (make-pathname :type nil :name nil :version nil :defaults pathname))
-
 (defun pathname-base-pathname (pathname)
   (make-pathname :directory nil :defaults pathname))
 
-(defun merge-pathnames* (specified &optional (defaults *default-pathname-defaults*))
-  "MERGE-PATHNAMES* is like MERGE-PATHNAMES except that if the SPECIFIED pathname
-does not have an absolute directory, then the HOST and DEVICE come from the DEFAULTS.
-Also, if either argument is NIL, then the other argument is returned unmodified."
-  ;; Same as in ASDF 2.
-  (when (null specified) (return-from merge-pathnames* defaults))
-  (when (null defaults) (return-from merge-pathnames* specified))
-  (let* ((specified (pathname specified))
-         (defaults (pathname defaults))
-         (directory (pathname-directory specified))
-         (directory (if (stringp directory) `(:absolute ,directory) directory))
-         (name (or (pathname-name specified) (pathname-name defaults)))
-         (type (or (pathname-type specified) (pathname-type defaults)))
-         (version (or (pathname-version specified) (pathname-version defaults))))
-    (labels ((ununspecific (x)
-               (if (eq x :unspecific) nil x))
-             (unspecific-handler (p)
-               (if (typep p 'logical-pathname) #'ununspecific #'identity)))
-      (multiple-value-bind (host device directory unspecific-handler)
-          (ecase (first directory)
-            ((nil)
-             (values (pathname-host defaults)
-                     (pathname-device defaults)
-                     (pathname-directory defaults)
-                     (unspecific-handler defaults)))
-            ((:absolute)
-             (values (pathname-host specified)
-                     (pathname-device specified)
-                     directory
-                     (unspecific-handler specified)))
-            ((:relative)
-             (values (pathname-host defaults)
-                     (pathname-device defaults)
-                     (append (pathname-directory defaults) (cdr directory))
-                     (unspecific-handler defaults))))
-        (make-pathname :host host :device device :directory directory
-                       :name (funcall unspecific-handler name)
-                       :type (funcall unspecific-handler type)
-                       :version (funcall unspecific-handler version))))))
-
 (defun pathname-parent (pathname)
   "Takes a pathname and returns the pathname of the parent directory
 of the directory of the given pathname"
@@ -207,21 +164,18 @@ erroring out if some source of non-portability is found"
     (make-pathname :directory (unless (equal r '(:relative)) (nreverse r))
                    :name name :type type)))
 
+#|
 (defun subpathname (path string)
   (merge-pathnames*
    (portable-pathname-from-string string :allow-absolute nil)
    path))
+|#
 
 (defun pathname-absolute-p (path)
   "Assuming PATH is a pathname, is it an absolute pathname?"
   (let ((directory (pathname-directory path)))
     (and (consp directory) (eq (car directory) :absolute))))
 
-(defun absolute-pathname-p (path)
-  "Return true iff pathname P is an absolute pathname"
-  (and (pathnamep path)
-       (pathname-absolute-p path)))
-
 (defun portable-namestring-absolute-p (namestring)
   (eql (first-char namestring) #\/))
 

diff --git a/package.lisp b/package.lisp
index 761e7e1..ef7972c 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -10,11 +10,9 @@
 |#
 
 (defpackage #:fare-utils
-  (:use #:common-lisp)
+  (:use #:common-lisp #:asdf)
   #+genera (:import-from #:scl #:boolean)
   #+clisp (:shadow :with-gensyms)
-  (:import-from #:asdf ;; import and reexport some utilities from asdf.
-   #:length=n-p #:orf #:appendf #:strcat #:first-char #:last-char)
   (:export
    #:$buffer-size #:*package-misdefinition-warning-hook*
    #:*safe-package* #:*standard-readtable*