From c653e3aca875247001fc49ac3c7b51f3b4771698 Mon Sep 17 00:00:00 2001 From: Stefan Israelsson Tampe Date: Wed, 11 Apr 2018 22:02:17 +0200 Subject: io compiles --- modules/language/python/bytes.scm | 8 +- modules/language/python/module/io.scm | 205 +++++++++++++++++++--------------- modules/language/python/module/os.scm | 10 +- modules/language/python/string.scm | 10 +- 4 files changed, 136 insertions(+), 97 deletions(-) (limited to 'modules/language') 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 ( pybytes-listing bytes bytearray bytes->bytevector - pybytesarray-listing)) + pybytesarray-listing scm-bytevector)) + +(define (scm-bytevector x) + (cond + ((bytevector? x) x) + ((is-a? x ) (slot-ref x 'bytes)) + ((is-a? x ) (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 ) + (slot-ref (pystring x) 'str)) + (else + #f))) + (define (scm-sym x) (if (symbol? x) x -- cgit v1.2.3