;;;; PMSF-Lib --- PMSF Common Lisp Utility Library
;;;; This is copyrighted software.  See documentation for terms.
;;;; 
;;;; printf.lisp --- C printf parsing routines
;;;; 
;;;; $Id$

(cl:in-package #:pmsf-lib)

;;;; %File Description:
;;;; 
;;;; This file contains a parser for C-style printf format
;;;; strings.
;;;; 

(defun make-printf-format-parser (string)
  (with-lexer (scan ()
                    ("%([-+ #0]+)?([1-9][0-9]*)?([.][0-9]*)?(hh|h|ll|l|L|z|j|t)?([diufFeEgGxXoscp%])"
                     (flags width precision length type)
                     (declare (ignore length))
                     (let ((width (when width (ignore-errors (parse-integer width))))
                           (precision (when precision (ignore-errors (parse-integer precision :start 1))))
                           (type (char type 0)))
                       (ecase type
                         (#\% (succeed :literal "%"))
                         ((#\e #\E) 
                          (succeed :double-float 
                                   (lambda (val)
                                     (format nil 
                                             (if (member #\+ flags) "~v,v,,,,v,v@E" "~v,v,,,,v,vE")
                                             width precision (if (member #\0 flags) #\0 #\Space)
                                             (if (upper-case-p type) #\E #\e)
                                             val))))
                         ((#\f #\F)
                          (succeed :double-float 
                                   (lambda (val)
                                     (format nil 
                                             (if (member #\+ flags) "~v,v,,,v@F" "~v,v,,,vF")
                                             width precision (if (member #\0 flags) #\0 #\Space)
                                             val))))
                         ((#\g #\G) 
                          (succeed :double-float 
                                   (lambda (val)
                                     (format nil 
                                             (if (member #\+ flags) "~v,v,,,,v,v@G" "~v,v,,,,v,vG")
                                             width precision (if (member #\0 flags) #\0 #\Space)
                                             (if (upper-case-p type) #\E #\e)
                                             val))))
                         ((#\d #\i #\u)
                          (succeed (if (char= type #\u) :unsigned :signed)
                                   (lambda (val)
                                     (format nil (if (member #\+ flags) "~v,v@D" "~v,vD")
                                             width (if (member #\0 flags) #\0 #\Space)
                                             val))))
                         ((#\x #\X)
                          (succeed :unsigned
                                   (lambda (val)
                                     (format nil (if (char= type #\X) "~:@(~v,vX~)" "~(~v,vX~)")
                                             width (if (member #\0 flags) #\0 #\Space)
                                             val))))
                         ((#\o)
                          (succeed :unsigned
                                   (lambda (val)
                                     (format nil "~v,vO"
                                             width (if (member #\0 flags) #\0 #\Space)
                                             val))))
                         (#\s
                          (succeed :string 
                                   (lambda (val)
                                     (format nil "~v@A"
                                             width
                                             (if precision 
                                                 (subseq val 0 (min (length val) precision))
                                               val)))))
                         (#\c
                          (succeed :char
                                   (lambda (val)
                                     (format nil "~A" val))))
                         (#\p
                          (succeed :pointer 
                                   (lambda (val)
                                     (format nil "~8,'0X" val)))))))
                    ("([^%]+)" 
                     (str)
                     (succeed :literal str)))
      string
    #'scan))