abc
[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 (sub <p>) (cls <p>))
126 (aif it (ref cls '__subclasscheck__)
127 (it cls sub)
128 (if (eq? sub cls)
129 #t
130 (is-a? (ref sub '__goops__) (ref cls '__goops__)))))
131
132 (define-method (isinstance (o <p>) (cl <p>))
133 (aif it (ref cl '__instancecheck__)
134 (it o)
135 (if (pair? cl)
136 (or
137 (isinstance o (car cl))
138 (isinstance o (cdr cl)))
139 (is-a? o (ref cl '__goops__)))))
140
141 (define iter
142 (case-lambda
143 ((o) (aif it (wrap-in o)
144 it
145 (aif get (ref o '__getitem__)
146 (make-generator iter
147 (lambda (yield)
148 (for () ((i 0))
149 (yield (get i))
150 (+ i 1))))
151 (raise TypeError "not iterable" o))))
152 ((f sent)
153 (make-generator iter
154 (lambda (yield)
155 (for () ()
156 (let ((r (f)))
157 (if (equal? r sent)
158 (break)
159 (yield r)))))))))
160
161
162
163 (define-syntax map
164 (lambda (x)
165 (syntax-case x ()
166 ((map f a ...)
167 (with-syntax (((x ...) (generate-temporaries #'(a ...))))
168 #'(for ((x : a) ...) ((l '()))
169 (cons (f x ...) l)
170 #:final (py-list (reverse l))))))))
171
172 (define* (sum i #:optional (start 0))
173 (for ((x : i)) ((s start))
174 (+ s x)
175 #:final
176 s))
177
178
179 (define (id x) (object-address x))
180
181 (define (input str)
182 (format #t str)
183 (readline))
184
185 (define (idx x) x)
186
187 (def (py-min (* l) (= key idx) (= default miss))
188 (let lp ((l l))
189 (match l
190 ((it)
191 (for ((x : it)) ((s miss) (b miss))
192 (if (eq? s miss)
193 (values (key x) x)
194 (let ((k (key x)))
195 (if (< k s)
196 (values k x)
197 (values s b))))
198 #:final
199 (if (eq? b miss)
200 (if (eq? default miss)
201 (raise ValueError
202 "min does not work for zero length list")
203 default)
204 b)))
205 (_ (lp ((@ (guile) list) l))))))
206
207 (def (py-max (* l) (= key idx) (= default miss))
208 (let lp ((l l))
209 (match l
210 ((it)
211 (for ((x : it)) ((s miss) (b miss))
212 (if (eq? s miss)
213 (values (key x) x)
214 (let ((k (key x)))
215 (if (> k s)
216 (values k x)
217 (values s b))))
218 #:final
219 (if (eq? b miss)
220 (if (eq? default miss)
221 (raise ValueError
222 "min does not work for zero length list")
223 default)
224 b)))
225 (_ (lp ((@ (guile) list) l))))))
226
227 (define (oct x) (+ "0o" (number->string (py-index x) 8)))
228 (define (ord x) (char->integer (string-ref (pylist-ref x 0) 0)))
229
230 (define pow
231 (case-lambda
232 ((x y)
233 (expt x y))
234 ((x y z)
235 (py-mod (expt x y) z))))
236
237 (define-syntax-rule (super . l) (py-super-mac . l))
238
239 (define min py-min)
240 (define max py-max)
241 (define list pylist)
242 (define reversed py-reversed)
243 (define (key-id x) x)
244 (define* (sorted it #:key (key key-id) (reverse #f))
245 (define l (to-pylist '()))
246 (for ((x : it)) () (pylist-append! l x))
247 (pylist-sort! l #:key key #:reverse reverse)
248 l)
249
250 (define (zip . l)
251 (let ((l ((@ (guile) map) wrap-in l)))
252 ((make-generator ()
253 (lambda (yield)
254 (let lp ()
255 (let lp2 ((l l) (r '()))
256 (if (pair? l)
257 (call-with-values (lambda () (next (car l)))
258 (lambda z
259 (lp2 (cdr l) (append (reverse z) r))))
260 (begin
261 (yield (reverse r))
262 (lp))))))))))
263
264 (define DEFAULT_BUFFER_SIZE 4096)
265 (def (open path
266 (= mode "r")
267 (= buffering -1 )
268 (= encoding None)
269 (= errors None)
270 (= newline None)
271 (= closefd #t)
272 (= opener None))
273
274 (define modelist (string->list mode))
275 (define path (path-it path))
276 (define (clean ch l)
277 (filter (lambda (c) (not (eq? ch c))) l))
278 (let ((port (if (number? path)
279 (begin
280 (if (member #\a modelist)
281 (seek path 0 SEEK_END))
282 (if (member #\x modelist)
283 (error "cannot use mode 'x' for fd input"))
284 (cond
285 ((member #\r modelist)
286 (fdes->inport path))
287 ((member #\w modelist)
288 (fdes->outport path))))
289 (begin
290 (if (member #\x modelist)
291 (if (file-exists? path)
292 (raise OSError "mode='x' and file exists")
293 (set mode (list->string
294 (clean #\x modelist)))))
295 ((@ (guile) open-file) (path-it path) mode)))))
296
297 (case buffering
298 ((-1)
299 (setvbuf port 'block DEFAULT_BUFFER_SIZE))
300 ((0)
301 (setvbuf port 'none))
302 ((1)
303 (setvbuf port 'line))
304 (else
305 (setvbuf port 'block buffering)))
306
307 port))
308
309
310 (define-python-class ClassMethod ())
311 (define-python-class StaticMethod ())
312 (define-python-class Funcobj ())
313
314
315
316
317