os debugged

4 files changed, 106 insertions, 81 deletions

diff --git a/modules/language/python/def.scm b/modules/language/python/def.scm
index 7045cec..bd2139e 100644
--- a/modules/language/python/def.scm
+++ b/modules/language/python/def.scm
@@ -5,7 +5,8 @@
   #:use-module (srfi srfi-11)
   #:export (def lam py-apply))
 
-(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
+(define e (list 'error))
+(define-syntax-rule (aif it p x y) (let ((it p)) (if (not (eq? it e)) x y)))
 (define (fold lam s l)
   (if (pair? l)
       (lam (car l) (fold lam s (cdr l)))
@@ -14,7 +15,7 @@
 (define-syntax-rule (take-1 pww ww* kw s v)
   (if (not pww)
       (values ww*
-              (aif it (hash-ref kw s #f)
+              (aif it (hash-ref kw s e)
                    (begin
                      (hash-remove! kw s)
                      it)
@@ -24,7 +25,7 @@
             (hash-remove! kw s)
             (values (cdr ww*) (car ww*)))
           (values ww*
-                  (aif it (hash-ref kw s #f)
+                  (aif it (hash-ref kw s e)
                        (begin
                          (hash-remove! kw s)
                          it)
diff --git a/modules/language/python/for.scm b/modules/language/python/for.scm
index 50e6ec4..7b8e57b 100644
--- a/modules/language/python/for.scm
+++ b/modules/language/python/for.scm
@@ -151,7 +151,7 @@
 
 (define-method (wrap-in x)
   (cond
-   ((pair? x)
+   ((or (null? x) (pair? x))
     (let ((o (make <scm-list>)))
       (slot-set! o 'l x)
       o))
diff --git a/modules/language/python/module/os.scm b/modules/language/python/module/os.scm
index 8791626..863287d 100644
--- a/modules/language/python/module/os.scm
+++ b/modules/language/python/module/os.scm
@@ -36,8 +36,8 @@
                   umask  uname  unsetenv
                   
                   path curdir pardir sep extsep altsep pathsep linesep defpath
-                  devnull
-
+                  devnull 
+                  
                   dopen close closerange device_encoding dup dup2 fchmod fchown
                   fdatasync fpathconf fstat fstatvfs fsynch ftruncate isatty
                   F_LOCK F_TLOCK F_ULOCK F_TEST lockf
@@ -54,6 +54,23 @@
                   set_blocking readv write writev set_inheritable
                   get_inheritable
 
+                  F_OK W_OK R_OK X_O AT_EACCESS AT_SYMLINK_NOFOLLOW
+                  
+                  lchown lchmod lchflags getcwdb fchdir chroot chown chmod
+                  chflags chdir access listdir link
+
+                  stat lstat mkdir mkdirs mkfifo mknod major
+
+                  minor makedev pathconf_names pathconf readlink remove
+                  unlink rmdir removedirs rename replace renames scandir
+                  stat_float_times
+
+                  ST_RDONLY ST_NOSUID ST_NODEV ST_NOEXEC ST_SYNCHRONOUS
+                  ST_MANDLOCK ST_WRITE ST_APPEND ST_IMMUTABLE ST_NOATIME
+                  ST_NODIRATIME ST_RELATIME
+
+                  statvfs symlink truncate utime walk fwalk
+                  
                   getxattr listxattr removexattr setxattr XATTR_SIZE_MAX
                   XATTR_CREATE XATTR_REPLACE
 
@@ -473,12 +490,13 @@
                    self scm)
           (if stat-float-times
            (begin
-             (set self 'atime (* (ref self 'atime) 1.0))
-             (set self 'mtime (* (ref self 'mtime) 1.0))
-             (set self 'ctime (* (ref self 'ctime) 1.0))
-             (set self 'atime_ns (/ (ref self 'atime_ns) 1000000000.0))
-             (set self 'mtime_ns (/ (ref self 'mtime_ns) 1000000000.0))
-             (set self 'ctime_ns (/ (ref self 'ctime_ns) 1000000000.0)))))))))
+             (set self 'st_atime (* (ref self 'st_atime) 1.0))
+             (set self 'st_mtime (* (ref self 'st_mtime) 1.0))
+             (set self 'st_ctime (* (ref self 'st_ctime) 1.0))
+             (set self 'st_atime_ns (/ (ref self 'st_atime_ns) 1000000000.0))
+             (set self 'st_mtime_ns (/ (ref self 'st_mtime_ns) 1000000000.0))
+             (set self 'st_ctime_ns
+                  (/ (ref self 'st_ctime_ns) 1000000000.0)))))))))
         
 (name-object stat_result)
        
@@ -527,7 +545,7 @@
                                (dynamic-func "openat" (dynamic-link))
                                (list int '* int int))))
 
-    (lambda* (path flags mode #:optional (dir_fd None))
+    (lam (path flags (= mode #o777) (= dir_fd None))
       (if (eq? dir_fd None)
           (ca (open-fdes path flags mode))
           (rm (f dir_fd (string->pointer path) flags mode))))))
@@ -756,7 +774,6 @@
 (define chflags
   (lambda x (error "Not implemented")))
 
-(define chmod (lambda x #f))
 (defineu chmod (0 2)
   (let ((f   (pointer->procedure int
                                  (dynamic-func "chmod" (dynamic-link))
@@ -788,7 +805,7 @@
        (it)
        path))
 
-(define chown (lambda x #f))
+
 (defineu chown (0 2)
   (let ((f   (pointer->procedure int
                                  (dynamic-func "chown" (dynamic-link))
@@ -858,7 +875,7 @@
 (define listdir
   (lambda* (#:optional (pth "."))
     (let ((pth (if (number? pth)
-                   ((@ (guile) read-link) (format #f "/proc/self/fd/~a" pth))
+                   ((@ (guile) readlink) (format #f "/proc/self/fd/~a" pth))
                    (path-it pth))))
       (let ((o (ca (opendir pth))))
         (dynamic-wind
@@ -873,7 +890,6 @@
                         (cons w (lp o)))))))
           (lambda x (closedir o)))))))
 
-(define stat (lambda x #f))
 (defineu stat (0 2)
   (let ((f (pointer->procedure int
                                (dynamic-func "__fxstatat" (dynamic-link))
@@ -881,17 +897,19 @@
         (g (pointer->procedure '*
                                (dynamic-func "scm_stat2scm_" (dynamic-link))
                                '(*))))
-    (lambda* (path #:key (dir_fd None) (follow_symlinks #t))
+    (lam (path (= dir_fd None) (= follow_symlinks #t))
       (if (number? path)
-          (stat_result ((@ (guile) stat) path))
+          (ca (stat_result ((@ (guile) stat) path)))
           (let ((path (path-it path)))
             (if (eq? dir_fd None)
-                (if follow_symlinks
-                    (stat_result ((@ (guile) stat) path))
-                    (stat_result ((@ (guile) lstat) path)))
+                (ca
+                 (if follow_symlinks
+                     (stat_result ((@ (guile) stat) path))
+                     (stat_result ((@ (guile) lstat) path))))
                 (let* ((bv  (make-bytevector 80))
                        (bvp (bytevector->pointer bv))) 
                   (rm (f 1 ;Special linux flag
+                         dir_fd
                          (string->pointer path)
                          bvp
                          (if follow_symlinks
@@ -903,7 +921,6 @@
   (lambda* (path #:key (dir_fd None))
     (stat path #:dir_fd dir_fd #:follow_symlinks #f)))
 
-(define mkdir #f)
 (defineu mkdir (0)
   (let ((fat (pointer->procedure int
                                  (dynamic-func "mkdirat" (dynamic-link))
@@ -936,7 +953,7 @@
              (mkdir s mode)))
          (lp s l))))))
 
-(define mkfifo #f)
+
 (defineu mkfifo (0)
   (let ((fat (pointer->procedure int
                                  (dynamic-func "mkfifoat" (dynamic-link))
@@ -946,7 +963,6 @@
                (string->pointer (path-it path))
                mode)))))
 
-(define mknod #f)
 (defineu mknod (0)
   (let ((fat (pointer->procedure int
                                  (dynamic-func "__xmknodat" (dynamic-link))
@@ -957,7 +973,6 @@
                mode
                device)))))
 
-(define major #f)
 (defineu major ()
   (let ((f (pointer->procedure int
                                (dynamic-func "gnu_dev_major" (dynamic-link))
@@ -965,7 +980,6 @@
     (lambda (device)
       (ca (f device)))))
 
-(define minor #f)
 (defineu minor ()
   (let ((f (pointer->procedure int
                                (dynamic-func "gnu_dev_minor" (dynamic-link))
@@ -973,7 +987,6 @@
     (lambda (device)
       (ca (f device)))))
 
-(define makedev #f)
 (defineu makedev ()
   (let ((f (pointer->procedure int64
                                (dynamic-func "gnu_dev_makedev" (dynamic-link))
@@ -981,6 +994,7 @@
     (lambda (major minor)
       (ca (f major minor)))))
 
+
 (define pathconf_names (dict))
 (pylist-set! pathconf_names "PC_LINK_MAX"  0)
 (pylist-set! pathconf_names "PC_MAX_CANON" 1)
@@ -1002,8 +1016,6 @@
               (error "Bug could not find pathcond name endex")
               (rm e2))))))
 
-
-(define pathconf #f)
 (defineu pathconf (2)
   (let ((f (pointer->procedure long
                                (dynamic-func "pathconf" (dynamic-link))
@@ -1018,7 +1030,6 @@
             (let ((path (path-it path)))
               (rmp (f (string->pointer path) ni))))))))
 
-(define readlink #f)
 (defineu readlink (0)
   (let ((fat (pointer->procedure int
                                  (dynamic-func "readlinkat" (dynamic-link))
@@ -1034,7 +1045,6 @@
         (bytevector-u8-set! bv (- n 1) 0)
         (pointer->string bvp)))))
 
-(define remove #f)
 (defineu remove (0)
   (let ((fat (pointer->procedure int
                                  (dynamic-func "unlinkat" (dynamic-link))
@@ -1052,7 +1062,7 @@
       (if (eq? dir_fd None)
           ((@ (guile) rmdir) path)
           (let* ((fd   (open path O_DIRECTORY #:dir_fd dir_fd))
-                 (path ((@ (guile) read-link) '
+                 (path ((@ (guile) readlink) '
                         (format #f "/proc/self/fd/~a" fd))))
             (close fd)
             ((@ (guile) rmdir) path))))))
@@ -1067,7 +1077,6 @@
               (lambda x (values)))
             (lp (cdr l)))))))
 
-(define rename #f)
 (defineu rename (0)
   (let ((fat (pointer->procedure int
                                  (dynamic-func "renameat" (dynamic-link))
@@ -1106,59 +1115,75 @@
               (removedirs (string-join (reverse (cdr (reverse l))) "/")))))
     (values)))
 
-
+(define statu stat)
                  
 (define-python-class DirEntry ()
   (define __init__
-    (lambda (self path stat errno)
+    (lambda (self path stat)
       (set self 'name (basename path))
       (set self 'path path)
-      (set self '__errno errno)
       (set self '__stat stat)))
+
+  (define __repr__
+    (lambda (self)
+      (format #f "DirEntry(~a)" (basename (ref self 'path)))))
   
   (define inode
     (lambda (self)
       (let ((stat (ref self '__stat)))
         (if stat
             (stat:ino stat)
-            (raise error (ref self '__errno))))))
+            (raise error "Bug no stat")))))
   
   (define is_dir
     (lambda* (self #:key (follow_symlinks #t))
-      (let ((s (stat (ref self 'path) #:follow_symlinks follow_symlinks)))
-        ((@ (stat) is-dir?) (ref s '_st_mode)))))
+      (let ((s (statu (ref self 'path)
+                      #:follow_symlinks follow_symlinks)))
+        (S_ISDIR (ref s 'st_mode)))))
   
   (define is_file
     (lambda* (self #:key (follow_symlinks #t))
-      (let ((s (stat (ref self 'path) #:follow_symlinks follow_symlinks)))
-        ((@ (stat) is-reg?) (ref s '_st_mode)))))
+      (let ((s (statu (ref self 'path) #:follow_symlinks follow_symlinks)))
+        (S_ISREG (ref s 'st_mode)))))
 
   (define is_symlink
     (lambda (self)
-      (let ((s (stat (ref self 'path))))
-        ((@ (stat) is-lnk?) (ref s '_st_mode)))))
+      (let ((s (statu (ref self 'path))))
+        (S_ISLNK (ref s 'st_mode)))))
   
   (define stat
     (lambda* (self #:key (follow_symlinks #t))
       (stat (ref self 'path) #:follow_symlinks follow_symlinks))))
 
+(define (one yield)
+  (let ((first? #t))
+    (lambda (name stat . x)
+      (if first?
+          (begin
+            (set! first? #f)
+            #t)
+          (begin
+            (yield (DirEntry name stat))
+            #f)))))
+
 (define* (scandir #:optional (path "."))
-  (make-generator ()
+  ((make-generator ()
     (lambda (yield)
       (file-system-fold
-       (lambda x #t)
-       (lambda (path stat errno r)
-         (yield (DirEntry path stat errno)))
+       (one yield)
+       (lambda (path stat res)
+         (yield (DirEntry path stat))
+         res)
        (lambda (path stat res)
-         (yield (DirEntry path stat 0)))
+         res)
        (lambda (path stat res)
-         (values))
+         res)
        (lambda (path stat res)
-         (values))
+         res)
        (lambda (path stat errno res)
-         (values))
+         res)
        #f
-       (path-it path)))))
+       (path-it path))))))
 
 (define (stat_float_times newvalue)
   (set! stat-float-times newvalue))
@@ -1194,7 +1219,6 @@
          f_namemax)
        (list a1 a2 a3 a4 a5 a6 a7 a8 a9 a10)))))
 
-(define statvfs #f)
 (defineu statvfs (2)
   (let ((f (pointer->procedure int
                                (dynamic-func "statvfs" (dynamic-link))
@@ -1221,7 +1245,7 @@
          (bytevector-u64-ref bv (* 9  8) (native-endianness))
          (bytevector-u64-ref bv (* 10 8) (native-endianness)))))))
 
-(define symlink #f)
+
 (defineu symlink (0)
   (let ((fat (pointer->procedure int
                                  (dynamic-func "symlinkat" (dynamic-link))
@@ -1232,7 +1256,6 @@
                 (if (eq? dir_fd None) AT_FDCWD dir_fd)
                 (string->pointer (path-it src))))))))
 
-(define truncate #f)
 (defineu truncate (2)
   (let ((ff (pointer->procedure int
                                 (dynamic-func "ftruncate" (dynamic-link))
@@ -1320,7 +1343,7 @@
        
         (for ((entry : entries)) ()
              (define is_dir (try
-                             (lambda () (ref entry 'is_dir))
+                             (lambda () ((ref entry 'is_dir)))
                              (#:except error => (lambda x #f))))
              (if is_dir
                  (pylist-append! dirs    (ref entry 'name))
@@ -1337,21 +1360,22 @@
                    (if walk-into
                        (for ((a b c : (walk (ref entry 'path) topdown
                                             onerror followlinks))) ()
-                           (yield a b c)))))
+                           (yield a b c))))))
         
-             (if topdown
-                 (begin
-                   (yield top dirs nondirs)
-
-                   (let ((islink  (ref path 'islink))
-                         (join    (ref path 'join)))
-                     (for ((dirname : dirs)) ()
-                          (let ((new_path (join top dirname)))
-                            (if (or followlinks (not (islink new_path)))
-                                (for ((a b c : (walk new_path topdown onerror
-                                                     followlinks))) ()
-                                   (yield a b c)))))))
-                 (yield top dirs nondirs))))))))
+        (if topdown
+            (begin
+              (yield top dirs nondirs)
+
+              (for ((dirname : dirs)) ()
+                   (let ((new_path (path:join top dirname)))
+                     (if (or followlinks (not (path:islink new_path)))
+                         (for ((a b c : (walk new_path topdown onerror
+                                              followlinks))) ()
+                            (yield a b c))))))
+            (yield top dirs nondirs)))))))
+
+(define (path:islink p)
+  (ca (S_ISLNK (stat:mode ((@ (guile) stat) (path-it p))))))
 
 (define (path:samestat s1 s2)
   (and (equal? (ref s1 'st_dev) (ref s2 'st_dev))
@@ -1386,11 +1410,11 @@
 
 (define (_fwalk topfd toppath topdown onerror follow_symlinks)
   ((make-generator ()
-   (lambda (yield)
+   (lambda (yield)                
      (define names   (listdir topfd))
      (define dirs    (py-list))
      (define nondirs (py-list))
-
+     
      (for ((name : names)) ()
           (try
            (lambda ()
@@ -1416,10 +1440,10 @@
                 (try
                  (lambda ()
                    (values (stat name #:dir_fd topfd
-                                 #:follow_symlinks follow_symlinks))
-                   (open name O_RDONLY #:dir_fd topfd))
+                                 #:follow_symlinks follow_symlinks)
+                           (open name O_RDONLY #:dir_fd topfd)))
                  (#:except error =>
-                   (lambda (err . l)
+                  (lambda (err . l)
                     (if (not (eq? onerror None))
                         (onerror err)
                         (continue))))))
@@ -1434,9 +1458,9 @@
                            (yield a b c d)))))
                
                #:finally
-               (close dirfd)))))
+              (lambda ()  (close dirfd))))))
 
-     (if not topdown
+     (if (not topdown)
          (yield toppath dirs nondirs topfd))))))
 
 (def (fwalk (= top ".") (= topdown #t) (= onerror #t)
@@ -1451,11 +1475,10 @@
         (if (or follow_symlinks (and (S_ISDIR (ref orig_st 'st_mode))
                                      (path:samestat orig_st (stat topfd))))
             (for ((a b c d :
-                     (_fwalk topfd top topdown onerror follow_symlinks)))
-              ()
+                     (_fwalk topfd top topdown onerror follow_symlinks))) ()
               (yield a b c d))))
       #:finally
-      (close topfd))))))
+      (lambda () (close topfd)))))))
 
 ;; Extended attributes
 (define getxattr #f)
diff --git a/modules/language/python/module/os/path.scm b/modules/language/python/module/os/path.scm
index 4cf96cf..8d76762 100644
--- a/modules/language/python/module/os/path.scm
+++ b/modules/language/python/module/os/path.scm
@@ -188,6 +188,7 @@
 
 (define (normcase x) x)
 
+(define islink   (@@ (language python module os) path:islink))
 (define join     (@@ (language python module os) path:join))
 (define normpath (@@ (language python module os) path:normpath))
 (define samestat (@@ (language python module os) path:samestat))