From: XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - 2008-08-20 19:46:58
|
Index: directory.lisp =================================================================== --- directory.lisp (revision 11286) +++ directory.lisp (working copy) @@ -1,6 +1,7 @@ ;;; directory.lisp ;;; ;;; Copyright (C) 2004-2007 Peter Graves +;;; Copyright (C) 2008 Ville Voutilainen ;;; $Id: directory.lisp,v 1.7 2007-03-15 18:56:28 piso Exp $ ;;; ;;; This program is free software; you can redistribute it and/or @@ -28,6 +29,33 @@ :type nil :version nil))) Hi Ville, Thanks for another patch! You mentioned not being an experienced Lisp Hacker. In my comments I'm going to assume you want to learn more about the different options you could have used to solve a problem. +(defun list-directories-with-wildcards (pathname) + (let* ((result ()) + (directory (pathname-directory pathname)) + (first-wild (position-if #'wild-p directory)) + (non-wild (or (and first-wild + (subseq directory 0 first-wild)) directory)) + (wild (and first-wild (subseq directory first-wild))) Regarding both WILD and NON-WILD, I don't believe the AND operator is guaranteed to return the last element, so, best would be to use IF instead of OR, testing the FIRST-WILD condition as the IF test. Regarding your WILD code, SUBSEQ creates a copy of the subsequence. That means, it allocates new cons cells. However, in this case, you want *all* elements after a specific one. You can do that with NTHCDR, which doesn't copy the cons cells. Depending on your lisp implementation, this may or may not really be important: some lisps create cons cells as fast as walking the cdr-chain of the object. However, given that we're working with ABCL, every new cons cell needs to be allocated as a Java object - with full initialization in the Java engine. That being the case, you want to prevent consing as much as possible. + (newpath (make-pathname :directory non-wild + :name nil :type nil :defaults pathname)) + (entries (list-directory newpath))) + (if (not wild) + (setf result entries) If we were only able to return a value from DOLIST, we could reduce the above form to just 'entries'. And, as a matter of fact: you can. DOLIST takes an optional 3rd parameter: the so-called 'result form'. That would reduce the need to SETF the 'result' variable. + (dolist (entry entries) + (let* ((pathname (pathname entry)) + (directory (pathname-directory pathname)) + (filename (file-namestring pathname)) + (rest-wild (cdr wild))) + (when filename + (setf directory (append directory (list filename)))) + (when rest-wild + (setf directory (append directory rest-wild))) + (setf result + (append (list-directories-with-wildcards + (make-pathname :directory directory + :defaults newpath)) result))))) However, before you make the change of using DOLIST with its 3-argument form, there's a reason not to use the above construct at all: DOLIST/SETF/APPEND can be replaced with MAPCAN. MAPCAN concatenates the returned lists, stringing them together into 1. To that extent, it uses NCONC: the destructive cousin of APPEND. APPEND creates a copy of all the lists it's being passed. So, for the same reason as the one given above, the approach you take should be avoided - if at all possible: it conses too much. I have a question: does your code *only* expand the directories at higher levels, or does it also expand the files there? If it also expands the files (only to be removed later because they don't match), this too may be done more efficiently - reducing the need to instantiate objects. I have been taking a stab at this problem myself (before I knew you were too), however, my solution also has issues: I didn't use the "wild-p" function, which I probably should have. I like that about yours. Do you want to look at my code and integrate both solutions into a single patch? This is my version - which comes after pathname-as-file in directory.lisp: (defun wild-directory-p (pathname) (some #'(lambda (c) (eq c :wild)) (pathname-directory pathname))) (defun add-pathname-dir-component (pathname subdir) (make-pathname :defaults pathname :directory (append (pathname-directory pathname) (list subdir)))) "Takes a directory specification as returned from PATHNAME-DIRECTORY and expands that into a list of paths in the filesystem. In case there's no wild component, it returns a list of 1 element, its argument." (defun resolve-wild-parents (pathname &optional (components (pathname-directory pathname))) "Takes a directory specification as returned from PATHNAME-DIRECTORY and expands that into a list of paths in the filesystem. In case there's no wild component, it returns a list of 1 element, its argument." (if (print (some #'(lambda (c) (eq c :wild)) components)) ;; we're a wild path! - somewhere... (let* ((parents (resolve-wild-parents pathname (butlast components))) (component (car (last components)))) (mapcan #'(lambda (parent) (if (not (eq component :wild)) (let ((subdir (add-pathname-dir-component parent component))) (when subdir (list subdir))) (remove-if (complement #'file-directory-p) (list-directory parent)))) parents)) (list (make-pathname :directory components :defaults pathname ;; be sure to return a directory and possibly a host, not a file :name nil :type nil :version nil)))) (defun directory (pathspec &key) (let ((pathname (merge-pathnames pathspec))) (when (logical-pathname-p pathname) (setq pathname (translate-logical-pathname pathname))) (if (wild-pathname-p pathname) (let ((namestring (directory-namestring pathname))) (when (and namestring (> (length namestring) 0)) ;; #+windows ### 20080815: Lets see how it works without this: ;; the first thing that happens in list-directory is "coerceToPathname"... ;; (let ((device (pathname-device pathname))) ;; (when device ;; (setq namestring (concatenate 'string device ":" namestring)))) (let ((entries (mapcan #'(lambda (dir) (list-directory dir)) (resolve-wild-parents pathname))) (matching-entries ())) (dolist (entry entries) (cond ((file-directory-p entry) (when (pathname-match-p (pathname-as-file entry) pathname) (push entry matching-entries))) ((pathname-match-p entry pathname) (push entry matching-entries)))) matching-entries))) ;; Not wild. (let ((truename (probe-file pathname))) (if truename (list (pathname truename)) nil))))) Bye, Erik. |