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 :)

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

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)

contrib/sb-grovel/sb-grovel.texinfo

@@ -111,6 +111,16 @@ Here's how to use the grovel clauses:
 @code{"C expression"} will be typically be the name of a constant. But
 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

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).

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)

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)

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"