bytevectors as str
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Wed, 11 Oct 2017 20:17:16 +0000 (22:17 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Wed, 11 Oct 2017 20:17:16 +0000 (22:17 +0200)
modules/language/python/str.scm [new file with mode: 0644]
modules/language/python/string.scm

diff --git a/modules/language/python/str.scm b/modules/language/python/str.scm
new file mode 100644 (file)
index 0000000..44d2803
--- /dev/null
@@ -0,0 +1,657 @@
+(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)
+  #:export (<py-str> chf ch-find 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 <py-str> () str)
+
+(define-python-class str (<py-str>)
+  (define __init__
+    (case-lambda
+      ((self s)
+       (cond
+        ((is-a? s <py-str>)
+         (slot-set! self 'str (slot-ref s 'str)))
+        ((is-a? s <bytevector>)
+         (slot-set! self 'str s)))))))
+
+(define-syntax-rule (define-py (f o . u) code ...)
+  (begin
+    (define-method (f (o <bytevector>) . u) code ...)
+    (define-method (f (o <py-str>)     . l) (apply f (slot-ref o 'str) l))))
+
+(define-method (write (b <py-str>) . 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 <bytevector>) . l)
+  (let* ((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 (suff <bytevector>) . l)
+  (let* ((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 0))
+          (cond
+           ((or (>= i end)
+                (>= i ns))
+            #t)
+           ((< i start)
+            (lp (+ i 1)))
+           (else
+            (and
+             (eq? (b-ref o i) (b-ref suff i))
+             (lp (+ i 1))))))))))
+
+#|
+(define-py (py-expandtabs expandtabs s . l)
+  (let* ((tabsize (match l (() 8) ((x) x)))
+         (u       (string->list (make-string tabsize #\space)))
+         (n       (string-length s)))
+    (let lp ((l (string->list s)) (r '()))
+      (if (pair? l)
+          (let ((x (car l)))
+            (if (eq? x #\tab)
+                (lp (cdr l) (append u r))
+                (lp (cdr l) (cons x r))))
+          (list->string (reverse r))))))
+      
+(define-py (py-find find s sub . l)
+  (let* ((n   (string-length 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)
+        (aif it (string-contains s sub start end)
+             it
+             -1)))))
+
+(define-py (py-rfind rfind s sub . l)  
+  (let* ((n   (string-length s))
+         (s   (string-reverse s))
+         (sub (string-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 (string-contains s sub start end)
+             (- n it (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 isalnum x ...)
+  (define-py (py-isalnum isalnum s)
+    (and (> (len s) 0)
+         (string-fold
+          (lambda (ch s)
+            (if (or (x ch) ...)
+                s
+                #f))
+          #t s))))
+
+(mk-is py-isalnum isalnum char-alphabetic? char-numeric?)
+(mk-is py-isalpha isalpha char-alphabetic?)
+(mk-is py-isdigit isdigit char-numeric?)
+(mk-is py-islower islower char-lower-case?)
+(mk-is py-isspace isspace char-whitespace?)
+(mk-is py-isupper isupper char-upper-case?)
+
+(define-py (py-istitle istitle s)
+  (let ((n (len s)))
+    (if ((> n 0))
+        (let lp ((i 0) (space? #t))
+          (if (< i n)
+              (let ((ch (string-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-py (py-join join s iterator)
+  (string-join (to-list iterator) s))
+
+(define-py (py-ljust ljust s width . l)
+  (let* ((n  (len s))
+         (ch (match l
+               ((x . l)
+                (if (string? x)
+                    (string-ref x 0)
+                    x))
+                (()
+                 #\space))))
+    (if (< width n)
+        (pylist-slice s 0 width)
+        (let ((ret (make-string width ch)))
+          (let lp ((i 0))
+            (if (< i n)
+                (string-set! ret i (string-ref s i))
+                ret))))))
+
+(define-py (py-rjust rjust s width . l)
+  (let* ((n  (len s))
+         (ch (match l
+               ((x . l)
+                (if (string? x)
+                    (string-ref x 0)
+                    x))
+               (()
+                #\space))))
+    (if (< width n)
+        (pylist-slice s (- width) (len s))
+        (let ((ret (make-string width ch)))
+          (let lp ((i 0) (j (- width n)))
+            (if (< i n)
+                (string-set! ret j (string-ref s i))
+                ret))))))
+
+(define-py (py-lower lower s)
+  (string-downcase s))
+
+(define-py (py-upper upper s)
+  (string-upcase s))
+
+(define-py (py-lstrip lstrip s . l)
+  (match l
+    (()
+     (string-trim s))
+    ((x . _)
+     (let ((l (map (lambda (x) (if (string? x) (string-ref x 0) x)) x)))
+       (string-trim s (lambda (ch) (member ch l)))))))
+
+(define-py (py-rstrip rstrip s . l)
+  (match l
+    (()
+     (string-trim-right s))
+    ((x . _)
+     (let ((l (map (lambda (x) (if (string? x) (string-ref x 0) x)) x)))
+       (string-trim-right s (lambda (ch) (member ch l)))))))
+
+(define-py (py-partition partition s (sep <string>))
+  (let ((n (len s))
+        (m (len sep)))
+    (define (test i)
+      (let lp ((i i) (j 0))
+        (if (< i n)
+            (if (< j m)
+                (if (eq? (string-ref s i) (string-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 rpartition ss (ssep <string>))
+  (let* ((s    (string-reverse ss))
+         (sep  (string-reverse ssep))
+         (n    (len s))
+         (m    (len sep)))
+    (define (test i)
+      (let lp ((i i) (j 0))
+        (if (< i n)
+            (if (< j m)
+                (if (eq? (string-ref s i) (string-ref sep j))
+                    (lp (+ i 1) (+ j 1))
+                    #f)
+                #t)
+            #f)))
+    (let lp ((i 0))
+      (if (< i n)
+          (if (test i)
+              (list (string-reverse
+                     (pylist-slice s (+ i m) n))
+                    ssep
+                    (string-reverse
+                     (pylist-slice s 0 i)))
+              (lp (+ i 1)))
+          (list "" "" s)))))
+    
+(define-py (py-replace replace s old new . l)
+  (let ((n (match l (() #f) ((n . _) n))))
+    (string-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 strip s . l)
+  (apply py-rstrip (apply py-lstrip s l) l))
+
+(define-py (py-title title s)
+  (string-titlecase s))
+
+(define-py (py-rindex rindex s . l) 
+  (let ((n (len s)))
+    (- n (apply pylist-index (string-reverse s) l) 1)))
+
+
+
+(define-py (py-split 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 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 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 ((ch (string-ref s i)))
+            (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-swapcase swapcase s)
+  (list->string
+   (string-fold
+    (lambda (ch s)
+      (cons
+       (cond
+        ((char-upper-case? ch)
+         (char-downcase ch))
+        ((char-lower-case? ch)
+         (char-upcase ch))
+        (else ch))
+       s))
+    '()
+    s)))
+        
+(define-py (py-translate translate s table . l)
+  (let* ((n (len s))
+         (w (make-string n))
+         (t (if (eq? table None) #f table))
+         (d (match l (() #f) ((x) x))))
+    (define (tr ch)
+      (define (e)
+        (if t
+            (let ((i (char->integer ch)))
+              (if (< i (string-length t))
+                  (string-ref t i)
+                  ch))
+            ch))
+
+      (if d
+          (if (string-contains d (list->string (list ch)))
+              #f
+              (e))
+          (e)))
+    
+    (let lp ((i 0) (k 0))
+      (if (< i n)
+          (let ((ch (tr (string-ref s i))))
+            (if ch
+                (begin
+                  (string-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 <string>) (s2 <py-string>))
+     (op s1 (slot-ref s2 'str)))
+   (define-method (op (s2 <py-string>) (s1 <string>))
+     (op s1 (slot-ref s2 'str)))))
+
+(mkop <)
+(mkop <=)
+(mkop >)
+(mkop >=)
+(mkop +)
+(mkop *)
+
+(define-method (<  (s1 <string>) (s2 <string>)) (string-ci<  s1 s2))
+(define-method (<= (s1 <string>) (s2 <string>)) (string-ci<= s1 s2))
+(define-method (>  (s1 <string>) (s2 <string>)) (string-ci>  s1 s2))
+(define-method (>= (s1 <string>) (s2 <string>)) (string-ci>= s1 s2))
+
+(define-method (<  (s1 <symbol>) (s2 <symbol>)) (a string-ci<  s1 s2))
+(define-method (<= (s1 <symbol>) (s2 <symbol>)) (a string-ci<= s1 s2))
+(define-method (>  (s1 <symbol>) (s2 <symbol>)) (a string-ci>  s1 s2))
+(define-method (>= (s1 <symbol>) (s2 <symbol>)) (a string-ci>= s1 s2))
+
+
+(define-py (py-zfill zfill s width)
+  (let* ((n (len s))
+         (w (pk (pylist-slice s 0 n 1))))
+    (let lp ((i 0))
+      (if (< i n)
+          (let ((ch (string-ref s i)))
+            (if (char-numeric? ch)
+                (let lp ((j (max 0 (- i width))))
+                  (pk i j)
+                  (if (< j i)
+                      (begin
+                        (string-set! w j #\0)
+                        (lp (+ j 1)))
+                      w))
+                (lp (+ i 1))))
+          s))))
+
+(define-python-class string (<py-string>)
+  (define __init__
+    (case-lambda
+      ((self s)
+       (cond
+        ((is-a? s <py-string>)
+         (slot-set! self 'str (slot-ref s 'src)))
+        ((is-a? s <string>)
+         (slot-set! self 'str s)))))))
+
+(define pystring string)
+
+(define-method (py-class (o <string>))    string)
+(define-method (py-class (o <py-string>)) string)
+
+(define-method (pyhash (o <py-string>)) (hash (slot-ref o 'str) pyhash-N))
+
+(define-method (py-equal? (o <py-string>) x)
+  (equal? (slot-ref o 'str) x))
+(define-method (py-equal? x (o <py-string>))
+  (equal? (slot-ref o 'str) x))
+
+(define-class <string-iter> (<py-string>) str i d)
+
+(define-method (write (o <string-iter>) . l)
+  (define port (if (null? l) #t (car l)))
+  (for ((x : o)) ((l '()))
+       (cons (string-ref x 0) l)
+       #:final
+       (format port "iter(~s)" (list->string (reverse l)))))
+
+(define-method (wrap-in (o <string-iter> ))
+  (let ((out (make <string-iter>)))
+    (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 <string>))
+  (let ((out (make <string-iter>)))
+    (slot-set! out 'str s)
+    (slot-set! out 'i   0)
+    (slot-set! out 'd   1)
+    out))
+
+(define-method (py-reversed (s <string>))
+  (let ((out (make <string-iter>)))
+    (slot-set! out 'str s)
+    (slot-set! out 'i   (- (string-length s) 1))
+    (slot-set! out 'd   -1)
+    out))
+
+(define-method (next (o <string-iter>))
+  (let ((i   (slot-ref o 'i  ))
+        (d   (slot-ref o 'd))
+        (str (slot-ref o 'str)))
+    (if (> d 0)
+        (if (< i (string-length str))
+            (let ((ret (string-ref str i)))
+              (slot-set! o 'i (+ i d))
+              (list->string (list ret)))
+            (throw StopIteration))
+        (if (>= i 0)
+            (let ((ret (string-ref str i)))
+              (slot-set! o 'i (+ i d))
+              (list->string (list ret)))
+            (throw StopIteration)))))
+
+(define (pystring-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))
+
+
+|#
index 16d9d0b9cdfd17eded563d76618b0cb3e46cfca7..d0e9c91ec7713a30a0b6fb70cbe9c7baa93ca8eb 100644 (file)
@@ -80,7 +80,7 @@
       (lambda (start end)
         (string-suffix? suff o 0 ns start end)))))
 
-(define-py (py-startswith endswith o (suff <string>) . l)
+(define-py (py-startswith startswith o (suff <string>) . l)
   (let* ((n   (string-length o))
          (ns  (string-length suff))
          (f   (lambda (x) (< x 0) (+ n x) x)))