(define-module (language python str) #:use-module (oop goops) #:use-module (oop pf-objects) #:use-module (ice-9 match) #:use-module (rnrs bytevectors) #:use-module (system foreign) #:use-module (language python string) #:use-module (language python for) #:use-module (language python try) #:use-module (language python exceptions) #:use-module (language python list) #:use-module (language python hash) #:export ( pystr-listing str str->bytevector)) (define (str->bytevector x) (slot-ref x 'str)) (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) (define b-ref bytevector-u8-ref) (define b-set! bytevector-u8-set!) (define b-make make-bytevector) (define b-len bytevector-length) (define-class () str) (define (b-char x) (cond ((char? x) (ch-find x)) ((string? x) (ch-find (string-ref x 0))) (else x))) (define-python-class str () (define __init__ (case-lambda ((self s) (cond ((is-a? s ) (let* ((n (string-length s)) (str (b-make n))) (let lp ((i 0)) (if (< i n) (begin (b-set! str i (ch-find (string-ref s i))) (lp (+ i 1))))) (slot-set! self 'str str))) ((is-a? s ) (__init__ self (slot-ref s 'str))) ((is-a? s ) (slot-set! self 'str (slot-ref s 'str))) ((is-a? s ) (slot-set! self 'str s)) (else (for ((x : s)) ((r '())) (cons (b-char x) r) #:final (let* ((n (length r)) (str (b-make n))) (let lp ((i (- n 1)) (r r)) (if (>= i 0) (begin (b-set! str i (car r)) (lp (- i 1) (cdr r))) (slot-set! self 'str str))))))))))) (define-syntax-rule (define-py (f o . u) code ...) (begin (define-method (f (o ) . u) code ...) (define-method (f (o ) . l) (apply f (slot-ref o 'str) l)))) (define-method (write (b ) . l) (apply write (b->string (slot-ref b 'str)) l)) (define dynlink (dynamic-link)) (define stringn (pointer->procedure '* (dynamic-func "scm_from_locale_stringn" dynlink) (list '* size_t))) (define ch->i (make-hash-table)) (define (re-eval ch) (let lp ((i 0)) (if (< i 256) (if (eq? ch (chf i)) (begin (hash-set! ch->i ch i) (lp (+ i 1))) (lp (+ i 1))) (hash-ref ch->i ch)))) (define (ch-find ch) (aif it (hash-ref ch->i ch #f) (if (eq? ch (chf it)) it (re-eval ch)) (re-eval ch))) (define (chf ch) (let ((str (pointer->scm (stringn (bytevector->pointer (b-make 1 ch)) 1)))) (if (= (string-length str) 1) (string-ref str 0) (chf 0)))) (define (b->string b) (pointer->scm (stringn (bytevector->pointer b) (b-len b)))) (define-py (py-capitalize s) (let* ((n (b-len s)) (w (b-make n))) (let lp ((i 0) (first? #t)) (if (< i n) (let* ((x (b-ref s i)) (ch (chf x))) (define (f first?) (b-set! w i x) (lp (+ i 1) first?)) (if (and first? (char-alphabetic? ch)) (aif it (ch-find (char-upcase ch)) (begin (b-set! w i it) (lp (+ i 1) #f)) (f #t)) (f #f))) (str w))))) (define-py (py-center o w . l) (let* ((ws (if (pair? l) (ch-find (b-ref (car l) 0)) (ch-find #\space))) (n (b-len o)) (w (if (< w n) n w)) (d (- w n)) (e (floor-quotient (- w n) 2)) (s (b-make w (ch-find #\space)))) (let lp ((i 0) (j e)) (if (< i n) (begin (b-set! s j (b-ref o i)) (lp (+ i 1) (+ j 1))))) (str s))) ;;;py-decode ;;;py-encode (define-py (py-endswith o suff . l) (let* ((suff (slot-ref (str suff) 'str)) (n (b-len o)) (ns (b-len suff)) (f (lambda (x) (< x 0) (+ n x) x))) (call-with-values (lambda () (match l (() (values 0 n )) ((x) (values (f x) n )) ((x y) (values (f x) (f y))))) (lambda (start end) (let lp ((i (- n ns)) (j 0)) (if (< i start) (lp (+ i 1) (+ j 1)) (if (>= i end) #t (and (eq? (b-ref o i) (b-ref suff j)) (lp (+ i 1) (+ j 1)))))))))) (define-py (py-startswith o pre . l) (let* ((pre (slot-ref (str pre) 'str)) (n (b-len o)) (ns (b-len pre)) (f (lambda (x) (< x 0) (+ n x) x))) (call-with-values (lambda () (match l (() (values 0 n )) ((x) (values (f x) n )) ((x y) (values (f x) (f y))))) (lambda (start end) (let lp ((i 0)) (cond ((or (>= i end) (>= i ns)) #t) ((< i start) (lp (+ i 1))) (else (and (eq? (b-ref o i) (b-ref pre i)) (lp (+ i 1)))))))))) (define-py (py-expandtabs s . l) (let* ((tabsize (match l (() 8) ((x) x))) (ct (ch-find #\tab)) (cs (ch-find #\space)) (n (b-len s))) (let lp ((i 0) (r '())) (if (< i n) (let ((x (b-ref s i))) (if (eq? x ct) (let lp2 ((j 0) (r r)) (if (< j tabsize) (lp2 (+ j 1) (cons cs r)) (lp (+ i 1) r))) (lp (+ i 1) (cons x r)))) (str (reverse r)))))) (define (b-contains s sub start end) (define nsub (b-len sub)) (define (match i) (let lp ((i i) (j 0)) (if (and (< j nsub) (< i end)) (if (eq? (b-ref s i) (b-ref sub j)) (lp (+ i 1) (+ j 1)) #f) #t))) (let lp ((i (max start 0))) (if (< i end) (if (match i) i (lp (+ i 1))) #f))) (define-py (py-find s sub . l) (let* ((n (b-len s)) (f (lambda (x) (< x 0) (+ n x) x))) (call-with-values (lambda () (match l (() (values 0 n )) ((x) (values (f x) n )) ((x y) (values (f x) (f y))))) (lambda (start end) (let ((sub (slot-ref (str sub) 'str))) (aif it (b-contains s sub start end) it -1)))))) (define (b-reverse s) (if (is-a? s ()) (b-reverse (slot-ref s 'str)) (let* ((n (b-len s)) (r (b-make n))) (let lp ((i 0) (j (- n 1))) (if (< i n) (begin (b-set! r j (b-ref s i)) (lp (+ i 1) (- j 1))) r))))) (define-py (py-rfind s sub . l) (let* ((sub (slot-ref (str sub) 'str)) (n (b-len s)) (s (b-reverse s)) (sub (b-reverse sub)) (f (lambda (x) (< x 0) (+ n x) x))) (call-with-values (lambda () (match l (() (values 0 n )) ((x) (values (f x) n )) ((x y) (values (f x) (f y))))) (lambda (start end) (aif it (b-contains s sub start end) (- n it (b-len sub)) -1))))) #| (define i (f-list #:i (mk-token (f+ (f-reg! "[0-9]"))))) (define s (f-list #:s (mk-token (f+ (f-not! (f-tag "}")))))) (define e (f-list #:e (f-and (f-tag "}") f-true))) (define tagbody (f-or! e i s)) (define tag (f-seq "{" tagbody "}")) (define nontag (f-list #:str (mk-token (f+ (f-or! (f-tag "{{") (f-not! tag)))))) (define e (ff* (f-or! tag nontag))) (define (compile x args kwargs) (let lp ((l x) (r '()) (u '()) (i 0)) (match l (((#:str x) . l) (lp l (cons x r) u i)) (((#:i x) . l) (lp l (cons "~a" r) (cons (list-ref args (string->number x)) u) i)) (((#:s x) . l) (lp l (cons "~a" r) (cons (hash-ref kwargs x None) u) i)) (((#:e) . l) (lp l (cons "~a" r) (cons (list-ref args i) u) (+ i 1))) (() (apply format #f (string-join (reverse r) "") (reverse u)))))) (define-py (py-format format s . l) (call-with-values (lambda () (let lp ((l l) (args '()) (kwargs (make-hash-table))) (match l (((? keyword? key) x . l) (hash-set! kwargs (symbol->string (keyword->symbol key)) x) (lp l args kwargs)) ((x . l) (lp l (cons x args) kwargs)) (() (values (reverse args) kwargs))))) (lambda (args kwargs) (compile (parse s e) args kwargs)))) |# (define-syntax-rule (mk-is py-isalnum x ...) (define-py (py-isalnum s) (let ((n (b-len s))) (let lp ((i 0)) (if (< i n) (let ((ch (chf (b-ref s i)))) (if (or (x ch) ...) (lp (+ i 1)) #f)) #t))))) (mk-is py-isalnum char-alphabetic? char-numeric?) (mk-is py-isalpha char-alphabetic?) (mk-is py-isdigit char-numeric?) (mk-is py-islower char-lower-case?) (mk-is py-isspace char-whitespace?) (mk-is py-isupper char-upper-case?) (define-py (py-istitle s) (let ((n (b-len s))) (if ((> n 0)) (let lp ((i 0) (space? #t)) (if (< i n) (let ((ch (chf (b-ref s i)))) (if space? (cond ((char-whitespace? ch) (lp (+ i 1) #t)) ((char-upper-case? ch) (lp (+ i 1) #f)) (else #f)) (cond ((char-whitespace? ch) (lp (+ i 1) #t)) ((char-upper-case? ch) #f) ((char-lower-case? ch) (lp (+ i 1) #f)) (else #f)))) #t)) #f))) (define (b-join l s) (let* ((ns (b-len s)) (l (pk (map (lambda (x) (slot-ref (str x) 'str)) l))) (n (let lp ((l l) (n 0)) (if (pair? l) (let ((x (car l)) (l (cdr l))) (lp l (+ n (b-len x) (if (pair? l) ns 0)))) n))) (r (b-make n))) (let lp ((l l) (i 0)) (if (pair? l) (let* ((x (car l)) (n (b-len x)) (l (cdr l))) (let lp2 ((j 0) (i i)) (if (< j n) (begin (b-set! r i (b-ref x j)) (lp2 (+ j 1) (+ i 1))) (if (pair? l) (let lp3 ((j 0) (i i)) (if (< j ns) (begin (b-set! r i (b-ref s j)) (lp3 (+ j 1) (+ i 1))) (lp l i))) (lp l i))))) (str r))))) (define-py (py-join s iterator) (b-join (to-list iterator) s)) (define-py (pylist-slice s n1 n2 n3) (define N (b-len s)) (define (f n) (if (< n 0) (+ N n) n)) (let* ((n1 (f (if (eq? n1 None) 0 n1))) (n2 (f (if (eq? n2 None) N n2))) (n3 (f (if (eq? n3 None) 1 n3))) (r (b-make (floor-quotient (+ 1 (abs (- n2 n1))) n3)))) (let lp ((i n1) (j 0)) (if (< i n3) (begin (b-set! r j (b-ref s i)) (lp (+ i n3) (+ j 1))) (str r))))) (define-py (py-ljust s width . l) (let* ((n (b-len s)) (ch (match l ((x) (b-char x)) (() (b-char #\space))))) (if (< width n) (pylist-slice s 0 width 1) (let ((ret (b-make width ch))) (let lp ((i 0)) (if (< i n) (begin (b-set! ret i (b-ref s i)) (lp (+ i 1))) (str ret))))))) (define-py (py-rjust s width . l) (let* ((n (b-len s)) (ch (match l ((x) (b-char x)) (() (b-char #\space))))) (if (< width n) (pylist-slice s (- width) (len s) 1) (let ((ret (b-make width ch))) (let lp ((i 0) (j (- width n))) (if (< i n) (begin (b-set! ret j (b-ref s i)) (lp (+ i 1) (+ j 1))) (str ret))))))) (define-py (py-lower s) (let* ((n (b-len s)) (r (b-make n))) (let lp ((i 0)) (if (< i n) (let* ((x (b-ref s i)) (ch (chf x))) (b-set! r i (if (char-upper-case? ch) (ch-find (char-downcase ch)) x)) (lp (+ i 1))) (str r))))) (define-py (py-upper s) (let* ((n (b-len s)) (r (b-make n))) (let lp ((i 0)) (if (< i n) (let* ((x (b-ref s i)) (ch (chf x))) (b-set! r i (if (char-lower-case? ch) (ch-find (char-upcase ch)) x)) (lp (+ i 1))) (str r))))) (define-py (py-swapcase s) (let* ((n (b-len s)) (r (b-make n))) (let lp ((i 0)) (if (< i n) (let* ((x (b-ref s i)) (ch (chf x))) (b-set! r i (cond ((char-lower-case? ch) (ch-find (char-upcase ch))) ((char-upper-case? ch) (ch-find (char-downcase ch))) (else x))) (lp (+ i 1))) (str r))))) (define b-trim (case-lambda ((s) (b-trim s (lambda (ch x) (char-whitespace? ch)))) ((s p) (let ((n (b-len s))) (let lp ((i 0) (r '()) (first? #t)) (if (< i n) (let ((x (b-ref s i))) (if first? (if (p (chf x) x) (lp (+ i 1) r #t) (lp (+ i 1) (cons x r) #f)) (lp (+ i 1) (cons x r) #f))) (str (reverse r)))))))) (define b-rtrim (case-lambda ((s) (b-rtrim s (lambda (ch x) (char-whitespace? ch)))) ((s p) (let ((n (b-len s))) (let lp ((i (- n 1)) (r '()) (first? #t)) (if (>= i 0) (let ((x (b-ref s i))) (if first? (if (p (chf x) x) (lp (- i 1) r #t) (lp (- i 1) (cons x r) #f)) (lp (- i 1) (cons x r) #f))) (str r))))))) (define-py (py-lstrip s . l) (match l (() (b-trim s)) ((x) (let ((l (map b-char (to-list x)))) (b-trim s (lambda (ch x) (member x l))))))) (define-py (py-rstrip s . l) (match l (() (b-rtrim s)) ((x) (let ((l (map b-char (to-list x)))) (b-rtrim s (lambda (ch x) (member x l))))))) (define-py (py-partition s sep) (let* ((sep (slot-ref (str sep) 'str)) (n (b-len s)) (m (b-len sep))) (define (test i) (let lp ((i i) (j 0)) (if (< i n) (if (< j m) (if (eq? (b-ref s i) (b-ref sep j)) (lp (+ i 1) (+ j 1)) #f) #t) #f))) (let lp ((i 0)) (if (< i n) (if (test i) (list (pylist-slice s 0 i) sep (pylist-slice s (+ i m) n)) (lp (+ i 1))) (list s "" ""))))) (define-py (py-rpartition ss ssep) (let* ((ssep (slot-ref (str ssep) 'str)) (s (b-reverse ss)) (sep (b-reverse ssep)) (n (b-len s)) (m (b-len sep))) (define (test i) (let lp ((i i) (j 0)) (if (< i n) (if (< j m) (if (eq? (b-ref s i) (b-ref sep j)) (lp (+ i 1) (+ j 1)) #f) #t) #f))) (let lp ((i 0)) (if (< i n) (if (test i) (list (str (b-reverse (pylist-slice s (+ i m) n))) ssep (str (b-reverse (pylist-slice s 0 i)))) (lp (+ i 1))) (list "" "" s))))) (define-py (py-replace s old new . l) (let ((n (match l (() #f) ((n . _) n)))) (b-join (reverse (let lp ((s s) (r '())) (let ((l (py-partition s old))) (if (equal? (cadr l) "") (cons s r) (lp (list-ref l 2) (cons (car l) r)))))) new))) (define-py (py-strip s . l) (apply py-rstrip (apply py-lstrip s l) l)) (define-py (pylist-index o val . l) (let* ((n (b-len o)) (vec o) (f (lambda (m) (if (< m 0) (+ m n) m)))) (call-with-values (lambda () (match l (() (values 0 n)) ((x) (values (f x) n)) ((x y) (values (f x) (f y))))) (lambda (n1 n2) (if (and (>= n1 0) (>= n2 0) (< n1 n) (<= n2 n)) (let lp ((i n1)) (if (< i n2) (let ((r (b-ref vec i))) (if (equal? r val) i (lp (+ i 1)))) (raise ValueError "could not find value in index fkn"))) (raise IndexError "index out of scop in index fkn")))))) (define-py (py-rindex s . l) (let ((n (b-len s))) (- n (apply pylist-index (b-reverse s) l) 1))) #; (define-py (py-title title s) (string-titlecase s)) #; (define-py (py-split s . l) (define ws (f+ (f-reg "[ \t\n]"))) (define r (f-or! (f-seq f-eof (f-out '())) (f-cons (f-seq (mk-token (f* (f-reg! "."))) f-eof) (f-out '())))) (define (u ws) (mk-token (f+ (f-not! ws)))) (define (tok ws i) (if (= i 0) (f-list (mk-token (f* (f-reg! ".")))) (let ((e (mk-token (f* (f-not! ws))))) (f-seq (f? ws) (f-cons e (let lp ((i i)) (if (> (- i 1) 0) (f-or! (f-seq (f? ws) f-eof (f-out '())) (f-cons (f-seq ws e) (Ds (lp (- i 1))))) r))))))) (define N 1000000000000) (let ((e (call-with-values (lambda () (match l (() (values ws N)) ((sep) (values (f-tag sep) N)) ((sep n) (values (f-tag sep) n)))) tok))) (parse s e))) #; (define-py (py-rsplit s . l) (reverse (map string-reverse (apply py-split (string-reverse s) (match l (() '()) ((sep . l) (cons (string-reverse sep) l))))))) (define-py (py-splitlines s . l) (let ((n (len s)) (keep? (match l ((#:keepends v) v) ((v) v) (_ #f)))) (let lp ((i 0) (r '()) (old 0)) (if (< i n) (let* ((x (b-ref s i)) (ch (chf x))) (if (eq? ch #\newline) (if keep? (lp (+ i 1) (cons (pylist-slice s old (+ i 1) 1) r) (+ i 1)) (lp (+ i 1) (cons (pylist-slice s old i 1) r) (+ i 1))) (lp (+ i 1) r old))) (reverse r))))) (define-py (py-translate s table . l) (let* ((table (slot-ref (str table) 'str)) (n (b-len s)) (w (b-make n)) (t (if (eq? table None) #f table)) (d (match l (() #f) ((x) (map b-char (to-list x)))))) (define (tr ch) (define (e) (if t (if (< ch (b-len t)) (b-ref t ch) ch) ch)) (if d (if (member ch d) #f (e)) (e))) (let lp ((i 0) (k 0)) (if (< i n) (let ((ch (tr (b-ref s i)))) (if ch (begin (b-set! w k ch) (lp (+ i 1) (+ k 1))) (lp (+ i 1) k))) (if (= k n) w (pylist-slice w 0 k 1)))))) (define-syntax-rule (a b x y) (b (symbol->string x) (symbol->string y))) (define-syntax-rule (mkop op) (begin (define-method (op (s1 ) (s2 )) (op s1 (slot-ref s2 'str))) (define-method (op (s2 ) (s1 )) (op s1 (slot-ref s2 'str))))) (mkop <) (mkop <=) (mkop >) (mkop >=) (mkop py-equal?) (mkop +) (mkop *) (define-syntax-rule (mkop2 op) (define-method (< (s1 ) (s2 )) (let* ((n1 (b-len s1)) (n2 (b-len s2)) (n (min n1 n2))) (let lp ((i 0)) (if (< i n) (let ((x1 (b-ref s1 i)) (x2 (b-ref s2 i))) (if (= x1 x2) (lp (+ i 1)) (op x1 x2))) (op n1 n2)))))) (mkop2 <) (mkop2 <=) (mkop2 >=) (mkop2 >) (mkop2 py-equal?) (define-py (py-zfill s width) (let* ((n (b-len s)) (w (pylist-slice s 0 n 1))) (let lp ((i 0)) (if (< i n) (let* ((x (b-ref s i)) (ch (chf x))) (if (char-numeric? ch) (let lp ((j (max 0 (- i width)))) (if (< j i) (begin (b-set! w j (ch-find #\0)) (lp (+ j 1))) w)) (lp (+ i 1)))) s)))) (define-method (pyhash (o )) (hash (slot-ref o 'str) pyhash-N)) (define-class () str i d) (define-method (wrap-in (o )) (let ((out (make ))) (slot-set! out 'str (slot-ref o 'str)) (slot-set! out 'i (slot-ref o 'i)) (slot-set! out 'd (slot-ref o 'd)) out)) (define-method (wrap-in (s )) (let ((out (make ))) (slot-set! out 'str s) (slot-set! out 'i 0) (slot-set! out 'd 1) out)) (define-method (py-reversed (s )) (let ((out (make ))) (slot-set! out 'str s) (slot-set! out 'i (- (b-len s) 1)) (slot-set! out 'd -1) out)) (define-method (next (o )) (let ((i (slot-ref o 'i )) (d (slot-ref o 'd)) (str (slot-ref o 'str))) (if (> d 0) (if (< i (b-len str)) (let ((ret (b-ref str i))) (slot-set! o 'i (+ i d)) ret) (throw StopIteration)) (if (>= i 0) (let ((ret (b-ref str i))) (slot-set! o 'i (+ i d)) ret) (throw StopIteration))))) (define (pystr-listing) (let ((l (to-pylist (map symbol->string '(__add__ __class__ __contains__ __delattr__ __doc__ __eq__ __format__ __ge__ __getattribute__ __getitem__ __getnewargs__ __getslice__ __gt__ __hash__ __init__ __le__ __len__ __lt__ __mod__ __mul__ __ne__ __new__ __reduce__ __reduce_ex__ __repr__ __rmod__ __rmul__ __setattr__ __sizeof__ __str__ __subclasshook__ _formatter_field_name_split _formatter_parser capitalize center count decode encode endswith expandtabs find format index isalnum isalpha isdigit islower isspace istitle isupper join ljust lower lstrip partition replace rfind rindex rjust rpartition rsplit rstrip split splitlines startswith strip swapcase title translate upper zfill))))) (pylist-sort! l) l))