diff options
Diffstat (limited to 'modules')
-rw-r--r-- | modules/language/python/bool.scm | 3 | ||||
-rw-r--r-- | modules/language/python/bytes.scm | 5 | ||||
-rw-r--r-- | modules/language/python/compile.scm | 11 | ||||
-rw-r--r-- | modules/language/python/module/io.scm | 194 | ||||
-rw-r--r-- | modules/language/python/string.scm | 8 | ||||
-rw-r--r-- | modules/oop/pf-objects.scm | 36 |
6 files changed, 149 insertions, 108 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) diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm index 2e9f9d2..d42865f 100644 --- a/modules/oop/pf-objects.scm +++ b/modules/oop/pf-objects.scm @@ -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))) + + |