X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-pathname.lisp;h=05497fc02016979aa104c4a1cddce048f95ec71c;hb=416152f084604094445a758ff399871132dff2bd;hp=f1dfb0eb0de5d59c3b3c86fe2ba4d7c87f52ea42;hpb=1513b29bfbe948e7b431b5f67f1ff10769c192cf;p=sbcl.git diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp index f1dfb0e..05497fc 100644 --- a/src/code/target-pathname.lisp +++ b/src/code/target-pathname.lisp @@ -1050,7 +1050,7 @@ a host-structure or string." ;;;; logical pathname support. ANSI 92-102 specification. ;;;; ;;;; As logical-pathname translations are loaded they are -;;;; canonicalized as patterns to enable rapid efficent translation +;;;; canonicalized as patterns to enable rapid efficient translation ;;;; into physical pathnames. ;;;; utilities @@ -1368,8 +1368,7 @@ a host-structure or string." (defun (setf logical-pathname-translations) (translations host) #!+sb-doc - "Set the translations list for the logical host argument. - Return translations." + "Set the translations list for the logical host argument." (declare (type (or string logical-host) host) (type list translations) (values list)) @@ -1378,9 +1377,15 @@ a host-structure or string." (canonicalize-logical-pathname-translations translations host)) (setf (logical-host-translations host) translations))) -(defun translate-logical-pathname (pathname &key) - #!+sb-doc - "Translate PATHNAME to a physical pathname, which is returned." +;;; KLUDGE: Ordinarily known functions aren't defined recursively, and +;;; it's common for compiler problems (e.g. missing/broken +;;; optimization transforms) to cause them to recurse inadvertently, +;;; so the compiler should warn about it. But the natural definition +;;; of TRANSLATE-LOGICAL-PATHNAME *is* recursive; and we don't want +;;; the warning, so we hide the definition of T-L-P in this +;;; differently named function so that the compiler won't warn about +;;; it. -- WHN 2001-09-16 +(defun %translate-logical-pathname (pathname) (declare (type pathname-designator pathname) (values (or null pathname))) (typecase pathname @@ -1398,6 +1403,13 @@ a host-structure or string." (stream (translate-logical-pathname (pathname pathname))) (t (translate-logical-pathname (logical-pathname pathname))))) +(defun translate-logical-pathname (pathname &key) + #!+sb-doc + "Translate PATHNAME to a physical pathname, which is returned." + (declare (type pathname-designator pathname) + (values (or null pathname))) + (%translate-logical-pathname pathname)) + (defvar *logical-pathname-defaults* (%make-logical-pathname (make-logical-host :name "BOGUS") :unspecific