Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2010-08-17

KMRCLを眺める(188) PROBE-DIRECTORY

| 23:21 | KMRCLを眺める(188) PROBE-DIRECTORY - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(188) PROBE-DIRECTORY - わだばLisperになる

今回は、KMRCLのimpl.lispからPROBE-DIRECTORYです。

CLの標準には、PROBE-FILEというのがありますが、これだとディレクトリとファイルで検出結果に区別がつきません。

ということで、処理系依存の機能を使ってディレクトリであるかどうかを調べるものになっています。

定義は、

(defun probe-directory (filename &key (error-if-does-not-exist nil))
  (let* ((path (canonicalize-directory-name filename))
         (probe
          #+allegro (excl:probe-directory path)
          #+clisp (values
                   (ignore-errors
                     (#+lisp=cl ext:probe-directory
                                #-lisp=cl lisp:probe-directory
                                path)))
          #+(or cmu scl) (when (eq :directory
                                   (unix:unix-file-kind (namestring path)))
                           path)
          #+lispworks (when (lw:file-directory-p path)
                        path)
          #+sbcl
          (let ((file-kind-fun
                 (or (find-symbol "NATIVE-FILE-KIND" :sb-impl)
                     (find-symbol "UNIX-FILE-KIND" :sb-unix))))
            (when (eq :directory (funcall file-kind-fun (namestring path)))
              path))
          #-(or allegro clisp cmu lispworks sbcl scl)
          (probe-file path)))
    (if probe
        probe
        (when error-if-does-not-exist
          (error "Directory ~A does not exist." filename)))))

動作は、

(KL:PROBE-DIRECTORY "/etc")
;⇒ #P"/etc/"

(KL:PROBE-DIRECTORY "/etc/hosts")
;⇒ NIL

;; 参考: PROBE-FILE
(PROBE-FILE "/etc")
;⇒ #P"/etc/"

(PROBE-FILE "/etc/hosts")
;⇒ #P"/etc/hosts"

という感じです。