(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 exceptions)
  #:use-module (language python number)
  #:use-module (language python dict)
  #:use-module (language python list)
  #:export (format fnm))

(define splitm  #f)
(define splitmm #f)

(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
    ((#:% _ _ _ _ _ "%")
     -1)

    ((#:% #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 <p>)
                           (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 (abs x)) -4)
                         (if prec (< (log10 (abs 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
		 ((-1)
		  (lambda (x)
		    (cons* a "%" (rest x))))

		 ((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 <py-hashtable>)))

(define (format-- s l ha)
  (set! l (if (id? l) l (list l)))
  (aif it (hashq-ref ha s #f)
       (string-join (it l) "")
       (begin
	 (hashq-set! ha s (compile s))
	 (format-- s l ha))))
  
(define (format- str l)
  (string-join ((compile str) (if (id? l) l (list l))) ""))

(define formatters (make-hash-table))

(define fnm 'formatter-map132)
(define-syntax format
  (lambda (x)
    (syntax-case x ()
      ((_ a b)
       (let ((s (syntax->datum #'a)))
	 (if (string? s)
	     (let* ((mod (datum->syntax #'a (module-name (current-module))))
		    (f   (datum->syntax #'a fnm)))

	       (if (not (module-defined? (current-module) fnm))
		   (module-define! (current-module) fnm (make-hash-table)))
	       
	       (with-syntax ((u (list #'@@ mod f)))
		  #'(format-- a b u)))
	     #'(format- a b))))
      ((_ . _)
       (error "wrong number of arguments to format"))
      (_
       #'format-))))
	     	     
(define-method (py-mod (s <string>) l)
  (format s l))