7700a00966cc39676cafa6d420a14068c9502a02
[software/python-on-guile.git] / modules / language / python / bytes.scm
1 (define-module (language python bytes)
2 #:use-module (oop goops)
3 #:use-module (oop pf-objects)
4 #:use-module (ice-9 match)
5 #:use-module (rnrs bytevectors)
6 #:use-module (system foreign)
7 #:use-module (language python string)
8 #:use-module (language python for)
9 #:use-module (language python try)
10 #:use-module (language python exceptions)
11 #:use-module (language python list)
12 #:use-module (language python hash)
13 #:export (<py-bytes> pybytes-listing bytes bytearray bytes->bytevector
14 <py-bytearray> pybytesarray-listing))
15
16 (define (bytes->bytevector x) (slot-ref x 'bytes))
17 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
18
19 (define b-ref bytevector-u8-ref)
20 (define b-set! bytevector-u8-set!)
21 (define b-make make-bytevector)
22 (define b-len bytevector-length)
23
24 (define-class <py-bytes> () bytes)
25 (define-class <py-bytearray> () n vec)
26
27 (define-method (b-get (o <bytevector>))
28 o)
29 (define-method (b-get (o <py-bytes>))
30 (slot-ref o 'bytes))
31 (define-method (b-get (o <py-bytearray>))
32 (slot-ref o 'vec))
33
34 (define (b-char x)
35 (cond
36 ((char? x)
37 (ch-find x))
38 ((string? x)
39 (ch-find (string-ref x 0)))
40 (else
41 x)))
42
43 (define-python-class bytes (<py-bytes>)
44 (define __init__
45 (case-lambda
46 ((self)
47 (__init__ self ""))
48 ((self s)
49 (cond
50 ((is-a? s <string>)
51 (let* ((n (string-length s))
52 (bytes (b-make n)))
53 (let lp ((i 0))
54 (if (< i n)
55 (begin
56 (b-set! bytes i (ch-find (string-ref s i)))
57 (lp (+ i 1)))))
58 (slot-set! self 'bytes bytes)))
59 ((is-a? s <py-string>)
60 (__init__ self (slot-ref s 'str)))
61 ((is-a? s <py-bytes>)
62 (slot-set! self 'bytes (slot-ref s 'bytes)))
63 ((is-a? s <bytevector>)
64 (slot-set! self 'bytes s))
65 ((is-a? s <py-bytearray>)
66 (let* ((n (slot-ref s 'n))
67 (b (b-make n)))
68 (bytevector-copy! (slot-ref s 'vec) 0 b 0 n)
69 (slot-set! self 'bytes b)))
70 (else
71 (for ((x : s)) ((r '()))
72 (cons (b-char x) r)
73
74 #:final
75 (let* ((n (length r))
76 (bytes (b-make n)))
77 (let lp ((i (- n 1)) (r r))
78 (if (>= i 0)
79 (begin
80 (b-set! bytes i (car r))
81 (lp (- i 1) (cdr r)))
82 (slot-set! self 'bytes bytes)))))))))))
83
84 (define-python-class bytearray (<py-bytearray>)
85 (define __init__
86 (case-lambda
87 ((self)
88 (__init__ self ""))
89 ((self s)
90 (cond
91 ((is-a? s <string>)
92 (let* ((n (string-length s))
93 (bytes (b-make n)))
94 (let lp ((i 0))
95 (if (< i n)
96 (begin
97 (b-set! bytes i (ch-find (string-ref s i)))
98 (lp (+ i 1)))))
99 (slot-set! self 'vec bytes)
100 (slot-set! self 'n n)))
101 ((is-a? s <py-string>)
102 (__init__ self (slot-ref s 'str)))
103 ((is-a? s <py-bytes>)
104 (let ((b (slot-ref s 'bytes)))
105 (slot-set! self 'vec (bytevector-copy b))
106 (slot-set! self 'n (b-len b))))
107 ((is-a? s <bytevector>)
108 (slot-set! self 'vec (bytevector-copy s))
109 (slot-set! self 'n (b-len s)))
110 ((is-a? s <py-bytearray>)
111 (slot-set! self 'vec (bytevector-copy (slot-ref s 'vec)))
112 (slot-set! self 'n (slot-ref s 'n)))
113 (else
114 (for ((x : s)) ((r '()))
115 (cons (b-char x) r)
116 #:final
117 (let* ((n (length r))
118 (bytes (b-make n)))
119 (let lp ((i (- n 1)) (r r))
120 (if (>= i 0)
121 (begin
122 (b-set! bytes i (car r))
123 (lp (- i 1) (cdr r)))
124 (begin
125 (slot-set! self 'vec bytes)
126 (slot-set! self 'n (b-len bytes)))))))))))))
127
128 (define-syntax-rule (define-py (f o . u) code ...)
129 (begin
130 (define-method (f (o <bytevector>) . u) code ...)
131 (define-method (f (o <py-bytes>) . l) (apply f (slot-ref o 'bytes) l))))
132
133 (define-syntax-rule (define-py! (f o . u) code ...)
134 (begin
135 (define-method (f (o <py-bytearray>) . u) code ...)))
136
137 (define (idd x) x)
138 (define-syntax-rule (define-py* g (f m o nn . u) code ...)
139 (begin
140 (define (g m o nn . u) code ...)
141 (define-method (f (o <bytevector>) . l)
142 (apply g idd o (b-len o) l))
143 (define-method (f (o <py-bytes>) . l)
144 (let ((b (slot-ref o 'bytes)))
145 (apply g bytes b (b-len b) l)))
146 (define-method (f (o <py-bytearray>) . l)
147 (let ((b (slot-ref o 'vec))
148 (n (slot-ref o 'n)))
149 (apply g bytearray b n l)))))
150
151 (define-method (write (b <py-bytes>) . l)
152 (define port (if (pair? l) (car l) #t))
153 (format port "b'")
154 (b->string port (slot-ref b 'bytes))
155 (format port "'"))
156
157 (define-method (write (b <py-bytearray>) . l)
158 (define port (if (pair? l) (car l) #t))
159 (format port "bytearray(b'")
160 (b->string port (pylist-slice (slot-ref b 'vec) 0 (len b) 1))
161 (format port "')"))
162
163
164 (define dynlink (dynamic-link))
165
166 (define stringn
167 (pointer->procedure
168 '*
169 (dynamic-func "scm_from_latin1_stringn" dynlink)
170 (list '* size_t)))
171
172 (define ch->i (make-hash-table))
173
174 (define (re-eval ch)
175 (let lp ((i 0))
176 (if (< i 256)
177 (if (eq? ch (chf i))
178 (begin
179 (hash-set! ch->i ch i)
180 (lp (+ i 1)))
181 (lp (+ i 1)))
182 (hash-ref ch->i ch))))
183
184 (define (ch-find ch)
185 (aif it (hash-ref ch->i ch #f)
186 (if (eq? ch (chf it))
187 it
188 (re-eval ch))
189 (re-eval ch)))
190
191 (define (chf ch)
192 (let ((bytes (pointer->scm
193 (stringn
194 (bytevector->pointer
195 (b-make 1 ch))
196 1))))
197 (if (= (string-length bytes) 1)
198 (string-ref bytes 0)
199 (chf 0))))
200
201 (define (b->string port b)
202 (let ((n (b-len b)))
203 (let lp ((i 0))
204 (if (< i n)
205 (let ((ch (b-ref b i)))
206 (cond
207 ((equal? ch 0)
208 (format port "\\x00"))
209 ((equal? (chf ch) #\\)
210 (format port "\\\\"))
211 ((equal? (chf ch) #\')
212 (format port "\\'"))
213 ((equal? (chf ch) #\newline)
214 (format port "\\n"))
215 ((= ch 7)
216 (format port "\\a"))
217 ((= ch 8)
218 (format port "\\b"))
219 ((= ch 12)
220 (format port "\\f"))
221 ((= ch 10)
222 (format port "\\n"))
223 ((= ch 13)
224 (format port "\\r"))
225 ((= ch 9)
226 (format port "\\t"))
227 ((= ch 11)
228 (format port "\\v"))
229 (else
230 (if (< ch 32)
231 (format port "\\x~2,'0x" ch)
232 (format port "~a" (make-string 1 (chf ch))))))
233 (lp (+ i 1)))))))
234
235 (define-py (py-hash b) (hash b pyhash-N))
236
237 (define-py* pylist (pylist-ref bytes o N nin)
238 (define n (if (< nin 0) (+ N nin) nin))
239 (if (and (>= n 0) (< n N))
240 (if (eq? bytes idd)
241 (b-ref o n)
242 (bytes (b-make 1 (b-ref o n))))
243 (raise IndexError)))
244
245 (define-py (len b) (b-len b))
246 (define-py! (len b) (slot-ref b 'n))
247
248 (define-py* ->list (to-list mk b n)
249 (let lp ((i 0) (r '()))
250 (if (< i n)
251 (lp (+ i 1) (cons (b-ref b i) r))
252 (reverse r))))
253
254 (define-py* ->pylist (to-pylist mk b n)
255 (let* ((m n)
256 (o (make <py-list>))
257 (v (make-vector m)))
258 (slot-set! o 'vec v)
259 (slot-set! o 'n n)
260 (let lp ((i 0))
261 (if (< i n)
262 (begin
263 (vector-set! v i (if (equal? bytes idd)
264 (b-ref b i)
265 (bytes (b-make 1 (b-ref b i)))))
266 (lp (+ i 1)))
267 o))))
268
269
270 (define-py! (pylist-set! o nin val)
271 (define N (slot-ref o 'n))
272 (define n (if (< nin 0) (+ N nin) nin))
273 (if (and (>= n 0) (< n (slot-ref o 'n)))
274 (b-set! (slot-ref o 'vec) n val)
275 (raise IndexError)))
276
277 (define-py* slice (pylist-slice bytes o N n1 n2 n3)
278 (define (f n) (if (< n 0) (+ N n) n))
279
280 (let* ((n1 (f (if (eq? n1 None) 0 n1)))
281 (n2 (f (if (eq? n2 None) N n2)))
282 (n3 (f (if (eq? n3 None) 1 n3)))
283 (n (let lp ((i n1) (j 0))
284 (if (< i n2)
285 (lp (+ i n3) (+ j 1))
286 j)))
287 (b (b-make n)))
288 (let lp ((i n1) (j 0))
289 (if (< j n)
290 (begin
291 (b-set! b j (b-ref o i))
292 (lp (+ i n3) (+ j 1)))
293 (bytes b)))))
294
295 (define-py! (pylist-subset! o n1 n2 n3 val)
296 (define N (slot-ref o 'n))
297 (define (f n) (if (< n 0) (+ N n) n))
298
299 (let* ((n1 (f (if (eq? n1 None) 0 n1)))
300 (n2 (f (if (eq? n2 None) (slot-ref o 'n) n2)))
301 (n3 (f (if (eq? n3 None) 1 n3)))
302 (vec (slot-ref o 'vec))
303 (l2 (to-list val))
304 (N2 (length l2)))
305 (if (<= n2 N)
306 (let lp ((i 0) (l2 l2) (j n1))
307 (if (< j n2)
308 (if (< i N2)
309 (let ((r (car l2)))
310 (if (and (number? r) (integer? r) (>= r 0) (< r 256))
311 (begin
312 (b-set! vec j r)
313 (lp (+ i 1) (cdr l2) (+ j n3)))
314 (raise TypeError "not a byte")))
315 (let lp ((j2 j))
316 (if (< j2 n2)
317 (lp (+ j2 n3))
318 (let lp ((k1 j) (k2 j2))
319 (if (< k2 N)
320 (begin
321 (b-set! vec k1 (b-ref vec k2))
322 (lp (+ k1 1) (+ k2 1)))
323 (begin
324 (let lp ((i k2))
325 (if (< i N)
326 (begin
327 (b-set! vec i #f)
328 (lp (+ i 1)))
329 (slot-set! o 'n k1)))))))))))
330 (raise IndexError))
331 (values)))
332
333 (define (byte x)
334 (or (and (integer? x) (>= x 0) (< x 256) x)
335 (and (is-a? x <bytevector>) (b-ref x 0))
336 (and (is-a? x <py-bytes>) (b-ref (slot-ref x 'bytes) 0))
337 (and (is-a? x <py-bytearray>) (b-ref (slot-ref x 'vec) 0))))
338
339 (define-py! (pylist-append! o val)
340 (let* ((n (slot-ref o 'n))
341 (vec (slot-ref o 'vec))
342 (N (b-len vec)))
343 (aif v (byte val)
344 (begin
345 (if (< n N)
346 (b-set! vec n v)
347 (let* ((N (* 2 N))
348 (vec2 (b-make N)))
349 (let lp ((i 0))
350 (if (< i n)
351 (begin
352 (b-set! vec2 i (b-ref vec i))
353 (lp (+ i 1)))))
354 (b-set! vec2 n v)
355 (slot-set! o 'vec vec2)))
356 (slot-set! o 'n (+ n 1))
357 (values))
358 (raise TypeError "not a byte" val))))
359
360
361 (define (b-concat b1 n1 b2 n2)
362 (let* ((n (+ n1 n2))
363 (b (b-make n)))
364 (let lp ((i 0))
365 (if (< i n1)
366 (begin
367 (b-set! b i (b-ref b1 i))
368 (lp (+ i 1)))
369 (let lp ((i i) (j 0))
370 (if (< j n2)
371 (begin
372 (b-set! b i (b-ref b2 j))
373 (lp (+ i 1) (+ j 1)))
374 b))))))
375
376 (define-method (+ (o1 <py-bytes>) (b2 <bytevector>))
377 (let* ((b1 (slot-ref o1 'bytes))
378 (n1 (b-len b1))
379 (n2 (b-len b2))
380 (o (make <py-bytes>))
381 (b (b-concat b1 n1 b2 n2)))
382 (slot-set! o 'bytes b)
383 o))
384
385 (define-method (+ (b2 <bytevector>) (o1 <py-bytes>))
386 (let* ((b1 (slot-ref o1 'bytes))
387 (n1 (b-len b1))
388 (n2 (b-len b2))
389 (o (make <py-bytes>))
390 (b (b-concat b2 n2 b1 n1)))
391 (slot-set! o 'bytes b)
392 o))
393
394 (define-method (+ (b1 <bytevector>) (b2 <bytevector>))
395 (let* ((n1 (b-len b1))
396 (n2 (b-len b2)))
397 (b-concat b1 n1 b2 n2)))
398
399 (define-method (+ (o1 <py-bytes>) (o2 <py-bytes>))
400 (let* ((b1 (slot-ref o1 'bytes))
401 (b2 (slot-ref o2 'bytes))
402 (n1 (b-len b1))
403 (n2 (b-len b2))
404 (o (make <py-bytes>))
405 (b (b-concat b1 n1 b2 n2)))
406 (slot-set! o 'bytes b)
407 o))
408
409 (define-method (+ (o1 <py-bytearray>) (o2 <py-bytes>))
410 (let* ((b1 (slot-ref o1 'vec))
411 (b2 (slot-ref o2 'bytes))
412 (n1 (slot-ref o1 'n))
413 (n2 (b-len b2))
414 (o (make <py-bytearray>))
415 (b (b-concat b1 n1 b2 n2)))
416 (slot-set! o 'vec b)
417 (slot-set! o 'n (+ n1 n2))
418 o))
419
420 (define-method (+ (o1 <py-bytearray>) (b2 <bytevector>))
421 (let* ((b1 (slot-ref o1 'vec))
422 (n1 (slot-ref o1 'n))
423 (n2 (b-len b2))
424 (o (make <py-bytearray>))
425 (b (b-concat b1 n1 b2 n2)))
426 (slot-set! o 'vec b)
427 (slot-set! o 'n (+ n1 n2))
428 o))
429
430 (define-method (+ (o2 <py-bytes>) (o1 <py-bytearray>))
431 (let* ((b1 (slot-ref o1 'vec))
432 (b2 (slot-ref o2 'bytes))
433 (n1 (slot-ref o1 'n))
434 (n2 (b-len b2))
435 (o (make <py-bytearray>))
436 (b (b-concat b2 n2 b1 n1)))
437 (slot-set! o 'vec b)
438 (slot-set! o 'n (+ n1 n2))
439 o))
440
441 (define-method (+ (b2 <bytevector>) (o1 <py-bytearray>) )
442 (let* ((b1 (slot-ref o1 'vec))
443 (n1 (slot-ref o1 'n))
444 (n2 (b-len b2))
445 (o (make <py-bytearray>))
446 (b (b-concat b2 n2 b1 n1)))
447 (slot-set! o 'vec b)
448 (slot-set! o 'n (+ n1 n2))
449 o))
450
451 (define-method (+ (o1 <py-bytearray>) (o2 <py-bytearray>))
452 (let* ((b1 (slot-ref o1 'vec))
453 (b2 (slot-ref o2 'vec))
454 (n1 (slot-ref o1 'n))
455 (n2 (slot-ref o2 'n))
456 (o (make <py-bytearray>))
457 (b (b-concat b1 n1 b2 n2)))
458 (slot-set! o 'vec b)
459 (slot-set! o 'n (+ n1 n2))
460 o))
461
462 (define (b-rep b n m)
463 (let* ((N (* n m))
464 (r (b-make N)))
465 (let lp ((i 0) (j 0))
466 (if (< i m)
467 (let lp2 ((j j) (k 0))
468 (if (< k n)
469 (begin
470 (b-set! r j (b-ref b k))
471 (lp2 (+ j 1) (+ k 1)))
472 (lp (+ i 1) j)))
473 r))))
474
475 (define-method (* (o1 <py-bytearray>) m)
476 (let* ((b1 (slot-ref o1 'vec))
477 (n1 (slot-ref o1 'n))
478 (o (make <py-bytearray>))
479 (b (b-rep b1 n1 m)))
480 (slot-set! o 'vec b)
481 (slot-set! o 'n (* n1 m))
482 o))
483
484 (define-method (* (b1 <bytevector>) m)
485 (let* ((n1 (b-len b1)))
486 (b-rep b1 n1 m)))
487
488 (define-method (* (o1 <py-bytes>) m)
489 (let* ((b1 (slot-ref o1 'bytes))
490 (n1 (b-len b1))
491 (o (make <py-bytes>))
492 (b (b-rep b1 n1 m)))
493 (slot-set! o 'bytes b)
494 o))
495
496 (define-py* cap (py-capitalize bytes s n)
497 (let* ((w (b-make n)))
498 (let lp ((i 0) (first? #t))
499 (if (< i n)
500 (let* ((x (b-ref s i))
501 (ch (chf x)))
502 (define (f first?)
503 (b-set! w i x)
504 (lp (+ i 1) first?))
505
506 (if (and first? (char-alphabetic? ch))
507 (aif it (ch-find (char-upcase ch))
508 (begin
509 (b-set! w i it)
510 (lp (+ i 1) #f))
511 (f #t))
512 (f #f)))
513 (bytes w)))))
514
515 (define-py* center (py-center bytes o n w . l)
516 (let* ((ws (if (pair? l)
517 (ch-find (b-ref (car l) 0))
518 (ch-find #\space)))
519 (w (if (< w n) n w))
520 (d (- w n))
521 (e (floor-quotient (- w n) 2))
522 (s (b-make w (ch-find #\space))))
523 (let lp ((i 0) (j e))
524 (if (< i n)
525 (begin
526 (b-set! s j (b-ref o i))
527 (lp (+ i 1) (+ j 1)))))
528 (bytes s)))
529
530 ;;;py-decode
531 ;;;py-encode
532
533 (define-py* endswith (py-endswith bytes o n suff . l)
534 (let* ((suff (slot-ref (bytes suff) 'bytes))
535 (ns (b-len suff))
536 (f (lambda (x) (< x 0) (+ n x) x)))
537 (call-with-values (lambda ()
538 (match l
539 (() (values 0 n ))
540 ((x) (values (f x) n ))
541 ((x y) (values (f x) (f y)))))
542 (lambda (start end)
543 (let lp ((i (- n ns)) (j 0))
544 (if (< i start)
545 (lp (+ i 1) (+ j 1))
546 (if (>= i end)
547 #t
548 (and
549 (eq? (b-ref o i) (b-ref suff j))
550 (lp (+ i 1) (+ j 1))))))))))
551
552 (define-py* startswith (py-startswith bytes o n pre . l)
553 (let* ((pre (slot-ref (bytes pre) 'bytes))
554 (pre (b-get pre))
555 (ns (len pre))
556 (f (lambda (x) (< x 0) (+ n x) x)))
557 (call-with-values (lambda ()
558 (match l
559 (() (values 0 n ))
560 ((x) (values (f x) n ))
561 ((x y) (values (f x) (f y)))))
562 (lambda (start end)
563 (let lp ((i 0))
564 (cond
565 ((or (>= i end)
566 (>= i ns))
567 #t)
568 ((< i start)
569 (lp (+ i 1)))
570 (else
571 (and
572 (eq? (b-ref o i) (b-ref pre i))
573 (lp (+ i 1))))))))))
574
575
576 (define-py* expand (py-expandtabs bytes s n . l)
577 (let* ((tabsize (match l (() 8) ((x) x)))
578 (ct (ch-find #\tab))
579 (cs (ch-find #\space))
580 (n (b-len s)))
581 (let lp ((i 0) (r '()))
582 (if (< i n)
583 (let ((x (b-ref s i)))
584 (if (eq? x ct)
585 (let lp2 ((j 0) (r r))
586 (if (< j tabsize)
587 (lp2 (+ j 1) (cons cs r))
588 (lp (+ i 1) r)))
589 (lp (+ i 1) (cons x r))))
590 (bytes (reverse r))))))
591
592 (define (b-contains s sub nsub start end)
593 (define (match i)
594 (let lp ((i i) (j 0))
595 (if (and (< j nsub) (< i end))
596 (if (eq? (b-ref s i) (b-ref sub j))
597 (lp (+ i 1) (+ j 1))
598 #f)
599 #t)))
600
601 (let lp ((i (max start 0)))
602 (if (< i end)
603 (if (match i)
604 i
605 (lp (+ i 1)))
606 #f)))
607
608 (define-py* find (py-find bytes s n sub . l)
609 (let* ((f (lambda (x) (< x 0) (+ n x) x)))
610 (call-with-values (lambda ()
611 (match l
612 (() (values 0 n ))
613 ((x) (values (f x) n ))
614 ((x y) (values (f x) (f y)))))
615 (lambda (start end)
616 (let ((sub (b-get sub)))
617 (aif it (b-contains s sub (len sub) start end)
618 it
619 -1))))))
620
621 (define (b-reverse s n)
622 (if (is-a? s (<py-bytes>))
623 (b-reverse (slot-ref s 'bytes) n)
624 (let* ((r (b-make n)))
625 (let lp ((i 0) (j (- n 1)))
626 (if (< i n)
627 (begin
628 (b-set! r j (b-ref s i))
629 (lp (+ i 1) (- j 1)))
630 r)))))
631
632
633 (define-py* rfind (py-rfind bytes s n sub . l)
634 (let* ((sub (slot-ref (bytes sub) 'bytes))
635 (s (b-reverse s n))
636 (nsub (len sub))
637 (sub (b-reverse (b-get sub) nsub))
638 (f (lambda (x) (< x 0) (+ n x) x)))
639 (call-with-values (lambda ()
640 (match l
641 (() (values 0 n ))
642 ((x) (values (f x) n ))
643 ((x y) (values (f x) (f y)))))
644 (lambda (start end)
645 (aif it (b-contains s sub nsub start end)
646 (- n it nsub)
647 -1)))))
648
649 #|
650 (define i (f-list #:i (mk-token (f+ (f-reg! "[0-9]")))))
651 (define s (f-list #:s (mk-token (f+ (f-not! (f-tag "}"))))))
652 (define e (f-list #:e (f-and (f-tag "}") f-true)))
653 (define tagbody (f-or! e i s))
654
655 (define tag (f-seq "{" tagbody "}"))
656 (define nontag (f-list #:bytes (mk-token (f+ (f-or! (f-tag "{{")
657 (f-not! tag))))))
658 (define e (ff* (f-or! tag nontag)))
659
660 (define (compile x args kwargs)
661 (let lp ((l x) (r '()) (u '()) (i 0))
662 (match l
663 (((#:bytes x) . l)
664 (lp l (cons x r) u i))
665 (((#:i x) . l)
666 (lp l (cons "~a" r) (cons (list-ref args (string->number x)) u) i))
667 (((#:s x) . l)
668 (lp l (cons "~a" r) (cons (hash-ref kwargs x None) u) i))
669 (((#:e) . l)
670 (lp l (cons "~a" r) (cons (list-ref args i) u) (+ i 1)))
671 (()
672 (apply format #f (string-join (reverse r) "") (reverse u))))))
673
674 (define-py (py-format format s . l)
675 (call-with-values
676 (lambda ()
677 (let lp ((l l) (args '()) (kwargs (make-hash-table)))
678 (match l
679 (((? keyword? key) x . l)
680 (hash-set! kwargs (symbol->string (keyword->symbol key)) x)
681 (lp l args kwargs))
682 ((x . l)
683 (lp l (cons x args) kwargs))
684 (()
685 (values (reverse args) kwargs)))))
686 (lambda (args kwargs)
687 (compile (parse s e) args kwargs))))
688 |#
689
690 (define-syntax-rule (mk-is py-isalnum x ...)
691 (define-py* isalnum (py-isalnum bytes s n)
692 (let lp ((i 0))
693 (if (< i n)
694 (let ((ch (chf (b-ref s i))))
695 (if (or (x ch) ...)
696 (lp (+ i 1))
697 #f))
698 #t))))
699
700 (mk-is py-isalnum char-alphabetic? char-numeric?)
701 (mk-is py-isalpha char-alphabetic?)
702 (mk-is py-isdigit char-numeric?)
703 (mk-is py-islower char-lower-case?)
704 (mk-is py-isspace char-whitespace?)
705 (mk-is py-isupper char-upper-case?)
706
707
708 (define-py* istitle (py-istitle bytes s n)
709 (if ((> n 0))
710 (let lp ((i 0) (space? #t))
711 (if (< i n)
712 (let ((ch (chf (b-ref s i))))
713 (if space?
714 (cond
715 ((char-whitespace? ch)
716 (lp (+ i 1) #t))
717 ((char-upper-case? ch)
718 (lp (+ i 1) #f))
719 (else
720 #f))
721 (cond
722 ((char-whitespace? ch)
723 (lp (+ i 1) #t))
724 ((char-upper-case? ch)
725 #f)
726 ((char-lower-case? ch)
727 (lp (+ i 1) #f))
728 (else
729 #f))))
730 #t))
731 #f))
732
733 (define (b-join bytes l s ns)
734 (let* ((n (let lp ((l l) (n 0))
735 (if (pair? l)
736 (let ((x (car l))
737 (l (cdr l)))
738 (lp l (+ n (len x) (if (pair? l) ns 0))))
739 n)))
740 (r (b-make n)))
741 (let lp ((l l) (i 0))
742 (if (pair? l)
743 (let* ((x (car l))
744 (n (len x))
745 (x (b-get x))
746 (l (cdr l)))
747 (let lp2 ((j 0) (i i))
748 (if (< j n)
749 (begin
750 (b-set! r i (b-ref x j))
751 (lp2 (+ j 1) (+ i 1)))
752 (if (pair? l)
753 (let lp3 ((j 0) (i i))
754 (if (< j ns)
755 (begin
756 (b-set! r i (b-ref s j))
757 (lp3 (+ j 1) (+ i 1)))
758 (lp l i)))
759 (lp l i)))))
760 (bytes r)))))
761
762 (define-py* join (py-join bytes s n iterator)
763 (b-join bytes (to-list iterator) s n))
764
765 (define-py* ljust (py-ljust bytes s n width . l)
766 (let* ((ch (match l
767 ((x)
768 (b-char x))
769 (()
770 (b-char #\space)))))
771 (if (< width n)
772 (pylist-slice s 0 width 1)
773 (let ((ret (b-make width ch)))
774 (let lp ((i 0))
775 (if (< i n)
776 (begin
777 (b-set! ret i (b-ref s i))
778 (lp (+ i 1)))
779 (bytes ret)))))))
780
781 (define-py* rjust (py-rjust bytes s n width . l)
782 (let* ((ch (match l
783 ((x)
784 (b-char x))
785 (()
786 (b-char #\space)))))
787 (if (< width n)
788 (pylist-slice s (- width) (len s) 1)
789 (let ((ret (b-make width ch)))
790 (let lp ((i 0) (j (- width n)))
791 (if (< i n)
792 (begin
793 (b-set! ret j (b-ref s i))
794 (lp (+ i 1) (+ j 1)))
795 (bytes ret)))))))
796
797
798 (define-py* lower (py-lower bytes s n)
799 (let* ((r (b-make n)))
800 (let lp ((i 0))
801 (if (< i n)
802 (let* ((x (b-ref s i))
803 (ch (chf x)))
804 (b-set! r i (if (char-upper-case? ch)
805 (ch-find (char-downcase ch))
806 x))
807 (lp (+ i 1)))
808 (bytes r)))))
809
810 (define-py* upper (py-upper bytes s n)
811 (let* ((r (b-make n)))
812 (let lp ((i 0))
813 (if (< i n)
814 (let* ((x (b-ref s i))
815 (ch (chf x)))
816 (b-set! r i (if (char-lower-case? ch)
817 (ch-find (char-upcase ch))
818 x))
819 (lp (+ i 1)))
820 (bytes r)))))
821
822 (define-py* swapcase (py-swapcase bytes s n)
823 (let* ((r (b-make n)))
824 (let lp ((i 0))
825 (if (< i n)
826 (let* ((x (b-ref s i))
827 (ch (chf x)))
828 (b-set! r i (cond
829 ((char-lower-case? ch)
830 (ch-find (char-upcase ch)))
831 ((char-upper-case? ch)
832 (ch-find (char-downcase ch)))
833 (else
834 x)))
835 (lp (+ i 1)))
836 (bytes r)))))
837
838 (define b-trim
839 (case-lambda
840 ((bytes s n)
841 (b-trim bytes s n (lambda (ch x) (char-whitespace? ch))))
842 ((bytes s n p)
843 (let lp ((i 0) (r '()) (first? #t))
844 (if (< i n)
845 (let ((x (b-ref s i)))
846 (if first?
847 (if (p (chf x) x)
848 (lp (+ i 1) r #t)
849 (lp (+ i 1) (cons x r) #f))
850 (lp (+ i 1) (cons x r) #f)))
851 (bytes (reverse r)))))))
852
853 (define b-rtrim
854 (case-lambda
855 ((bytes s n)
856 (b-rtrim bytes s n (lambda (ch x) (char-whitespace? ch))))
857 ((bytes s n p)
858 (let lp ((i (- n 1)) (r '()) (first? #t))
859 (if (>= i 0)
860 (let ((x (b-ref s i)))
861 (if first?
862 (if (p (chf x) x)
863 (lp (- i 1) r #t)
864 (lp (- i 1) (cons x r) #f))
865 (lp (- i 1) (cons x r) #f)))
866 (bytes r))))))
867
868 (define-py* lstrip (py-lstrip bytes s n . l)
869 (match l
870 (()
871 (b-trim bytes s n))
872 ((x)
873 (let ((l (map b-char (to-list x))))
874 (b-trim bytes s n (lambda (ch x) (member x l)))))))
875
876 (define-py* restrip (py-rstrip bytes s n . l)
877 (match l
878 (()
879 (b-rtrim bytes s n))
880 ((x)
881 (let ((l (map b-char (to-list x))))
882 (b-rtrim bytes s n (lambda (ch x) (member x l)))))))
883
884
885 (define-py* partition (py-partition bytes s n sep)
886 (let* ((sep (b-get sep))
887 (m (b-len sep)))
888 (define (test i)
889 (let lp ((i i) (j 0))
890 (if (< i n)
891 (if (< j m)
892 (if (eq? (b-ref s i) (b-ref sep j))
893 (lp (+ i 1) (+ j 1))
894 #f)
895 #t)
896 #f)))
897 (let lp ((i 0))
898 (if (< i n)
899 (if (test i)
900 (list (pylist-slice s 0 i) sep (pylist-slice s (+ i m) n))
901 (lp (+ i 1)))
902 (list s "" "")))))
903
904 (define-py* rpartition (py-rpartition bytes ss n ssep)
905 (let* ((s (b-reverse ss n))
906 (m (len ssep))
907 (sep (b-reverse (b-get ssep) m)))
908 (define (test i)
909 (let lp ((i i) (j 0))
910 (if (< i n)
911 (if (< j m)
912 (if (eq? (b-ref s i) (b-ref sep j))
913 (lp (+ i 1) (+ j 1))
914 #f)
915 #t)
916 #f)))
917 (let lp ((i 0))
918 (if (< i n)
919 (if (test i)
920 (list (bytes
921 (b-reverse
922 (pylist-slice s (+ i m) n)
923 (- n (+ i m))))
924 (bytes sep)
925 (bytes
926 (b-reverse
927 (pylist-slice s 0 i)
928 i)))
929 (lp (+ i 1)))
930 (list (bytes "") (bytes "") s)))))
931
932 (define-py* replace (py-replace bytes s n old new . l)
933 (let ((n (match l (() #f) ((n . _) n))))
934 (b-join
935 bytes
936 (reverse
937 (let lp ((s s) (r '()))
938 (let ((l (py-partition s old)))
939 (if (equal? (cadr l) "")
940 (cons s r)
941 (lp (list-ref l 2) (cons (car l) r))))))
942 n
943 new)))
944
945 (define-py (py-stripip s . l)
946 (apply py-rstrip (apply py-lstrip s l) l))
947
948 (define-py! (py-stripip s . l)
949 (apply py-rstrip (apply py-lstrip s l) l))
950
951 (define-py* index (pylist-index bytes o n val . l)
952 (let* ((vec o)
953 (f (lambda (m) (if (< m 0) (+ m n) m))))
954 (call-with-values
955 (lambda ()
956 (match l
957 (()
958 (values 0 n))
959 ((x)
960 (values (f x) n))
961 ((x y)
962 (values (f x) (f y)))))
963 (lambda (n1 n2)
964 (if (and (>= n1 0) (>= n2 0) (< n1 n) (<= n2 n))
965 (let lp ((i n1))
966 (if (< i n2)
967 (let ((r (b-ref vec i)))
968 (if (equal? r val)
969 i
970 (lp (+ i 1))))
971 (raise ValueError "could not find value in index fkn")))
972 (raise IndexError "index out of scop in index fkn"))))))
973
974 (define-py* rindex (py-rindex býtes s n . l)
975 (let ((n (b-len s)))
976 (- n (apply pylist-index (b-reverse s n) l) 1)))
977
978 #;
979 (define-py (py-title title s)
980 (string-titlecase s))
981
982 #;
983 (define-py (py-split s . l)
984 (define ws (f+ (f-reg "[ \t\n]")))
985 (define r
986 (f-or! (f-seq f-eof (f-out '()))
987 (f-cons (f-seq (mk-token (f* (f-reg! "."))) f-eof) (f-out '()))))
988 (define (u ws) (mk-token (f+ (f-not! ws))))
989 (define (tok ws i)
990 (if (= i 0)
991 (f-list (mk-token (f* (f-reg! "."))))
992 (let ((e (mk-token (f* (f-not! ws)))))
993 (f-seq (f? ws)
994 (f-cons e
995 (let lp ((i i))
996 (if (> (- i 1) 0)
997 (f-or! (f-seq (f? ws) f-eof (f-out '()))
998 (f-cons (f-seq ws e) (Ds (lp (- i 1)))))
999 r)))))))
1000
1001 (define N 1000000000000)
1002 (let ((e (call-with-values
1003 (lambda ()
1004 (match l
1005 (() (values ws N))
1006 ((sep) (values (f-tag sep) N))
1007 ((sep n) (values (f-tag sep) n))))
1008 tok)))
1009 (parse s e)))
1010
1011 #;
1012 (define-py (py-rsplit s . l)
1013 (reverse
1014 (map string-reverse
1015 (apply py-split
1016 (string-reverse s)
1017 (match l
1018 (() '())
1019 ((sep . l) (cons (string-reverse sep) l)))))))
1020
1021
1022 (define-py* splitlines (py-splitlines bytes s n . l)
1023 (let ((keep? (match l
1024 ((#:keepends v)
1025 v)
1026 ((v)
1027 v)
1028 (_ #f))))
1029 (let lp ((i 0) (r '()) (old 0))
1030 (if (< i n)
1031 (let* ((x (b-ref s i))
1032 (ch (chf x)))
1033 (if (eq? ch #\newline)
1034 (if keep?
1035 (lp (+ i 1)
1036 (cons
1037 (pylist-slice s old (+ i 1) 1)
1038 r)
1039 (+ i 1))
1040 (lp (+ i 1)
1041 (cons
1042 (pylist-slice s old i 1)
1043 r)
1044 (+ i 1)))
1045 (lp (+ i 1) r old)))
1046 (reverse r)))))
1047
1048 (define-py* translate (py-translate bytes s n table . l)
1049 (let* ((table (b-get table))
1050 (w (b-make n))
1051 (t (if (eq? table None) #f table))
1052 (d (match l (() #f) ((x) (map b-char (to-list x))))))
1053 (define (tr ch)
1054 (define (e)
1055 (if t
1056 (if (< ch (b-len t))
1057 (b-ref t ch)
1058 ch)
1059 ch))
1060
1061 (if d
1062 (if (member ch d)
1063 #f
1064 (e))
1065 (e)))
1066
1067 (let lp ((i 0) (k 0))
1068 (if (< i n)
1069 (let ((ch (tr (b-ref s i))))
1070 (if ch
1071 (begin
1072 (b-set! w k ch)
1073 (lp (+ i 1) (+ k 1)))
1074 (lp (+ i 1) k)))
1075 (bytes
1076 (if (= k n)
1077 w
1078 (pylist-slice w 0 k 1)))))))
1079
1080 (define-syntax-rule (a b x y) (b (symbol->string x) (symbol->string y)))
1081
1082 (define (cmp op s1 n1 s2 n2)
1083 (let ((n (min n1 n2)))
1084 (let lp ((i 0))
1085 (if (< i n)
1086 (let ((x1 (b-ref s1 i))
1087 (x2 (b-ref s2 i)))
1088 (if (= x1 x2)
1089 (lp (+ i 1))
1090 (op x1 x2)))
1091 (op n1 n2)))))
1092
1093
1094 (define-syntax-rule (mkop op)
1095 (begin
1096 (define-method (op (b1 <bytevector>) (s2 <py-bytes>))
1097 (let ((b2 (slot-ref s2 'bytes)))
1098 (cmp op b1 (b-len b1) b2 (b-len b2))))
1099 (define-method (op (s1 <py-bytes>) (b2 <bytevector>) )
1100 (let ((b1 (slot-ref s1 'bytes)))
1101 (cmp op b1 (b-len b1) b2 (b-len b2))))
1102 (define-method (op (b1 <bytevector>) (b2 <bytevector>) )
1103 (cmp op b1 (b-len b1) b2 (b-len b2)))
1104 (define-method (op (s1 <py-bytes>) (s2 <py-bytes>) )
1105 (let ((b1 (slot-ref s1 'bytes))
1106 (b2 (slot-ref s2 'bytes)))
1107 (cmp op b1 (b-len b1) b2 (b-len b2))))
1108 (define-method (op (a1 <py-bytearray>) (b2 <bytevector>))
1109 (let ((b1 (slot-ref a1 'vec))
1110 (n1 (slot-ref a1 'n)))
1111 (cmp op b1 n1 b2 (b-len b2))))
1112 (define-method (op (b1 <bytevector>) (a2 <py-bytearray>))
1113 (let ((b2 (slot-ref a2 'vec))
1114 (n2 (slot-ref a2 'n)))
1115 (cmp op b1 (b-len b1) b2 n2)))
1116 (define-method (op (a1 <py-bytearray>) (s2 <py-bytes>))
1117 (let ((b1 (slot-ref a1 'vec))
1118 (n1 (slot-ref a1 'n))
1119 (b2 (slot-ref s2 'bytes)))
1120 (cmp op b1 n1 b2 (b-len b2))))
1121 (define-method (op (s1 <py-bytes>) (a2 <py-bytearray>))
1122 (let ((b2 (slot-ref a2 'vec))
1123 (n2 (slot-ref a2 'n))
1124 (b1 (slot-ref s1 'bytes)))
1125 (cmp op b1 (b-len b1) b2 n2)))
1126 (define-method (op (a1 <py-bytearray>) (a2 <py-bytearray>))
1127 (let ((b1 (slot-ref a1 'vec))
1128 (n1 (slot-ref a1 'n ))
1129 (b2 (slot-ref a2 'vec))
1130 (n2 (slot-ref a2 'n )))
1131 (cmp op b1 n1 b2 n2)))))
1132
1133 (mkop <)
1134 (mkop <=)
1135 (mkop >)
1136 (mkop >=)
1137 (mkop py-equal?)
1138
1139 (define-py* zfill (py-zfill bytes s n width)
1140 (let* ((w (pylist-slice s 0 n 1)))
1141 (let lp ((i 0))
1142 (if (< i n)
1143 (let* ((x (b-ref s i))
1144 (ch (chf x)))
1145 (if (char-numeric? ch)
1146 (let lp ((j (max 0 (- i width))))
1147 (if (< j i)
1148 (begin
1149 (b-set! w j (ch-find #\0))
1150 (lp (+ j 1)))
1151 (bytes w)))
1152 (lp (+ i 1))))
1153 s))))
1154
1155 (define-method (py-hash (o <py-bytes>)) (hash (slot-ref o 'bytes) pyhash-N))
1156
1157 (define-class <bytes-iter> (<py-bytes>) i d)
1158 (define-class <bytearray-iter> (<py-bytearray>) i d)
1159
1160 (define-method (wrap-in (o <bytes-iter> ))
1161 (let ((out (make <bytes-iter>)))
1162 (slot-set! out 'bytes (slot-ref o 'bytes))
1163 (slot-set! out 'i (slot-ref o 'i))
1164 (slot-set! out 'd (slot-ref o 'd))
1165 out))
1166
1167 (define-method (wrap-in (o <bytearray-iter> ))
1168 (let ((out (make <bytearray-iter>)))
1169 (slot-set! out 'vec (slot-ref o 'vec))
1170 (slot-set! out 'n (slot-ref o 'n))
1171 (slot-set! out 'i (slot-ref o 'i))
1172 (slot-set! out 'd (slot-ref o 'd))
1173 out))
1174
1175 (define-method (wrap-in (s <bytevector>))
1176 (let ((out (make <bytes-iter>)))
1177 (slot-set! out 'bytes s)
1178 (slot-set! out 'i 0)
1179 (slot-set! out 'd 1)
1180 out))
1181
1182 (define-method (py-reversed (s <py-bytes>))
1183 (let ((out (make <bytes-iter>)))
1184 (slot-set! out 'bytes (slot-ref s 'bytes))
1185 (slot-set! out 'i (- (b-len s) 1))
1186 (slot-set! out 'd -1)
1187 out))
1188
1189 (define-method (py-reversed (s <py-bytearray>))
1190 (let ((out (make <bytearray-iter>)))
1191 (slot-set! out 'n (slot-ref s 'n))
1192 (slot-set! out 'vec (slot-ref s 'vec))
1193 (slot-set! out 'i (- (slot-ref s 'n) 1))
1194 (slot-set! out 'd -1)
1195 out))
1196
1197 (define-method (next (o <bytes-iter>))
1198 (let ((i (slot-ref o 'i ))
1199 (d (slot-ref o 'd))
1200 (bytes (slot-ref o 'bytes)))
1201 (if (> d 0)
1202 (if (< i (b-len bytes))
1203 (let ((ret (b-ref bytes i)))
1204 (slot-set! o 'i (+ i d))
1205 ret)
1206 (throw StopIteration))
1207 (if (>= i 0)
1208 (let ((ret (b-ref bytes i)))
1209 (slot-set! o 'i (+ i d))
1210 ret)
1211 (throw StopIteration)))))
1212
1213 (define-method (next (o <bytearray-iter>))
1214 (let ((i (slot-ref o 'i ))
1215 (d (slot-ref o 'd ))
1216 (bytes (slot-ref o 'vec))
1217 (n (slot-ref o 'n )))
1218 (if (> d 0)
1219 (if (< i n)
1220 (let ((ret (b-ref bytes i)))
1221 (slot-set! o 'i (+ i d))
1222 ret)
1223 (throw StopIteration))
1224 (if (>= i 0)
1225 (let ((ret (b-ref bytes i)))
1226 (slot-set! o 'i (+ i d))
1227 ret)
1228 (throw StopIteration)))))
1229
1230 (define (pybytes-listing)
1231 (let ((l (to-pylist
1232 (map symbol->string
1233 '(__add__ __class__ __contains__ __delattr__ __doc__
1234 __eq__ __format__ __ge__ __getattribute__
1235 __getitem__ __getnewargs__ __getslice__ __gt__
1236 __hash__ __init__ __le__ __len__ __lt__ __mod__
1237 __mul__ __ne__ __new__ __reduce__ __reduce_ex__
1238 __repr__ __rmod__ __rmul__ __setattr__ __sizeof__
1239 __bytes__ __subclasshook__
1240 _formatter_field_name_split _formatter_parser
1241 capitalize center count decode encode endswith
1242 expandtabs find format index isalnum isalpha
1243 isdigit islower isspace istitle isupper join
1244 ljust lower lbytesip partition replace rfind rindex
1245 rjust rpartition rsplit rbytesip split splitlines
1246 startswith strip swapcase
1247 title translate upper zfill)))))
1248 (pylist-sort! l)
1249 l))
1250
1251 (define (pybytesarray-listing)
1252 (let ((l (to-pylist
1253 (map symbol->string
1254 '(__add__ __alloc__ __class__ __contains__ __delattr__
1255 __delitem__ __dir__ __doc__ __eq__ __format__
1256 __ge__ __getattribute__ __getitem__ __gt__
1257 __hash__ __iadd__ __imul__ __init__ __iter__
1258 __le__ __len__ __lt__ __mod__ __mul__ __ne__
1259 __new__ __reduce__ __reduce_ex__ __repr__
1260 __rmod__ __rmul__ __setattr__ __setitem__
1261 __sizeof__ __str__ __subclasshook__ append
1262 capitalize center clear copy count decode endswith
1263 expandtabs extend find fromhex hex index insert
1264 isalnum isalpha isdigit islower isspace istitle
1265 isupper join ljust lower lstrip maketrans
1266 partition pop remove replace reverse rfind rindex
1267 rjust rpartition rsplit rstrip split splitlines
1268 startswith strip swapcase title translate upper
1269 zfill)))))
1270 (pylist-sort! l)
1271 l))