Lispy Days

Lizp 0.1 -- lazy extension of Common Lisp

c.l.l より(元記事 Message-ID: <kgr9h1xles.ln2@ibhome.cgitftp.uiggm.nsc.ru>) http://lispnik.newmail.ru/lizp/ から入手可能。

↓サンプルで付いてきた lazy な fibonacci ストリームを進めてる所。

[50]> (setq lizt (fibonacci))
(1 . "#<DELAYED-COMPUTATION>")
[51]> (setq lizt (lazy-lizt:lcdr lizt))
(1 . "#<DELAYED-COMPUTATION>")
[52]> (setq lizt (lazy-lizt:lcdr lizt))
(2 . "#<DELAYED-COMPUTATION>")
[53]> (setq lizt (lazy-lizt:lcdr lizt))
(3 . "#<DELAYED-COMPUTATION>")
[54]> (setq lizt (lazy-lizt:lcdr lizt))
(5 . "#<DELAYED-COMPUTATION>")
[55]> (setq lizt (lazy-lizt:lcdr lizt))
(8 . "#<DELAYED-COMPUTATION>")
[56]> 

計算が遅延されて無限の fibonaci 数列ができてます。

Portable directory listing function

c.l.l より。(元記事 Message-ID: <m3hdxb7ywv.fsf@javamonkey.com>)

  (defpackage :pathnames 
    (:use :cl)
    (:export
     :list-directory
     :walk-directory
     :pathname-as-directory
     :directory-pathname-p))

  (in-package :pathnames)

  (defun list-directory (dirname)
    "Return a list of the contents of the directory named by dirname.
  Names of subdirectories will be returned in `directory normal form'.
  Unlike CL:DIRECTORY, LIST-DIRECTORY does not accept wildcard
  pathnames; `dirname' should simply be a pathname that names a
  directory. It can be in either file or directory form."
    (let ((wildcard (make-pathname :name :wild 
                                   :type :wild
                                   :defaults (pathname-as-directory dirname))))

      #+(or sbcl cmu lispworks)
      ;; SBCL, CMUCL, and Lispworks return subdirectories in directory
      ;; form just the way we want.
      (directory wildcard)

      #+openmcl
      ;; OpenMCl by default doesn't return subdirectories at all. But
      ;; when prodded to do so with the special argument :directories,
      ;; it returns them in directory form.
      (directory wildcard :directories t)

      #+allegro
      ;; Allegro normally return directories in file form but we can
      ;; change that with the :directories-are-files argument.
      (directory wildcard :directories-are-files nil)

      #+clisp
      ;; CLISP has a particularly idiosyncratic (though arguably
      ;; logically consistent) view of things. And (as of 2.32) it has a
      ;; slight bug to work around. But we can bludgeon even it into
      ;; doing what we want.
      (nconc 
       ;; CLISP 2.32 won't list files without an extension when :type is
       ;; wild so we make a special wildcard for it.
       (directory (make-pathname :type nil :defaults wildcard))
       ;; And CLISP doesn't consider subdirectories to match unless
       ;; there is a :wild in the directory component.
       (directory (make-pathname 
                   :directory (append (pathname-directory wildcard) (list :wild))
                   :name nil
                   :type nil
                   :defaults wildcard)))))

  (defun pathname-as-directory (pathname)
    "Return a pathname reperesenting the given pathname in `directory
  form', i.e. with all the name elements in the directory component and
  NIL in the name and type components. Can not be used on wild
  pathnames. Returns its argument if name and type are both nil or
  :unspecific."
    (setf pathname (pathname pathname))
    (when (wild-pathname-p pathname)
      (error "Can't reliably convert wild pathnames to directory names."))
    (cond 
     ((or (component-present-p (pathname-name pathname))
          (component-present-p (pathname-type pathname)))
      (make-pathname 
       :directory (append (pathname-directory pathname) (list (file-namestring pathname)))
       :name      nil
       :type      nil
       :defaults pathname))
      (t pathname)))

  (defun walk-directory (dirname fn &key (depth-first t) (directories t))
    "Walk a directory invoking `fn' on each pathname found. If
  `depth-first' is t (the default) walks depth-first. If `directories'
  is t (the default) invokes `fn' on directory pathnames as well."
    (do ((files (list (pathname-as-directory dirname))))
        ((null files))
      (let ((f (pop files)))
        (cond
         ((directory-pathname-p f)
          (when directories (funcall fn f))
          (let ((children (list-directory f)))
            (setf files 
                  (if depth-first
                    (nconc children files)
                    (nconc files children)))))
         (t (funcall fn f))))))

  (defun directory-pathname-p  (p)
    "Is the given pathname the name of a directory? This function can
  usefully be used to test whether a name returned by LIST-DIRECTORIES
  or passed to the function in WALK-DIRECTORY is the name of a directory
  in the file system since they always return names in `directory normal
  form'."
    (and 
     (not (component-present-p (pathname-name p)))
     (not (component-present-p (pathname-type p)))))

  (defun component-present-p (value)
    (and value (not (eql value :unspecific))))