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