path: root/modules/language/python/module/string.scm

(define-module (language python module string)
  #:use-module (oop pf-objects)
  #:use-module (oop goops)
  #:use-module (ice-9 match)
  #:use-module (ice-9 format)
  #: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))