os
[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
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 print
53 (case-lambda
54 (() ((@ (guile) format) #t "~%"))
55 ((x) ((@ (guile) format) #t "~s~%" x))
56 (l ((@ (guile) format) #t "~s~%" l))))
57
58 (define (repr x) ((@ (guile) format) #f "~a" x))
59 (define abs py-abs)
60 (define str pystring)
61 (define complex py-complex)
62 (define float py-float)
63 (define int py-int)
64 (define round py-round)
65 (define set py-set)
66 (define all py-all)
67 (define any py-any)
68 (define bin py-bin)
69 (define divmod py-divmod)
70 (define format py-format)
71 (define hash py-hash)
72 (define hex py-hex)
73
74 (define-method (callable x ) #f)
75 (define-method (callable (x <procedure> )) #t)
76 (define-method (callable (x <procedure-class> )) #t)
77 (define-method (callable (x <applicable> )) #t)
78 (define-method (callable (x <primitive-generic>)) #t)
79 (define-method (callable (x <p>))
80 (ref x '__call__))
81
82 (define chr integer->char)
83
84 (define classmethod class-method)
85 (define staticmethod static-method)
86
87 (define (enumerate l)
88 (make-generator enumerate
89 (lambda (yield)
90 (for ((x : l)) ((i 0))
91 (yield i x)
92 (+ i 1)))))
93
94 (define (filter f l)
95 (make-generator enumerate
96 (lambda (yield)
97 (for ((x : l)) ()
98 (if (f x)
99 (yield x))))))
100
101 (define miss ((@ (guile) list) 'miss))
102
103 (define* (getattr a b #:optional (k miss))
104 (let ((r (ref a (symbol->string b) k)))
105 (if (eq? r miss)
106 (raise AttributeError "object/class ~a is missing attribute ~a" a b)
107 r)))
108
109 (define (hasattr a b)
110 (let ((r (ref a (symbol->string b) miss)))
111 (not (eq? r miss))))
112
113 (define-method (issubclass (sub <p>) (cls <p>))
114 (aif it (ref cls '__subclasscheck__)
115 (it sub)
116 (is-a? (ref sub '__goops__) (ref cls '__goops__))))
117
118 (define-method (isinstance (o <p>) (cl <p>))
119 (aif it (ref cl '__instancecheck__)
120 (it o)
121 (if (pair? cl)
122 (or
123 (isinstance o (car cl))
124 (isinstance o (cdr cl)))
125 (is-a? (ref (ref o '__class__) '__goops__) cl))))
126
127 (define iter
128 (case-lambda
129 ((o) (aif it (wrap-in o)
130 it
131 (aif get (ref o '__getitem__)
132 (make-generator iter
133 (lambda (yield)
134 (for () ((i 0))
135 (yield (get i))
136 (+ i 1))))
137 (raise TypeError "not iterable" o))))
138 ((f sent)
139 (make-generator iter
140 (lambda (yield)
141 (for () ()
142 (let ((r (f)))
143 (if (equal? r sent)
144 (break)
145 (yield r)))))))))
146
147
148
149 (define-syntax map
150 (lambda (x)
151 (syntax-case x ()
152 ((map f a ...)
153 (with-syntax (((x ...) (generate-temporaries #'(a ...))))
154 #'(make-generator map
155 (lambda (yield)
156 (for ((x : a) ...) () (yield (f x ...))))))))))
157
158 (define* (sum i #:optional (start 0))
159 (for ((x : i)) ((s start))
160 (+ s x)
161 #:final
162 s))
163
164
165 (define (id x) (object-address x))
166
167 (define (input str)
168 (format #t str)
169 (readline))
170
171 (define (idx x) x)
172
173 (def (py-min (* l) (= key idx) (= default miss))
174 (let lp ((l l))
175 (match l
176 ((it)
177 (for ((x : it)) ((s default) (b default))
178 (if (eq? s miss)
179 (values (key x) x)
180 (let ((k (key x)))
181 (if (< k s)
182 (values k x)
183 (values s b))))
184 #:final
185 (if (eq? b miss)
186 (raise ValueError "min does not work for zero length list")
187 b)))
188 (_ (lp ((@ (guile) list) l))))))
189
190 (def (py-max (* l) (= key idx) (= default miss))
191 (let lp ((l l))
192 (match l
193 ((it)
194 (for ((x : it)) ((s default) (b default))
195 (if (eq? default miss)
196 (values (key x) x)
197 (let ((k (key x)))
198 (if (> k s)
199 (values k x)
200 (values s b))))
201 #:final
202 (if (eq? b miss)
203 (raise ValueError "min does not work for zero length list")
204 b)))
205 (_ (lp ((@ (guile) list) l))))))
206
207 (define (oct x) (+ "0o" (number->string (py-index x) 8)))
208 (define (ord x) (char->integer (string-ref (pylist-ref x 0) 0)))
209
210 (define pow
211 (case-lambda
212 ((x y)
213 (expt x y))
214 ((x y z)
215 (py-mod (expt x y) z))))
216
217 (define-syntax-rule (super . l) (py-super-mac . l))
218
219 (define min py-min)
220 (define max py-max)
221 (define list pylist)
222 (define reversed py-reversed)
223 (define (key-id x) x)
224 (define* (sorted it #:key (key key-id) (reverse #f))
225 (define l (to-pylist '()))
226 (for ((x : it)) () (pylist-append! l x))
227 (pylist-sort! l #:key key #:reverse reverse)
228 l)
229
230 (define (zip . l)
231 (let ((l ((@ (guile) map) wrap-in l)))
232 ((make-generator ()
233 (lambda (yield)
234 (let lp ()
235 (let lp2 ((l l) (r '()))
236 (if (pair? l)
237 (call-with-values (lambda () (next (car l)))
238 (lambda z
239 (lp2 (cdr l) (append (reverse z) r))))
240 (begin
241 (yield (reverse r))
242 (lp))))))))))
243
244
245