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