3398dbb589158ecef079e3619b7da496aa4e108e
[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 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 list )
17 #:use-module (language python dict )
18 #:use-module (language python set )
19 #:use-module (language python compile )
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)
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
40 len dir next dict None property range
41 tuple bytes bytearray eval locals globals
42 compile exec type object open
43 )
44
45 #:export (print repr complex float int str
46 set all any bin callable reversed
47 chr classmethod staticmethod objectmethod
48 divmod enumerate filter
49 getattr hasattr setattr hex isinstance issubclass
50 iter map sum id input oct ord pow super
51 sorted zip
52 ClassMethod StaticMethod Funcobj))
53
54 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
55
56 (define print
57 (case-lambda
58 (() ((@ (guile) format) #t "~%"))
59 ((x) ((@ (guile) format) #t "~s~%" x))
60 (l ((@ (guile) format) #t "~s~%" l))))
61
62 (define (repr x) ((@ (guile) format) #f "~a" x))
63 (define abs py-abs)
64 (define str pystring)
65 (define complex py-complex)
66 (define float py-float)
67 (define int py-int)
68 (define round py-round)
69 (define set py-set)
70 (define all py-all)
71 (define any py-any)
72 (define bin py-bin)
73 (define divmod py-divmod)
74 (define format py-format)
75 (define hash py-hash)
76 (define hex py-hex)
77
78 (define-method (callable x ) #f)
79 (define-method (callable (x <procedure> )) #t)
80 (define-method (callable (x <procedure-class> )) #t)
81 (define-method (callable (x <applicable> )) #t)
82 (define-method (callable (x <primitive-generic>)) #t)
83 (define-method (callable (x <p>))
84 (ref x '__call__))
85
86 (define chr integer->char)
87
88 (define objectmethod object-method)
89 (define classmethod class-method)
90 (define staticmethod static-method)
91
92 (define (enumerate l)
93 ((make-generator ()
94 (lambda (yield)
95 (for ((x : l)) ((i 0))
96 (yield i x)
97 (+ i 1))))))
98
99 (define (filter f l)
100 ((make-generator ()
101 (lambda (yield)
102 (for ((x : l)) ()
103 (if (f x)
104 (yield x)))))))
105
106 (define miss ((@ (guile) list) 'miss))
107
108 (define* (getattr a b #:optional (k miss))
109 (let ((r (ref a (if (string? b) (string->symbol b) b) k)))
110 (if (eq? r miss)
111 (raise AttributeError "object/class ~a is missing attribute ~a" a b)
112 r)))
113
114 (define (setattr a k v)
115 (set a (if (string? k) (string->symbol k) k) v))
116
117 (define (hasattr a b)
118 (let ((r (ref a (symbol->string b) miss)))
119 (not (eq? r miss))))
120
121 (define-method (issubclass x y) #f)
122 (define-method (issubclass (sub <p>) (cls <p>))
123 (aif it (ref cls '__subclasscheck__)
124 (it cls sub)
125 (if (eq? sub cls)
126 #t
127 (is-a? (ref sub '__goops__) (ref cls '__goops__)))))
128
129 (define-method (isinstance x y)
130 (if (null? y)
131 #f
132 (if (pair? y)
133 (or (isinstance x (car y))
134 (isinstance x (cdr y)))
135 (is-a? x y))))
136
137 (define-method (isinstance (i <integer>) y)
138 (if (issubclass y int)
139 #t
140 (if (pair? y)
141 (or (isinstance i (car y))
142 (isinstance i (cdr y)))
143 (is-a? i y))))
144
145 (define-method (isinstance (i <real>) y)
146 (if (issubclass y float)
147 #t
148 (if (pair? y)
149 (or (isinstance i (car y))
150 (isinstance i (cdr y)))
151 (is-a? i y))))
152
153 (define-method (isinstance (i <pair>) y)
154 (if (issubclass y tuple)
155 #t
156 (if (pair? y)
157 (or (isinstance i (car y))
158 (isinstance i (cdr y)))
159 (is-a? i y))))
160
161 (define-method (isinstance (i <string>) y)
162 (if (issubclass y str)
163 #t
164 (if (pair? y)
165 (or (isinstance i (car y))
166 (isinstance i (cdr y)))
167 (is-a? i y))))
168
169 (define-method (isinstance (i <bytevector>) y)
170 (if (issubclass y bytes)
171 #t
172 (if (pair? y)
173 (or (isinstance i (car y))
174 (isinstance i (cdr y)))
175 (is-a? i y))))
176
177
178 (define-method (isinstance o (cl <p>))
179 (cond
180 ((eq? cl py-list)
181 (is-a? o <py-list>))
182 (else #f)))
183
184 (define-method (isinstance (o <p>) (cl <p>))
185 (cond
186 ((ref cl '__instancecheck__) =>
187 (lambda (it)
188 (it o)))
189 ((pair? cl)
190 (or
191 (isinstance o (car cl))
192 (isinstance o (cdr cl))))
193 (else
194 (is-a? o (ref cl '__goops__)))))
195
196
197
198 (define iter
199 (case-lambda
200 ((o) (aif it (wrap-in o)
201 it
202 (aif get (ref o '__getitem__)
203 (make-generator iter
204 (lambda (yield)
205 (for () ((i 0))
206 (yield (get i))
207 (+ i 1))))
208 (raise TypeError "not iterable" o))))
209 ((f sent)
210 (make-generator iter
211 (lambda (yield)
212 (for () ()
213 (let ((r (f)))
214 (if (equal? r sent)
215 (break)
216 (yield r)))))))))
217
218
219
220 (define-syntax map
221 (lambda (x)
222 (syntax-case x ()
223 ((map f a ...)
224 (with-syntax (((x ...) (generate-temporaries #'(a ...))))
225 #'(for ((x : a) ...) ((l '()))
226 (cons (f x ...) l)
227 #:final (py-list (reverse l))))))))
228
229 (define* (sum i #:optional (start 0))
230 (for ((x : i)) ((s start))
231 (+ s x)
232 #:final
233 s))
234
235
236 (define (id x) (object-address x))
237
238 (define (input str)
239 ((@ (guile) format) #t str)
240 (readline))
241
242 (define (idx x) x)
243
244 (def (py-min (* l) (= key idx) (= default miss))
245 (let lp ((l l))
246 (match l
247 ((it)
248 (for ((x : it)) ((s miss) (b miss))
249 (if (eq? s miss)
250 (values (key x) x)
251 (let ((k (key x)))
252 (if (< k s)
253 (values k x)
254 (values s b))))
255 #:final
256 (if (eq? b miss)
257 (if (eq? default miss)
258 (raise ValueError
259 "min does not work for zero length list")
260 default)
261 b)))
262 (_ (lp ((@ (guile) list) l))))))
263
264 (def (py-max (* l) (= key idx) (= default miss))
265 (let lp ((l l))
266 (match l
267 ((it)
268 (for ((x : it)) ((s miss) (b miss))
269 (if (eq? s miss)
270 (values (key x) x)
271 (let ((k (key x)))
272 (if (> k s)
273 (values k x)
274 (values s b))))
275 #:final
276 (if (eq? b miss)
277 (if (eq? default miss)
278 (raise ValueError
279 "min does not work for zero length list")
280 default)
281 b)))
282 (_ (lp ((@ (guile) list) l))))))
283
284 (define (oct x) (+ "0o" (number->string (py-index x) 8)))
285 (define (ord x) (char->integer (string-ref (pylist-ref x 0) 0)))
286
287 (define pow
288 (case-lambda
289 ((x y)
290 (expt x y))
291 ((x y z)
292 (py-mod (expt x y) z))))
293
294 (define-syntax-rule (super . l) (py-super-mac . l))
295
296 (define min py-min)
297 (define max py-max)
298 (define list pylist)
299 (define reversed py-reversed)
300 (define (key-id x) x)
301 (define* (sorted it #:key (key key-id) (reverse #f))
302 (define l (to-pylist '()))
303 (for ((x : it)) () (pylist-append! l x))
304 (pylist-sort! l #:key key #:reverse reverse)
305 l)
306
307 (define (zip . l)
308 (let ((l ((@ (guile) map) wrap-in l)))
309 ((make-generator ()
310 (lambda (yield)
311 (let lp ()
312 (let lp2 ((l l) (r '()))
313 (if (pair? l)
314 (call-with-values (lambda () (next (car l)))
315 (lambda z
316 (lp2 (cdr l) (append (reverse z) r))))
317 (begin
318 (yield (reverse r))
319 (lp))))))))))
320
321 (define-python-class ClassMethod ())
322 (define-python-class StaticMethod ())
323 (define-python-class Funcobj ())
324
325
326
327
328