88 lines
4.4 KiB
Common Lisp
88 lines
4.4 KiB
Common Lisp
;;;; 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))
|