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