1.0.44.4: make MAKE-FUNCTIONAL-FROM-TOPLEVEL-LAMBDA build proper XEPs

[sbcl.git] / src / code / unix-pathname.lisp

diff --git a/src/code/unix-pathname.lisp b/src/code/unix-pathname.lisp
index e7faa3e..05c8307 100644 (file)
--- a/src/code/unix-pathname.lisp
+++ b/src/code/unix-pathname.lisp
@@ -132,80 +132,6 @@
   ;; 2002-05-09
   "")
 
-(defun unparse-unix-piece (thing)
-  (etypecase thing
-    ((member :wild) "*")
-    (simple-string
-     (let* ((srclen (length thing))
-            (dstlen srclen))
-       (dotimes (i srclen)
-         (case (schar thing i)
-           ((#\* #\? #\[)
-            (incf dstlen))))
-       (let ((result (make-string dstlen))
-             (dst 0))
-         (dotimes (src srclen)
-           (let ((char (schar thing src)))
-             (case char
-               ((#\* #\? #\[)
-                (setf (schar result dst) #\\)
-                (incf dst)))
-             (setf (schar result dst) char)
-             (incf dst)))
-         result)))
-    (pattern
-     (collect ((strings))
-       (dolist (piece (pattern-pieces thing))
-         (etypecase piece
-           (simple-string
-            (strings piece))
-           (symbol
-            (ecase piece
-              (:multi-char-wild
-               (strings "*"))
-              (:single-char-wild
-               (strings "?"))))
-           (cons
-            (case (car piece)
-              (:character-set
-               (strings "[")
-               (strings (cdr piece))
-               (strings "]"))
-              (t
-               (error "invalid pattern piece: ~S" piece))))))
-       (apply #'concatenate
-              'simple-string
-              (strings))))))
-
-(defun unparse-unix-directory-list (directory)
-  (declare (type list directory))
-  (collect ((pieces))
-    (when directory
-      (ecase (pop directory)
-        (:absolute
-         (pieces "/"))
-        (:relative
-         ;; nothing special
-         ))
-      (dolist (dir directory)
-        (typecase dir
-          ((member :up)
-           (pieces "../"))
-          ((member :back)
-           (error ":BACK cannot be represented in namestrings."))
-          ((member :wild-inferiors)
-           (pieces "**/"))
-          ((or simple-string pattern (member :wild))
-           (pieces (unparse-unix-piece dir))
-           (pieces "/"))
-          (t
-           (error "invalid directory component: ~S" dir)))))
-    (apply #'concatenate 'simple-string (pieces))))
-
-(defun unparse-unix-directory (pathname)
-  (declare (type pathname pathname))
-  (unparse-unix-directory-list (%pathname-directory pathname)))
-
 (defun unparse-unix-file (pathname)
   (declare (type pathname pathname))
   (collect ((strings))
@@ -224,7 +150,7 @@
         (when (and (typep name 'string)
                    (string= name ""))
           (error "name is of length 0: ~S" pathname))
-        (strings (unparse-unix-piece name)))
+        (strings (unparse-physical-piece name)))
       (when type-supplied
         (unless name
           (error "cannot specify the type without a file: ~S" pathname))
@@ -232,7 +158,7 @@
           (when (position #\. type)
             (error "type component can't have a #\. inside: ~S" pathname)))
         (strings ".")
-        (strings (unparse-unix-piece type))))
+        (strings (unparse-physical-piece type))))
     (apply #'concatenate 'simple-string (strings))))
 
 (/show0 "filesys.lisp 406")
@@ -240,7 +166,7 @@
 (defun unparse-unix-namestring (pathname)
   (declare (type pathname pathname))
   (concatenate 'simple-string
-               (unparse-unix-directory pathname)
+               (unparse-physical-directory pathname)
                (unparse-unix-file pathname)))
 
 (defun unparse-native-unix-namestring (pathname as-file)
@@ -313,7 +239,7 @@
                      pathname-directory)
                     (t
                      (bug "Bad fallthrough in ~S" 'unparse-unix-enough)))))
-        (strings (unparse-unix-directory-list result-directory)))
+        (strings (unparse-physical-directory-list result-directory)))
       (let* ((pathname-type (%pathname-type pathname))
              (type-needed (and pathname-type
                                (not (eq pathname-type :unspecific))))
@@ -329,7 +255,7 @@
                      (typep pathname-name 'simple-string)
                      (position #\. pathname-name :start 1))
             (error "too many dots in the name: ~S" pathname))
-          (strings (unparse-unix-piece pathname-name)))
+          (strings (unparse-physical-piece pathname-name)))
         (when type-needed
           (when (or (null pathname-type) (eq pathname-type :unspecific))
             (lose))
@@ -337,7 +263,7 @@
             (when (position #\. pathname-type)
               (error "type component can't have a #\. inside: ~S" pathname)))
           (strings ".")
-          (strings (unparse-unix-piece pathname-type))))
+          (strings (unparse-physical-piece pathname-type))))
       (apply #'concatenate 'simple-string (strings)))))
 
 (defun simplify-unix-namestring (src)