From: Barry Margolin
Subject: Re: How to limit the list of possible slot values?
Date:
Message-ID: <666vn7$2ta@tools.bbnplanet.com>
In article <··························@tikko-s>,
Tiko & Margo <····@aip.mk.ua> wrote:
>Please tell me how to limit the list of possible slot values?
You can use the :TYPE slot option, and specify a type like (MEMBER A B C)
to declare that the slot will only contains one of those symbols.
Note that this is a declaration -- it tells Lisp that you promise never to
try to store something other than this in the slot. It doesn't require
Lisp to add code to check what you store. Some implementations may add
this for you if you specify high a SAFETY optimization setting, but you
can't depend on it in general.
--
Barry Margolin, ······@bbnplanet.com
GTE Internetworking, Powered by BBN, Cambridge, MA
Support the anti-spam movement; see <http://www.cauce.org/>
Please don't send technical questions directly to me, post them to newsgroups.
From: Kent M Pitman
Subject: Re: How to limit the list of possible slot values?
Date:
Message-ID: <sfw67p49t3u.fsf@world.std.com>
Barry Margolin <······@bbnplanet.com> writes:
> Tiko & Margo <····@aip.mk.ua> wrote:
> >Please tell me how to limit the list of possible slot values?
>
> You can use the :TYPE slot option, and specify a type like (MEMBER A B C)
> to declare that the slot will only contains one of those symbols.
>
> Note that this is a declaration -- it tells Lisp that you promise never to
> try to store something other than this in the slot. It doesn't require
> Lisp to add code to check what you store. Some implementations may add
> this for you if you specify high a SAFETY optimization setting, but you
> can't depend on it in general.
I agree with what Barry says, but I'd add this additional note:
You could avoid the use of (SETF (SLOT-VALUE ...) ...) [which can't
be user-customized to add error-checking] and use only slot accessors.
If you do, then you could do:
(DEFMACRO FUSSY-DEFCLASS (NAME SUPERCLASSES SLOTS)
(LET ((CHECKS '())
(NEW (GENSYM "NEW"))
(OBJ (GENSYM "OBJ"))
(TEMP (GENSYM "TEMP")))
(DOLIST (SLOT SLOTS)
(WHEN (AND (GETF (CDR SLOT) :TYPE)
(GETF (CDR SLOT) :ACCESSOR))
(PUSH SLOT CHECKS)))
(SETQ CHECKS (NREVERSE CHECKS))
`(PROG1 (DEFCLASS ,NAME ,SUPERCLASSES ,SLOTS)
(DEFMETHOD INITIALIZE-INSTANCE :AFTER ((,OBJ ,NAME) &REST ,TEMP)
(DECLARE (IGNORE ,TEMP))
(WITH-SLOTS ,(MAPCAR #'CAR CHECKS) ,OBJ
,@(MAPCAR #'(LAMBDA (CHECK)
(DESTRUCTURING-BIND (SLOT-NAME &KEY TYPE
&ALLOW-OTHER-KEYS) CHECK
`(CHECK-TYPE ,SLOT-NAME ,TYPE)))
CHECKS)))
,@(MAPCAR #'(LAMBDA (CHECK)
(DESTRUCTURING-BIND (SLOT-NAME &KEY ACCESSOR TYPE
&ALLOW-OTHER-KEYS) CHECK
`(DEFMETHOD (SETF ,ACCESSOR) :AROUND
(,NEW (,OBJ ,NAME))
(CHECK-TYPE ,NEW ,TYPE)
(CALL-NEXT-METHOD))))
CHECKS))))
or some such thing to have automatic type checks generated for accessors
and for object creation. (WARNING: I didn't test the above code extensively.
Use at own risk.) A typical expansion might look like:
(macroexpand-1
'(fussy-defclass foo ()
((a :initarg :a :accessor foo-a :type integer)
(b :initarg :b :accessor foo-b :type (member alpha beta gamma)))))
=> (PROG1
(DEFCLASS FOO NIL
((A :INITARG :A :ACCESSOR FOO-A :TYPE INTEGER)
(B :INITARG :B :ACCESSOR FOO-B :TYPE (MEMBER ALPHA BETA GAMMA))))
(DEFMETHOD INITIALIZE-INSTANCE :AFTER ((#:OBJ2876 FOO) &REST #:TEMP2877)
(DECLARE (IGNORE #:TEMP2877))
(WITH-SLOTS (A B) #:OBJ2876
(CHECK-TYPE A INTEGER)
(CHECK-TYPE B (MEMBER ALPHA BETA GAMMA))))
(DEFMETHOD (SETF FOO-A) :AROUND (#:NEW2875 (#:OBJ2876 FOO))
(CHECK-TYPE #:NEW2875 INTEGER)
(CALL-NEXT-METHOD))
(DEFMETHOD (SETF FOO-B) :AROUND (#:NEW2875 (#:OBJ2876 FOO))
(CHECK-TYPE #:NEW2875 (MEMBER ALPHA BETA GAMMA))
(CALL-NEXT-METHOD)))