find.rkt

#lang racket/base
(require racket/unsafe/ops)


(define d "/home/samth/sw/plt")

(define (in-directory2 dir)                        
  (let loop ([dir (path->complete-path dir)]
             [prefix dir])
    (for/fold ([lst '()]) ([i (in-list (directory-list dir))])
      (let ([p (if prefix (build-path prefix i) i)]
            [fp (build-path dir i)])
        (if (directory-exists? fp)
            (cons fp (append (loop fp p) lst))
            (cons fp lst))))))

(define (in-directory3 dir)
  (define ch (make-channel))
  (thread (lambda ()
            (let loop ([dir (path->complete-path dir)]
                       [prefix dir])
              (for ([i (in-list (directory-list dir))])
                (let ([p (if prefix (build-path prefix i) i)]
                      [fp (build-path dir i)])
                  (channel-put ch fp)
                  (when (directory-exists? fp)
                    (loop fp p)))))
            (channel-put ch #f)))
  (make-do-sequence
   (lambda ()
     (values
      channel-get
      values
      ch
      #f
      values
      #f))))

(define (in-directory4 dir MAX)
  (define ch (make-channel))
  (thread (lambda ()
            (define v (make-vector MAX))
            (define idx 0)
            (let loop ([dir (path->complete-path dir)]
                       [prefix dir])
              (for ([i (in-list (directory-list dir))])
                (let ([p (if prefix (build-path prefix i) i)]
                      [fp (build-path dir i)])
                  (unsafe-vector-set! v idx fp)
                  (set! idx (unsafe-fx+ 1 idx))
                  (when (= idx MAX)
                    (set! idx 0)
                    (channel-put ch v)
                    (set! v (make-vector MAX)))
                  (when (directory-exists? fp)
                    (loop fp p)))))
            (unsafe-vector-set! v idx eof)
            (set! idx (unsafe-fx+ 1 idx))
            (channel-put ch v)))
  (make-do-sequence
   (lambda ()
     (values
      (λ (pos) (unsafe-vector-ref (unsafe-car pos) (unsafe-cdr pos)))
      (λ (pos) (if (= (unsafe-cdr pos) (unsafe-fx- MAX 1))
                   (cons (channel-get ch) 0)
                   (cons (unsafe-car pos) (unsafe-fx+ 1 (unsafe-cdr pos)))))
      (cons (channel-get ch) 0)
      #f
      (λ (val) (not (eof-object? val)))
      #f))))

(set! d (vector-ref (current-command-line-arguments) 0))
d
'for/sum
'plain
(time (for/sum ([i (in-directory d)]) 1))
'list
(time (for/sum ([i (in-directory2 d)]) 1))
'channel
(time (for/sum ([i (in-directory3 d)]) 1))
'(channel/vector 5)
(time (for/sum ([i (in-directory4 d 5)]) 1))
'(channel/vector 10)
(time (for/sum ([i (in-directory4 d 10)]) 1))
'(channel/vector 1000)
(time (for/sum ([i (in-directory4 d 1000)]) 1))
(newline)

'for/first
'plain
(time (for/first ([i (in-directory d)]) 1))
'list
(time (for/first ([i (in-directory2 d)]) 1))
'channel
(time (for/first ([i (in-directory3 d)]) 1))
'(channel/vector 5)
(time (for/first ([i (in-directory4 d 5)]) 1))
'(channel/vector 10)
(time (for/first ([i (in-directory4 d 10)]) 1))
'(channel/vector 1000)
(time (for/first ([i (in-directory4 d 1000)]) 1))