io compiles
[software/python-on-guile.git] / modules / language / python / module / io.scm
1 (define-module (language python module io)
2 #:use-module (oop pf-objects)
3 #:use-module (system foreign)
4 #:use-module (ice-9 binary-ports)
5 #:use-module (ice-9 textual-ports)
6 #:use-module (ice-9 rdelim)
7
8 #:use-module (language python exceptions)
9 #:use-module (language python def)
10 #:use-module (language python try)
11 #:use-module (language python string)
12 #:use-module (language python list)
13 #:use-module (language python bytes)
14 #:use-module (language python bool)
15
16 #:use-module (language python module errno)
17 #:re-export (BlockingIOError)
18 #:replace (open)
19 #:export (UnsupportedOperation scm-port DEFAULT_BUFFER_SIZE
20 IOBase RawIOBase BufferedIOBase FileIO
21 BytesIO BufferedReader BufferedWriter
22 BufferedRandom TextIOBase TextIOWrapper
23 StringIO))
24
25 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
26
27 (define-syntax-rule (ca code)
28 (catch #t
29 (lambda () code)
30 (lambda x (raise error x))))
31
32 (define-syntax-rule (rm code)
33 (let ((r (ca code)))
34 (if (< r 0)
35 (raise error (errno) ((@ (guile) strerror) (errno)))
36 r)))
37
38 (define F_GETFL 3)
39
40 (define fcntl2 (pointer->procedure int
41 (dynamic-func "fcntl" (dynamic-link))
42 (list int int)))
43 (define fcntl3 (pointer->procedure int
44 (dynamic-func "fcntl" (dynamic-link))
45 (list int int int)))
46
47 (define (get_blocking fd)
48 (let ((fd (if (port? fd) (port->fdes fd) fd)))
49 (if (= (logand O_NONBLOCK (rm (fcntl2 fd F_GETFL))) 0)
50 #f
51 #t)))
52
53 (define (scm-port x)
54 (if (port? x)
55 x
56 (aif it (ref x '_port)
57 it
58 (aif it (ref x 'raw)
59 (scm-port it)
60 (raise ValueError "no port in scm-port")))))
61
62 (define-python-class UnsupportedOperation (OSError ValueError))
63
64 (define DEFAULT_BUFFER_SIZE 4096)
65
66 (define (path-it path)
67 (aif it (ref path '__fspath__)
68 (it)
69 path))
70
71 (def (open- path
72 (= mode "r")
73 (= buffering -1 )
74 (= encoding None)
75 (= errors None)
76 (= newline None)
77 (= closefd #t)
78 (= opener None))
79
80 (define modelist (string->list mode))
81 (define path* (path-it path))
82 (define (clean ch l)
83 (filter (lambda (c) (not (eq? ch c))) l))
84
85 (let* ((port (if (number? path)
86 (begin
87 (if (member #\a modelist)
88 (seek path* 0 SEEK_END))
89 (if (member #\x modelist)
90 (error "cannot use mode 'x' for fd input"))
91 (cond
92 ((member #\r modelist)
93 (fdes->inport path*))
94 ((member #\w modelist)
95 (fdes->outport path*))))
96 (begin
97 (if (member #\x modelist)
98 (if (file-exists? path*)
99 (raise OSError "mode='x' and file exists")
100 (set mode (list->string
101 (clean #\x modelist)))))
102 ((@ (guile) open-file) path* mode))))
103
104 (errors (if (bool errors)
105 (scm-str errors)
106 (let ((s (port-conversion-strategy port)))
107 (cond
108 ((eq? s 'error) "strict")
109 ((eq? s 'substitute) "replace")
110 ((eq? s 'escape) "basckslashreplace")))))
111
112 (encoding (if (eq? encoding None)
113 (port-encoding port)
114 encoding)))
115
116
117 ;; encoding
118 (set-port-encoding! port encoding)
119
120 (case buffering
121 ((-1)
122 (setvbuf port 'block DEFAULT_BUFFER_SIZE))
123 ((0)
124 (setvbuf port 'none))
125 ((1)
126 (setvbuf port 'line))
127 (else
128 (setvbuf port 'block buffering)))
129
130 (cond
131 ((equal? errors "strict")
132 (set-port-conversion-strategy! port 'error))
133 ((equal? errors "replace")
134 (set-port-conversion-strategy! port 'substitute))
135 ((equal? errors "basckslashreplace")
136 (set-port-conversion-strategy! port 'escape))
137 (else
138 (set-port-conversion-strategy! port 'escape)))
139
140 port))
141
142
143 (def (open path
144 (= mode "r")
145 (= buffering -1 )
146 (= encoding None)
147 (= errors None)
148 (= newline None)
149 (= closefd #t)
150 (= opener None))
151
152 (let ((F
153 (FileIO (cons
154 (open path mode buffering encoding errors
155 newline closefd opener)
156 path)
157 mode)))
158 (if (member #\b (string->list mode))
159 F
160 (TextIOWrapper F encoding errors))))
161
162
163 (define-syntax-rule (check self . l)
164 (aif it (ref self 'raw)
165 (let ((self it))
166 (if (ref self 'closed)
167 (raise ValueError "IO operation on closed port"))
168 . l)
169 (begin
170 (if (ref self 'closed)
171 (raise ValueError "IO operation on closed port"))
172 . l)))
173
174 ;; ABC
175
176
177 (define-python-class IOBase ()
178 (define __init__
179 (lambda (self port)
180 (set self '_port port)
181 (set self 'closed (port-closed? port))))
182
183 (define __getport__
184 (lambda (self)
185 (check self
186 (ref self '_port))))
187
188 (define close
189 (lambda (self)
190 (check self
191 (close-port (ref self '_port))
192 (set self 'closed #t))))
193
194 (define __enter__
195 (lambda (self)
196 (check self)
197 self))
198
199 (define __exit__
200 (lambda (self . x)
201 (check self
202 ((ref self 'close)))))
203
204 (define flush
205 (lambda (self)
206 (check self
207 (if ((ref self 'readable)) (drain-input (ref self '_port)))
208 (if ((ref self 'writeable)) (force-output (ref self '_port))))))
209
210 (define isatty
211 (lambda (self)
212 (check self
213 (isatty? (ref self '_port)))))
214
215 (define __iter__
216 (lambda (self)
217 (check self)
218 self))
219
220 (define __next__
221 (lambda (self)
222 (check self
223 (raise StopIteration))))
224
225 (define readable
226 (lambda (self)
227 (check self
228 (output-port? (ref self '_port)))))
229
230 (define readline
231 (lam (self (= size -1))
232 (check self
233 (raise UnsupportedOperation))))
234
235 (define readlines
236 (lam (self (= hint -1))
237 (check self
238 (raise UnsupportedOperation))))
239
240 (define seekable
241 (lambda (self)
242 (check self
243 (catch #t
244 (lambda () (seek (ref self '_port) 0 SEEK_CUR) #t)
245 (lambda x #f)))))
246
247 (define seek
248 (lambda* (self offset #:optional (whence SEEK_SET))
249 (check self
250 (if (not ((ref self seekable)))
251 (raise (ValueError "Not seekable")))
252 (seek (ref self '_port) offset whence))))
253
254
255 (define tell
256 (lambda (self)
257 (check self
258 (ftell (ref self '_port)))))
259
260 (define truncate
261 (lam (self (= size None))
262 (check self
263 (if (eq? size None)
264 (truncate-file (ref self '_port))
265 (truncate-file (ref self '_port) size)))))
266
267
268 (define writeable
269 (lambda (self)
270 (check self
271 (input-port? (ref self '_port)))))
272
273 (define writelines
274 (lambda (self lines)
275 (check self
276 (raise UnsupportedOperation))))
277
278 (define __del__
279 (lambda (self)
280 ((ref self 'close)))))
281
282
283
284
285
286
287 (define-python-class RawIOBase (IOBase)
288 (define __next__
289 (lambda (self)
290 (read self 1)))
291
292 (define read
293 (lam (self (= size -1))
294 (check self
295 (bytes
296 (if (< size 0)
297 ((ref self 'readall))
298 (get-bytevector-n (ref self '_port) size))))))
299
300
301 (define readall
302 (lambda (self)
303 (check self
304 (bytes
305 (get-bytevector-all (ref self '_port))))))
306
307 (define readinto
308 (lambda (self b)
309 (check self
310 (let* ((n (len b))
311 (b (scm-bytevector b))
312 (m (get-bytevector-n! (ref self '_port) b 0 n)))
313 (if (eq? m eof-object)
314 (if (get_blocking (ref self '_port))
315 0
316 None)
317 m)))))
318
319 (define write
320 (lambda (self b)
321 (check self
322 (let ((n (len b))
323 (b (scm-bytevector b)))
324 (put-bytevector (ref self '_port) b 0 n)
325 n)))))
326
327
328 (define-python-class BufferedIOBase (RawIOBase)
329 (define detach
330 (lambda (self)
331 (check self
332 (raise UnsupportedOperation "detach"))))
333
334 (define read1
335 (lambda* (self #:optional (size -1))
336 (check self
337 ((ref self 'read) size))))
338
339 (define readinto1
340 (lambda (self b)
341 (check self
342 ((ref self 'readinto) b)))))
343
344 (define-python-class FileIO (RawIOBase)
345 (define __init__
346 (lam (self name (= mode 'r') (= closefd #t) (= opener None))
347 (if (pair? name)
348 (set self '_port (car name))
349 (set self '_port
350 (open- (path-it name)
351 #:mode mode
352 #:closefd closefd
353 #:opener opener)))
354 (set self 'mode mode)
355 (set self 'name (cdr name)))))
356
357
358 (define-python-class BytesIO (BufferedIOBase)
359 (define __init__
360 (lambda* (self #:optional (initial_bytes None))
361 (if (eq? initial_bytes None)
362 (call-with-values open-bytevector-output-port
363 (lambda (port get-bytevector)
364 (set self '_port port)
365 (set self '_gtbv get-bytevector)))
366 (set self '_port
367 (open-bytevector-input-port initial_bytes)))))
368
369 (define getvalue
370 (lambda (self)
371 (check self
372 (bytes ((ref self '_gtbv)))))))
373
374 (define-python-class BufferedReader (BufferedIOBase)
375 (define __init__
376 (lambda* (self raw #:optional (buffer_size DEFAULT_BUFFER_SIZE))
377 (let ((port (ref raw '_port)))
378 (case buffer_size
379 ((0)
380 (setvbuf port 'none))
381 ((1)
382 (setvbuf port 'line))
383 (else
384 (setvbuf port 'block buffer_size))))
385 (set self 'raw raw)))
386
387 (define peek
388 (lambda (self)
389 (raise UnsupportedOperation peek))))
390
391 (define-python-class BufferedWriter (BufferedIOBase)
392 (define __init__
393 (lambda* (self raw #:optional (buffer_size DEFAULT_BUFFER_SIZE))
394 (let ((port (ref raw '_port)))
395 (case buffer_size
396 ((0)
397 (setvbuf port 'none))
398 ((1)
399 (setvbuf port 'line))
400 (else
401 (setvbuf port 'block buffer_size))))
402 (set self 'raw raw))))
403
404 (define-python-class BufferedRandom (BufferedIOBase)
405 (define __init__
406 (lambda* (self raw #:optional (buffer_size DEFAULT_BUFFER_SIZE))
407 (let ((port (ref raw '_port)))
408 (case buffer_size
409 ((0)
410 (setvbuf port 'none))
411 ((1)
412 (setvbuf port 'line))
413 (else
414 (setvbuf port 'block buffer_size))))
415 (set self 'raw raw)))
416
417 (define peek
418 (lambda (self)
419 (raise UnsupportedOperation peek))))
420
421 (define-python-class TextIOBase (IOBase)
422 (define __next__
423 (lambda (self)
424 (read self 1)))
425
426 (define read
427 (lam (self (= size -1))
428 (check self
429 (let ((port (ref self '_port)))
430 (if (< size 0)
431 (get-string-all port)
432 (get-string-n port size))))))
433
434 (define readline
435 (lam (self (= size -1))
436 (check self
437 (let ((port (ref self '_port)))
438 (read-line port 'concat)))))
439
440 (define write
441 (lambda (self s)
442 (check self
443 (let ((port (ref self '_port)))
444 (put-string port (scm-str s) 0 (len s))
445 (len s))))))
446
447 (define (get-port x)
448 (aif it (ref x '_port)
449 it
450 (aif it (ref x 'raw)
451 (get-port it)
452 (raise (ValueError "No port associated to IO wrapper")))))
453
454 (define-python-class TextIOWrapper (TextIOBase)
455 (define __init__
456 (lam (self buffer
457 (= encoding None)
458 (= errors None)
459 (= newline None)
460 (= line_buffering #f)
461 (= write_through #f))
462 (set self 'raw buffer)
463 (let* ((port (get-port buffer))
464 (errors (if (bool errors)
465 (scm-str errors)
466 (let ((s (port-conversion-strategy port)))
467 (cond
468 ((eq? s 'error) "strict")
469 ((eq? s 'substitute) "replace")
470 ((eq? s 'escape) "basckslashreplace")))))
471 (encoding (if (eq? encoding None)
472 (port-encoding port)
473 encoding)))
474 ;; encoding
475 (set self 'encoding encoding)
476 (set-port-encoding! port encoding)
477
478 ;; buffering
479 (if line_buffering
480 (setvbuf port 'line))
481
482 (set self 'line_buffering line_buffering)
483
484 ;; errors
485 (set self 'error errors)
486 (cond
487 ((equal? errors "strict")
488 (set-port-conversion-strategy! port 'error))
489 ((equal? errors "replace")
490 (set-port-conversion-strategy! port 'substitute))
491 ((equal? errors "basckslashreplace")
492 (set-port-conversion-strategy! port 'escape))
493 (else
494 (set-port-conversion-strategy! port 'escape)))
495
496 ;; write trough
497 (set self 'write_through write_through)))))
498
499 (define-python-class StringIO (TextIOBase)
500 (define __init__
501 (lam (self (= initial_value "") (= newline "\n"))
502 (set self 'newline newline)
503 (if (equal? initial_value "")
504 (set self '_port (open-output-string))
505 (set self '_port (open-input-string initial_value)))))
506
507 (define getvalue
508 (lambda (self)
509 (check self
510 (get-output-string (ref self '_port))))))