[alexandria-devel] Fix for CDR5 type generation / Symbol case

Hans Hübner hans.huebner at gmail.com
Mon Jun 14 06:27:16 UTC 2010


Hi,

find a patch to Alexandria attached that makes CDR5 type generation
work with Allegro CL in "modern" mode.

Thanks for pushing,
Hans
-------------- next part --------------
commit 0c53e15bd6b43e77970dd2dd8b79fbd3c80aabbf
Author: Hans Huebner <hans.huebner at gmail.com>
Date:   Mon Jun 14 08:22:40 2010 +0200

    Modify CDR5 type generation macro to work with lower-case symbols for
    those lisps that make the distinction.

diff --git a/types.lisp b/types.lisp
index dd354f3..716efc8 100644
--- a/types.lisp
+++ b/types.lisp
@@ -18,9 +18,10 @@ ARRAY-DIMENSION-LIMIT."
     ((frob (type &optional (base-type type))
        (let ((subtype-names (list))
              (predicate-names (list)))
-         (flet ((make-subtype-name (format-control)
-                  (let ((result (format-symbol :alexandria format-control
-                                               (symbol-name type))))
+         (flet ((make-subtype-name (prefix)
+                  (let ((result (format-symbol :alexandria
+                                               "~A-~A"
+                                               prefix (symbol-name type))))
                     (push result subtype-names)
                     result))
                 (make-predicate-name (sybtype-name)
@@ -34,10 +35,10 @@ ARRAY-DIMENSION-LIMIT."
 			    type
 			    (if (equal range-beg ''*) inf (ensure-car range-beg))
 			    (if (equal range-end ''*) inf (ensure-car range-end))))))
-           (let* ((negative-name     (make-subtype-name "NEGATIVE-~A"))
-                  (non-positive-name (make-subtype-name "NON-POSITIVE-~A"))
-                  (non-negative-name (make-subtype-name "NON-NEGATIVE-~A"))
-                  (positive-name     (make-subtype-name "POSITIVE-~A"))
+           (let* ((negative-name     (make-subtype-name '#:negative))
+                  (non-positive-name (make-subtype-name '#:non-positive))
+                  (non-negative-name (make-subtype-name '#:non-negative))
+                  (positive-name     (make-subtype-name '#:positive))
                   (negative-p-name     (make-predicate-name negative-name))
                   (non-positive-p-name (make-predicate-name non-positive-name))
                   (non-negative-p-name (make-predicate-name non-negative-name))


More information about the alexandria-devel mailing list