(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 ) f) (convert-float s f)) (define-method (py-format (s ) f) (convert-float s f)) (define-method (py-format (s ) f) (convert-complex s f)) (define-method (py-format (s ) 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 ) f) (convert-integer s f)) (define-method (py-format (o ) 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))