diff options
Diffstat (limited to 'modules/language/python/module/io.scm')
-rw-r--r-- | modules/language/python/module/io.scm | 510 |
1 files changed, 510 insertions, 0 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)))))) |