X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=strings.lisp;h=166c5fa28bec6e30ff68dd0083f8ab583f6bc8ec;hp=d5bfa07a4b7c35e2baa47d3f513666c8d8dfe492;hb=c806ada1a12795e377d2ad588e56e051c7a92598;hpb=b9b882d7884b08b878e59c7c2c20828d57b3ce55

diff --git a/strings.lisp b/strings.lisp
index d5bfa07..166c5fa 100644
--- a/strings.lisp
+++ b/strings.lisp
@@ -277,27 +277,40 @@ list of characters and replacement strings."
       (unless (and last-elem last-list)
 	(write-string separator strm)))))
 
-(defun prefixed-fixnum-string (num pchar len)
-  "Outputs a string of LEN digit with an optional initial character PCHAR.
-Leading zeros are present."
-  (declare (optimize (speed 3) (safety 0) (space 0))
-	   (type fixnum num len))
-  (when pchar
-    (incf len))
-  (do* ((zero-code (char-code #\0))
-	(result (make-string len :initial-element #\0))
-	(minus? (minusp num))
-	(val (if minus? (- num) num)
-	     (nth-value 0 (floor val 10)))
-	(pos (1- len) (1- pos))
-	(mod (mod val 10) (mod val 10)))
-      ((or (zerop val) (minusp pos))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defmacro def-prefixed-number-string (fn-name type &optional doc)
+    `(defun ,fn-name (num pchar len)
+       ,@(when (stringp doc) (list doc))
+       (declare (optimize (speed 3) (safety 0) (space 0))
+                (fixnum len)
+                (,type num))
        (when pchar
-	 (setf (schar result 0) pchar))
-       (when minus? (setf (schar result (if pchar 1 0)) #\-))
-       result)
-    (declare (fixnum val mod zero-code pos) (simple-string result))
-    (setf (schar result pos) (code-char (+ zero-code mod)))))
+         (incf len))
+       (do* ((zero-code (char-code #\0))
+           (result (make-string len :initial-element #\0))
+           (minus? (minusp num))
+           (val (if minus? (- num) num)
+                (nth-value 0 (floor val 10)))
+           (pos (1- len) (1- pos))
+           (mod (mod val 10) (mod val 10)))
+         ((or (zerop val) (minusp pos))
+          (when pchar
+            (setf (schar result 0) pchar))
+          (when minus? (setf (schar result (if pchar 1 0)) #\-))
+          result)
+       (declare (,type val) 
+                (fixnum mod zero-code pos)
+                (boolean minus?)
+                (simple-string result))
+       (setf (schar result pos) (code-char (the fixnum (+ zero-code mod))))))))
+
+(def-prefixed-number-string prefixed-fixnum-string fixnum
+ "Outputs a string of LEN digit with an optional initial character PCHAR.
+Leading zeros are present. LEN must be a fixnum.")
+
+(def-prefixed-number-string prefixed-integer-string integer
+ "Outputs a string of LEN digit with an optional initial character PCHAR.
+Leading zeros are present. LEN must be an integer.")
 
 (defun integer-string (num len)
   "Outputs a string of LEN digit with an optional initial character PCHAR.