main.ss
#lang scheme/base

(require (prefix-in gen: "generate-ffi.ss")
         (prefix-in s: "lookup.ss")
         
         scheme/foreign)

(unsafe!)

(define ffi-stat (gen:access))

(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) #o777000)
   (- #o11)))
 
(define (normal-file? bits)
  (= #o100 bits))

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

(define (link? bits)
  (= #o120 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)
  (for-each
   (λ (n)
     (display n)(newline)
     (display (number->string (stat n s:mode) #o10))(newline)
     (let ((bits (type-bits n)))
       (display (number->string bits #o10)) (newline)
       (display (directory? bits)) (newline)
       (display (normal-file? bits))(newline)))
   '("main.ss"
     "feep.ss"
     "/tmp"
     "/usr"
     "/home/synx"
     "/dev/null"
     "/bin/bash"
     "faoeuuou")))

(provide main stat)