X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/e6813115567e9df9ec8ccb0714c8aa6fa0f65e6c..ad4a2c4e90303713b089383980ddaca3c715ca9b:/gffi/enums.lisp

diff --git a/gffi/enums.lisp b/gffi/enums.lisp
index d97ef70..a762180 100644
--- a/gffi/enums.lisp
+++ b/gffi/enums.lisp
@@ -20,7 +20,7 @@
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
-;; $Id: enums.lisp,v 1.1 2006-04-25 20:37:49 espen Exp $
+;; $Id: enums.lisp,v 1.3 2006-09-05 13:15:46 espen Exp $
 
 (in-package "GFFI")
   
@@ -56,6 +56,10 @@
   (assert-inlined type inlined)
   (size-of 'signed))
 
+(define-type-method type-alignment ((type enum) &key (inlined t))
+  (assert-inlined type inlined)
+  (type-alignment 'signed))
+
 (define-type-method to-alien-form ((type enum) form &optional copy-p)
   (declare (ignore copy-p))
   `(case ,form
@@ -163,8 +167,7 @@
 		(:int-symbol `(,value ,symbol)))))
    :key #'first :from-end t))
 
-(deftype flags (&rest args)
-  `(or (member ,@(%map-symbols args)) list))
+(deftype flags (&rest args) (declare (ignore args)) t)
 
 (define-type-method alien-type ((type flags))
   (declare (ignore type))
@@ -174,6 +177,10 @@
   (assert-inlined type inlined)
   (size-of 'unsigned))
 
+(define-type-method type-alignment ((type flags) &key (inlined t))
+  (assert-inlined type inlined)
+  (type-alignment 'unsigned))
+
 (define-type-method to-alien-form ((type flags) flags &optional copy-p)
   (declare (ignore copy-p))
   `(reduce #'logior (mklist ,flags)
@@ -231,8 +238,9 @@
   (let ((flags-int (intern (format nil "~A-TO-INT" name)))
 	(int-flags (intern (format nil "INT-TO-~A" name)))
 	(satisfies  (intern (format nil "~A-P" name))))
-    `(progn
-       (deftype ,name () '(satisfies ,satisfies))
+    `(eval-when (:compile-toplevel :load-toplevel :execute)
+;;        (deftype ,name () '(satisfies ,satisfies))
+       (deftype ,name () '(flags ,@args))
        (defun ,satisfies (object)
 	 (flet ((valid-p (ob)
 		  (find ob ',(%map-symbols args))))
@@ -250,37 +258,39 @@
 	  for (int symbol) in ',(%map-flags args :int-symbol)
 	  when(= (logand value int) int)
 	  collect symbol))
-       (eval-when (:compile-toplevel :load-toplevel :execute)
-	 (define-type-method alien-type ((type ,name))
-	   (declare (ignore type))
-	   (alien-type 'flags))
-	 (define-type-method size-of ((type ,name) &key (inlined t))
-	   (assert-inlined type inlined)
-	   (size-of 'flags))
-	 (define-type-method to-alien-form ((type ,name) form &optional copy-p)
-	   (declare (ignore type copy-p))
-	   (list ',flags-int form))
-	 (define-type-method from-alien-form ((type ,name) form &key ref)
-	   (declare (ignore type ref))
-	   (list ',int-flags form))
-	 (define-type-method to-alien-function ((type ,name) &optional copy-p)
-	   (declare (ignore type copy-p))
-	   #',flags-int)
-	 (define-type-method from-alien-function ((type ,name) &key ref)
-	   (declare (ignore type ref))
-	   #',int-flags)
-	 (define-type-method writer-function ((type ,name) &key temp (inlined t))
-	   (declare (ignore temp))
-	   (assert-inlined type inlined)
-	   (let ((writer (writer-function 'signed)))
-	     #'(lambda (flags location &optional (offset 0))
-		 (funcall writer (,flags-int flags) location offset))))
-	 (define-type-method reader-function ((type ,name) &key ref (inlined t))
-	   (declare (ignore ref))
-	   (assert-inlined type inlined)
-	   (let ((reader (reader-function 'signed)))
-	     #'(lambda (location &optional (offset 0))
-		 (,int-flags (funcall reader location offset)))))))))
+       (define-type-method alien-type ((type ,name))
+	 (declare (ignore type))
+	 (alien-type 'flags))
+       (define-type-method size-of ((type ,name) &key (inlined t))
+	 (assert-inlined type inlined)
+	 (size-of 'flags))
+       (define-type-method type-alignment ((type ,name) &key (inlined t))
+	 (assert-inlined type inlined)
+	 (type-alignment 'flags))
+       (define-type-method to-alien-form ((type ,name) form &optional copy-p)
+	 (declare (ignore type copy-p))
+	 (list ',flags-int form))
+       (define-type-method from-alien-form ((type ,name) form &key ref)
+	 (declare (ignore type ref))
+	 (list ',int-flags form))
+       (define-type-method to-alien-function ((type ,name) &optional copy-p)
+	 (declare (ignore type copy-p))
+	 #',flags-int)
+       (define-type-method from-alien-function ((type ,name) &key ref)
+	 (declare (ignore type ref))
+	 #',int-flags)
+       (define-type-method writer-function ((type ,name) &key temp (inlined t))
+	 (declare (ignore temp))
+	 (assert-inlined type inlined)
+	 (let ((writer (writer-function 'signed)))
+	   #'(lambda (flags location &optional (offset 0))
+	       (funcall writer (,flags-int flags) location offset))))
+       (define-type-method reader-function ((type ,name) &key ref (inlined t))
+	 (declare (ignore ref))
+	 (assert-inlined type inlined)
+	 (let ((reader (reader-function 'signed)))
+	   #'(lambda (location &optional (offset 0))
+	       (,int-flags (funcall reader location offset))))))))
 
 
 (defexport define-enum-type (name &rest args)