io compiles

4 files changed, 136 insertions, 97 deletions

diff --git a/modules/language/python/bytes.scm b/modules/language/python/bytes.scm
index bd590b8..2acb9e5 100644
--- a/modules/language/python/bytes.scm
+++ b/modules/language/python/bytes.scm
@@ -13,7 +13,13 @@
   #:use-module (language python bool)
   #:use-module (language python persist)
   #:export (<py-bytes> pybytes-listing bytes bytearray bytes->bytevector
-		       <py-bytearray> pybytesarray-listing))
+		       <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))))
 
 (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/module/io.scm b/modules/language/python/module/io.scm
index b2f9342..6bd7193 100644
--- a/modules/language/python/module/io.scm
+++ b/modules/language/python/module/io.scm
@@ -1,22 +1,63 @@
 (define-module (language python module io)
-  #:use-module (language python module exceptions)
-  #:use-module ((language python module os)
-                #:select (get_blocking))  
+  #:use-module (oop pf-objects)
+  #:use-module (system foreign)
+  #:use-module (ice-9 binary-ports)
+  #:use-module (ice-9 textual-ports)
+  #:use-module (ice-9 rdelim)
+
+  #:use-module (language python exceptions)
+  #:use-module (language python def)
+  #:use-module (language python try)
+  #:use-module (language python string)
+  #:use-module (language python list)
+  #:use-module (language python bytes)
+  #:use-module (language python bool)
+  
+  #:use-module (language python module errno)
   #:re-export (BlockingIOError)
-  #:export (UnsupportedOperation scm-port open DEFAULT_BUFFER_SIZE
+  #:replace (open)
+  #:export (UnsupportedOperation scm-port DEFAULT_BUFFER_SIZE
                                  IOBase RawIOBase BufferedIOBase FileIO
                                  BytesIO BufferedReader BufferedWriter
                                  BufferedRandom TextIOBase TextIOWrapper
                                  StringIO))
 
