Merge branch 'master' of https://gitlab.com/python-on-guile/python-on-guile

4 files changed, 522 insertions, 66 deletions

diff --git a/modules/language/python/module/io.scm b/modules/language/python/module/io.scm
new file mode 100644
index 0000000..6bd7193
--- /dev/null
+++ b/modules/language/python/module/io.scm
@@ -0,0 +1,510 @@
+(define-module (language python module io)
+  #: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)
+  #: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
+           (aif it (ref x 'raw)
+                (scm-port it)
+                (raise ValueError "no port in scm-port")))))
+
+(define-python-class UnsupportedOperation (OSError ValueError))
+
+(define DEFAULT_BUFFER_SIZE 4096)
+
+(define (path-it path)
+  (aif it (ref path '__fspath__)
+       (it)
+       path))
+
+(def (open- path
+           (= mode      "r")
+           (= buffering -1 )
+           (= encoding   None)
+           (= errors     None)
+           (= newline    None)
+           (= closefd    #t)
+           (= opener     None))
+     
+     (define modelist (string->list mode))
+     (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* 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
+       (set-port-encoding! port encoding)
+
+       (case buffering
+         ((-1)
+          (setvbuf port 'block DEFAULT_BUFFER_SIZE))
+         ((0)
+          (setvbuf port 'none))
+         ((1)
+          (setvbuf port 'line))
+         (else
+          (setvbuf port 'block buffering)))
+
+       (cond
+        ((equal? errors "strict")
+         (set-port-conversion-strategy! port 'error))
+        ((equal? errors "replace")
+         (set-port-conversion-strategy! port 'substitute))
+        ((equal? errors "basckslashreplace")
+         (set-port-conversion-strategy! port 'escape))
+        (else
+         (set-port-conversion-strategy! port 'escape)))
+
+       port))
+
+
+(def (open path
+           (= mode      "r")
+           (= buffering -1 )
+           (= encoding   None)
+           (= errors     None)
+           (= newline    None)
+           (= closefd    #t)
+           (= opener     None))
+
+     (let ((F
+            (FileIO (cons
+                     (open path mode buffering encoding errors
+                           newline closefd opener)
+                     path)
+                    mode)))
+       (if (member #\b (string->list mode))
+           F
+           (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)))
+
+;; ABC
+
+
+(define-python-class IOBase ()
+  (define __init__
+    (lambda (self port)
+      (set self '_port  port)
+      (set self 'closed (port-closed? port))))
+
+  (define __getport__
+    (lambda (self)
+      (check self
+        (ref self '_port))))
+  
+  (define close
+    (lambda (self)      
+      (check self
+         (close-port (ref self '_port))
+         (set self 'closed #t))))
+  
+  (define __enter__
+    (lambda (self)
+      (check self)
+      self))
+
+  (define __exit__
+    (lambda (self . x)
+      (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))))))
+
+  (define isatty
+    (lambda (self)
+      (check self
+        (isatty? (ref self '_port)))))
+
+  (define __iter__
+    (lambda (self)
+      (check self)
+      self))
+
+  (define __next__
+    (lambda (self)
+      (check self
+             (raise StopIteration))))
+
+  (define readable
+    (lambda (self)
+      (check self
+        (output-port? (ref self '_port)))))
+
+  (define readline
+    (lam (self (= size -1))
+         (check self
+           (raise UnsupportedOperation))))
+
+  (define readlines
+    (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)))))
+                          
+  (define seek
+    (lambda* (self offset #:optional (whence SEEK_SET))
+      (check self
+        (if (not ((ref self seekable)))
+            (raise (ValueError "Not seekable")))
+        (seek (ref self '_port) offset whence))))
+
+
+  (define tell
+    (lambda (self)
+      (check self
+        (ftell (ref self '_port)))))
+
+  (define truncate
+    (lam (self (= size None))
+         (check self
+           (if (eq? size None)
+               (truncate-file (ref self '_port))
+               (truncate-file (ref self '_port) size)))))
+
+             
+  (define writeable
+    (lambda (self)
+      (check self
+         (input-port? (ref self '_port)))))
+
+  (define writelines
+    (lambda (self lines)
+      (check self
+        (raise UnsupportedOperation))))
+
+  (define __del__
+    (lambda (self)
+      ((ref self 'close)))))
+
+
+
+      
+
+  
+(define-python-class RawIOBase (IOBase)
+  (define __next__
+    (lambda (self)
+      (read self 1)))
+        
+  (define read
+    (lam (self (= size -1))
+      (check self
+      (bytes
+       (if (< size 0)
+           ((ref self 'readall))
+           (get-bytevector-n (ref self '_port) size))))))
+        
+
+  (define readall
+    (lambda (self)
+      (check self
+        (bytes
+         (get-bytevector-all (ref self '_port))))))
+
+  (define readinto
+    (lambda (self b)
+      (check self
+        (let* ((n (len b))
+               (b (scm-bytevector b))
+               (m (get-bytevector-n! (ref self '_port) b 0 n)))
+          (if (eq?  m eof-object)
+              (if (get_blocking (ref self '_port))
+                  0
+                  None)
+              m)))))
+            
+  (define write
+    (lambda (self b)
+      (check self
+        (let ((n (len b))
+              (b (scm-bytevector b)))
+          (put-bytevector (ref self '_port) b 0 n)
+          n)))))
+
+            
+(define-python-class BufferedIOBase (RawIOBase)
+  (define detach
+    (lambda (self)
+      (check self
+        (raise UnsupportedOperation "detach"))))
+
+  (define read1
+    (lambda* (self #:optional (size -1))
+      (check self
+        ((ref self 'read) size))))
+
+  (define readinto1
+    (lambda (self b)
+      (check self 
+        ((ref self 'readinto) b)))))
+
+(define-python-class FileIO (RawIOBase)
+  (define __init__
+    (lam (self name (= mode 'r') (= closefd #t) (= opener None))
+         (if (pair? name)
+             (set self '_port (car name))
+             (set self '_port
+                  (open- (path-it name)
+                         #:mode      mode
+                         #:closefd   closefd
+                         #:opener    opener)))
+         (set self 'mode mode)
+         (set self 'name (cdr name)))))
+
+
+(define-python-class BytesIO (BufferedIOBase)
+  (define __init__
+    (lambda* (self #:optional (initial_bytes None))
+      (if (eq? initial_bytes None)
+          (call-with-values open-bytevector-output-port
+            (lambda (port get-bytevector)
+              (set self '_port port)
+              (set self '_gtbv get-bytevector)))
+          (set self '_port
+               (open-bytevector-input-port initial_bytes)))))
+
+  (define getvalue
+    (lambda (self)
+      (check self
+             (bytes ((ref self '_gtbv)))))))
+
+(define-python-class BufferedReader (BufferedIOBase)
+  (define __init__
+    (lambda* (self raw #:optional (buffer_size DEFAULT_BUFFER_SIZE))
+      (let ((port (ref raw '_port)))
+        (case buffer_size
+          ((0)
+           (setvbuf port 'none))
+          ((1)
+           (setvbuf port 'line))
+          (else
+           (setvbuf port 'block buffer_size))))
+      (set self 'raw raw)))
+
+  (define peek
+    (lambda (self)
+      (raise UnsupportedOperation peek))))
+
+(define-python-class BufferedWriter (BufferedIOBase)
+  (define __init__
+    (lambda* (self raw #:optional (buffer_size DEFAULT_BUFFER_SIZE))
+      (let ((port (ref raw '_port)))
+        (case buffer_size
+          ((0)
+           (setvbuf port 'none))
+          ((1)
+           (setvbuf port 'line))
+          (else
+           (setvbuf port 'block buffer_size))))
+      (set self 'raw raw))))
+
+(define-python-class BufferedRandom (BufferedIOBase)
+  (define __init__
+    (lambda* (self raw #:optional (buffer_size DEFAULT_BUFFER_SIZE))
+      (let ((port (ref raw '_port)))
+        (case buffer_size
+          ((0)
+           (setvbuf port 'none))
+          ((1)
+           (setvbuf port 'line))
+          (else
+           (setvbuf port 'block buffer_size))))
+      (set self 'raw raw)))
+  
+  (define peek
+    (lambda (self)
+      (raise UnsupportedOperation peek))))
+
+(define-python-class TextIOBase (IOBase)
+  (define __next__
+    (lambda (self)
+      (read self 1)))
+  
+  (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))))))
+
+  (define readline
+    (lam (self (= size -1))
+         (check self
+           (let ((port (ref self '_port)))
+             (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))))))
+
+(define (get-port x)
+  (aif it (ref x '_port)
+       it
+       (aif it (ref x 'raw)
+            (get-port it)
+            (raise (ValueError "No port associated to IO wrapper")))))
+
+(define-python-class TextIOWrapper (TextIOBase)
+  (define __init__
+    (lam (self buffer
+               (= encoding       None)
+               (= errors         None)
+               (= newline        None)
+               (= line_buffering #f)
+               (= write_through  #f))
+         (set self 'raw buffer)
+         (let* ((port     (get-port buffer))
+                (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
+           (set self 'encoding encoding)
+           (set-port-encoding! port encoding)
+
+           ;; buffering
+           (if line_buffering
+               (setvbuf port 'line))
+           
+           (set self 'line_buffering line_buffering)
+           
+           ;; errors
+           (set self 'error errors)        
+           (cond
+            ((equal? errors "strict")
+             (set-port-conversion-strategy! port 'error))
+            ((equal? errors "replace")
+             (set-port-conversion-strategy! port 'substitute))
+            ((equal? errors "basckslashreplace")
+             (set-port-conversion-strategy! port 'escape))
+            (else
+             (set-port-conversion-strategy! port 'escape)))
+
+           ;; 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-string))
+             (set self '_port (open-input-string initial_value)))))
+
+  (define getvalue
+    (lambda (self)
+      (check self
+        (get-output-string (ref self '_port))))))
diff --git a/modules/language/python/module/os.scm b/modules/language/python/module/os.scm
index 863287d..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)))
@@ -694,9 +693,10 @@
         (rm (fcntl3 fd F_GETFL (logand o (lognot O_NONBLOCK)))))))
 
 (define (get_blocking fd)
-  (if (= (logand O_NONBLOCK (rm (fcntl2 fd F_GETFL))) 0)
-      #f
-      #t))
+  (let ((fd (if (port? fd) (port->fdes fd) fd)))
+    (if (= (logand O_NONBLOCK (rm (fcntl2 fd F_GETFL))) 0)
+        #f
+        #t)))
 
 (define (readv fd buffers) (error "not implemented"))
 
@@ -1710,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/module/python.scm b/modules/language/python/module/python.scm
index f433360..3398dbb 100644
--- a/modules/language/python/module/python.scm
+++ b/modules/language/python/module/python.scm
@@ -8,6 +8,7 @@
 		     object-method))
   #:use-module (language python exceptions       )
   #:use-module ((language python module string   ) #:select ())
+  #:use-module ((language python module io       ) #:select (open))
   #:use-module (language python def              )
   #:use-module (language python for              )
   #:use-module (language python try              )
@@ -38,13 +39,13 @@
                              SyntaxError bool
                              len dir next dict None property range
                              tuple bytes bytearray eval locals globals
-                             compile exec type object
+                             compile exec type object open
                              )
   
   #:export (print repr complex float int str
                   set all any bin callable reversed
                   chr classmethod staticmethod objectmethod
-                  divmod enumerate filter open
+                  divmod enumerate filter
                   getattr hasattr setattr hex isinstance issubclass
                   iter map sum id input oct ord pow super
                   sorted zip
@@ -52,11 +53,6 @@
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
-(define (path-it path)
-  (aif it (ref path '__fspath__)
-       (it)
-       path))
-
 (define print
   (case-lambda
     (()  ((@ (guile) format) #t "~%"))
@@ -322,52 +318,6 @@
                   (yield (reverse r))
                   (lp))))))))))
 
-(define DEFAULT_BUFFER_SIZE 4096)
-(def (open path
-           (= mode      "r")
-           (= buffering -1 )
-           (= encoding   None)
-           (= errors     None)
-           (= newline    None)
-           (= closefd    #t)
-           (= opener     None))
-     
-     (define modelist (string->list mode))
-     (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)))))
-
-       (case buffering
-         ((-1)
-          (setvbuf port 'block DEFAULT_BUFFER_SIZE))
-         ((0)
-          (setvbuf port 'none))
-         ((1)
-          (setvbuf port 'line))
-         (else
-          (setvbuf port 'block buffering)))
-
-       port))
-
-
 (define-python-class ClassMethod  ())
 (define-python-class StaticMethod ())
 (define-python-class Funcobj      ())
diff --git a/modules/language/python/module/subprocess.py b/modules/language/python/module/subprocess.py
index 0d8ee7e..d4dd259 100644
--- a/modules/language/python/module/subprocess.py
+++ b/modules/language/python/module/subprocess.py
@@ -86,7 +86,6 @@ class CalledProcessError(SubprocessError):
         # .stdout is a transparent alias for .output
         self.output = value
 
-
 class TimeoutExpired(SubprocessError):
     """This exception is raised when the timeout expires while waiting for a
     child process.
@@ -133,12 +132,12 @@ else:
         import threading
     except ImportError:
         import dummy_threading as threading
-
+    pk(1)
     # When select or poll has indicated that the file is writable,
     # we can write up to _PIPE_BUF bytes without risk of blocking.
     # POSIX defines PIPE_BUF as >= 512.
     _PIPE_BUF = getattr(select, 'PIPE_BUF', 512)
-
+    pk(2)
     # poll/select have the advantage of not requiring any extra file
     # descriptor, contrarily to epoll/kqueue (also, they require a single
     # syscall).