;; 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")
(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
(: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))
(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)
(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))))
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)