From d4f5255498d07b424ba5d6b8535aedc3ec40808a Mon Sep 17 00:00:00 2001 From: Stefan Israelsson Tampe Date: Fri, 1 Dec 2017 17:24:12 +0100 Subject: string formatter library --- modules/language/python/for.scm | 5 +- modules/language/python/list.scm | 4 + modules/language/python/module/python.scm | 26 +-- modules/language/python/module/string.scm | 278 ++++++++++++++++++++++++++++++ modules/language/python/number.scm | 2 +- modules/language/python/string.scm | 53 ++---- 6 files changed, 308 insertions(+), 60 deletions(-) create mode 100644 modules/language/python/module/string.scm (limited to 'modules') 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 )) - (let ((out (make ))) - (slot-set! out 'k (slot-ref o 'k)) - (slot-set! out 's (slot-ref o 's)) - out)) + o) (define-method (next (l

)) ((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-length v)) (define-method (len (s )) (string-length s)) (define-method (len (o )) (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 )) #t) (define-method (callable (x

)) (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 ) 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 + (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 ) . l) (apply write (slot-ref o 'x) l)) - + (define-python-class 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 )) (let ((out (make ))) -- cgit v1.2.3