From mmommer at common-lisp.net Tue Jun 15 16:01:55 2004 From: mmommer at common-lisp.net (Mario Mommer) Date: Tue, 15 Jun 2004 09:01:55 -0700 Subject: [lgtk-cvs] CVS update: lgtk/src/enums.lisp Message-ID: Update of /project/lgtk/cvsroot/lgtk/src In directory common-lisp.net:/tmp/cvs-serv13382 Modified Files: enums.lisp Log Message: Use a symbol for satisfies type specifier (patch by Tim Daly Jr.) Date: Tue Jun 15 09:01:54 2004 Author: mmommer Index: lgtk/src/enums.lisp diff -u lgtk/src/enums.lisp:1.2 lgtk/src/enums.lisp:1.3 --- lgtk/src/enums.lisp:1.2 Wed Nov 5 09:49:56 2003 +++ lgtk/src/enums.lisp Tue Jun 15 09:01:54 2004 @@ -98,44 +98,49 @@ (ast (alistize stuff)) (msk (if bitwise (reduce #'logior ast :key #'cdr))) (arg (gensym)) + (predicate-name (intern (format nil "~A-p" symb) :enum-land)) tconds) (if (and strict (not bitwise)) - (push `(satisfies - (lambda (,arg) - (rassoc ,arg (edata-alist ,symb)))) tconds)) + (push `(lambda (,arg) + (rassoc ,arg (edata-alist ,symb))) + tconds)) (if (and bitwise strict) - (push `(satisfies - (lambda (,arg) - (= ,msk (logior ,arg ,msk)))) + (push `(lambda (,arg) + (= ,msk (logior ,arg ,msk))) tconds)) ;; always - (push `(satisfies - (lambda (,arg) - (assoc ,arg (edata-alist ,symb)))) tconds) + (push `(lambda (,arg) + (assoc ,arg (edata-alist ,symb))) + tconds) (if (not strict) - (push '(satisfies fixnump) tconds)) + (push 'fixnump tconds)) `(eval-when (:compile-toplevel :load-toplevel :execute) - (defparameter ,symb - (make-edata :alist (quote ,ast) - :strict ,strict - :bitwise ,bitwise - :mask ,msk)) - - (setf (get ',name 'enum) ,symb) - - (deftype ,name () - `(or . ,',tconds)) - - (defmacro ,name (,arg) - `(translated-form ,,symb ,,arg ,',name - ,',(if bitwise '((:optor . logior) - (:optand . logand))))) - - (def-binding-type ,name - :in ',name - :alien :int)))) + (defparameter ,symb + (make-edata :alist (quote ,ast) + :strict ,strict + :bitwise ,bitwise + :mask ,msk)) + + (setf (get ',name 'enum) ,symb) + + (defun ,predicate-name (,arg) + (or ,@(mapcar (lambda (pred) + `(,pred ,arg)) + tconds))) + + (deftype ,name () + '(satisfies ,predicate-name)) + + (defmacro ,name (,arg) + `(translated-form ,,symb ,,arg ,',name + ,',(if bitwise '((:optor . logior) + (:optand . logand))))) + + (def-binding-type ,name + :in ',name + :alien :int)))) From root at common-lisp.net Sat Jun 19 18:20:58 2004 From: root at common-lisp.net (root) Date: Sat, 19 Jun 2004 11:20:58 -0700 Subject: [lgtk-cvs] CVS update: CVSROOT/passwd Message-ID: Update of /var/lib/cvsd/project/lgtk/cvsroot/CVSROOT In directory common-lisp.net:/var/lib/cvsd/project/tmp/CVSROOT Modified Files: passwd Log Message: Added anonymous with passwd. Date: Sat Jun 19 11:20:58 2004 Author: root Index: CVSROOT/passwd diff -u CVSROOT/passwd:1.1 CVSROOT/passwd:1.2 --- CVSROOT/passwd:1.1 Thu Oct 23 13:29:24 2003 +++ CVSROOT/passwd Sat Jun 19 11:20:58 2004 @@ -1 +1 @@ -anonymous +anonymous:efQG9MDXxTujg:cvsd