              (begin
                         (closedir dir)
                         (let ((r+v
                                (fold (lambda (subdir result+visited)
                                        (call-with-values
                                            (lambda ()
                                              (loop (car subdir)
                                                    full-name
                                                    (cdr subdir)
                                                    (car result+visited)
                                                    (cdr result+visited)))
                                          cons))
                                      (cons result visited)
                                      subdirs)))
                           (values (up full-name dir-stat (car r+v))
                                   (cdr r+v)))))
                      ((or (string=? entry ".")
                           (string=? entry ".."))
                       (liip (readdir dir)
                             result
                             subdirs))
                      (else
                       (let* ((child (string-append full-name "/" entry))
                              (st    (errno-if-exception (stat child))))
                         (if (integer? st) ; CHILD is a dangling symlink?
                             (liip (readdir dir)
                                   (error child #f st result)
                                   subdirs)
                             (if (eq? (stat:type st) 'directory)
                                 (liip (readdir dir)
                                       result
                                       (alist-cons entry st subdirs))
                                 (liip (readdir dir)
                                       (leaf child st result)
                                       subdirs))))))))
             (else
              ;; Directory FULL-NAME not readable, but it is stat'able.
              (values (error full-name dir-stat dir result)
                      visited))))
          (values (skip full-name dir-stat result)
                  (mark visited dir-stat full-name))))
     (else
      ;; Caller passed a FILE-NAME that names a flat file, not a directory.
      (leaf full-name dir-stat result)))))

(define* (file-system-tree file-name
                           #:optional (enter? (lambda (n s) #t))
                                      (stat lstat))
  "Return a tree of the form (FILE-NAME STAT CHILDREN ...) where STAT is
the result of (STAT FILE-NAME) and CHILDREN are similar structures for
each file contained in FILE-NAME when it designates a directory.  The
optional ENTER? predicate is invoked as (ENTER? NAME STAT) and should
return true to allow recursion into directory NAME; the default value is
a procedure that always returns #t.  When a directory does not match
ENTER?, it nonetheless appears in the resulting tree, only with zero
children.  The optional STAT parameter defaults to `lstat'.  Return #f
when FILE-NAME is not readable."
  (define (enter?* name stat result)
    (enter? name stat))
  (define (leaf name stat result)
    (match result
      (((siblings ...) rest ...)
       (cons (alist-cons (basename name) (cons stat '()) siblings)
             rest))))
  (define (down name stat result)
    (cons '() result))
  (define (up name stat result)
    (match result
      (((children ...) (siblings ...) rest ...)
       (cons (alist-cons (basename name) (cons stat children)
                         siblings)
             rest))))
  (define skip                   ; keep an entry for skipped directories
    leaf)
  (define (error name stat errno result)
    (if (string=? name file-name)
        result
        (leaf name stat result)))

  (match (file-system-fold enter?* leaf down up skip error '(())
                           file-name stat)
    (((tree)) tree)
    ((())     #f)))                            ; FILE-NAME is unreadable

(define* (scandir name #:optional (select? (const #t))
                                  (entry<? string-locale<?))
  "Return the list of the names of files contained in directory NAME
that match predicate SELECT? (by default, all files.)  The returned list
of file names is sorted according to ENTRY<?, which defaults to
`string-locale<?'.  Return #f when NAME is unreadable or is not a
directory."

  ;; This procedure is implemented in terms of 'readdir' instead of
  ;; 'file-system-fold' to avoid the extra 'stat' call that the latter
  ;; makes for each entry.

  (define (opendir* directory)
    (catch 'system-error
      (lambda ()
        (opendir directory))
      (const #f)))

  (and=> (opendir* name)
         (lambda (stream)
           (let loop ((entry  (readdir stream))
                      (files   '()))
             (if (eof-object? entry)
                 (begin
                   (closedir stream)
                   (sort files entry<?))
                 (loop (readdir stream)
                       (if (select? entry)
                           (cons entry files)
                           files)))))))

;;; ftw.scm ends here
