remove warnings, reordering
[software/python-on-guile.git] / modules / language / python / module / _python.scm
1 (define-module (language python module _python)
2 #:use-module (oop goops)
3 #:use-module (ice-9 match)
4 #:use-module (ice-9 readline)
5 #:use-module ((oop pf-objects) #:select
6 (<p> <property> class-method static-method ref (set . pf-set)
7 py-super-mac type object pylist-ref define-python-class
8 object-method py-dict))
9 #:use-module (language python exceptions )
10 #:use-module ((language python module string ) #:select ())
11 #:use-module ((language python module io ) #:select (open))
12 #:use-module (language python def )
13 #:use-module (language python for )
14 #:use-module (language python try )
15 #:use-module (language python yield )
16 #:use-module (language python module )
17 #:use-module (language python list )
18 #:use-module (language python dict )
19 #:use-module (language python set )
20 #:use-module (language python string )
21 #:use-module (language python bytes )
22 #:use-module (language python set )
23 #:use-module (language python number )
24 #:use-module (language python dir )
25 #:use-module (language python hash )
26 #:use-module (language python property )
27 #:use-module (language python range )
28 #:use-module (language python tuple )
29 #:use-module (language python eval )
30 #:use-module (language python bool )
31
32 #:replace (list abs min max hash round format map filter)
33
34 #:re-export (StopIteration GeneratorExit RuntimeError
35 Exception ValueError TypeError
36 IndexError KeyError AttributeError
37 send sendException next
38 GeneratorExit sendClose RuntimeError
39 SyntaxError bool compile
40 len dir next dict None property range
41 tuple bytes bytearray eval locals globals
42 exec type object open __import__ frozenset
43 Warning BytesWarning DeprecationWarning
44 py-list
45 )
46
47 #:export (print repr complex float int str
48 set all any bin callable reversed
49 chr classmethod staticmethod objectmethod
50 divmod enumerate delattr
51 getattr hasattr setattr delattr hex isinstance issubclass
52 iter sum id input oct ord pow super
53 sorted zip vars slice))
54
55 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
56
57 (define (vars x)
58 (for ((k v : x)) ((l '()))
59 (cons (cons k v) l)
60 #:final
61 (dict l)))
62
63 (define (repr x) ((@ (guile) format) #f "~a" x))
64 (define abs py-abs)
65 (define str pystring)
66 (define complex py-complex)
67 (define float py-float)
68 (define int py-int)
69 (define round py-round)
70 (define set py-set)
71 (define all py-all)
72 (define any py-any)
73 (define bin py-bin)
74 (define divmod py-divmod)
75 (define format py-format)
76 (define hash py-hash)
77 (define hex py-hex)
78
79 (define-method (callable x ) #f)
80 (define-method (callable (x <procedure> )) #t)
81 (define-method (callable (x <procedure-class> )) #t)
82 (define-method (callable (x <applicable> )) #t)
83 (define-method (callable (x <primitive-generic>)) #t)
84 (define-method (callable (x <p>))
85 (ref x '__call__))
86
87 (define chr integer->char)
88
89 (define objectmethod object-method)
90 (define classmethod class-method)
91 (define staticmethod static-method)
92
93 (def (enumerate l (= start 0))
94 ((make-generator ()
95 (lambda (yield)
96 (for ((x : l)) ((i start))
97 (yield i x)
98 (+ i 1))))))
99
100 (define (filter f l)
101 ((make-generator ()
102 (lambda (yield)
103 (for ((x : l)) ()
104 (if (f x)
105 (yield x)))))))
106
107 (define miss ((@ (guile) list) 'miss))
108
109 (define* (getattr a b #:optional (k miss))
110 (let ((r (ref a (if (string? b) (string->symbol b) b) k)))
111 (if (eq? r miss)
112 (raise AttributeError "object/class ~a is missing attribute ~a" a b)
113 r)))
114
115 (define (setattr a k v)
116 (pf-set a (if (string? k) (string->symbol k) k) v))
117
118 (define (hasattr a b)
119 (let ((r (ref a (if (string? b) (string->symbol b) b) miss)))
120 (not (eq? r miss))))
121
122 (define-method (issubclass x y) #f)
123 (define-method (issubclass (sub <p>) (cls <p>))
124 (aif it (ref cls '__subclasscheck__)
125 (it sub)
126 (if (eq? sub cls)
127 #t
128 (if (memq cls (ref sub '__mro__))
129 #t
130 #f))))
131
132 (define-method (isinstance x y)
133 (cond
134 ((null? y)
135 #f)
136 ((pair? y)
137 (or (isinstance x (car y))
138 (isinstance x (cdr y))))
139 (else
140 (catch #t
141 (lambda () (is-a? x y))
142 (lambda x #f)))))
143
144 (define-method (isinstance (i <integer>) (y <p>))
145 (cond
146 ((ref y '__instancecheck__) =>
147 (lambda (it)
148 (it i)))
149 (else
150 (next-method))))
151
152 (define-method (isinstance (i <integer>) y)
153 (if (issubclass y int)
154 #t
155 (if (pair? y)
156 (or (isinstance i (car y))
157 (isinstance i (cdr y)))
158 (is-a? i y))))
159
160 (define-method (isinstance (i <real>) (y <p>))
161 (cond
162 ((ref y '__instancecheck__) =>
163 (lambda (it)
164 (it i)))
165 (else
166 (next-method))))
167
168 (define-method (isinstance (i <real>) y)
169 (if (issubclass y float)
170 #t
171 (if (pair? y)
172 (or (isinstance i (car y))
173 (isinstance i (cdr y)))
174 (is-a? i y))))
175
176 (define-method (isinstance (i <pair>) (y <p>))
177 (cond
178 ((ref y '__instancecheck__) =>
179 (lambda (it)
180 (it i)))
181 (else
182 (next-method))))
183
184 (define-method (isinstance (i <pair>) y)
185 (if (issubclass y tuple)
186 #t
187 (if (pair? y)
188 (or (isinstance i (car y))
189 (isinstance i (cdr y)))
190 (is-a? i y))))
191
192 (define-method (isinstance (i <string>) (y <p>))
193 (cond
194 ((ref y '__instancecheck__) =>
195 (lambda (it)
196 (it i)))
197 (else
198 (next-method))))
199
200 (define-method (isinstance (i <string>) y)
201 (if (issubclass y str)
202 #t
203 (if (pair? y)
204 (or (isinstance i (car y))
205 (isinstance i (cdr y)))
206 (is-a? i y))))
207
208 (define-method (isinstance (i <bytevector>) (y <p>))
209 (cond
210 ((ref y '__instancecheck__) =>
211 (lambda (it)
212 (it i)))
213 (else
214 (next-method))))
215
216 (define-method (isinstance (i <bytevector>) y)
217 (if (issubclass y bytes)
218 #t
219 (if (pair? y)
220 (or (isinstance i (car y))
221 (isinstance i (cdr y)))
222 (is-a? i y))))
223
224
225 (define-method (isinstance o (cl <p>))
226 (cond
227 ((eq? cl py-list)
228 (is-a? o <py-list>))
229 (else #f)))
230
231 (define-method (isinstance (o <p>) (cl <p>))
232 (cond
233 ((ref cl '__instancecheck__) =>
234 (lambda (it)
235 (it o)))
236 ((pair? cl)
237 (or
238 (isinstance o (car cl))
239 (isinstance o (cdr cl))))
240 (else
241 (is-a? o (ref cl '__goops__)))))
242
243
244
245 (define iter
246 (case-lambda
247 ((o) (aif it (wrap-in o)
248 it
249 (aif get (ref o '__getitem__)
250 (make-generator iter
251 (lambda (yield)
252 (for () ((i 0))
253 (yield (get i))
254 (+ i 1))))
255 (raise TypeError "not iterable" o))))
256 ((f sent)
257 (make-generator iter
258 (lambda (yield)
259 (for () ()
260 (let ((r (f)))
261 (if (equal? r sent)
262 (break)
263 (yield r)))))))))
264
265
266
267 (define-syntax map
268 (lambda (x)
269 (syntax-case x ()
270 ((map f a ...)
271 (with-syntax (((x ...) (generate-temporaries #'(a ...))))
272 #'(for ((x : a) ...) ((l '()))
273 (cons (f x ...) l)
274 #:final (py-list (reverse l))))))))
275
276 (define* (sum i #:optional (start 0))
277 (for ((x : i)) ((s start))
278 (+ s x)
279 #:final
280 s))
281
282
283 (define (id x) (object-address x))
284
285 (define (input str)
286 ((@ (guile) format) #t str)
287 (readline))
288
289 (define (idx x) x)
290
291
292 (define-syntax min
293 (lambda (x)
294 (syntax-case x ()
295 ((_ x y)
296 #'(if (and (number? x) (number? y))
297 (if (<= x y) x y)
298 (py-min- x y)))
299
300 ((_ l ...)
301 #'(if (and (number? l) ...)
302 ((@ (guile) min) l ...)
303 (py-min- l ...)))
304 (_ #'py-min-))))
305
306 (def (py-min- (* l) (= key idx) (= default miss))
307 (let lp ((l l))
308 (match l
309 ((it)
310 (for ((x : it)) ((s miss) (b miss))
311 (if (eq? s miss)
312 (values (key x) x)
313 (let ((k (key x)))
314 (if (< k s)
315 (values k x)
316 (values s b))))
317 #:final
318 (if (eq? b miss)
319 (if (eq? default miss)
320 (raise ValueError
321 "min does not work for zero length list")
322 default)
323 b)))
324 (_ (lp ((@ (guile) list) l))))))
325
326 (define-syntax max
327 (lambda (x)
328 (syntax-case x ()
329 ((_ x y)
330 #'(if (and (number? x) (number? y))
331 (if (>= x y) x y)
332 (py-max- x y)))
333 ((_ l ...)
334 #'(if (and (number? l) ...)
335 ((@ (guile) max) l ...)
336 (py-max- l ...)))
337 (_ #'py-max-))))
338
339 (def (py-max- (* l) (= key idx) (= default miss))
340 (let lp ((l l))
341 (match l
342 ((it)
343 (for ((x : it)) ((s miss) (b miss))
344 (if (eq? s miss)
345 (values (key x) x)
346 (let ((k (key x)))
347 (if (> k s)
348 (values k x)
349 (values s b))))
350 #:final
351 (if (eq? b miss)
352 (if (eq? default miss)
353 (raise ValueError
354 "min does not work for zero length list")
355 default)
356 b)))
357 (_ (lp ((@ (guile) list) l))))))
358
359 (define (oct x) (+ "0o" (number->string (py-index x) 8)))
360 (define (ord x) (char->integer (string-ref (pylist-ref x 0) 0)))
361
362 (define pow
363 (case-lambda
364 ((x y)
365 (expt x y))
366 ((x y z)
367 (if (and (number? y) (integer? y) (number? x) (integer? x) (number? z) (integer? z))
368 (modulo-expt x y z)
369 (modulo (expt x y) z)))))
370
371 (define-syntax-rule (super . l) (py-super-mac . l))
372
373 (define list pylist)
374 (define reversed py-reversed)
375 (define (key-id x) x)
376 (define* (sorted it #:key (key key-id) (reverse #f))
377 (define l (to-pylist '()))
378 (for ((x : it)) () (pylist-append! l x))
379 (pylist-sort! l #:key key #:reverse reverse)
380 l)
381
382 (define (zip . l)
383 (let ((l ((@ (guile) map) wrap-in l)))
384 ((make-generator ()
385 (lambda (yield)
386 (let lp ()
387 (let lp2 ((l l) (r '()))
388 (if (pair? l)
389 (call-with-values (lambda () (next (car l)))
390 (lambda z
391 (lp2 (cdr l) (append (reverse z) r))))
392 (begin
393 (yield (reverse r))
394 (lp))))))))))
395
396 (define print
397 (lam ((= file #f) (* l))
398 (if file
399 (if (port? file)
400 #t
401 (set! file (ref file '_port)))
402 (set! file (current-output-port)))
403 (with-output-to-port file
404 (lambda ()
405 (apply
406 (case-lambda
407 (() ((@ (guile) display) "\n"))
408 ((x) ((@ (guile) display) x ) (print))
409 (l ((@ (guile) display) l ) (print)))
410 l)))))
411
412
413 (define-syntax-rule (mk cl cls ? tp)
414 (begin
415 (set! (@@ (oop pf-objects) cl) cls)
416 (set! (@@ (oop pf-objects) ? ) (lambda (x) (isinstance x tp)))))
417
418 (mk int-cls int int? int)
419 (mk tuple-cls tuple tuple? tuple)
420 (mk string-cls str str? str)
421 (mk bytes-cls bytes bytes? bytes)
422 (mk list-cls list list? list)
423 (mk float-cls float float? float)
424
425 (define-python-class slice ()
426 (define __init__
427 (lam (self x (= y None) (= z None))
428 (pf-set self 'x x)
429 (pf-set self 'y y)
430 (pf-set self 'z z))))
431
432
433 (set! (@@ (language python module) m?)
434 (lambda (x) (isinstance x (@@ (language python module) Module))))
435
436 (define (delattr o key) (rawdel o key))