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