-                                 
+(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
+
+(define-syntax-rule (ca code)
+  (catch #t
+    (lambda () code)
+    (lambda x (raise error x))))
+
+(define-syntax-rule (rm code)
+  (let ((r (ca code)))
+    (if (< r 0)
+        (raise error (errno) ((@ (guile) strerror) (errno)))
+        r)))
+
+(define F_GETFL 3)
+
+(define fcntl2 (pointer->procedure int
+                                   (dynamic-func "fcntl" (dynamic-link))
+                                   (list int int)))
+(define fcntl3 (pointer->procedure int
+                                   (dynamic-func "fcntl" (dynamic-link))
+                                   (list int int int)))
+
+(define (get_blocking fd)
+  (let ((fd (if (port? fd) (port->fdes fd) fd)))
+    (if (= (logand O_NONBLOCK (rm (fcntl2 fd F_GETFL))) 0)
+        #f
+        #t)))
 
 (define (scm-port x)
   (if (port? x)
       x
       (aif it (ref x '_port)
            it
-           (raise ValueError "no port in scm-port"))))
+           (aif it (ref x 'raw)
+                (scm-port it)
+                (raise ValueError "no port in scm-port")))))
 
 (define-python-class UnsupportedOperation (OSError ValueError))
 
@@ -37,43 +78,43 @@
            (= opener     None))
      
      (define modelist (string->list mode))
-     (define path     (path-it path))
+     (define path*    (path-it path))
      (define (clean ch l)
        (filter (lambda (c) (not (eq? ch c))) l))
-     (let ((port (if (number? path)
-                     (begin
-                       (if (member #\a modelist)
-                           (seek path 0 SEEK_END))
-                       (if (member #\x modelist)
-                           (error "cannot use mode 'x' for fd input"))
-                       (cond
-                        ((member #\r modelist)
-                         (fdes->inport path))
-                        ((member #\w modelist)
-                         (fdes->outport path))))
-                     (begin
-                       (if (member #\x modelist)
-                           (if (file-exists? path)
-                               (raise OSError "mode='x' and file exists")
-                               (set mode (list->string
-                                          (clean #\x modelist)))))
-                       ((@ (guile) open-file) (path-it path) mode))))
-           
-           (errors   (if (bool errors)
-                         (scm-str errors)
-                         (let ((s (port-conversion-strategy port)))
-                           (cond
-                            ((eq? s 'error)      "strict")
-                            ((eq? s 'substitute) "replace")
-                            ((eq? s 'escape)     "basckslashreplace")))))
+
+     (let* ((port (if (number? path)
+                      (begin
+                        (if (member #\a modelist)
+                            (seek path* 0 SEEK_END))
+                        (if (member #\x modelist)
+                            (error "cannot use mode 'x' for fd input"))
+                        (cond
+                         ((member #\r modelist)
+                          (fdes->inport path*))
+                         ((member #\w modelist)
+                          (fdes->outport path*))))
+                      (begin
+                        (if (member #\x modelist)
+                            (if (file-exists? path*)
+                                (raise OSError "mode='x' and file exists")
+                                (set mode (list->string
+                                           (clean #\x modelist)))))
+                        ((@ (guile) open-file) path* mode))))
+            
+            (errors   (if (bool errors)
+                          (scm-str errors)
+                          (let ((s (port-conversion-strategy port)))
+                            (cond
+                             ((eq? s 'error)      "strict")
+                             ((eq? s 'substitute) "replace")
+                             ((eq? s 'escape)     "basckslashreplace")))))
            
-           (encoding (if (eq? encoding None)
-                         (port-encoding port)
-                         encoding)))
+            (encoding (if (eq? encoding None)
+                          (port-encoding port)
+                          encoding)))
        
        
        ;; encoding
-       (set self 'encoding encoding)
        (set-port-encoding! port encoding)
 
        (case buffering
@@ -119,8 +160,6 @@
            (TextIOWrapper F encoding errors))))
                    
 
-;;ABC
-
 (define-syntax-rule (check self . l)
   (aif it (ref self 'raw)
        (let ((self it))
@@ -132,6 +171,9 @@
              (raise ValueError "IO operation on closed port"))
          . l)))
 
+;; ABC
+
+
 (define-python-class IOBase ()
   (define __init__
     (lambda (self port)
@@ -141,7 +183,7 @@
   (define __getport__
     (lambda (self)
       (check self
-        (ref self _port))))
+        (ref self '_port))))
   
   (define close
     (lambda (self)      
@@ -162,8 +204,8 @@
   (define flush
     (lambda (self)
       (check self
-        (if ((ref self readable))  (drain-input  (ref self '_port)))
-        (if ((ref self writeable)) (force-output (ref self '_port))))))
+        (if ((ref self 'readable))  (drain-input  (ref self '_port)))
+        (if ((ref self 'writeable)) (force-output (ref self '_port))))))
 
   (define isatty
     (lambda (self)
@@ -178,12 +220,12 @@
   (define __next__
     (lambda (self)
       (check self
-          (raise StopIteration))))
+             (raise StopIteration))))
 
   (define readable
     (lambda (self)
       (check self
-         (output-port? (ref self '_port)))))
+        (output-port? (ref self '_port)))))
 
   (define readline
     (lam (self (= size -1))
@@ -194,13 +236,13 @@
     (lam (self (= hint -1))
          (check self
             (raise UnsupportedOperation))))
-
+  
   (define seekable
     (lambda (self)
       (check self
-        (catch #t
-          (lambda  () (seek (ref self '_port) 0 SEEK_CUR) #t)
-          (lambda  x  #f)))))
+         (catch #t
+           (lambda  () (seek (ref self '_port) 0 SEEK_CUR) #t)
+           (lambda  x  #f)))))
                           
   (define seek
     (lambda* (self offset #:optional (whence SEEK_SET))
@@ -216,14 +258,14 @@
         (ftell (ref self '_port)))))
 
   (define truncate
-    (lam (self (size None))
+    (lam (self (= size None))
          (check self
            (if (eq? size None)
                (truncate-file (ref self '_port))
                (truncate-file (ref self '_port) size)))))
 
              
-  (define writable
+  (define writeable
     (lambda (self)
       (check self
          (input-port? (ref self '_port)))))
@@ -234,8 +276,8 @@
         (raise UnsupportedOperation))))
 
   (define __del__
-    (lambda (self
-       ((ref self 'close))))))
+    (lambda (self)
+      ((ref self 'close)))))
 
 
 
@@ -243,8 +285,12 @@
 
   
 (define-python-class RawIOBase (IOBase)
+  (define __next__
+    (lambda (self)
+      (read self 1)))
+        
   (define read
-    (lambda (self #:optional (size -1))
+    (lam (self (= size -1))
       (check self
       (bytes
        (if (< size 0)
@@ -264,11 +310,12 @@
         (let* ((n (len b))
                (b (scm-bytevector b))
                (m (get-bytevector-n! (ref self '_port) b 0 n)))
-          (if (eof? m)
-              (if (get_blocking port)
+          (if (eq?  m eof-object)
+              (if (get_blocking (ref self '_port))
                   0
-                  None))))))
-  
+                  None)
+              m)))))
+            
   (define write
     (lambda (self b)
       (check self
@@ -300,7 +347,7 @@
          (if (pair? name)
              (set self '_port (car name))
              (set self '_port
-                  (open_ it
+                  (open- (path-it name)
                          #:mode      mode
                          #:closefd   closefd
                          #:opener    opener)))
@@ -371,15 +418,18 @@
     (lambda (self)
       (raise UnsupportedOperation peek))))
 
-(use-modules (ice-9 textual-ports))
-(use-modules (ice-9 rdelim))
-
 (define-python-class TextIOBase (IOBase)
+  (define __next__
+    (lambda (self)
+      (read self 1)))
+  
   (define read
-    (lambda (self size)
+    (lam (self (= size -1))
       (check self
         (let ((port (ref self '_port)))
-          (get-string-n port size)))))
+          (if (< size 0)
+              (get-string-all port)
+              (get-string-n port size))))))
 
   (define readline
     (lam (self (= size -1))
@@ -444,38 +494,17 @@
              (set-port-conversion-strategy! port 'escape)))
 
            ;; write trough
-           (set self 'write_trough write_trough)))))
+           (set self 'write_through write_through)))))
 
 (define-python-class StringIO (TextIOBase)
   (define __init__
     (lam (self (= initial_value "") (= newline "\n"))
          (set self 'newline newline)
          (if (equal? initial_value "")
-             (set self '_port (open-output-str))
-             (set self '_port (open-input-str initial_value)))))
+             (set self '_port (open-output-string))
+             (set self '_port (open-input-string initial_value)))))
 
   (define getvalue
     (lambda (self)
       (check self
-        (get-output-string (ref self port))))))
-
-
-
-
-         
-         
-
-
-
-
-
-        
-
-
-      
-
-
-  
-(define-python-class TextIOWrapper (TextIOBase))
-(define-python-class StringIO (TextIOBase))
-
+        (get-output-string (ref self '_port))))))
diff --git a/modules/language/python/module/os.scm b/modules/language/python/module/os.scm
index 757d549..d985501 100644
--- a/modules/language/python/module/os.scm
+++ b/modules/language/python/module/os.scm
@@ -20,9 +20,10 @@
   #:use-module (language python set)
   #:use-module (language python def)
   #:use-module (language python module errno)
+  #:use-module ((language python module io)
+                #:select ((open . builtin:open)  DEFAULT_BUFFER_SIZE))
   #:use-module (language python module resource)
-  #:use-module ((language python module python)
-                #:select ((open . builtin:open)))
+               
   #:use-module (language python list)
   #:replace (getcwd getuid getenv)
   #:export (error name ctermid environ environb chdir fchdir 
@@ -678,8 +679,6 @@
 
 (define F_GETFL 3)
 
-(define fcntl2 #f)
-(define fcntl3 #f)
 (defineu fcntl2 () (pointer->procedure int
                                        (dynamic-func "fcntl" (dynamic-link))
                                        (list int int)))
@@ -1711,9 +1710,6 @@
 
 (define (plock . l) (error "not implemented"))
 
-(define DEFAULT_BUFFER_SIZE (@@ (language python module python)
-                                DEFAULT_BUFFER_SIZE))
-
 (define* (popen com #:optional (mode "r") (buffering -1))
   (let ((port (ca ((@ (ice-9 popen) open-pipe) com
                    (cond 
diff --git a/modules/language/python/string.scm b/modules/language/python/string.scm
index 11a9737..084d933 100644
--- a/modules/language/python/string.scm
+++ b/modules/language/python/string.scm
@@ -23,7 +23,15 @@
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
-(define (scm-str x) (slot-ref (pystring x) 'str))
+(define (scm-str x)
+  (cond
+   ((string? x)
+    x)
+   ((is-a? x <py-string>)
+    (slot-ref (pystring x) 'str))
+   (else
+    #f)))
+
 (define (scm-sym x)
   (if (symbol? x)
       x