0.8.17.27:

	Improve ENUM support a little.  (VJA sbcl-devel 2004-12-09)
	... SB-ALIEN enums not limited to symbols any more;
	... SB-GROVEL enum grovelation;
	... tests (which pass despite the current, erm, suboptimality
		of arithmetic :)

diff --git a/NEWS b/NEWS
index e7a6a05..4e93d5a 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -7,6 +7,8 @@ changes in sbcl-0.8.18 relative to sbcl-0.8.17:
     available at runtime.
   * Solaris 10 (aka SunOS 5.10) on the SPARC platform is now
     supported.  (thanks to Dan Debertin)
+  * SB-ALIEN enums can now be represented in Lisp by any symbols, not
+    just keywords.  (thanks to Vincent Arkesteijn)
   * fixed bug #331: structure-class instances corresponding to
     DEFSTRUCT forms are now created eagerly.
   * fixed bug #345: backtraces from calls to undefined functions work

diff --git a/contrib/sb-grovel/def-to-lisp.lisp b/contrib/sb-grovel/def-to-lisp.lisp
index 01ff4d6..b39ff5e 100644 (file)
--- a/contrib/sb-grovel/def-to-lisp.lisp
+++ b/contrib/sb-grovel/def-to-lisp.lisp
@@ -37,6 +37,19 @@ code:
           (c-escape formatter)
           args)))
 
