io module tested and debugged
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Thu, 12 Apr 2018 19:33:56 +0000 (21:33 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Thu, 12 Apr 2018 19:33:56 +0000 (21:33 +0200)
modules/language/python/bool.scm
modules/language/python/bytes.scm
modules/language/python/compile.scm
modules/language/python/module/io.scm
modules/language/python/string.scm
modules/oop/pf-objects.scm

index 3eb6bc865fa8da474b5619fdd87c90a004650ca2..461dc263fb79429280cd3213a4313db02e309924 100644 (file)
@@ -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)))
index 2acb9e5c577ea02058db898276eaac0620a8138e..e222c3e6c7911472977ebffde286952380b897b3 100644 (file)
                       <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)))
index fe3533b43920e8ff52556a22da41e2fda8e435cc..170cb11ee82e562b68a93445ed60724e41408371 100644 (file)
              ,(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!)
              ,(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)))
       ((_ 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)
index 6bd71937e15fba95dcc2600d8978b08f21fbc7dc..dceced876cd3119fa03281b47323c43fbc6afd91 100644 (file)
 (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")
 
      (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))
            (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
 
 
   (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)
             
   (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)
               (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__
 (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)
 
   (define getvalue
     (lambda (self)
-      (check self
-        (get-output-string (ref self '_port))))))
+      (check (self port)
+        (get-output-string port)))))
index 084d933b14f59b9890ecbc4b520dd5f682dc2217..f94580cdebb7017f62408918bab8aef9264ffad1 100644 (file)
 (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)
index 2e9f9d284d44d3cc43a9fe87ed9dee5e592a50e0..d42865f2d7dc283172d6c302f3fa0b01718e0461 100644 (file)
@@ -90,9 +90,15 @@ explicitly tell it to not update etc.
 
 (define (mk-getter-object f)
   (lambda (obj cls)
-    (if (or (pyclass? obj) (pytype? obj))
+    (if (pytype? obj)
        (lambda x (apply f x))
-       (lambda x (apply f obj x)))))
+        (if (pyclass? obj)
+            (if (pytype? cls)                
+                (lambda x (apply f obj x))
+                (lambda x (apply f x)))
+            (if (pyclass? cls)
+                (lambda x (apply f obj x))
+                (lambda x (apply f x)))))))
 
 (define (mk-getter-class f)                                   
   (lambda (obj cls)
@@ -173,6 +179,7 @@ explicitly tell it to not update etc.
        (hashforeach
         (lambda (k v) k (set class k v))
         dict))
+    
     (let((mro (ref class '__mro__)))
       (if (pair? mro)
          (let ((p (car mro)))
@@ -308,7 +315,7 @@ explicitly tell it to not update etc.
   (kif r (find-in-class klass key fail)
        r
        (aif parents (find-in-class klass '__mro__ #f)
-           (let lp ((parents parents))
+           (let lp ((parents (cdr parents)))
              (if (pair? parents)
                  (kif r (find-in-class (car parents) key fail)
                       r
@@ -320,7 +327,7 @@ explicitly tell it to not update etc.
   (let ()
     (define (end) (if (pair? l) (car l) #f))    
     (fluid-set! *location* klass)
-    (kif it (find-in-class-and-parents klass key fail)
+    (kif it (find-in-class klass key fail)
         it
         (aif klass (find-in-class klass '__class__ #f)
              (begin
@@ -1154,10 +1161,18 @@ explicitly tell it to not update etc.
            (find-tree o (nxt tree))))
       #f))
 
+(define (linearize x)
+  (cond
+   ((null? x) x)
+   ((pair? x)
+    (append (linearize (car x)) (linearize (cdr x))))
+   (else (list x))))
+
 (define (get-mro parents)
-  (if (null? parents)
-      parents
-      (get-mro0 parents)))
+  (linearize
+   (if (null? parents)
+       parents
+       (get-mro0 (map  class-to-tree parents)))))
 
 (define (get-mro0 parents)  
   (define tree (mk-tree parents))
@@ -1221,3 +1236,10 @@ explicitly tell it to not update etc.
 
 (name-object type)
 (name-object object)
+
+(define-method (py-class (o <p>))
+  (aif it (ref o '__class__)
+       it
+       (next-method)))
+
+