strings now sully supported
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Fri, 22 Sep 2017 19:40:04 +0000 (21:40 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Fri, 22 Sep 2017 19:40:04 +0000 (21:40 +0200)
modules/language/python/compile.scm
modules/language/python/list.scm
modules/language/python/string.scm

index c823ee0409edf1531be454805dada022a169ab1a..f364e7aa3d188eb095dd0a4e76bc1314d46c82a6 100644 (file)
 (define-syntax-rule (<< x y) (ash x y))
 (define-syntax-rule (>> x y) (ash x (- y)))
 
-(define (fastfkn x)
-  (case x
-    ;; Lists
-    ((append)  (L 'pylist-append!))
-    ((count)   (L 'pylist-count))
-    ((extend)  (L 'pylist-extend!))
-    ((index)   (L 'pylist-index))
-    ((pop)     (L 'pylist-pop!))
-    ((insert)  (L 'pylist-insert!))
-    ((remove)  (L 'pylist-remove!))
-    ((reverse) (L 'pylist-reverse!))
-    ((sort)    (L 'pylist-sort!))
-
-    ;; String
-    ((format)     (S 'py-format ))
-    ((capitalize) (S 'py-capitalize))
-    ((center)     (S 'py-center ))
-    ((endswith)   (S 'py-endswith))
-    ((expandtabs) (S 'py-expandtabs))
-    ((find)       (S 'py-find   ))
-    ((rfind)      (S 'py-rfind  ))
-    ((isalnum)    (S 'py-isalnum))
-    ((isalpha)    (S 'py-isalpha))
-    ((isdigit)    (S 'py-isdigit))
-    ((islower)    (S 'py-islower))
-    ((isspace)    (S 'py-isspace))
-    ((isupper)    (S 'py-isupper))
-    ((istitle)    (S 'py-istitle))
-    ((join)       (S 'py-join   ))
-    ((ljust)      (S 'py-join   ))
-    ((rljust)     (S 'py-rljust ))
-    ((lower)      (S 'py-lower  ))
-    ((upper)      (S 'py-upper  ))
-    ((lstrip)     (S 'py-lstrip ))
-    ((rstrip)     (S 'py-rstrip ))
-    ((partition)  (S 'py-partiti))
-    ((replace)    (S 'py-replace))
-    ((strip)      (S 'py-strip  ))
-    ((title)      (S 'py-title  ))
+(define-syntax-rule (mkfast ((a) v) ...)
+  (let ((h (make-hash-table)))
+    (hash-set! h 'a v)
+    ...
+    h))
+
+(define fasthash
+  (mkfast
+   ;; Lists
+   ((append)  (L 'pylist-append!))
+   ((count)   (L 'pylist-count))
+   ((extend)  (L 'pylist-extend!))
+   ((index)   (L 'pylist-index))
+   ((pop)     (L 'pylist-pop!))
+   ((insert)  (L 'pylist-insert!))
+   ((remove)  (L 'pylist-remove!))
+   ((reverse) (L 'pylist-reverse!))
+   ((sort)    (L 'pylist-sort!))
+
+   ;; String
+   ((format)     (S 'py-format ))
+   ((capitalize) (S 'py-capitalize))
+   ((center)     (S 'py-center ))
+   ((endswith)   (S 'py-endswith))
+   ((expandtabs) (S 'py-expandtabs))
+   ((find)       (S 'py-find   ))
+   ((rfind)      (S 'py-rfind  ))
+   ((isalnum)    (S 'py-isalnum))
+   ((isalpha)    (S 'py-isalpha))
+   ((isdigit)    (S 'py-isdigit))
+   ((islower)    (S 'py-islower))
+   ((isspace)    (S 'py-isspace))
+   ((isupper)    (S 'py-isupper))
+   ((istitle)    (S 'py-istitle))
+   ((join)       (S 'py-join   ))
+   ((ljust)      (S 'py-join   ))
+   ((rljust)     (S 'py-rljust ))
+   ((lower)      (S 'py-lower  ))
+   ((upper)      (S 'py-upper  ))
+   ((lstrip)     (S 'py-lstrip ))
+   ((rstrip)     (S 'py-rstrip ))
+   ((partition)  (S 'py-partiti))
+   ((replace)    (S 'py-replace))
+   ((strip)      (S 'py-strip  ))
+   ((title)      (S 'py-title  ))
+   ((rpartition) (S 'py-rpartition))
+   ((rindex)     (S 'py-rindex ))
+   ((split)      (S 'py-split  ))
+   ((rsplit)     (S 'py-rsplit ))
+   ((splitlines) (S 'py-splitlines))
+   ((startswith) (S 'py-startswith))
+   ((swapcase)   (S 'py-swapcas))
+   ((translate)  (S  'py-translate))
+   ((zfill)      (S 'py-zfill))))
+   
+(define (fastfkn x) (hash-ref fasthash x))
     
-    (else #f)))
-
 (define (get-kwarg vs arg)
   (let lp ((arg arg) (l '()) (kw '()))
     (match arg
index a88aa0a172407ccd83e040a7a0fb0aa02664139e..498934fbf7cce0b895f822a9b6343f6ab3cf41e1 100644 (file)
@@ -10,7 +10,8 @@
   #:export (to-list pylist-ref pylist-set! pylist-append!
                     pylist-slice pylist-subset! pylist-reverse!
                     pylist-pop! pylist-count pylist-extend! len in
-                    pylist-insert! pylist-remove! pylist-sort!))
+                    pylist-insert! pylist-remove! pylist-sort!
+                    pylist-index))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
 (define-method (len (l <pair>  ))  (length l))
 (define-method (len (v <vector>))  (vector-length v))
 (define-method (len (s <string>))  (string-length s))
-(define-method (len (o <py-list>)) (slot-ref i 'n))
+(define-method (len (o <py-list>)) (slot-ref o 'n))
 (define-method (len (o <p>))       ((ref o '__len__)))
 
 (define-method (in x (l <pair>))   (member x l))
         #f)))
 
 (define-method (in x (s <string>))
-  (let ((n (string-length l))
+  (let ((n (string-length s))
         (x (if (string? x) (string-ref x 0) x)))
     (let lp ((i 0))
       (if (< i n)
index 96b97f33f82da4657387474202372c16051ed08d..d15ca23c4cbb6a5d25b091b0ee3f01af43092ad3 100644 (file)
@@ -9,7 +9,11 @@
                       py-isalnum py-isalpha py-isdigit py-islower
                       py-isspace py-isupper py-istitle py-join py-ljust
                       py-rljust py-lower py-upper py-lstrip py-rstrip
-                      py-partition py-replace py-strip py-title))
+                      py-partition py-replace py-strip py-title
+                      py-rpartitio py-rindex py-split py-rsplit py-splitlines
+                      py-startswith py-swapcase py-translate py-zfill))
+
+(define None 'None)
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
     (define-method (f (o <string>) . u) code ...)
     (define-method (f (o <p>) . l) (apply (ref o 'n) l))))
 
-(define-py (py-capitalize capitalize o)
-  (string-capitalize o))
+(define-py (py-capitalize capitalize s)
+  (let* ((n (len s))
+         (w (make-string n)))
+    (let lp ((i 0) (first? #t))
+      (if (< i n)
+          (let ((ch (string-ref s i)))
+            (if (and first? (char-alphabetic? ch))
+                (begin
+                  (string-set! w i (char-upcase ch))
+                  (lp (+ i 1) #f))
+                (begin
+                  (string-set! w i ch)
+                  (lp (+ i 1) first?))))
+          w))))
 
 (define-py (py-center center o w . l)
   (let* ((ws (if (pair? l)
       (lambda (start end)
         (string-suffix? suff o 0 ns start end)))))
 
+(define-py (py-startswith endswith o (suff <string>) . l)
+  (let* ((n   (string-length o))
+         (ns  (string-length 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)
+        (string-prefix? suff o 0 ns start end)))))
+
 (define-py (py-expandtabs expandtabs s . l)
   (let* ((tabsize (match l (() 8) ((x) x)))
          (u       (string->list (make-string tabsize #\space)))
       (((#: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))
+       (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)))
       (()
               (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))))
 (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-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)))
+
+
 
-#|
-py-rindex
-py-rpartition
+(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)))
 
-py-rsplit
-py-split
-py-splitlines
+(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)))))))
 
-py-startswith
 
-py-swapcase
-py-translate
-py-zfill
-|#
+(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)
+      (if d
+          (if (string-contains d (list->string (list ch)))
+              #f
+              (if t
+                  (let ((i (char->integer ch)))
+                    (if (< i n)
+                        (string-ref t i)
+                        ch))
+                  ch))))
+                    
+    (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-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))))