Initial CL parser/generator implementation

2019-08-07 16:16:36 +02:00
commit 8126f8e3d1
25 changed files with 3728 additions and 0 deletions
--- a/lib/printf.lisp
+++ b/lib/printf.lisp
@ -0,0 +1,89 @@
+;;;; 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)
+
+(pmsf-lib:file-version :pmsf-lib "$Id$")
+
+;;;; %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))