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.scm#411
1 files changed, 411 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..3255d99
--- /dev/null
+++ b/modules/language/python/module/#string.scm#
@@ -0,0 +1,411 @@
+(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 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 (language python bytes)
+ #:use-module ((parser stis-parser) #:select (*whitespace* f-n f-m))
+ #:use-module (parser stis-parser lang python3 tool)
+ #:export (Formatter ascii_letters digits hexdigits))
+
+(define digits "0123456789")
+(define ascii_letters "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ")
+(define hexdigits "0123456789abcdefABCDEF")
+
+(define (repr x) ((@ (guile) format) #f "~a" x))
+(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)
+ (match 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 format-str s)
+ (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))
+ (_ (raise (ValueError (+ "wrong format " format-str))))))
+
+(set! (@@ (language python string) format)
+ (lambda (f s)
+ (py-format s f)))
+
+(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-float s format-str)
+ (match (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* ((prec (if prec prec 6))
+ (s (let lp ((type type))
+ (match type
+ (#f (lp "g"))
+
+ ("f"
+ (format #f (+ "~," (number->string prec) "f") s))
+
+ ("F"
+ (let ((s (format #f (+ "~," (number->string prec)
+ "f")
+ s)))
+ (py-replace
+ (py-replace s "nan" "NAN")
+ "inf" "INF")))
+
+ ("e"
+ (py-replace
+ (format #f (+ "~," (number->string prec) "e") s)
+ "E" "e"))
+
+ ("E"
+ (format #f (+ "~," (number->string prec) "e") s))
+
+ ("g"
+ (let ((exp (log10 (abs s))))
+ (if (and (<= -4 exp)
+ (<= exp (max 1 prec)))
+ (lp "f")
+ (lp "e"))))
+ ("G"
+ (let ((exp (log10 (abs s))))
+ (if (and (<= -4 exp)
+ (<= exp (max 1 prec)))
+ (lp "F")
+ (lp "E"))))
+ ("n"
+ (let ((exp (log10 (abs s))))
+ (if (and (<= -4 exp)
+ (<= exp (max 1 prec)))
+ (lp "f")
+ (format #f (+ "~," (number->string prec) "h")
+ s))))
+
+ ("%"
+ (set s (* s 100))
+ (+ (lp "f") "%"))))))
+
+ (if width
+ (if zero
+ (get-align s '(#:align "0" "=") width
+ s-sign)
+ (get-align s align width
+ s-sign))
+
+ (+ s-sign s))))))))
+
+(define (convert-complex s format-str)
+ (match (with-fluids ((*whitespace* f-true))
+ (stis-parse format-str (f-seq formatSpec f-eof)))
+ ((align sign sharp zero width comma prec type)
+ (let* ((prec (if prec prec 6))
+ (s (let lp ((type type))
+ (match type
+ (#f (lp "f"))
+ ("f"
+ (format #f (+ "~," (number->string prec) "i") s))))))
+ (if width
+ (get-align s align width "")
+ s)))))
+
+
+(define-method (py-format (s <real>) f)
+ (convert-float s f))
+(define-method (py-format (s <py-float>) f)
+ (convert-float s f))
+
+(define-method (py-format (s <complex>) f)
+ (convert-complex s f))
+(define-method (py-format (s <py-complex>) f)
+ (convert-complex s f))
+
+
+
+
+
+(define (convert-integer s format-str)
+ (match (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"
+ (if comma
+ (format #f "~:b" s)
+ (format #f "~b" s)))
+ ("x"
+ (if comma
+ (format #f "~:x" s)
+ (format #f "~x" s)))
+ ("X"
+ (if comma
+ (format #f "~:@(~:x~)" s)
+ (format #f "~:@(~x~)" s)))
+ ("o"
+ (if comma
+ (format #f "~:o" s)
+ (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))
+
+ (+ s-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 fieldName1)
+ (f-list
+ #:field
+ (ff? fieldName1 None)
+ (ff? (f-seq "!" (mk-token (f-scope conversion))) None)
+ (ff? (f-seq ":" (mk-token (f-scope formatSpec))) None)))
+
+(define (tag fieldName1)
+ (f-seq (f-tag "{") (replField fieldName1) (f-tag "}")))
+
+(define nontag (f-list #:str
+ (mk-token (f+
+ (f-or!
+ (f-tag! "{{")
+ (f-not! (tag (mk-token
+ (f-scope
+ fieldName)))))))))
+
+(define e (f-seq (ff* (f-or! (tag (mk-token (f-scope fieldName)))
+ nontag))
+ f-eof))
+
+(set! (@@ (parser stis-parser lang python3-parser) f-formatter) tag)
+
+(define mk-gen
+ (make-generator (l)
+ (lambda (yield l)
+ (let lp ((u l) (i 0))
+ (match 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)
+ (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 vformat2
+ (lambda (self fn2 co fo)
+ (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))))))
+
+ (define vformat1
+ (lambda (self s fn fo co ss args kwargs)
+ (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)))))
+
+ (define vformat
+ (lambda (self format_string args kwargs)
+ (set self '_args '())
+ (for ((s fn fo co : ((ref self 'parse) format_string))) ((ss '("")))
+ (vformat1 self s fn fo co ss args kwargs)
+ #: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)
+ (match (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 (+ "wrong field name format" field_name)))))))
+
+ (define get_value
+ (lambda (self 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)
+ (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)) ()
+ (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)
+ (cond
+ ((equal? conversion "s")
+ (str value))
+ ((equal? conversion "r")
+ (repr value))
+ ((equal? conversion "a")
+ (ascii value))
+ (else
+ (throw (TypeError (+ "conversion " conversion))))))))
+
+(define (ascii x) (bytes x))
+
+(define formatter (Formatter))
+(set! (@@ (language python string) formatter) formatter)
+(set! (@@ (language python compile) formatter) (ref formatter 'vformat2))