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