+(defun c-for-enum (lispname elements export)
+  (printf "(cl:eval-when (:compile-toplevel :load-toplevel :execute) (sb-alien:define-alien-type ~A (sb-alien:enum nil" lispname)
+  (dolist (element elements)
+    (destructuring-bind (lisp-element-name c-element-name) element
+      (printf " (~S %d)" lisp-element-name c-element-name)))
+  (printf ")))")
+  (when export
+    (dolist (element elements)
+      (destructuring-bind (lisp-element-name c-element-name) element
+        (declare (ignore c-element-name))
+       (unless (keywordp lisp-element-name)
+         (printf "(export '~S)" lisp-element-name))))))
+
 (defun c-for-structure (lispname cstruct)
   (destructuring-bind (cname &rest elements) cstruct
     (printf "(cl:eval-when (:compile-toplevel :load-toplevel :execute) (sb-grovel::define-c-struct ~A %d" lispname
@@ -87,6 +100,8 @@ code:
           (as-c "#else")
           (printf "(sb-int:style-warn \"Couldn't grovel for ~A (unknown to the C compiler).\")" cname)
           (as-c "#endif"))
+          (:enum
+           (c-for-enum lispname cname export))
          (:type
           (printf "(cl:eval-when (:compile-toplevel :load-toplevel :execute) (sb-alien:define-alien-type ~A (sb-alien:%ssigned %d)))" lispname
                   (format nil "SIGNED_(~A)" cname)

diff --git a/contrib/sb-grovel/sb-grovel.texinfo b/contrib/sb-grovel/sb-grovel.texinfo
index ccb6fd2..8c7b0aa 100644 (file)
--- a/contrib/sb-grovel/sb-grovel.texinfo
+++ b/contrib/sb-grovel/sb-grovel.texinfo
@@ -112,6 +112,16 @@ Here's how to use the grovel clauses:
 other forms are possible.
 
 @item
+@code{:enum}
+@lisp
+ (:enum lisp-type-name ((lisp-enumerated-name c-enumerated-name) ...)))
+@end lisp
+
+An @code{sb-alien:enum} type with name @code{lisp-type-name} will be defined.
+The symbols are the @code{lisp-enumerated-name}s, and the values
+are grovelled from the @code{c-enumerated-name}s.
+
+@item
 @code{:structure} - alien structure definitions look like this:
 @lisp
  (:structure lisp-struct-name ("struct c_structure"

diff --git a/doc/manual/ffi.texinfo b/doc/manual/ffi.texinfo
index 80e6a59..c8bc8d5 100644 (file)
--- a/doc/manual/ffi.texinfo
+++ b/doc/manual/ffi.texinfo
@@ -216,9 +216,9 @@ determine which field is active from context.
 @item
 The foreign type specifier @code{(sb-alien:enum @var{name} &rest
 @var{specs})} describes an enumeration type that maps between integer
-values and keywords. If @var{name} is @code{nil}, then the type is
+values and symbols. If @var{name} is @code{nil}, then the type is
 anonymous.  Each element of the @var{specs} list is either a Lisp
-keyword, or a list @code{(@var{keyword} @var{value})}.  @var{value} is
+symbol, or a list @code{(@var{symbol} @var{value})}.  @var{value} is
 an integer. If @var{value} is not supplied, then it defaults to one
 greater than the value for the preceding spec (or to zero if it is the
 first spec).

diff --git a/src/code/host-alieneval.lisp b/src/code/host-alieneval.lisp
index bd3ad14..e1c2488 100644 (file)
--- a/src/code/host-alieneval.lisp
+++ b/src/code/host-alieneval.lisp
@@ -607,8 +607,8 @@
 (define-alien-type-class (enum :include (integer (bits 32))
                               :include-args (signed))
   name         ; name of this enum (if any)
-  from         ; alist from keywords to integers
-  to           ; alist or vector from integers to keywords
+  from         ; alist from symbols to integers
+  to           ; alist or vector from integers to symbols
   kind         ; kind of from mapping, :VECTOR or :ALIST
   offset)      ; offset to add to value for :VECTOR from mapping
 
@@ -649,8 +649,8 @@
              (values (first el) (second el))
              (values el (1+ prev)))
        (setf prev val)
-       (unless (keywordp sym)
-         (error "The enumeration element ~S is not a keyword." sym))
+       (unless (symbolp sym)
+         (error "The enumeration element ~S is not a symbol." sym))
        (unless (integerp val)
          (error "The element value ~S is not an integer." val))
        (unless (and max (> max val)) (setq max val))
@@ -718,7 +718,7 @@
     (:alist
      `(ecase ,alien
        ,@(mapcar (lambda (mapping)
-                   `(,(car mapping) ,(cdr mapping)))
+                   `(,(car mapping) ',(cdr mapping)))
                  (alien-enum-type-to type))))))
 
 (define-alien-type-method (enum :deport-gen) (type value)

diff --git a/tests/alien.impure.lisp b/tests/alien.impure.lisp
index 536acf3..6cd9807 100644 (file)
--- a/tests/alien.impure.lisp
+++ b/tests/alien.impure.lisp
@@ -94,5 +94,26 @@
 ;;; reported on sbcl-help 2004-11-16 by John Morrison
 (define-alien-type enum.1 (enum nil (:val0 0)))
 
+(define-alien-type enum.2 (enum nil (zero 0) (one 1) (two 2) (three 3)
+                                    (four 4) (five 5) (six 6) (seven 7)
+                                    (eight 8) (nine 9)))
+(with-alien ((integer-array (array integer 3)))
+  (let ((enum-array (cast integer-array (array enum.2 3))))
+    (setf (deref enum-array 0) 'three
+          (deref enum-array 1) 'four)
+    (setf (deref integer-array 2) (+ (deref integer-array 0)
+                                     (deref integer-array 1)))
+    (assert (eql (deref enum-array 2) 'seven))))
+;; The code that is used for mapping from integers to symbols depends on the
+;; `density' of the set of used integers, so test with a sparse set as well.
+(define-alien-type enum.3 (enum nil (zero 0) (one 1) (k-one 1001) (k-two 1002)))
+(with-alien ((integer-array (array integer 3)))
+  (let ((enum-array (cast integer-array (array enum.3 3))))
+    (setf (deref enum-array 0) 'one
+          (deref enum-array 1) 'k-one)
+    (setf (deref integer-array 2) (+ (deref integer-array 0)
+                                     (deref integer-array 1)))
+    (assert (eql (deref enum-array 2) 'k-two))))
+
 ;;; success
 (quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index 4c11e51..673838c 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.17.26"
+"0.8.17.27"