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