diff options
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)) |