X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/79c7839653d89bae3d5d7ef490ef32dd5d248b30..42e68ad2e0b1de35c307ac170d8e3c993baed6ac:/glib/genums.lisp diff --git a/glib/genums.lisp b/glib/genums.lisp index a3c4d90..c1548e0 100644 --- a/glib/genums.lisp +++ b/glib/genums.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: genums.lisp,v 1.18 2006-02-19 22:25:31 espen Exp $ +;; $Id: genums.lisp,v 1.19 2006-02-26 15:30:01 espen Exp $ (in-package "GLIB") @@ -42,54 +42,44 @@ (deftype enum (&rest args) `(member ,@(%map-enum args :symbols))) -(defmethod alien-type ((type (eql 'enum)) &rest args) - (declare (ignore type args)) +(define-type-method alien-type ((type enum)) + (declare (ignore type)) (alien-type 'signed)) -(defmethod size-of ((type (eql 'enum)) &rest args) - (declare (ignore type args)) +(define-type-method size-of ((type enum)) + (declare (ignore type)) (size-of 'signed)) -(defmethod to-alien-form (form (type (eql 'enum)) &rest args) - (declare (ignore type)) +(define-type-method to-alien-form ((type enum) form ) `(case ,form - ,@(%map-enum args :symbol-int) - (t (error 'type-error :datum ,form :expected-type '(enum ,@args))))) - - -(defmethod callback-from-alien-form (form (type (eql 'enum)) &rest args) - (apply #'from-alien-form form type args)) + ,@(%map-enum (rest (type-expand-to 'enum type)) :symbol-int) + (t (error 'type-error :datum ,form :expected-type ',type)))) -(defmethod from-alien-form (form (type (eql 'enum)) &rest args) - (declare (ignore type)) +(define-type-method from-alien-form ((type enum) form) `(case ,form - ,@(%map-enum args :int-quoted-symbol))) + ,@(%map-enum (rest (type-expand-to 'enum type)) :int-quoted-symbol))) -(defmethod to-alien-function ((type (eql 'enum)) &rest args) - (declare (ignore type)) - (let ((mappings (%map-enum args :symbol-int))) +(define-type-method to-alien-function ((type enum)) + (let ((mappings (%map-enum (rest (type-expand-to 'enum type)) :symbol-int))) #'(lambda (enum) (or (second (assoc enum mappings)) - (error 'type-error :datum enum :expected-type (cons 'enum args)))))) + (error 'type-error :datum enum :expected-type type))))) -(defmethod from-alien-function ((type (eql 'enum)) &rest args) - (declare (ignore type)) - (let ((mappings (%map-enum args :int-symbol))) +(define-type-method from-alien-function ((type enum)) + (let ((mappings (%map-enum (rest (type-expand-to 'enum type)) :int-symbol))) #'(lambda (int) (second (assoc int mappings))))) -(defmethod writer-function ((type (eql 'enum)) &rest args) - (declare (ignore type)) +(define-type-method writer-function ((type enum)) (let ((writer (writer-function 'signed)) - (function (apply #'to-alien-function 'enum args))) + (function (to-alien-function (type-expand-to 'enum type)))) #'(lambda (enum location &optional (offset 0)) (funcall writer (funcall function enum) location offset)))) -(defmethod reader-function ((type (eql 'enum)) &rest args) - (declare (ignore type)) +(define-type-method reader-function ((type enum)) (let ((reader (reader-function 'signed)) - (function (apply #'from-alien-function 'enum args))) + (function (from-alien-function (type-expand-to 'enum type)))) #'(lambda (location &optional (offset 0) weak-p) (declare (ignore weak-p)) (funcall function (funcall reader location offset))))) @@ -118,25 +108,25 @@ (defun ,int-enum (value) (case value ,@(%map-enum args :int-quoted-symbol))) - (defmethod to-alien-form (form (type (eql ',name)) &rest args) - (declare (ignore type args)) + (define-type-method to-alien-form ((type ,name) form) + (declare (ignore type)) (list ',enum-int form)) - (defmethod from-alien-form (form (type (eql ',name)) &rest args) - (declare (ignore type args)) + (define-type-method from-alien-form ((type ,name) form) + (declare (ignore type)) (list ',int-enum form)) - (defmethod to-alien-function ((type (eql ',name)) &rest args) - (declare (ignore type args)) + (define-type-method to-alien-function ((type ,name)) + (declare (ignore type)) #',enum-int) - (defmethod from-alien-function ((type (eql ',name)) &rest args) - (declare (ignore type args)) + (define-type-method from-alien-function ((type ,name)) + (declare (ignore type)) #',int-enum) - (defmethod writer-function ((type (eql ',name)) &rest args) - (declare (ignore type args)) + (define-type-method writer-function ((type ,name)) + (declare (ignore type)) (let ((writer (writer-function 'signed))) #'(lambda (enum location &optional (offset 0)) (funcall writer (,enum-int enum) location offset)))) - (defmethod reader-function ((type (eql ',name)) &rest args) - (declare (ignore type args)) + (define-type-method reader-function ((type ,name)) + (declare (ignore type)) (let ((reader (reader-function 'signed))) #'(lambda (location &optional (offset 0) weak-p) (declare (ignore weak-p)) @@ -160,63 +150,53 @@ (deftype flags (&rest args) `(or (member ,@(%map-flags args :symbols)) list)) -(defmethod alien-type ((type (eql 'flags)) &rest args) - (declare (ignore type args)) +(define-type-method alien-type ((type flags)) + (declare (ignore type)) (alien-type 'unsigned)) -(defmethod size-of ((type (eql 'flags)) &rest args) - (declare (ignore type args)) +(define-type-method size-of ((type flags)) + (declare (ignore type)) (size-of 'unsigned)) -(defmethod to-alien-form (flags (type (eql 'flags)) &rest args) +(define-type-method to-alien-form ((type flags) flags) `(reduce #'logior (mklist ,flags) :key #'(lambda (flag) (case flag - ,@(%map-flags args :symbol-int) - (t (error 'type-error :datum ,flags - :expected-type '(,type ,@args))))))) + ,@(%map-flags (rest (type-expand-to 'flags type)) :symbol-int) + (t (error 'type-error :datum ,flags :expected-type ',type)))))) -(defmethod callback-from-alien-form (form (type (eql 'flags)) &rest args) - (apply #'from-alien-form form type args)) - -(defmethod from-alien-form (value (type (eql 'flags)) &rest args) - (declare (ignore type)) +(define-type-method from-alien-form ((type flags) value) `(loop - for (int symbol) in ',(%map-flags args :int-symbol) + for (int symbol) in ',(%map-flags (rest (type-expand-to 'flags type)) :int-symbol) when (= (logand ,value int) int) collect symbol)) -(defmethod to-alien-function ((type (eql 'flags)) &rest args) - (declare (ignore type)) - (let ((mappings (%map-flags args :symbol-int))) +(define-type-method to-alien-function ((type flags)) + (let ((mappings (%map-flags (rest (type-expand-to 'flags type)) :symbol-int))) #'(lambda (flags) (reduce #'logior (mklist flags) :key #'(lambda (flag) (or (second (assoc flag mappings)) - (error 'type-error :datum flags - :expected-type (cons 'flags args)))))))) + (error 'type-error :datum flags :expected-type type))))))) -(defmethod from-alien-function ((type (eql 'flags)) &rest args) - (declare (ignore type)) - (let ((mappings (%map-flags args :int-symbol))) +(define-type-method from-alien-function ((type flags)) + (let ((mappings (%map-flags (rest (type-expand-to 'flags type)) :int-symbol))) #'(lambda (value) (loop for (int symbol) in mappings when (= (logand value int) int) collect symbol)))) -(defmethod writer-function ((type (eql 'flags)) &rest args) - (declare (ignore type)) +(define-type-method writer-function ((type flags)) (let ((writer (writer-function 'unsigned)) - (function (apply #'to-alien-function 'flags args))) + (function (to-alien-function (type-expand-to 'flags type)))) #'(lambda (flags location &optional (offset 0)) (funcall writer (funcall function flags) location offset)))) -(defmethod reader-function ((type (eql 'flags)) &rest args) - (declare (ignore type)) +(define-type-method reader-function ((type flags)) (let ((reader (reader-function 'unsigned)) - (function (apply #'from-alien-function 'flags args))) + (function (from-alien-function (type-expand-to 'flags type)))) #'(lambda (location &optional (offset 0) weak-p) (declare (ignore weak-p)) (funcall function (funcall reader location offset))))) @@ -248,31 +228,31 @@ for (int symbol) in ',(%map-flags args :int-symbol) when(= (logand value int) int) collect symbol)) - (defmethod alien-type ((type (eql ',name)) &rest args) - (declare (ignore type args)) + (define-type-method alien-type ((type ,name)) + (declare (ignore type)) (alien-type 'flags)) - (defmethod size-of ((type (eql ',name)) &rest args) - (declare (ignore type args)) + (define-type-method size-of ((type ,name)) + (declare (ignore type)) (size-of 'flags)) - (defmethod to-alien-form (form (type (eql ',name)) &rest args) - (declare (ignore type args)) + (define-type-method to-alien-form ((type ,name) form) + (declare (ignore type)) (list ',flags-int form)) - (defmethod from-alien-form (form (type (eql ',name)) &rest args) - (declare (ignore type args)) + (define-type-method from-alien-form ((type ,name) form) + (declare (ignore type)) (list ',int-flags form)) - (defmethod to-alien-function ((type (eql ',name)) &rest args) - (declare (ignore type args)) + (define-type-method to-alien-function ((type ,name)) + (declare (ignore type)) #',flags-int) - (defmethod from-alien-function ((type (eql ',name)) &rest args) - (declare (ignore type args)) + (define-type-method from-alien-function ((type ,name)) + (declare (ignore type)) #',int-flags) - (defmethod writer-function ((type (eql ',name)) &rest args) - (declare (ignore type args)) + (define-type-method writer-function ((type ,name)) + (declare (ignore type)) (let ((writer (writer-function 'signed))) #'(lambda (flags location &optional (offset 0)) - (funcall writer (,flags-int flags) location offset)))) - (defmethod reader-function ((type (eql ',name)) &rest args) - (declare (ignore type args)) + (funcall writer (,flags-int flags) location offset)))) + (define-type-method reader-function ((type ,name)) + (declare (ignore type)) (let ((reader (reader-function 'signed))) #'(lambda (location &optional (offset 0) weak-p) (declare (ignore weak-p))