(define-module (language python format2) #:use-module (ice-9 match) #:use-module (parser stis-parser) #:use-module (oop pf-objects) #:use-module (oop goops) #:use-module ((language python module re) #:select (splitm splitmm)) #:use-module (language python exceptions) #:use-module (language python number) #:use-module (language python dict) #:use-module (language python list) #:export (format fnm)) (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) (define scm-format (@ (guile) format)) (define e-map (f-seq "(" (mk-token (f* (f-not! (f-tag ")")))) ")")) (define e-conv (mk-token (f+ (f-reg! "[-#0 +]")))) (define e-min (f-or! (mk-token (f+ (f-reg! "[0-9]")) string->number) (f-seq "*" (f-out #:*)))) (define e-prec (f-seq "." (f-or! (mk-token (f+ (f-reg! "[0-9]")) string->number) (f-seq "*" (f-out #:*))))) (define e-len (mk-token (f-reg! "[hlL]"))) (define e-type (mk-token (f-reg! "[diouxXeEfFgGcrsa%]"))) (define e (f-list #:% "%" (ff? e-map) (ff? e-conv) (ff? e-min) (ff? e-prec) (ff? e-len) e-type)) (define (map? l) (let lp ((l l)) (match l ((a (#:% #f . _) . l) (lp l)) ((a (#:% _ . _) . l) #t) (_ #f)))) (define (get-n p) (match p ((#:% #f _ #:* #:* . _) 2) ((#:% #f _ #:* _ . _) 1) ((#:% #f _ _ #:* . _) 1) (_ 0))) (define (create c min prec tp) (define (get-intkind tp) (match tp ((or "d" "i" "u") "d") ("o" "o") ((or "x" "X") "x"))) (let ((prec (if prec prec 6)) (min (if min min 0)) (c (if c c ""))) (match tp ("c" (lambda (x) (if (and (number? x) (integer? x)) (list->string (list (integer->char x))) x))) ("s" (lambda (x) (let ((s (if (is-a? x
)
(aif it (ref x '__str__)
(scm-format #f "~a" (it))
(scm-format #f "~a" x))
(scm-format #f "~a" x))))
(+ s (* " " (max 0 (- min (len s))))))))
("a" (lambda (x)
(let ((s (scm-format #f "~a" x)))
(+ s (* " " (max 0 (- min (len s))))))))
("r" (lambda (x)
(let ((s (scm-format #f "~a" x)))
(+ s (* " " (max 0 (- min (len s))))))))
("%"
(lambda (x) (* "%" (if min min 1))))
((or "f" "F" "e" "E" "g" "G")
(let ((c (string->list c)))
(define (make-decimal)
(string-append
"~"
(if min (number->string min) "")
","
(number->string prec)
",,,"
(if (member #\0 c)
"0"
(if (member #\space c)
" "
""))
(if (member #\+ c) "@" "")
"f"))
(define (make-exp expchar)
(string-append
"~"
(if min (number->string min) "")
","
(number->string prec)
",,,,"
(if (member #\0 c)
"0"
(if (member #\space c)
" "
""))
",'"
expchar
(if (member #\+ c) "@" "")
"e"))
(match tp
((or "f" "F")
(let ((pat (make-decimal)))
(lambda (x) (scm-format #f pat x))))
((or "e" "E")
(let ((pat (make-exp tp)))
(lambda (x) (scm-format #f pat x))))
((or "g" "G")
(let ((pat1 (make-decimal))
(pat2 (make-exp (if (equal? tp "g") "e" "E"))))
(lambda (x)
(if (or (< (log10 x) -4) (if prec (< (log10 x) (- prec)) #f))
(scm-format #f pat2 x)
(scm-format #f pat1 x))))))))
((or "d" "i" "u" "o" "x" "X")
(match c
(""
(let ((kind (get-intkind tp)))
(if min
(let ((pat (string-append "~"
(number->string min) ",' " kind)))
(lambda (x)
(scm-format #f pat x)))
(let ((pat (string-append "~" kind)))
(lambda (x)
(scm-format #f pat x))))))
(_
(if min
(let ((c (string->list c)))
(if (and (member #\# c)
(match tp
((or "x" "o" "X") #t)
(_ #f)))
(set! c (cons #\0 c)))
(let* ((kind (get-intkind tp))
(padchar (if (member #\0 c) "0" " "))
(pre (if (member #\+ c)
"~a"
(if (member #\0 c)
"~a"
(if (member #\space c)
"~a"
""))))
(pos (if (member #\+ c) "+"
(if (member #\space c)
" "
padchar)))
(kpre (if (member #\# c)
(match tp
("o" "0o")
((or "x" "X") "0x")
(_ ""))
""))
(neg (if (or (member #\+ c)
(member #\space c)
(member #\0 c))
"-"
""))
(d (string-append
pre kpre "~"
(number->string
(- min
(if (= (string-length kpre) 0) 0 2)
(if (= (string-length pre ) 0) 0 1)))
",'"
padchar
kind)))
(if (= (string-length pre) 0)
(lambda (x)
(if (and (number? x) (integer? x))
(scm-format #f d x)
(raise
(ValueError "not a integer, format spec %d"))))
(lambda (x)
(if (and (number? x) (integer? x))
(scm-format #f d (if (< x 0) neg pos) (abs x))
(raise
(ValueError
"not a integer, format spec %d")))))))
(let* ((kind (get-intkind tp))
(pat (string-append "~" kind)))
(lambda (x)
(if (and (number? x) (integer? x))
(scm-format #f pat x)
(raise
(ValueError "not a integer, format spec %d"))))))))))))
(define (analyze p)
(match p
((#:% #f c #:* #:* _ tp)
(lambda (min prec x)
((create c min prec tp) x)))
((#:% #f c #:* prec _ tp)
(lambda (min x)
((create c min prec tp) x)))
((#:% #f c #:* prec _ tp)
(lambda (min x)
((create c min prec tp) x)))
((#:% #f c min #:* _ tp)
(lambda (prec x)
((create c min prec tp) x)))
((#:% #f c min prec _ tp)
(create c min prec tp))
((#:% tag c min prec _ tp)
(let ((f (create c min prec tp)))
(lambda (x)
(f (pylist-ref x tag)))))))
(define (compile str)
(let* ((l (splitmm e str)))
(if (map? l)
(let lp ((l l))
(match l
((a p . l)
(let ((rest (lp l))
(f (analyze p)))
(lambda (x)
(cons* a (f x) (rest x)))))
((a)
(lambda (x)
(list a)))
(()
(lambda (x)
'()))))
(let lp ((l l))
(match l
((a p . l)
(let ((rest (lp l))
(n (get-n p))
(f (analyze p)))
(case n
((0)
(lambda (x)
(cons* a (f (car x)) (rest (cdr x)))))
((1)
(lambda (x)
(cons* a (f (car x) (cadr x)) (rest (cddr x)))))
((2)
(lambda (x)
(cons* a (f (car x) (cadr x) (caddr x))
(rest (cdddr x))))))))
((a)
(lambda (x)
(list a)))
(()
(lambda (x)
'())))))))
(define (id? x)
(or (pair? x)
(hash-table? x)
(is-a? x