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-02-12

KMRCLを眺める (86) PROBE-DIRECTORY

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

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

今回もimpl.lispです。

PROBE-DIRECTORYも、名前そのままのディレクトリを検出する関数です。

動作は、

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

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

(KL::PROBE-DIRECTORY "/etc" :ERROR-IF-DOES-NOT-EXIST T)
;⇒ #P"/etc/"

(KL::PROBE-DIRECTORY "/et" :ERROR-IF-DOES-NOT-EXIST T)
>>> Directory /et does not exist.

という感じです。これくらい標準でできそうな気もしますが、OSや処理系に依存するところがあったりする様子。

定義は、

(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)))))

という風になっていて、:ERROR-IF-DOES-NOT-EXISTを指定することによってディレクトリが存在しない場合、エラーを上げることもできます。

(FIND-SYMBOL "NATIVE-FILE-KIND" :SB-IMPL)

という風にFIND-SYMBOLしたりしているのは、もし存在しなかった場合に、無駄なシンボルをINTERNしないためでしょうか。