r11092: add clisp mop support; prefixed-number-string macro
authorKevin M. Rosenberg <kevin@rosenberg.net>
Tue, 5 Sep 2006 01:32:56 +0000 (01:32 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Tue, 5 Sep 2006 01:32:56 +0000 (01:32 +0000)
kmrcl.asd
mop.lisp
package.lisp
strings.lisp
tests.lisp

index a90e206..0fab1a0 100644 (file)
--- a/kmrcl.asd
+++ b/kmrcl.asd
@@ -20,7 +20,7 @@
 (defpackage #:kmrcl-system (:use #:asdf #:cl))
 (in-package #:kmrcl-system)
 
-#+(or allegro cmu lispworks sbcl scl openmcl)
+#+(or allegro cmu clisp lispworks sbcl scl openmcl)
 (pushnew :kmr-mop cl:*features*)
 
 (defsystem kmrcl
index 8decec5..f85912b 100644 (file)
--- a/mop.lisp
+++ b/mop.lisp
@@ -42,6 +42,7 @@
    #+kmr-cmucl-mop #:mop
    #+allegro #:mop
    #+lispworks #:clos
+   #+clisp #:clos
    #+scl #:clos
    #+openmcl #:openmcl-mop
    )
@@ -84,6 +85,8 @@
    '(excl::compute-effective-slot-definition-initargs)
    #+lispworks
    '(clos::compute-effective-slot-definition-initargs)
+   #+clisp
+   '(clos::compute-effective-slot-definition-initargs)
    #+sbcl
    '(#+kmr-sbcl-mop class-of #-kmr-sbcl-mop sb-pcl:class-of
      #+kmr-sbcl-mop class-name #-kmr-sbcl-mop sb-pcl:class-name
index f4d42ff..a138169 100644 (file)
@@ -49,6 +49,7 @@
    #:string-delimited-string-to-list
    #:list-to-delimited-string
    #:prefixed-fixnum-string
+   #:prefixed-integer-string
    #:integer-string
    #:fast-string-search
    #:string-substitute
index d5bfa07..166c5fa 100644 (file)
@@ -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.
index d78aba3..b33befd 100644 (file)
 (deftest :nwp.2
        (numbers-within-percentage 1. 1.1 11)
   t)
-  
+
+(deftest :pfs.1 (prefixed-fixnum-string 0 #\A 5) "A00000")
+
+(deftest :pfs.2 (prefixed-fixnum-string 1 #\A 5) "A00001")
+
+(deftest :pfs.3 (prefixed-fixnum-string 21 #\B 3) "B021")
+          
+(deftest :pis.4 (prefixed-integer-string 234134 #\C 7) "C0234134")
           
  ;;; MOP Testing