string formatter library

6 files changed, 308 insertions, 60 deletions

diff --git a/modules/language/python/for.scm b/modules/language/python/for.scm
index ab077db..bd9fa41 100644
--- a/modules/language/python/for.scm
+++ b/modules/language/python/for.scm
@@ -108,10 +108,7 @@
         (s))))
 
 (define-method (wrap-in (o <yield>))
-  (let ((out (make <yield>)))
-    (slot-set! out 'k (slot-ref o 'k))
-    (slot-set! out 's (slot-ref o 's))
-    out))
+  o)
 
 (define-method (next (l <p>))
   ((ref l '__next__)))
diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm
index 34c9ba0..0131328 100644
--- a/modules/language/python/list.scm
+++ b/modules/language/python/list.scm
@@ -727,6 +727,10 @@
 
 
 (defpair (len l)  (length l))
+(define-method (len x)
+  (if (null? x)
+      0
+      (error "not a suitable lengthof")))
 (define-method (len (v <vector>))  (vector-length v))
 (define-method (len (s <string>))  (string-length s))
 (define-method (len (o <py-list>)) (slot-ref o 'n))
diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm
index 02f4e5e..69e02b0 100644
--- a/modules/language/python/module/python.scm
+++ b/modules/language/python/module/python.scm
@@ -25,7 +25,7 @@
   #:use-module (language python tuple            )
   #:use-module (language python eval             )
 
-  #:replace (list abs min max hash round)
+  #:replace (list abs min max hash round format)
   
   #:re-export (StopIteration GeneratorExit RuntimeError
                              Exception ValueError TypeError
@@ -38,10 +38,10 @@
                              compile exec type object
                              )
   
-  #:export (print repr complex float int
+  #:export (print repr complex float int str
                   set all any bin callable reversed
                   chr classmethod staticmethod
-                  divmod enumerate filter format
+                  divmod enumerate filter 
                   getattr hasattr hex isinstance issubclass
                   iter map sum id input oct ord pow super
                   sorted zip))
@@ -50,13 +50,13 @@
 
 (define print
   (case-lambda
-    (()  (format #t "~%"))
-    ((x) (format #t "~s~%" x))
-    (l   (format #t "~s~%" l))))
+    (()  ((@ (guile) format) #t "~%"))
+    ((x) ((@ (guile) format) #t "~s~%" x))
+    (l   ((@ (guile) format) #t "~s~%" l))))
 
-(define (repr x) (format #f "~a" x))
+(define (repr x) ((@ (guile) format) #f "~a" x))
 (define abs     py-abs)
-(define string  pystring)
+(define str     pystring)
 (define complex py-complex)
 (define float   py-float)
 (define int     py-int)
@@ -77,17 +77,17 @@
 (define-method (callable (x <primitive-generic>)) #t)
 (define-method (callable (x <p>))
   (ref x '__call__))
-                            
+
 (define chr integer->char)
-  
+
 (define classmethod  class-method)
 (define staticmethod static-method)
 
 (define (enumerate l)
   (make-generator enumerate
-    (lambda (yield)
-      (for ((x : l)) ((i 0))
-           (yield i x)
+     (lambda (yield)
+       (for ((x : l)) ((i 0))
+            (yield i x)
            (+ i 1)))))
 
 (define (filter f l)
diff --git a/modules/language/python/module/string.scm b/modules/language/python/module/string.scm
new file mode 100644
index 0000000..6ece062
--- /dev/null
+++ b/modules/language/python/module/string.scm
@@ -0,0 +1,278 @@
+(define-module (language python module string)
+  #:use-module (oop pf-objects)
+  #:use-module (oop goops)
+  #:use-module (ice-9 match)
+  #:use-module (language python number)
+  #:use-module ((language python module python) #:select (repr))
+  #:use-module (language python exceptions)
+  #:use-module (language python yield)
+  #:use-module (language python list)
+  #:use-module (language python for)
+  #:use-module (language python def)
+  #:use-module (language python string)
+  #:use-module (parser stis-parser)
+  #:export (Formatter))
+
+(define int (mk-token (f+ (f-reg! "[0-9]")) string->number))
+(define id  (mk-token (f-seq (f-reg! "[_a-zA-Z]")
+                             (f* (f-reg! "[_0-9a-zA-Z]")))))
+(define str (mk-token (f+ (f-not! (f-char #\[)))))
+
+(define conversion (mk-token (f-reg "[rsa]")))
+
+(define fill      (mk-token (f-reg! ".")))
+(define align     (mk-token (f-reg! "[<>=^]")))
+(define sign      (mk-token (f-reg! "[-+ ]")))
+(define width     int)
+(define precision int)
+(define type      (mk-token (f-reg! "[bcdeEfFgGnosxX%]")))
+(define formatSpec
+  (f-list
+   (gg? (f-list #:align (gg? fill) align))
+   (gg? sign)
+   (gg? (mk-token (f-tag! "#")))
+   (gg? (mk-token (f-tag! "0")))
+   (gg? width)
+   (gg? (mk-token (f-tag ",")))
+   (gg? (f-seq "." precision))
+   (gg? type)))
+
+(define (get-align s align width sign)
+  (define widthq (- width (len sign)))
+  (define (f s a l)
+    (pk 'res (match (pk 'm a)
+      ("<" (apply py-ljust  (+ sign s) width l))
+      (">" (apply py-rjust  (+ sign s) width l))
+      ("^" (apply py-center (+ sign s) width l))
+      ("=" (+ sign (apply py-rjust s widthq l))))))
+     
+  (match align
+    (#f
+     (f s "<" '()))
+    ((_ #f a)
+     (f s a '()))
+    ((_ fill a)
+     (f s a (list fill)))))
+
+(define (convert-string s format-str)
+  (match (with-fluids ((*whitespace* f-true))
+           (stis-parse format-str (f-seq formatSpec f-eof)))
+    ((align sign sharp zero width comma rec type)
+     (if width
+         (get-align s align width "")
+         s))))
+
+(set! (@@ (language python string) format) convert-string)
+
+(define (gen-sign s sign)
+  (let lp ((sign sign))
+    (match sign
+      (#f  (lp "-"))
+      ("+" (if (< s 0)
+               (values (- s) "-")
+               (values s     "+")))
+      ("-" (if (< s 0)
+               (values (- s) "-")
+               (values s     "")))
+      (" " (if (< s 0)
+               (values (- s) "-")
+               (values s     " "))))))
+
+(define (convert-integer s format-str)
+  (match (pk 'conv-int
+             (with-fluids ((*whitespace* f-true))
+               (stis-parse format-str (f-seq formatSpec f-eof))))
+    ((align sign sharp zero width comma prec type)
+     (call-with-values (lambda () (gen-sign s sign))                         
+       (lambda (s s-sign)
+         (let ((prefix (if sharp
+                           (match type
+                             ("b" "0b")
+                             ("x" "0x")
+                             ("X" "0X")
+                             ("o" "0o")
+                             ("d"  "")
+                             (#f  ""))
+                           ""))
+               (s (let lp ((type type))
+                    (match type
+                      ("b"
+                       (format #f "~b"       s))
+                      ("x"
+                       (format #f "~x"       s))
+                      ("X"
+                       (format #f "~:@(~x~)" s))
+                      ("o"
+                       (format #f "~o"       s))
+                      ("d"
+                       (if comma
+                           (format #f "~:d" s)
+                           (format #f "~d" s)))
+                      (#f
+                       (lp "d"))))))
+           (if width
+               (if zero
+                   (get-align s '(#:align "0" "=") width
+                              (+ s-sign prefix))
+                   (get-align (+ prefix s) align width
+                              s-sign))
+               
+               (+ sign prefix s))))))))
+
+(define-method (py-format (s <integer>) f)
+  (convert-integer s f))
+
+(define-method (py-format (o <py-int>) f)
+  (convert-integer (slot-ref o 'x) f))
+
+(define argName (f-or! id int))
+(define attributeName id)
+(define elementIndex  (f-or! int str))
+
+(define fieldName
+  (f-cons argName (ff* (f-or! (f-list #:attr "." attributeName)
+                              (f-list #:elem "[" elementIndex "]")))))
+
+(define replField
+  (f-list
+   #:field
+   (ff?            (mk-token (f-scope fieldName ))  None)
+   (ff? (f-seq "!" (mk-token (f-scope conversion))) None)
+   (ff? (f-seq ":" (mk-token (f-scope formatSpec))) None)))
+ 
+(define tag     (f-seq (f-tag "{") replField (f-tag "}")))
+(define nontag  (f-list #:str
+                        (mk-token (f+ (f-or! (f-tag! "{{") (f-not! tag))))))
+(define e       (f-seq (ff* (f-or! tag nontag)) f-eof))
+
+(define mk-gen
+  (make-generator (l)
+    (lambda (yield l)
+      (let lp ((u l) (i 0))
+        (match (pk 'lp u)
+          (()
+           (yield "" None None None))
+          (((#:str str))
+           (yield str None None None))
+          (((#:field a b c))
+           (if (eq? a None)
+               (yield "" (number->string i) c b)
+               (yield "" a b c)))
+          (((#:field a b c) . u)
+           (if (eq? a None)
+               (begin
+                 (yield "" (number->string i) c b)
+                 (lp u (+ i 1)))
+               (begin
+                 (yield "" a b c)
+                 (lp u i))))
+          (((#:str s) (#:field a b c) . u)
+           (if (eq? a None)
+               (begin
+                 (yield s (number->string i) c b)
+                 (pk 'next)
+                 (lp u (+ i 1)))
+               (begin
+                 (yield s a c b)
+                 (lp u i)))))))))
+     
+(define (f-parse str)
+  (let ((l (with-fluids ((*whitespace* f-true))
+             (parse str e))))
+    (mk-gen l)))        
+
+(define stis-parse parse)
+
+(define-python-class Formatter ()
+  (define format
+    (lam (self format_string (* args) (** kwargs))
+         ((ref self 'vformat) format_string args kwargs)))
+
+  (define vformat
+    (lambda (self format_string args kwargs)
+      (pk 'vformat format_string args kwargs)
+      (set self '_args '())
+      (for ((s fn fo co : ((ref self 'parse) format_string))) ((ss '("")))
+           (pk 'parse s ss fn fo co)
+           (if (eq? fn None)
+               (cons s ss)
+               (let* ((fn2 ((ref self 'get_field    ) fn args kwargs))
+                      (fn3 (if (and (eq? fo None) (eq? co None))
+                               ((ref self 'convert_field)  fn2 "r")
+                               (let ((fn3 (if (eq? co None)
+                                              fn2
+                                              ((ref self 'convert_field)
+                                               fn2 co))))
+                                 (if (eq? fo None)
+                                     fn3
+                                     ((ref self 'format_field )
+                                      fn3 fo))))))
+                 (cons* fn3 s ss)))
+           #:final
+           (begin
+             ((ref self 'check_unused_args) (ref self '_args) args kwargs)
+             (apply string-append (reverse ss))))))
+
+  (define parse
+    (lambda (self format_string)
+      (f-parse format_string)))
+  
+  (define get_field
+    (lambda (self field_name args kwargs)
+      (pk 'get_field field_name args kwargs)
+      (match (pk 'field (with-fluids ((*whitespace* f-true))
+                          (stis-parse field_name fieldName)))
+        ((key a ...)
+         (set self '_args (cons key (ref self '_args)))
+         (let ((f ((ref self 'get_value) key args kwargs)))
+           (let lp ((a a) (f f))
+             (match a
+               (((#:ref r) . l)
+                (lp l (ref f (string->symbol r))))
+               (((#:elem k) . l)
+                (lp l (pylist-ref f k)))
+               (()
+                f)))))
+        (_
+         (throw TypeError "wromg field name format")))))
+
+  (define get_value
+    (lambda (self key args kwargs)
+      (pk 'get_value key args kwargs)
+      (set self '__args (cons key args))
+      (if (integer? key)
+          (pylist-ref args   key)
+          (pylist-ref kwargs key))))
+  
+  (define check_unused_args
+    (lambda (self used_args args kwargs)
+      (pk 'check_unused_args used_args args kwargs)
+      (let ((n (len args)))
+        (let lp ((i 0))
+          (if (< i n)
+              (if (member i used_args)
+                  (lp (+ i 1))
+                  (warn "unused arg" i)))))
+      (for ((k v : kwargs)) ()
+           (pk 'key k)
+           (if (not (member k used_args))
+               (warn "unused arg" k)))))
+            
+
+  (define format_field
+    (lambda (self value format_spec)
+      (py-format value format_spec)))
+  
+  (define convert_field
+    (lambda (self value conversion)
+      (pk 'convert_field value conversion)
+      (cond
+       ((equal? conversion "s")
+        (str value))
+       ((equal? conversion "r")
+        (repr value))
+       ((equal? conversion "a")
+        (ascii value))
+       (else
+        (throw TypeError "conversion" conversion))))))
+
diff --git a/modules/language/python/number.scm b/modules/language/python/number.scm
index 2d90554..521cc42 100644
--- a/modules/language/python/number.scm
+++ b/modules/language/python/number.scm
@@ -209,7 +209,7 @@
   (apply write (slot-ref o 'x) l))
 (define-method (write (o <py-int>) . l)
   (apply write (slot-ref o 'x) l))
-          
+
 (define-python-class int (<py-int>)
   (define __init__
     (letrec ((__init__
diff --git a/modules/language/python/string.scm b/modules/language/python/string.scm
index 2a8fbcc..1b9883d 100644
--- a/modules/language/python/string.scm
+++ b/modules/language/python/string.scm
@@ -1,4 +1,5 @@
 (define-module (language python string)
+  #:use-module (parser stis-parser)
   #:use-module (oop goops)
   #:use-module (oop pf-objects)
   #:use-module (language python hash)
@@ -6,7 +7,6 @@
   #:use-module (language python list)
   #:use-module (language python exceptions)
   #:use-module (language python for)
-  #:use-module (parser stis-parser)
   #:export (py-format py-capitalize py-center py-endswith
                       py-expandtabs py-find py-rfind
                       py-isalnum py-isalpha py-isdigit py-islower
@@ -133,44 +133,9 @@
              (- 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 format (lambda (a b) a))
+(define-py (py-format format s format-string)
+  (format s format-string))
 
 (define-syntax-rule (mk-is py-isalnum isalnum x ...)
   (define-py (py-isalnum isalnum s)
@@ -233,7 +198,9 @@
         (let ((ret (make-string width ch)))
           (let lp ((i 0))
             (if (< i n)
-                (string-set! ret i (string-ref s i))
+                (begin
+                  (string-set! ret i (string-ref s i))
+                  (lp (+ i 1)))
                 ret))))))
 
 (define-py (py-rjust rjust s width . l)
@@ -250,7 +217,9 @@
         (let ((ret (make-string width ch)))
           (let lp ((i 0) (j (- width n)))
             (if (< i n)
-                (string-set! ret j (string-ref s i))
+                (begin
+                  (string-set! ret j (string-ref s i))
+                  (lp (+ i 1) (+ j 1)))
                 ret))))))
 
 (define-py (py-lower lower s)
@@ -525,7 +494,7 @@
   (for ((x : o)) ((l '()))
        (cons (string-ref x 0) l)
        #:final
-       (format port "iter(~s)" (list->string (reverse l)))))
+       ((@ (guile) format) port "iter(~s)" (list->string (reverse l)))))
 
 (define-method (wrap-in (o <string-iter> ))
   (let ((out (make <string-iter>)))