main.rkt
#lang racket/base

(require (for-syntax "generate-ffi.rkt")
         (prefix-in ffi: "ext.rkt")
         (prefix-in s: "lookup.rkt")
         ffi/unsafe)

(define (stat i . flags)
  (let ((flags (apply vector flags)))
    (cond
      ((string? i) (ffi:stat (string->path i) flags))
      ((path? i) (ffi:stat i flags))
      ((port? i) (ffi:stat i flags))
      (else (error "Don't know how to stat" i)))))

(define (type-bits i)
  (arithmetic-shift (bitwise-and (stat i s:mode) 261632) (- 9)))

(define (normal-file? bits) (= #o100 bits))

(define (directory? bits) (= #o40 (bitwise-and #o740 bits)))

(define (link? bits) (= 80 bits))

(define (fold-files proc init (very-top (build-path #f)))
  (let do-directory ((top very-top) (result init))
    (let ((contents (map (λ (i) (build-path top i)) (directory-list top))))
      (let do-list ((contents contents) (result result) (dirs null))
        (if (null? contents)
            (foldl (λ (dir result) (do-directory dir result)) result dirs)
            (let* ((item (car contents))
                   (bits (type-bits item))
                   (result
                    (proc
                     item
                     (cond
                       ((normal-file? bits) 'file)
                       ((directory? bits) 'directory)
                       ((link? bits) 'link)
                       (else 'other))
                     result)))
              (do-list
               (cdr contents)
               result
               (if (directory? bits) (cons item dirs) dirs))))))))

(define (main)
  (display (current-directory))
  (newline)
  (for-each 
   (λ (n)
     (with-handlers
         ((exn:fail? (λ (e) (display (exn-message e))(newline))))
       (display n)
       (newline)
       (display (number->string (stat n s:mode) 8))
       (newline)
       (let ((bits (type-bits n)))
         (display (number->string bits 8))
         (newline)
         (display (list 'directory (directory? bits)))
         (newline)
         (display (list 'normal (normal-file? bits)))
         (newline))))
   '("main.rkt"
     "feep.rkt"
     "/tmp"
     "/usr"
     "/home/synx"
     "/home/synx/.mailsplit/socket"
     "/dev/null"
     "/bin/bash"
     "faoeuuou")))

(provide main stat fold-files normal-file? directory? link? type-bits)