debuggings
[software/python-on-guile.git] / modules / language / python / string.scm
1 (define-module (language python string)
2 #:use-module (parser stis-parser)
3 #:use-module (oop goops)
4 #:use-module (oop pf-objects)
5 #:use-module (language python hash)
6 #:use-module (ice-9 match)
7 #:use-module (language python list)
8 #:use-module (language python exceptions)
9 #:use-module (language python for)
10 #:use-module (language python bool)
11 #:use-module (language python persist)
12 #:export (py-format py-capitalize py-center py-endswith
13 py-expandtabs py-find py-rfind
14 py-isalnum py-isalpha py-isdigit py-islower
15 py-isspace py-isupper py-istitle py-join py-ljust
16 py-rjust py-format-map
17 py-rljust py-lower py-upper py-lstrip py-rstrip
18 py-partition py-replace py-strip py-title
19 py-rpartitio py-rindex py-split py-rsplit py-splitlines
20 py-startswith py-swapcase py-translate py-zfill
21 pystring-listing <py-string> pystring py-string?
22 scm-str scm-sym py-identifier?))
23
24 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
25
26 (define (scm-str x)
27 (slot-ref (pystring x) 'str))
28
29 (define (scm-sym x)
30 (if (symbol? x)
31 x
32 (string->symbol (scm-str x))))
33
34 (define (py-string? x)
35 (or (string? x)
36 (is-a? x <py-string>)))
37
38 (define-class <py-string> () str)
39 (name-object <py-string>)
40
41 (cpit <py-string> (o (lambda (o s) (slot-set! o 'str s))
42 (list (slot-ref o 'str))))
43
44 (define-syntax-rule (define-py (f n o . u) code ...)
45 (begin
46 (define-method (f (o <string>) . u) code ...)
47 (define-method (f (o <py-string>) . l) (apply f (slot-ref o 'str) l))
48 (define-method (f (o <p>) . l)
49 (aif it (ref o 'n)
50 (apply it l)
51 (next-method)))))
52
53 (define-syntax-rule (define-py0 (f o . u) code ...)
54 (begin
55 (define-method (f (o <string>) . u) code ...)
56 (define-method (f (o <py-string>) . l) (apply f (slot-ref o 'str) l))))
57
58 (define-py0 (pylist-ref s i)
59 (list->string (list (string-ref s (if (< i 0)
60 (+ (len s) i)
61 i)))))
62
63 (define-py0 (bool s)
64 (if (= (len s) 0)
65 #f
66 s))
67
68 (define-py (py-capitalize capitalize s)
69 (let* ((n (len s))
70 (w (make-string n)))
71 (let lp ((i 0) (first? #t))
72 (if (< i n)
73 (let ((ch (string-ref s i)))
74 (if (and first? (char-alphabetic? ch))
75 (begin
76 (string-set! w i (char-upcase ch))
77 (lp (+ i 1) #f))
78 (begin
79 (string-set! w i ch)
80 (lp (+ i 1) first?))))
81 w))))
82
83 (define-py (py-center center o w . l)
84 (let* ((ws (if (pair? l)
85 (car (string->list (car l)))
86 #\space))
87 (n (string-length o))
88 (w (if (< w n) n w))
89 (d (- w n))
90 (e (floor-quotient (- w n) 2))
91 (s (make-string w #\space)))
92 (let lp ((i 0) (j e))
93 (if (< i n)
94 (begin
95 (string-set! s j (string-ref o i))
96 (lp (+ i 1) (+ j 1)))))
97 s))
98
99
100
101 ;;;py-decode
102 ;;;py-encode
103
104
105 (define-py (py-endswith endswith o (suff <string>) . l)
106 (let* ((n (string-length o))
107 (ns (string-length suff))
108 (f (lambda (x) (< x 0) (+ n x) x)))
109 (call-with-values (lambda ()
110 (match l
111 (() (values 0 n ))
112 ((x) (values (f x) n ))
113 ((x y) (values (f x) (f y)))))
114 (lambda (start end)
115 (string-suffix? suff o 0 ns start end)))))
116
117 (define-py (py-startswith startswith o (suff <string>) . l)
118 (let* ((n (string-length o))
119 (ns (string-length suff))
120 (f (lambda (x) (< x 0) (+ n x) x)))
121 (call-with-values (lambda ()
122 (match l
123 (() (values 0 n ))
124 ((x) (values (f x) n ))
125 ((x y) (values (f x) (f y)))))
126 (lambda (start end)
127 (string-prefix? suff o 0 ns start end)))))
128
129 (define-py (py-expandtabs expandtabs s . l)
130 (let* ((tabsize (match l (() 8) ((x) x)))
131 (u (string->list (make-string tabsize #\space)))
132 (n (string-length s)))
133 (let lp ((l (string->list s)) (r '()))
134 (if (pair? l)
135 (let ((x (car l)))
136 (if (eq? x #\tab)
137 (lp (cdr l) (append u r))
138 (lp (cdr l) (cons x r))))
139 (list->string (reverse r))))))
140
141 (define-py (py-find find s sub . l)
142 (let* ((n (string-length s))
143 (f (lambda (x) (< x 0) (+ n x) x)))
144 (call-with-values (lambda ()
145 (match l
146 (() (values 0 n ))
147 ((x) (values (f x) n ))
148 ((x y) (values (f x) (f y)))))
149 (lambda (start end)
150 (aif it (string-contains s sub start end)
151 it
152 -1)))))
153
154 (define-py (py-rfind rfind s sub . l)
155 (let* ((n (string-length s))
156 (s (string-reverse s))
157 (sub (string-reverse sub))
158 (f (lambda (x) (< x 0) (+ n x) x)))
159 (call-with-values (lambda ()
160 (match l
161 (() (values 0 n ))
162 ((x) (values (f x) n ))
163 ((x y) (values (f x) (f y)))))
164 (lambda (start end)
165 (aif it (string-contains s sub start end)
166 (- n it (len sub))
167 -1)))))
168
169 (define formatter #f)
170 (define-py (py-strformat format s . l)
171 (apply (ref formatter 'format) s l))
172
173 (define-py (py-format-map format_map s map)
174 (apply (ref formatter 'vformat) s '() map))
175
176 (define format (lambda (a b) a))
177 (define-py (py-format format s format-string)
178 (format s format-string))
179
180 (define-syntax-rule (mk-is py-isalnum isalnum x ...)
181 (define-py (py-isalnum isalnum s)
182 (and (> (len s) 0)
183 (string-fold
184 (lambda (ch s)
185 (if (or (x ch) ...)
186 s
187 #f))
188 #t s))))
189
190 (mk-is py-isalnum isalnum char-alphabetic? char-numeric?)
191 (mk-is py-isalpha isalpha char-alphabetic?)
192 (mk-is py-isdigit isdigit char-numeric?)
193 (mk-is py-islower islower char-lower-case?)
194 (mk-is py-isspace isspace char-whitespace?)
195 (mk-is py-isupper isupper char-upper-case?)
196
197 (define-py (py-identifier? isidentifier s)
198 (let lp ((l (string->list s)) (first? #t))
199 (if (pair? l)
200 (let ((x (car l)))
201 (if first?
202 (if (or (char-alphabetic? x)
203 (eq? x #\_))
204 (lp (cdr l) #f)
205 #f)
206 (if (or (char-alphabetic? x)
207 (char-numeric? x)
208 (eq? x #\_))
209 (lp (cdr l) #f)
210 #f)))
211 (if ((@ (language python module keyword) iskeyword) s)
212 #f
213 #t))))
214
215 (define-py (py-istitle istitle s)
216 (let ((n (len s)))
217 (if ((> n 0))
218 (let lp ((i 0) (space? #t))
219 (if (< i n)
220 (let ((ch (string-ref s i)))
221 (if space?
222 (cond
223 ((char-whitespace? ch)
224 (lp (+ i 1) #t))
225 ((char-upper-case? ch)
226 (lp (+ i 1) #f))
227 (else
228 #f))
229 (cond
230 ((char-whitespace? ch)
231 (lp (+ i 1) #t))
232 ((char-upper-case? ch)
233 #f)
234 ((char-lower-case? ch)
235 (lp (+ i 1) #f))
236 (else
237 #f))))
238 #t))
239 #f)))
240
241
242 (define-py (py-join join s iterator)
243 (string-join (to-list iterator) s))
244
245 (define-py (py-ljust ljust s width . l)
246 (let* ((n (len s))
247 (ch (match l
248 ((x . l)
249 (if (string? x)
250 (string-ref x 0)
251 x))
252 (()
253 #\space))))
254 (if (< width n)
255 (pylist-slice s 0 width 1)
256 (let ((ret (make-string width ch)))
257 (let lp ((i 0))
258 (if (< i n)
259 (begin
260 (string-set! ret i (string-ref s i))
261 (lp (+ i 1)))
262 ret))))))
263
264 (define-py (py-rjust rjust s width . l)
265 (let* ((n (len s))
266 (ch (match l
267 ((x . l)
268 (if (string? x)
269 (string-ref x 0)
270 x))
271 (()
272 #\space))))
273 (if (< width n)
274 (pylist-slice s (- width) (len s) 1)
275 (let ((ret (make-string width ch)))
276 (let lp ((i 0) (j (- width n)))
277 (if (< i n)
278 (begin
279 (string-set! ret j (string-ref s i))
280 (lp (+ i 1) (+ j 1)))
281 ret))))))
282
283 (define-py (py-lower lower s)
284 (string-downcase s))
285
286 (define-py (py-upper upper s)
287 (string-upcase s))
288
289 (define-py (py-lstrip lstrip s . l)
290 (match l
291 (()
292 (string-trim s))
293 ((x . _)
294 (let ((l (map (lambda (x) (if (string? x) (string-ref x 0) x)) x)))
295 (string-trim s (lambda (ch) (member ch l)))))))
296
297 (define-py (py-rstrip rstrip s . l)
298 (match l
299 (()
300 (string-trim-right s))
301 ((x . _)
302 (let ((l (map (lambda (x) (if (string? x) (string-ref x 0) x)) x)))
303 (string-trim-right s (lambda (ch) (member ch l)))))))
304
305 (define-py (py-partition partition s (sep <string>))
306 (let ((n (len s))
307 (m (len sep)))
308 (define (test i)
309 (let lp ((i i) (j 0))
310 (if (< i n)
311 (if (< j m)
312 (if (eq? (string-ref s i) (string-ref sep j))
313 (lp (+ i 1) (+ j 1))
314 #f)
315 #t)
316 #f)))
317 (let lp ((i 0))
318 (if (< i n)
319 (if (test i)
320 (list (pylist-slice s 0 i 1) sep (pylist-slice s (+ i m) n 1))
321 (lp (+ i 1)))
322 (list s "" "")))))
323
324 (define-py (py-partition partition s (sep <py-string>))
325 (py-partition s (slot-ref sep 'str)))
326
327
328 (define-py (py-rpartition rpartition ss (ssep <string>))
329 (let* ((s (string-reverse ss))
330 (sep (string-reverse ssep))
331 (n (len s))
332 (m (len sep)))
333 (define (test i)
334 (let lp ((i i) (j 0))
335 (if (< i n)
336 (if (< j m)
337 (if (eq? (string-ref s i) (string-ref sep j))
338 (lp (+ i 1) (+ j 1))
339 #f)
340 #t)
341 #f)))
342 (let lp ((i 0))
343 (if (< i n)
344 (if (test i)
345 (list (string-reverse
346 (pylist-slice s (+ i m) n 1))
347 ssep
348 (string-reverse
349 (pylist-slice s 0 i 1)))
350 (lp (+ i 1)))
351 (list "" "" s)))))
352
353 (define-py (py-rpartition rpartition s (sep <py-string>))
354 (py-rpartition s (slot-ref sep 'str)))
355
356 (define-py (py-replace replace s old new . l)
357 (let ((n (match l (() #f) ((n . _) n))))
358 (string-join
359 (reverse
360 (let lp ((s s) (r '()))
361 (let ((l (py-partition s old)))
362 (if (equal? (cadr l) "")
363 (cons s r)
364 (lp (list-ref l 2) (cons (car l) r))))))
365 new)))
366
367 (define-py (py-strip strip s . l)
368 (apply py-rstrip (apply py-lstrip s l) l))
369
370 (define-py (py-title title s)
371 (string-titlecase s))
372
373 (define-py (py-rindex rindex s . l)
374 (let ((n (len s)))
375 (- n (apply pylist-index (string-reverse s) l) 1)))
376
377
378
379 (define-py (py-split split s . l)
380 (define ws (f+ (f-reg "[ \t\n]")))
381 (define r
382 (f-or! (f-seq f-eof (f-out '()))
383 (f-cons (f-seq (mk-token (f* (f-reg! "."))) f-eof) (f-out '()))))
384 (define (u ws) (mk-token (f+ (f-not! ws))))
385 (define (tok ws i)
386 (if (= i 0)
387 (f-list (mk-token (f* (f-reg! "."))))
388 (let ((e (mk-token (f* (f-not! ws)))))
389 (f-seq (f? ws)
390 (f-cons e
391 (let lp ((i i))
392 (if (> (- i 1) 0)
393 (f-or! (f-seq (f? ws) f-eof (f-out '()))
394 (f-cons (f-seq ws e) (Ds (lp (- i 1)))))
395 r)))))))
396
397 (define N 1000000000000)
398 (let ((e (call-with-values
399 (lambda ()
400 (match l
401 (() (values ws N))
402 ((sep) (values (f-tag sep) N))
403 ((sep n) (values (f-tag sep) n))))
404 tok)))
405 (parse s e)))
406
407 (define-py (py-rsplit rsplit s . l)
408 (reverse
409 (map string-reverse
410 (apply py-split
411 (string-reverse s)
412 (match l
413 (() '())
414 ((sep . l) (cons (string-reverse sep) l)))))))
415
416
417 (define-py (py-splitlines splitlines s . l)
418 (let ((n (len s))
419 (keep? (match l
420 ((#:keepends v)
421 v)
422 ((v)
423 v)
424 (_ #f))))
425 (let lp ((i 0) (r '()) (old 0))
426 (if (< i n)
427 (let ((ch (string-ref s i)))
428 (if (eq? ch #\newline)
429 (if keep?
430 (lp (+ i 1)
431 (cons
432 (pylist-slice s old (+ i 1) 1)
433 r)
434 (+ i 1))
435 (lp (+ i 1)
436 (cons
437 (pylist-slice s old i 1)
438 r)
439 (+ i 1)))
440 (lp (+ i 1) r old)))
441 (reverse r)))))
442
443 (define-py (py-swapcase swapcase s)
444 (list->string
445 (string-fold
446 (lambda (ch s)
447 (cons
448 (cond
449 ((char-upper-case? ch)
450 (char-downcase ch))
451 ((char-lower-case? ch)
452 (char-upcase ch))
453 (else ch))
454 s))
455 '()
456 s)))
457
458 (define-py (py-translate translate s table . l)
459 (let* ((n (len s))
460 (w (make-string n))
461 (t (if (eq? table None) #f table))
462 (d (match l (() #f) ((x) x))))
463 (define (tr ch)
464 (define (e)
465 (if t
466 (let ((i (char->integer ch)))
467 (if (< i (string-length t))
468 (string-ref t i)
469 ch))
470 ch))
471
472 (if d
473 (if (string-contains d (list->string (list ch)))
474 #f
475 (e))
476 (e)))
477
478 (let lp ((i 0) (k 0))
479 (if (< i n)
480 (let ((ch (tr (string-ref s i))))
481 (if ch
482 (begin
483 (string-set! w k ch)
484 (lp (+ i 1) (+ k 1)))
485 (lp (+ i 1) k)))
486 (if (= k n)
487 w
488 (pylist-slice w 0 k 1))))))
489
490 (define-syntax-rule (a b x y) (b (symbol->string x) (symbol->string y)))
491
492 (define-syntax-rule (mkop op)
493 (begin
494 (define-method (op (s1 <string>) (s2 <py-string>))
495 (op s1 (slot-ref s2 'str)))
496 (define-method (op (s2 <py-string>) (s1 <string>))
497 (op s1 (slot-ref s2 'str)))))
498
499 (mkop <)
500 (mkop <=)
501 (mkop >)
502 (mkop >=)
503 (mkop +)
504 (mkop *)
505
506 (define-method (< (s1 <string>) (s2 <string>)) (string-ci< s1 s2))
507 (define-method (<= (s1 <string>) (s2 <string>)) (string-ci<= s1 s2))
508 (define-method (> (s1 <string>) (s2 <string>)) (string-ci> s1 s2))
509 (define-method (>= (s1 <string>) (s2 <string>)) (string-ci>= s1 s2))
510
511 (define-method (< (s1 <symbol>) (s2 <symbol>)) (a string-ci< s1 s2))
512 (define-method (<= (s1 <symbol>) (s2 <symbol>)) (a string-ci<= s1 s2))
513 (define-method (> (s1 <symbol>) (s2 <symbol>)) (a string-ci> s1 s2))
514 (define-method (>= (s1 <symbol>) (s2 <symbol>)) (a string-ci>= s1 s2))
515
516
517 (define-py (py-zfill zfill s width)
518 (let* ((n (len s))
519 (w (pylist-slice s 0 n 1)))
520 (let lp ((i 0))
521 (if (< i n)
522 (let ((ch (string-ref s i)))
523 (if (char-numeric? ch)
524 (let lp ((j (max 0 (- i width))))
525 (if (< j i)
526 (begin
527 (string-set! w j #\0)
528 (lp (+ j 1)))
529 w))
530 (lp (+ i 1))))
531 s))))
532
533 (define-python-class string (<py-string>)
534 (define __init__
535 (case-lambda
536 ((self s)
537 (cond
538 ((is-a? s <py-string>)
539 (slot-ref s 'src))
540 ((is-a? s <string>)
541 s)
542 (else
543 (__init__ self ((@ (guile) format) #f "~a" s)))))))
544
545 (define __new__ (lambda x (apply __init__ x)))
546
547 (define __repr__
548 (lambda (self)
549 (slot-ref self 'str))))
550
551 (name-object string)
552
553 (define pystring string)
554
555 (define-method (py-class (o <string>)) string)
556 (define-method (py-class (o <py-string>)) string)
557
558 (define-method (pyhash (o <py-string>)) (hash (slot-ref o 'str) pyhash-N))
559
560 (define-method (py-equal? (o <py-string>) x)
561 (equal? (slot-ref o 'str) x))
562 (define-method (py-equal? x (o <py-string>))
563 (equal? (slot-ref o 'str) x))
564
565 (define-class <string-iter> (<py-string>) str i d)
566 (name-object <string-iter>)
567 (cpit <string-iter> (o
568 (lambda (o str i d)
569 (slot-set! o 'str str)
570 (slot-set! o 'i i )
571 (slot-set! o 'd d ))
572 (list
573 (slot-ref o 'str)
574 (slot-ref o 'i)
575 (slot-ref o 'd))))
576
577
578 (define-method (write (o <string-iter>) . l)
579 (define port (if (null? l) #t (car l)))
580 (for ((x : o)) ((l '()))
581 (cons (string-ref x 0) l)
582 #:final
583 ((@ (guile) format) port "iter(~s)" (list->string (reverse l)))))
584
585 (define-method (wrap-in (o <string-iter> ))
586 (let ((out (make <string-iter>)))
587 (slot-set! out 'str (slot-ref o 'str))
588 (slot-set! out 'i (slot-ref o 'i))
589 (slot-set! out 'd (slot-ref o 'd))
590 out))
591
592 (define-method (wrap-in (s <string>))
593 (let ((out (make <string-iter>)))
594 (slot-set! out 'str s)
595 (slot-set! out 'i 0)
596 (slot-set! out 'd 1)
597 out))
598
599 (define-method (py-reversed (s <string>))
600 (let ((out (make <string-iter>)))
601 (slot-set! out 'str s)
602 (slot-set! out 'i (- (string-length s) 1))
603 (slot-set! out 'd -1)
604 out))
605
606 (define-method (next (o <string-iter>))
607 (let ((i (slot-ref o 'i ))
608 (d (slot-ref o 'd))
609 (str (slot-ref o 'str)))
610 (if (> d 0)
611 (if (< i (string-length str))
612 (let ((ret (string-ref str i)))
613 (slot-set! o 'i (+ i d))
614 (list->string (list ret)))
615 (throw StopIteration))
616 (if (>= i 0)
617 (let ((ret (string-ref str i)))
618 (slot-set! o 'i (+ i d))
619 (list->string (list ret)))
620 (throw StopIteration)))))
621
622 (define (pystring-listing)
623 (let ((l (to-pylist
624 (map symbol->string
625 '(__add__ __class__ __contains__ __delattr__ __doc__
626 __eq__ __format__ __ge__ __getattribute__
627 __getitem__ __getnewargs__ __getslice__ __gt__
628 __hash__ __init__ __le__ __len__ __lt__ __mod__
629 __mul__ __ne__ __new__ __reduce__ __reduce_ex__
630 __repr__ __rmod__ __rmul__ __setattr__ __sizeof__
631 __str__ __subclasshook__
632 _formatter_field_name_split _formatter_parser
633 capitalize center count decode encode endswith
634 expandtabs find format index isalnum isalpha
635 isdigit islower isspace istitle isupper join
636 ljust lower lstrip partition replace rfind rindex
637 rjust rpartition rsplit rstrip split splitlines
638 startswith strip swapcase format_map
639 title translate upper zfill)))))
640 (pylist-sort! l)
641 l))
642
643