r11092: add clisp mop support; prefixed-number-string macro

[kmrcl.git] / strings.lisp

diff --git a/strings.lisp b/strings.lisp
index d5bfa07a4b7c35e2baa47d3f513666c8d8dfe492..166c5fa28bec6e30ff68dd0083f8ab583f6bc8ec 100644 (file)
--- 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.