io module tested and debugged

5 files changed, 120 insertions, 101 deletions

diff --git a/modules/language/python/bool.scm b/modules/language/python/bool.scm
index 3eb6bc8..461dc26 100644
--- a/modules/language/python/bool.scm
+++ b/modules/language/python/bool.scm
@@ -1,5 +1,6 @@
 (define-module (language python bool)
   #:use-module (oop goops)
+  #:use-module (language python exceptions)
   #:use-module (oop pf-objects)
   #:export (bool))
 
@@ -9,6 +10,8 @@
   (cond
    ((null? x)
     #f)
+   ((eq? x None)
+    #f)
    (else x)))
 
 (define-method (bool (x <integer>)) (not (= x 0)))
diff --git a/modules/language/python/bytes.scm b/modules/language/python/bytes.scm
index 2acb9e5..e222c3e 100644
--- a/modules/language/python/bytes.scm
+++ b/modules/language/python/bytes.scm
@@ -16,10 +16,7 @@
 		       <py-bytearray> pybytesarray-listing scm-bytevector))
 
 (define (scm-bytevector x)
-  (cond
-   ((bytevector? x) x)
-   ((is-a? x <py-bytes>    ) (slot-ref x 'bytes))
-   ((is-a? x <py-bytearray>) (slot-ref x 'vec))))
+  (slot-ref (bytes x) 'bytes))
 
 (define (bytes->bytevector x) (slot-ref x 'bytes))
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index fe3533b..170cb11 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -1392,7 +1392,8 @@
              ,(C 'clear-warning-data)
              (fluid-set! (@@ (system base message) %dont-warn-list) '())
              ,@(map (lambda (s) `(,(C 'var) ,s)) globs)
-             ,@(map (g globs exp) x))))
+             ,@(map (g globs exp) x)
+             (,(C 'export-all)))))
       (begin
         (if (fluid-ref (@@ (system base compile) %in-compile))
             (set! s/d 'set!)
@@ -1407,8 +1408,8 @@
              ,(C 'clear-warning-data)
              (fluid-set! (@@ (system base message) %dont-warn-list) '())
              ,@(map (lambda (s) `(,(C 'var) ,s)) globs)
-             ,@(map (g globs exp) x)
-             (,(C 'export-all)))))))
+             ,@(map (g globs exp) x))))))
+
 
 (define-syntax-parameter break
   (lambda (x) #'(values)))
@@ -1822,13 +1823,11 @@
       ((_ v)
        #'v)
       ((_ v (#:fastfkn-ref f _) . l)
-       #'(ref-x (lambda x (if (py-class? v) (apply f x) (apply f v x))) . l))
+       #'(ref-x (lambda x (if (pyclass? v) (apply f x) (apply f v x))) . l))
       ((_ v (#:fast-id f _) . l)
        #'(ref-x (f v) . l))
       ((_ v (#:identifier x) . l)
        #'(ref-x (ref v x) . l))
-      ((_ v (#:identifier x) . l)
-       #'(ref-x (ref v x) . l))
       ((_ v (#:call-obj x) . l)
        #'(ref-x (x v) . l))
       ((_ v (#:call x ...) . l)
diff --git a/modules/language/python/module/io.scm b/modules/language/python/module/io.scm
index 6bd7193..dceced8 100644
--- a/modules/language/python/module/io.scm
+++ b/modules/language/python/module/io.scm
@@ -64,9 +64,12 @@
 (define DEFAULT_BUFFER_SIZE 4096)
 
 (define (path-it path)
-  (aif it (ref path '__fspath__)
-       (it)
-       path))
+  (if (number? path)
+      path
+      (scm-str
+       (aif it (ref path '__fspath__)
+            (it)
+            path))))
 
 (def (open- path
            (= mode      "r")
@@ -151,8 +154,8 @@
 
      (let ((F
             (FileIO (cons
-                     (open path mode buffering encoding errors
-                           newline closefd opener)
+                     (open- path mode buffering encoding errors
+                            newline closefd opener)
                      path)
                     mode)))
        (if (member #\b (string->list mode))
@@ -160,16 +163,23 @@
            (TextIOWrapper F encoding errors))))
                    
 
-(define-syntax-rule (check self . l)
-  (aif it (ref self 'raw)
-       (let ((self it))
-         (if (ref self 'closed)
-             (raise ValueError "IO operation on closed port"))
-         . l)
-       (begin
-         (if (ref self 'closed)
-             (raise ValueError "IO operation on closed port"))
-         . l)))
+(define-syntax check
+  (syntax-rules ()
+    ((_ (self) . l)
+     (check (self a b) . l))
+    
+    ((_ (self port) . l)
+     (check (self port b) . l))
+    
+    ((_ (self port it) . l)
+     (let lp ((it self))
+       (aif it2 (ref it 'raw)
+            (lp it2)
+            (begin
+              (if (ref self 'closed)
+                  (raise ValueError "IO operation on closed port"))
+              (let ((port (ref it '_port)))
+                . l)))))))
 
 ;; ABC
 
@@ -182,135 +192,150 @@
 
   (define __getport__
     (lambda (self)
-      (check self
-        (ref self '_port))))
+      (check (self port)
+             port)))
   
   (define close
     (lambda (self)      
-      (check self
-         (close-port (ref self '_port))
-         (set self 'closed #t))))
+      (check (self port it)
+         (close-port port)
+         (set it 'closed #t))))
   
   (define __enter__
     (lambda (self)
-      (check self)
-      self))
+      (check (self)
+         self)))
 
   (define __exit__
     (lambda (self . x)
-      (check self
-         ((ref self 'close)))))
+      (check (self)
+        ((ref self 'close)))))
 
   (define flush
     (lambda (self)
-      (check self
-        (if ((ref self 'readable))  (drain-input  (ref self '_port)))
-        (if ((ref self 'writeable)) (force-output (ref self '_port))))))
+      (check (self port)
+        (if ((ref self 'readable))  (drain-input  port))
+        (if ((ref self 'writeable)) (force-output port)))))
 
   (define isatty
     (lambda (self)
-      (check self
-        (isatty? (ref self '_port)))))
+      (check (self port)
+        (isatty? port))))
 
   (define __iter__
     (lambda (self)
-      (check self)
-      self))
+      (check (self)
+        self)))
 
   (define __next__
     (lambda (self)
-      (check self
-             (raise StopIteration))))
+      (check (self)
+        (raise StopIteration))))
 
   (define readable
     (lambda (self)
-      (check self
-        (output-port? (ref self '_port)))))
+      (check (self port)
+        (output-port? port))))
 
   (define readline
     (lam (self (= size -1))
-         (check self
+         (check (self)
            (raise UnsupportedOperation))))
 
   (define readlines
     (lam (self (= hint -1))
-         (check self
+         (check (self)
             (raise UnsupportedOperation))))
   
   (define seekable
     (lambda (self)
-      (check self
+      (check (self port)
          (catch #t
-           (lambda  () (seek (ref self '_port) 0 SEEK_CUR) #t)
+           (lambda  () (seek port 0 SEEK_CUR) #t)
            (lambda  x  #f)))))
                           
   (define seek
     (lambda* (self offset #:optional (whence SEEK_SET))
-      (check self
+      (check (self port)
         (if (not ((ref self seekable)))
             (raise (ValueError "Not seekable")))
-        (seek (ref self '_port) offset whence))))
+        (seek port offset whence))))
 
 
   (define tell
     (lambda (self)
-      (check self
-        (ftell (ref self '_port)))))
+      (check (self port)
+        (ftell port))))
 
   (define truncate
     (lam (self (= size None))
-         (check self
+         (check (self port)
            (if (eq? size None)
-               (truncate-file (ref self '_port))
-               (truncate-file (ref self '_port) size)))))
+               (truncate-file port)
+               (truncate-file port size)))))
 
              
   (define writeable
     (lambda (self)
-      (check self
-         (input-port? (ref self '_port)))))
+      (check (self port)
+         (input-port? port))))
 
   (define writelines
     (lambda (self lines)
-      (check self
+      (check (self)
         (raise UnsupportedOperation))))
 
+  (define __repr__
+    (lambda (self)
+      (let lp ((it self))
+        (aif it2 (ref it 'raw)
+             (lp it2)
+             (let* ((port (ref it   '_port    ))
+                    (cln  (ref self '__name__ ))
+                    (nm   (port-filename port ))
+                    (mod  (port-mode     port )))
+               (format #f "~a ~a : ~a" cln nm mod))))))
+  
   (define __del__
     (lambda (self)
       ((ref self 'close)))))
 
 
 
-      
+(define (wrap  x) (if (eof-object? x) #vu8() x))
+(define (wraps x) (if (eof-object? x) "" x))
 
   
 (define-python-class RawIOBase (IOBase)
   (define __next__
     (lambda (self)
-      (read self 1)))
+      (let ((x (read self 1)))
+        (if (= (len x) 0)
+            StopIteration
+            x))))
         
   (define read
     (lam (self (= size -1))
-      (check self
-      (bytes
-       (if (< size 0)
-           ((ref self 'readall))
-           (get-bytevector-n (ref self '_port) size))))))
+      (check (self port)
+        (bytes
+         (if (< size 0)
+             ((ref self 'readall))
+             (wrap (get-bytevector-n port size)))))))
         
 
   (define readall
     (lambda (self)
-      (check self
+      (check (self port)
         (bytes
-         (get-bytevector-all (ref self '_port))))))
+         (wrap (get-bytevector-all port))))))
 
   (define readinto
     (lambda (self b)
-      (check self
+      (check (self port)
         (let* ((n (len b))
                (b (scm-bytevector b))
-               (m (get-bytevector-n! (ref self '_port) b 0 n)))
-          (if (eq?  m eof-object)
+               (m (get-bytevector-n! port b 0 n)))
+          (if (eq? m eof-object)
               (if (get_blocking (ref self '_port))
                   0
                   None)
@@ -318,27 +343,27 @@
             
   (define write
     (lambda (self b)
-      (check self
+      (check (self port)
         (let ((n (len b))
               (b (scm-bytevector b)))
-          (put-bytevector (ref self '_port) b 0 n)
+          (put-bytevector port b 0 n)
           n)))))
 
             
 (define-python-class BufferedIOBase (RawIOBase)
   (define detach
     (lambda (self)
-      (check self
+      (check (self)
         (raise UnsupportedOperation "detach"))))
 
   (define read1
     (lambda* (self #:optional (size -1))
-      (check self
+      (check (self)
         ((ref self 'read) size))))
 
   (define readinto1
     (lambda (self b)
-      (check self 
+      (check (self) 
         ((ref self 'readinto) b)))))
 
 (define-python-class FileIO (RawIOBase)
@@ -364,12 +389,13 @@
               (set self '_port port)
               (set self '_gtbv get-bytevector)))
           (set self '_port
-               (open-bytevector-input-port initial_bytes)))))
+               (open-bytevector-input-port
+                (scm-bytevector initial_bytes))))))
 
   (define getvalue
     (lambda (self)
-      (check self
-             (bytes ((ref self '_gtbv)))))))
+      (check (self)
+        (bytes ((ref self '_gtbv)))))))
 
 (define-python-class BufferedReader (BufferedIOBase)
   (define __init__
@@ -421,28 +447,28 @@
 (define-python-class TextIOBase (IOBase)
   (define __next__
     (lambda (self)
-      (read self 1)))
+      (let ((x ((ref self 'read) 1)))
+        (if (= (len x) 0)
+            StopIteration
+            x))))
   
   (define read
     (lam (self (= size -1))
-      (check self
-        (let ((port (ref self '_port)))
-          (if (< size 0)
-              (get-string-all port)
-              (get-string-n port size))))))
+      (check (self port)
+        (if (< size 0)
+            (wraps (get-string-all port))
+            (wraps (get-string-n port size))))))
 
   (define readline
     (lam (self (= size -1))
-         (check self
-           (let ((port (ref self '_port)))
-             (read-line port 'concat)))))
+         (check (self port)
+           (wraps (read-line port 'concat)))))
 
   (define write
     (lambda (self s)
-      (check self
-        (let ((port (ref self '_port)))
-          (put-string port (scm-str s) 0 (len s))
-          (len s))))))
+      (check (self port)
+         (put-string port (scm-str s) 0 (len s))
+         (len s)))))
 
 (define (get-port x)
   (aif it (ref x '_port)
@@ -506,5 +532,5 @@
 
   (define getvalue
     (lambda (self)
-      (check self
-        (get-output-string (ref self '_port))))))
+      (check (self port)
+        (get-output-string port)))))
diff --git a/modules/language/python/string.scm b/modules/language/python/string.scm
index 084d933..f94580c 100644
--- a/modules/language/python/string.scm
+++ b/modules/language/python/string.scm
@@ -24,13 +24,7 @@
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
 (define (scm-str x)
-  (cond
-   ((string? x)
-    x)
-   ((is-a? x <py-string>)
-    (slot-ref (pystring x) 'str))
-   (else
-    #f)))
+  (slot-ref (pystring x) 'str))
 
 (define (scm-sym x)
   (if (symbol? x)