在常见的lisp中加入一系列路径组件

时间:2014-06-23 07:30:19

标签: common-lisp sbcl

如何在常见的lisp中加入一系列路径组件?

在python中,我可以做到,

`os.path.join("/home/", username, "dira", "dirb", "dirc");`

普通的lisp会有什么相同的东西?

当然我可以编写自己的函数,但我怀疑我应该可以使用内置函数。

2 个答案:

答案 0 :(得分:6)

如果你坚持使用字符串来表示路径名,那么除了滚动自己的解决方案之外似乎没有内置的解决方案。

(defun join-strings (list &key (separator "/") (force-leading nil))
  (let* ((length (length list))
         (separator-size (length separator))
         (text-size (reduce #'+ (mapcar #'length list) :initial-value 0))
         (size (+ text-size (* separator-size (if force-leading length (1- length)))))
         (buffer (make-string size)))
    (flet ((copy-to (position string)
             (loop
               :with wp := position
               :for char :across string 
               :do (setf (char buffer (prog1 wp (incf wp))) char)
               :finally (return wp))))
      (loop
        :with wp := 0
        :for string :in list
        :do (when (or force-leading (plusp wp)) (setf wp (copy-to wp separator)))
            (setf wp (copy-to wp string)))
      buffer)))

(join-strings '("home" "kurt" "source" "file.txt") :force-leading t)
==> "/home/kurt/source/file.txt"

但是,如果您可以使用pathnames,那么您可以执行以下操作:

(merge-pathnames #P"subdir1/subdir2/file.type" #P"/usr/share/my-app")
==> #P"/usr/share/my-app/subdir1/subdir2/file.type"

pathname API还提供了以符号方式操作路径名,提取路径名组件等的功能:

(pathname-directory #P"subdir1/subdir2/file.type")
==> '(:relative "subdir1" "subdir2")

(pathname-name #P"subdir1/subdir2/file.type")
==> "file"

(pathname-type #P"subdir1/subdir2/file.type")
==> "type"

(make-pathname :name "file" :type "type" :directory '(:relative "subdir1" "subdir2"))
==> #P"subdir1/subdir2/file.type"

特别是,路径名的directory组件表示为列表,因此,您可以使用完整的列表处理函数集从其他人派生directory值:

(make-pathname :directory (append '(:absolute "usr" "share") '("more" "stuff"))
               :name "packages" :type "lisp")

答案 1 :(得分:0)

更简单的连接字符串

(defun join-strings (lst sep)
  (if
   (atom lst)
   lst
   (reduce
    (lambda (a b)
      (concatenate 'string a sep b))
    (cdr lst)
    :initial-value (car lst))))