ac35e889fa3cafe1d1b4c61283657e51b1c5e537
[software/python-on-guile.git] / modules / language / python / list.scm
1 (define-module (language python list)
2 #:use-module (oop pf-objects)
3 #:use-module (oop goops)
4 #:use-module (language python exceptions)
5 #:use-module (language python yield)
6 #:use-module (language python for)
7 #:use-module (language python try)
8 #:use-module (language python exceptions)
9 #:export (to-list pylist-ref pylist-set! pylist-append!
10 pylist-slice pylist-subset! pylist-reverse!
11 pylist-pop! pylist-count))
12
13 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
14
15 (define-class <py-list> () vec n)
16
17 (define-method (to-list x)
18 (if (vector? x)
19 (vector->list x)
20 x))
21
22 (define-method (to-list (x <p>))
23 ((ref x '__tolist__ (lambda () (error "missing __tolist__ in object")))))
24
25
26 (define-method (to-list (x <yield>))
27 (define l '())
28 (catch StopIteration
29 (lambda ()
30 (let lp ()
31 (set! l (cons (next x) l))
32 (lp)))
33 (lambda x
34 (reverse l))))
35
36 (define-method (to-list (x <py-list>))
37 (let ((vec (slot-ref x 'vec))
38 (n (slot-ref x 'n)))
39 (let lp ((i 0))
40 (if (< i n)
41 (cons (vector-ref vec i) (lp (+ i 1)))
42 '()))))
43
44 (define-method (to-pylist (l <py-list>))
45 l)
46
47
48 (define-method (to-pylist (l <pair>))
49 (let* ((n (length l))
50 (vec (make-vector (* 2 n)))
51 (o (make <py-list>)))
52
53 (let lp ((l l) (i 0))
54 (if (pair? l)
55 (begin
56 (vector-set! vec i (car l))
57 (lp (cdr l) (+ i 1)))))
58
59 (slot-set! o 'n n)
60 (slot-set! o 'vec vec)
61 o))
62
63 (define-method (to-pylist (l <vector>))
64 (to-pylist (vector->list l)))
65
66 (define-method (to-pylist l)
67 (if (null? l)
68 (let ((o (make <py-list>)))
69 (slot-set! o 'vec (make-vector 4))
70 (slot-set! o 'n 0)
71 o)
72 (error "not able to make a pylist")))
73
74 ;;; REF
75 (define-method (pylist-ref (o <py-list>) nin)
76 (define N (slot-ref o 'n))
77 (define n (if (< nin 0) (+ N nin) nin))
78 (if (and (>= n 0) (< n (slot-ref o 'n)))
79 (vector-ref (slot-ref o 'vec) n)
80 (raise IndexError)))
81
82 (define-method (pylist-ref (o <pair>) n)
83 (define n (if (< n 0) (+ (length o) n)))
84 (list-ref o n))
85
86 (define-method (pylist-ref (o <vector>) n)
87 (vector-ref o n))
88
89 (define-method (pylist-ref (o <p>) n)
90 ((ref o '__listref__) n))
91
92 ;;; SET
93 (define-method (pylist-set! (o <py-list>) nin val)
94 (define N (slot-ref o 'n))
95 (define n (if (< nin 0) (+ N nin) nin))
96
97 (if (and (>= n 0) (< n (slot-ref o 'n)))
98 (vector-set! (slot-ref o 'vec) n val)
99 (raise IndexError)))
100
101 (define-method (pylist-set! (o <pair>) n val)
102 (list-set! o n val))
103
104 (define-method (pylist-set! (o <vector>) n val)
105 (vector-set! o n val))
106
107 (define-method (pylist-set! (o <p>) n val)
108 ((ref o '__listset__) n val))
109
110 ;;SLICE
111 (define-method (pylist-slice (o <py-list>) n1 n2 n3)
112 (define N (slot-ref o 'n))
113 (define (f n) (if (< n 0) (+ N n) n))
114
115 (let* ((n1 (f (if (eq? n1 'None) 0 n1)))
116 (n2 (f (if (eq? n2 'None) (slot-ref o 'n) n2)))
117 (n3 (f (if (eq? n3 'None) 1 n3)))
118
119 (vec (slot-ref o 'vec))
120 (l (let lp ((i n1))
121 (if (< i n2)
122 (cons (vector-ref vec i) (lp (+ i n3)))
123 '()))))
124 (to-pylist l)))
125
126 (define-method (pylist-slice o n1 n2 n3)
127 (pylist-slice (to-pylist o) n1 n2 n3))
128
129 ;;SUBSET
130 (define-method (pylist-subset! (o <py-list>) n1 n2 n3 val)
131 (define N (slot-ref o 'n))
132 (define (f n) (if (< n 0) (+ N n) n))
133
134 (let* ((n1 (f (if (eq? n1 'None) 0 n1)))
135 (n2 (f (if (eq? n2 'None) (slot-ref o 'n) n2)))
136 (n3 (f (if (eq? n3 'None) 1 n3)))
137 (vec (slot-ref o 'vec))
138 (o2 (to-pylist val))
139 (N2 (slot-ref o2 'n))
140 (vec2 (slot-ref o2 'vec)))
141 (if (<= n2 N)
142 (let lp ((i 0) (j n1))
143 (if (< j n2)
144 (if (< i N2)
145 (begin
146 (vector-set! vec j (vector-ref vec2 i))
147 (lp (+ i 1) (+ j n3)))
148 (let lp ((j2 j))
149 (if (< j2 n2)
150 (lp (+ j2 n3))
151 (let lp ((k1 j) (k2 j2))
152 (if (< k2 N)
153 (begin
154 (vector-set! vec k1 (vector-ref vec k2))
155 (lp (+ k1 1) (+ k2 1)))
156 (slot-set! o 'n k1))))))))
157
158
159 (raise IndexError))
160 (values)))
161
162
163 ;;APPEND
164 (define-method (pylist-append! (o <py-list>) val)
165 (let* ((n (slot-ref o 'n))
166 (vec (slot-ref o 'vec))
167 (N (vector-length vec)))
168 (if (< n N)
169 (begin
170 (vector-set! vec n val)
171 (slot-set! o 'n (+ n 1)))
172 (let* ((N (* 2 N))
173 (vec2 (make-vector N)))
174 (let lp ((i 0))
175 (if (< i n)
176 (begin
177 (vector-set! vec2 i (vector-ref vec i))
178 (lp (+ i 1)))))
179 (vector-set! vec2 n val)
180 (slot-set! o 'vec vec2)))
181 (slot-set! o 'n (+ n 1))
182 (values)))
183
184 (define-method (pylist-append! o n)
185 (raise 'NotSupportedOP '__append__))
186
187 (define-method (pylist-append! (o <p>) n . l)
188 (aif it (ref o 'append)
189 (apply it n l)
190 (error "no append")))
191
192
193
194 (define-method (write (o <py-list>) . l)
195 (define port (if (null? l) #t (car l)))
196
197 (let* ((l (to-list o)))
198 (if (null? l)
199 (format port "[]")
200 (format port "[~a~{, ~a~}]" (car l) (cdr l)))))
201
202 (define-method (display (o <py-list>) . l)
203 (define port (if (null? l) #t (car l)))
204
205 (let* ((l (to-list o)))
206 (if (null? l)
207 (format port "[]")
208 (format port "[~a~{, ~a~}]" (car l) (cdr l)))))
209
210
211 (define-method (+ (o1 <py-list>) (o2 <py-list>))
212 (let* ((vec1 (slot-ref o1 'vec))
213 (vec2 (slot-ref o2 'vec))
214 (n1 (slot-ref o1 'n))
215 (n2 (slot-ref o2 'n))
216 (n (+ n1 n2))
217 (vec (make-vector (* 2 n)))
218 (o (make <py-list>)))
219
220 (let lp ((i1 0))
221 (if (< i1 n1)
222 (begin
223 (vector-set! vec i1 (vector-ref vec1 i1))
224 (lp (+ i1 1)))
225 (let lp ((i2 0) (i i1))
226 (if (< i2 n2)
227 (begin
228 (vector-set! vec i (vector-ref vec2 i2))
229 (lp (+ i2 1) (+ i 1)))))))
230
231 (slot-set! o 'n n )
232 (slot-set! o 'vec vec)
233 o))
234
235
236 (define-method (+ (o1 <pair>) (o2 <pair>))
237 (append o1 o2))
238
239 (define-method (+ (o1 <string>) (o2 <string>))
240 (string-append o1 o2))
241
242 (define-method (* (o1 <py-list>) (x <integer>))
243 (let* ((vec (slot-ref o1 'vec))
244 (n (slot-ref o1 'n))
245 (n2 (* n x))
246 (vec2 (make-vector (* 2 n2)))
247 (o (make <py-list>)))
248
249 (let lp1 ((i 0) (j 0))
250 (if (< i x)
251 (let lp2 ((j j) (k 0))
252 (if (< k n)
253 (begin
254 (vector-set! vec2 j (vector-ref vec k))
255 (lp2 (+ j 1) (+ k 1)))
256 (lp1 (+ i 1) j)))))
257
258 (slot-set! o 'n n2 )
259 (slot-set! o 'vec vec2)
260 o))
261
262 (define-method (* (vec <string>) (x <integer>))
263 (let* ((n (string-length vec))
264 (n2 (* n x))
265 (vec2 (make-string n2)))
266
267 (let lp1 ((i 0) (j 0))
268 (if (< i x)
269 (let lp2 ((j j) (k 0))
270 (if (< k n)
271 (begin
272 (string-set! vec2 j (string-ref vec k))
273 (lp2 (+ j 1) (+ k 1)))
274 (lp1 (+ i 1) j)))))
275 vec2))
276
277 (define-method (* (l <pair>) (x <integer>))
278 (let lp1 ((i 0))
279 (if (< i x)
280 (let lp2 ((k l))
281 (if (pair? k)
282 (cons (car k) (lp2 (cdr k)))
283 (lp1 (+ i 1))))
284 '())))
285
286
287 (define-method (+ (o1 <pair>) (o2 <pair>))
288 (append o1 o2))
289
290 (define-method (+ (o1 <string>) (o2 <string>))
291 (string-append o1 o2))
292
293 ;;REVERSE
294 (define-method (pylist-reverse! (o <py-list>))
295 (let* ((N (slot-ref o 'n))
296 (M (- N 1))
297 (n (floor-quotient N 2))
298 (vec (slot-ref o 'vec)))
299 (let lp ((i 0))
300 (if (< i n)
301 (let ((swap (vector-ref vec i))
302 (k (- M i)))
303 (vector-set! vec i (vector-ref vec k))
304 (vector-set! vec k swap))))))
305
306 (define-method (pylist-reverse! (o <p>)) ((ref o 'reverse)))
307
308 ;;POP!
309 (define-method (pylist-pop! (o <py-list>))
310 (let* ((n (slot-ref o 'n))
311 (m (- n 1))
312 (vec (slot-ref o 'vec)))
313 (if (> n 0)
314 (let ((ret (vector-ref vec m)))
315 (slot-set! o 'n m)
316 (vector-set! vec m #f)
317 ret)
318 (raise IndexError "pop from empty list"))))
319
320 (define-method (pylist-pop! (o <p>)) ((ref o 'pop)))
321
322 ;;COUNT
323 (define-method (pylist-count (o <py-list>) q)
324 (let* ((n (slot-ref o 'n))
325 (vec (slot-ref o 'vec)))
326 (let lp ((i 0) (sum 0))
327 (if (< i n)
328 (if (equal? (vector-ref vec i) q)
329 (lp (+ i 1) (+ sum 1))
330 (lp (+ i 1) sum ))
331 sum))))
332
333 (define-method (pylist-count (s <string>) q)
334 (let* ((n (string-length s))
335 (q (if (and (string? q) (= (string-length q) 1))
336 (string-ref q 0))))
337 (let lp ((i 0) (sum 0))
338 (if (< i n)
339 (if (eq? (string-ref s i) q)
340 (lp (+ i 1) (+ sum 1))
341 (lp (+ i 1) sum ))
342 sum))))
343
344 (define-method (pylist-count (l <pair>) q)
345 (let lp ((l l) (sum 0))
346 (if (pair? l)
347 (if (eq? (car l) q)
348 (lp (cdr l) (+ sum 1))
349 (lp (cdr l) sum ))
350 sum)))
351
352 (define-method (pylist-count (o <p>) q) ((ref o 'count) q))