summaryrefslogtreecommitdiff
path: root/modules/language/python/module/string.scm
diff options
context:
space:
mode:
Diffstat (limited to 'modules/language/python/module/string.scm')
-rw-r--r--modules/language/python/module/string.scm278
1 files changed, 278 insertions, 0 deletions
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))))))
+
generated by cgit v1.2.3 (git 2.46.0) at 2024-10-18 20:24:01 +0000