Still a newbie, and trying to make a macro that will write the defclass form
for me.
I'm trying to stick to the syntax of the usual defclass form only adding
what's necessary for
my purpose.
So here is my attempt ... the thing is working but I'd be very happy to
receive some advice about the style/design mistakes i might have introduced.
That is my first real macro so not doubt these are plenty =P
Amongst other things i tried to use a better destructuring but the class
options gave me a hard time, so i had to give up on that part.
here's the code :
;;
;; defcontainer translates to the defclass for name-container
;;
;; container-slots have this form :
;; (:container-slots ((class1 . class1-hash-table) (class2 .
class2-hash-table)))
;;
(defmacro defcontainer (name super-classes (&key container-slots) slots
&rest rest)
(pushnew 'name-container super-classes)
`(defclass ,name ,super-classes
,(merge-slot-defs slots (parse-container-slots container-slots))
,@(parse-class-options rest container-slots)))
;; returns slots found in container-slots as valid slot definitions
(defun parse-container-slots (container-slots)
(let ((result '()))
(dolist (a-cons container-slots result)
(push `(,(cdr a-cons) :accessor ,(cdr a-cons) :initform
(make-hash-table :test #'equal))
result))))
;;
(defun merge-slot-defs (original-slots generated-slots)
(let ((result '()))
(append original-slots
`((container-slots :accessor container-slots
:initarg :container-slots
:allocation :class))
(dolist (a-slot-def generated-slots result)
(unless (assoc (first a-slot-def) original-slots)
(push a-slot-def result))))))
;; ensures the class options initialize container-slots
(defun parse-class-options (class-options container-slots)
(let ((init-args-form (assoc :default-initargs class-options)))
(cond (init-args-form
(nconc init-args-form `(:container-slots ',container-slots))
class-options)
(t (append class-options
(list `(:default-initargs :container-slots
',container-slots)))))))
And there goes the expansion :
CL-USER 124 > (pprint (macroexpand-1
'(defcontainer test-container-class ()
(:container-slots ((class1 .
class1-hash-table)(class2 . class2-hash-table)(class3 . class3-hash-table)))
((some-other-slot :accessor
some-other-slot :initarg :some-other-slot))
(:default-initargs . (:some-other-slot
1))
(:documentation "let's test this
thing"))))
(DEFCLASS TEST-CONTAINER-CLASS
(NAME-CONTAINER)
((SOME-OTHER-SLOT :ACCESSOR SOME-OTHER-SLOT :INITARG
:SOME-OTHER-SLOT)
(CONTAINER-SLOTS :ACCESSOR CONTAINER-SLOTS :INITARG
:CONTAINER-SLOTS :ALLOCATION :CLASS)
(CLASS1-HASH-TABLE :ACCESSOR CLASS1-HASH-TABLE :INITFORM
(MAKE-HASH-TABLE :TEST #'EQUAL))
(CLASS2-HASH-TABLE :ACCESSOR CLASS2-HASH-TABLE :INITFORM
(MAKE-HASH-TABLE :TEST #'EQUAL))
(CLASS3-HASH-TABLE :ACCESSOR CLASS3-HASH-TABLE :INITFORM
(MAKE-HASH-TABLE :TEST #'EQUAL)))
(:DEFAULT-INITARGS
:SOME-OTHER-SLOT
1
:CONTAINER-SLOTS
'((CLASS1 . CLASS1-HASH-TABLE) (CLASS2 . CLASS2-HASH-TABLE)
(CLASS3 . CLASS3-HASH-TABLE)))
(:DOCUMENTATION "let's test this thing"))
Thanks in advance for any advice.
Sacha
Sacha wrote:
> Still a newbie, and trying to make a macro that will write the defclass form
> for me.
> I'm trying to stick to the syntax of the usual defclass form only adding
> what's necessary for
> my purpose.
>
> So here is my attempt ... the thing is working but I'd be very happy to
> receive some advice about the style/design mistakes i might have introduced.
> That is my first real macro so not doubt these are plenty =P
>
> Amongst other things i tried to use a better destructuring but the class
> options gave me a hard time, so i had to give up on that part.
>
>
> here's the code :
>
>
> ;;
> ;; defcontainer translates to the defclass for name-container
> ;;
> ;; container-slots have this form :
> ;; (:container-slots ((class1 . class1-hash-table) (class2 .
> class2-hash-table)))
> ;;
> (defmacro defcontainer (name super-classes (&key container-slots) slots
> &rest rest)
> (pushnew 'name-container super-classes)
I am wondering if class precedence problems will come up with a base
class always at the front as you develop a deep container class
hierarchy. Would it work better at the end of the superclasses?
> `(defclass ,name ,super-classes
> ,(merge-slot-defs slots (parse-container-slots container-slots))
You do not have to merge them:
`(defclass <etc>
(,@slots
,@(parse-container-slots ....))
> ,@(parse-class-options rest container-slots)))
>
> ;; returns slots found in container-slots as valid slot definitions
> (defun parse-container-slots (container-slots)
> (let ((result '()))
> (dolist (a-cons container-slots result)
> (push `(,(cdr a-cons) :accessor ,(cdr a-cons) :initform
> (make-hash-table :test #'equal))
> result))))
Shucks, just use mapcar or loop:
(loop for a-cons in container-slots
collecting `(,(cdr a-cons) <etc>))
btw, your code outputs slots in reverse order, then they get re-reversed
in merge-slot-defs such that they come out in the right order. Ewwww! :)
> ;;
> (defun merge-slot-defs (original-slots generated-slots)
> (let ((result '()))
> (append original-slots
> `((container-slots :accessor container-slots
> :initarg :container-slots
> :allocation :class))
Why not just put that slot in the superclass 'name-container? Note that
you could have specified here ":initform ',container-slots" and avoided
mucking with the default-initargs. But I really do think the right way
is for name-container to have the slot container-slots.
> (dolist (a-slot-def generated-slots result)
> (unless (assoc (first a-slot-def) original-slots)
Why would I code an original slot for class1 and then specify it as a
container-slot only to have it thrown away here? btw, it would be
cleaner, should you persist in this, to toss repetitions ASAP so the
reader does not get confused:
(parse-container-slots (remove-if <repetition-test> container-slots))
> (push a-slot-def result))))))
>
> ;; ensures the class options initialize container-slots
> (defun parse-class-options (class-options container-slots)
> (let ((init-args-form (assoc :default-initargs class-options)))
> (cond (init-args-form
This cond looks like it should be an IF.
> (nconc init-args-form `(:container-slots ',container-slots))
Here and several other places I wonder what happens when you get a
deeper class hierarchy. If you intend that. If so, will a subclass get
any container slots (both the slot defs themselves /and/ the value of
the container-slots slot) from the parent classes?
> class-options)
> (t (append class-options
> (list `(:default-initargs :container-slots
> ',container-slots)))))))
>
>
>
> And there goes the expansion :
>
> CL-USER 124 > (pprint (macroexpand-1
> '(defcontainer test-container-class ()
> (:container-slots ((class1 .
> class1-hash-table)(class2 . class2-hash-table)(class3 . class3-hash-table)))
I like the consistent naming. Why not save the user some typing and do
that for them so they just say "class1" and then you provide the
accessor (intern (format nil "~a-hash-table"))?
> ((some-other-slot :accessor
> some-other-slot :initarg :some-other-slot))
> (:default-initargs . (:some-other-slot
> 1))
Yikes, don't change the syntax of the :default-initargs option. You can
splice in the :container-slots initialization without doing that.
> (:documentation "let's test this
> thing"))))
>
> (DEFCLASS TEST-CONTAINER-CLASS
> (NAME-CONTAINER)
> ((SOME-OTHER-SLOT :ACCESSOR SOME-OTHER-SLOT :INITARG
> :SOME-OTHER-SLOT)
> (CONTAINER-SLOTS :ACCESSOR CONTAINER-SLOTS :INITARG
> :CONTAINER-SLOTS :ALLOCATION :CLASS)
> (CLASS1-HASH-TABLE :ACCESSOR CLASS1-HASH-TABLE :INITFORM
> (MAKE-HASH-TABLE :TEST #'EQUAL))
> (CLASS2-HASH-TABLE :ACCESSOR CLASS2-HASH-TABLE :INITFORM
> (MAKE-HASH-TABLE :TEST #'EQUAL))
> (CLASS3-HASH-TABLE :ACCESSOR CLASS3-HASH-TABLE :INITFORM
> (MAKE-HASH-TABLE :TEST #'EQUAL)))
> (:DEFAULT-INITARGS
> :SOME-OTHER-SLOT
> 1
> :CONTAINER-SLOTS
> '((CLASS1 . CLASS1-HASH-TABLE) (CLASS2 . CLASS2-HASH-TABLE)
> (CLASS3 . CLASS3-HASH-TABLE)))
> (:DOCUMENTATION "let's test this thing"))
>
>
> Thanks in advance for any advice.
Download Cells and look at DEFMODEL. If you email me, I can send you
DEFTK from my Tk package. That is closer to your example in that the
user does specify a separate list of tk-slots.
What I would do is simply support a syntax like this:
(defcontainer test-container-class ()
((class1 :container t)
(class2 :container t)
(class3 :container t)
(some-other-slot :accessor some-other-slot :initarg :some-other-slot))
(:default-initargs
:some-other-slot 1))
(:documentation "let's test this thing")))
The macro will be a lot easier to code by having the user merge the
slots themselves, and later you can have other options for container
slots. This will be helpful as your solution evolves and you discover a
need to vary container slots in one way or another. (This latter
consideration did not apply to the Tk package.)
btw, nothing above has been tested or even stared at very hard. :)
ken
>> (pushnew 'name-container super-classes)
>
> I am wondering if class precedence problems will come up with a base class
> always at the front as you develop a deep container class hierarchy. Would
> it work better at the end of the superclasses?
This might be a problem, i'm not really familiar with multiple-ineheritance.
So i'll just follow your advice.
>> `(defclass ,name ,super-classes
>> ,(merge-slot-defs slots (parse-container-slots container-slots))
>
> You do not have to merge them:
>
> `(defclass <etc>
> (,@slots
> ,@(parse-container-slots ....))
>
Even more so if i use a defcontainer syntax like the one you
show at the end of your message. I think i'll update the syntax
to reflect it, it makes sense to define slots in the slot definitions list
=P
>> ;; returns slots found in container-slots as valid slot definitions
>> (defun parse-container-slots (container-slots)
>> (let ((result '()))
>> (dolist (a-cons container-slots result)
>> (push `(,(cdr a-cons) :accessor ,(cdr a-cons) :initform
>> (make-hash-table :test #'equal))
>> result))))
>
> Shucks, just use mapcar or loop:
>
> (loop for a-cons in container-slots
> collecting `(,(cdr a-cons) <etc>))
>
> btw, your code outputs slots in reverse order, then they get re-reversed
> in merge-slot-defs such that they come out in the right order. Ewwww! :)
haha well, the loop facility is pretty badly documented in the hyperspec.
Pretty hard for a newbie
to understand it all. That's how i almost always avoid it.
There should be somme place with a lot of examples in a single page.
The same thing could be said about format.
Peter Siebel's book helps a lot though.
>> ;;
>> (defun merge-slot-defs (original-slots generated-slots)
>> (let ((result '()))
>> (append original-slots
>> `((container-slots :accessor container-slots
>> :initarg :container-slots
>> :allocation :class))
>
> Why not just put that slot in the superclass 'name-container? Note that
> you could have specified here ":initform ',container-slots" and avoided
> mucking with the default-initargs. But I really do think the right way is
> for name-container to have the slot container-slots.
There you're touching a problematic point.
The container-slots slot is a class allocated slot, as it pertains to a
whole container class
If i define it as a class slot of the named-container class, changing it in
a sub-class will change it for all sub-classes (i guess?).
So i need to define it at this level.
But yes, it would be easier to set an init-form instead of doing the
default-initargs stuff.
I'll update the code.
>> (dolist (a-slot-def generated-slots result)
>> (unless (assoc (first a-slot-def) original-slots)
>
> Why would I code an original slot for class1 and then specify it as a
> container-slot only to have it thrown away here? btw, it would be cleaner,
> should you persist in this, to toss repetitions ASAP so the reader does
> not get confused:
I guess i wanted to allow the user of this class to be able to set its own
init-form... though it doesn't make sense.
> (parse-container-slots (remove-if <repetition-test> container-slots))
>
>> (push a-slot-def result))))))
>>
>> ;; ensures the class options initialize container-slots
>> (defun parse-class-options (class-options container-slots)
>> (let ((init-args-form (assoc :default-initargs class-options)))
>> (cond (init-args-form
>
> This cond looks like it should be an IF.
either a cond or an if with a progn ....
anyways this whole function will disapear as i'm applying your advice.
>> (nconc init-args-form `(:container-slots ',container-slots))
>
> Here and several other places I wonder what happens when you get a deeper
> class hierarchy. If you intend that. If so, will a subclass get any
> container slots (both the slot defs themselves /and/ the value of the
> container-slots slot) from the parent classes?
I intended to redefine them for each class.
Though it makes sense to allow inheritance of the container-slots property,
i don't see how this could be done, as the container-slots property doesn't
exist
until an instance of one of these super-classes is created.
>> CL-USER 124 > (pprint (macroexpand-1
>> '(defcontainer test-container-class ()
>> (:container-slots ((class1 .
>> class1-hash-table)(class2 . class2-hash-table)(class3 .
>> class3-hash-table)))
>
> I like the consistent naming. Why not save the user some typing and do
> that for them so they just say "class1" and then you provide the accessor
> (intern (format nil "~a-hash-table"))?
instead of having classes like "class1" and hash tables slots like
"class1-hash-table"
i'll have more likely a slot "groups" storing "pricegroup" classes.
>> ((some-other-slot :accessor
>> some-other-slot :initarg :some-other-slot))
>> (:default-initargs .
>> (:some-other-slot 1))
>
> Yikes, don't change the syntax of the :default-initargs option. You can
> splice in the :container-slots initialization without doing that.
haha well ... *blushes* that is a bug. I reallly intended to keep the same
syntax as defclass =P
>
> Download Cells and look at DEFMODEL.
I will have a look to this. And probably will use the cells package later on
for
some formula driven default values applied to my price list columns.
Well this project keeps going back to the fundamentals, so this might not
hapend before 2050 =P
> What I would do is simply support a syntax like this:
>
> (defcontainer test-container-class ()
> ((class1 :container t)
> (class2 :container t)
> (class3 :container t)
> (some-other-slot :accessor some-other-slot :initarg :some-other-slot))
> (:default-initargs
> :some-other-slot 1))
> (:documentation "let's test this thing")))
i'll probably make it :
(class1-hash-table :owned-class class1 :container t)
But yes, as i said earlier this makes perfect sense : back to the drawing
board i guess.
That macro took me a while to code =P
I pray that my mind eventually wraps around all that so that I actually
get productivity improvements out of that macro thing.
All in all this is a nice exercise. I'm having a lot of fun =P
>
> ken
This was quite a lot of code to review, i really apreciate the effort from
you and Pascal Costanza.
Thanks both of you for your time.
Sacha
Sacha wrote:
> Still a newbie, and trying to make a macro that will write the defclass form
> for me.
> I'm trying to stick to the syntax of the usual defclass form only adding
> what's necessary for
> my purpose.
>
> So here is my attempt ... the thing is working but I'd be very happy to
> receive some advice about the style/design mistakes i might have introduced.
> That is my first real macro so not doubt these are plenty =P
>
> Amongst other things i tried to use a better destructuring but the class
> options gave me a hard time, so i had to give up on that part.
I don't completely understand what you are trying to achieve here, but I
can give some comments...
> here's the code :
>
> ;;
> ;; defcontainer translates to the defclass for name-container
> ;;
> ;; container-slots have this form :
> ;; (:container-slots ((class1 . class1-hash-table) (class2 .
> class2-hash-table)))
> ;;
> (defmacro defcontainer (name super-classes (&key container-slots) slots
> &rest rest)
> (pushnew 'name-container super-classes)
> `(defclass ,name ,super-classes
> ,(merge-slot-defs slots (parse-container-slots container-slots))
> ,@(parse-class-options rest container-slots)))
You can some extra syntax checking for free for the list of direct
superclasses and the list of slots by saying (&rest super-classes)
instead of just superclasses, and (&rest slots) instead of slots. This
will make sure that the user indeed passes lists, and not some atoms in
those positions.
Instead of &rest I would use &body in order to get some nicer indentation.
> ;; returns slots found in container-slots as valid slot definitions
> (defun parse-container-slots (container-slots)
> (let ((result '()))
> (dolist (a-cons container-slots result)
> (push `(,(cdr a-cons) :accessor ,(cdr a-cons) :initform
> (make-hash-table :test #'equal))
> result))))
> ;;
> (defun merge-slot-defs (original-slots generated-slots)
> (let ((result '()))
> (append original-slots
> `((container-slots :accessor container-slots
> :initarg :container-slots
> :allocation :class))
> (dolist (a-slot-def generated-slots result)
> (unless (assoc (first a-slot-def) original-slots)
> (push a-slot-def result))))))
>
> ;; ensures the class options initialize container-slots
> (defun parse-class-options (class-options container-slots)
> (let ((init-args-form (assoc :default-initargs class-options)))
> (cond (init-args-form
> (nconc init-args-form `(:container-slots ',container-slots))
> class-options)
> (t (append class-options
> (list `(:default-initargs :container-slots
> ',container-slots)))))))
You shouldn't use nconc here. The class-options that are passed here are
part of the original macro invocation, so in the general case, part of
your source code. It seems to me that this code attempts to change the
source code. Better use append.
Pascal
--
My website: http://p-cos.net
Closer to MOP & ContextL:
http://common-lisp.net/project/closer/
>
> I don't completely understand what you are trying to achieve here, but I
> can give some comments...
Well i posted this just before going to bed, my mistake.
The classes defined using this macro are part of a larger system.
Basicaly, when adding some instances of the "named" class to one of the hash
tables of
an instance of the "name-container" class, it will be checked that no 2
names are the same and
later on, any change of a "named" instance's name will be forwarded to this
class, and up the chain to any
pther "named-container" instance that would be interested in such name
changes.
an example structure though not really what i'm working on.
sale-items (named-container named)
item-group (named-container named)
item (named)
item-group
item
item
each item-group needs to have a unique name amongst sale-items.
each item needs a unique name amongst an item-group ...
and when the item-group belongs to a sale-items instance
its name needs to be unique as well.
Names of items need to be checked for uniqueness when an item-group is added
to a sale-items instance.
>> here's the code :
>> ;;
>> (defmacro defcontainer (name super-classes (&key container-slots) slots
>> &rest rest)
<snip>
> You can some extra syntax checking for free for the list of direct
> superclasses and the list of slots by saying (&rest super-classes) instead
> of just superclasses, and (&rest slots) instead of slots. This will make
> sure that the user indeed passes lists, and not some atoms in those
> positions.
Awesome, that's exactly the kind of advice i was looking for.
> Instead of &rest I would use &body in order to get some nicer indentation.
I will update the code
<snip>
>> ;; ensures the class options initialize container-slots
>> (defun parse-class-options (class-options container-slots)
>> (let ((init-args-form (assoc :default-initargs class-options)))
>> (cond (init-args-form
>> (nconc init-args-form `(:container-slots ',container-slots))
>> class-options)
>> (t (append class-options
>> (list `(:default-initargs :container-slots
>> ',container-slots)))))))
> You shouldn't use nconc here. The class-options that are passed here are
> part of the original macro invocation, so in the general case, part of
> your source code. It seems to me that this code attempts to change the
> source code. Better use append.
Ok i'll change it as well..
Thanks for your help
Sacha
Sacha wrote:
> Still a newbie, and trying to make a macro that will write the defclass form
> for me.
Your macro doesn't seem to buy a whole lot. It hides a few hash table
creations and a couple of other details.
My question would be, what the heck is a container, and why do hash
tables have to be associated with class names.
What does this stuff do, and is it really necessary?
> ;;
> ;; defcontainer translates to the defclass for name-container
> ;;
> ;; container-slots have this form :
> ;; (:container-slots ((class1 . class1-hash-table) (class2 .
> class2-hash-table)))
Are the symbols in this pair list (the names of) CLOS classes or is the
word class being used to mean something else?
Would CLASS-1-HASH-TABLE slot contain only instances of CLASS1? Where
would that be enforced and why?
Why does a container have to be a general class, with custom slots?
What is the advantage of combining those other properties into the
container under control of the macro, versus simply using inheritance?
That is to say, a DEFCONTAINER could define a pure container with no
other material in it other than the hash table cruft. If you want other
slots, then just make another class that derives from the container and
adds the slots.
(defcontainer foo ...)
(defclass embellished-foo (foo) ...)
Imagine if you had no inheritance at all, and you wanted to write
several macros that resemble DEFCONTAINER, say a DEFINE-FOOTAINER, and
a DEFINE-BARTAINER. Suppose you wanted an objct that is both a
footainer and a bartainer, what then? The macros would probably not
work together very nicely, right? Without inheritance, your only option
would be to invent some framework whereby you have a modified version
of DEFCLASS which has a macro language built into its syntax for
generating class material. That footainer and bartainer stuff would be
written in that special inner macro language, allowing both to be
expressed in the same class definition.
> Your macro doesn't seem to buy a whole lot. It hides a few hash table
> creations and a couple of other details.
>
> My question would be, what the heck is a container, and why do hash
> tables have to be associated with class names.
Here is a sample object model (the real thing might have a couple more
levels)
items (name-container)
item-group (name-container named)
item (named)
item
item-group
item
item
i want to ensure that :
1: i can manipulate each object independantly from the class hierarchy, or
maybe parts of it too
2: each named item must have a unique name amongst other items of the same
class, two items of different classes could have the same name
3: if an item-group is not part of an items object it still needs to enforce
the unicity of item names
4: if there are several groups then it's up to the items object to enforce
the unicity of item names
5: i need reasonably fast lookup per name at any level
6: name changes must update the tables without user intervention
> What does this stuff do, and is it really necessary?
7: i need to learn lisp, any problem no matter how stupid will do
>> ;;
>> ;; defcontainer translates to the defclass for name-container
>> ;;
>> ;; container-slots have this form :
>> ;; (:container-slots ((class1 . class1-hash-table) (class2 .
>> class2-hash-table)))
>
> Are the symbols in this pair list (the names of) CLOS classes or is the
> word class being used to mean something else?
these indeed are classes, though the name would be a bit better than class1
=P
> Would CLASS-1-HASH-TABLE slot contain only instances of CLASS1? Where
> would that be enforced and why?
This will be enforced by the generic functions coming with the
name-container class.
I suppose the user (me) will be smart enough (there's no guarantee there) to
use the functions for adding/deleting items.
> Why does a container have to be a general class, with custom slots?
> What is the advantage of combining those other properties into the
> container under control of the macro, versus simply using inheritance?
I couldn't come up with a solution where inheritance only would allow me to
enforce all these rules.
The macro here is only part of the ..hum .. library ..and a result of my
exploration of this problem.
I though "hum there should be some kind of a macro there", then worked on
it.
I was not happy with the result and thought i would ask here for some
stylistic direction.
Maybe this macro will eventually go, as parts of the design, but still i
learned quite a lot about
the loop macro in the process, so that's all good !
> That is to say, a DEFCONTAINER could define a pure container with no
> other material in it other than the hash table cruft. If you want other
> slots, then just make another class that derives from the container and
> adds the slots.
In this case the unicity would only be ensured for a single class, or across
diferent classes, which is not the goal.
it is acceptable to have an item-group having the same name as a group
it is not acceptable to have an item (or descendant) having the same name as
any other item.
the goal here would be to have this kind of call :
(insert-named item-group items)
and have all the rules enforced.
I could use a list of "pure containers" and include it in my current
container class.
> (defcontainer foo ...)
>
> (defclass embellished-foo (foo) ...)
>
> Imagine if you had no inheritance at all, and you wanted to write
> several macros that resemble DEFCONTAINER, say a DEFINE-FOOTAINER, and
> a DEFINE-BARTAINER. Suppose you wanted an objct that is both a
> footainer and a bartainer, what then? The macros would probably not
> work together very nicely, right? Without inheritance, your only option
> would be to invent some framework whereby you have a modified version
> of DEFCLASS which has a macro language built into its syntax for
> generating class material. That footainer and bartainer stuff would be
> written in that special inner macro language, allowing both to be
> expressed in the same class definition.
I can see the problem...but well, i'll see if that really becomes a problem
and act accordingly.
As i said earlier the primary purpose of all this is "playing with lisp" and
hopefully learn a bit about it.
Sacha
With your help, here's what the macro now looks like
There's no more need for additional functions.
I'm looping twice across the slots list, is there a way for loop to collect
two lists in a single pass ?
Thanks for your help.
(defmacro defcontainer (name (&rest super-classes) (&rest slots) &body body)
`(defclass ,name
,(if (member 'name-container super-classes)
super-classes
(append super-classes (list 'name-container)))
;slots are next
(,@(loop for slot-def
in slots
collecting
(if (getf (rest slot-def) :containing)
(let ((slot-name (first slot-def)))
`(,slot-name
:accessor ,slot-name
:initform (make-hash-table :test #'equal)))
slot-def))
(container-slots
:accessor container-slots
:initform
',(loop with contained = nil
for slot-def
in slots
do (setf contained (getf (rest slot-def) :containing))
when contained
collect (cons (first slot-def) contained))))
,@body))
CL-USER 67 > (pprint (macroexpand-1
'(defcontainer items (name-container)
((groups :containing itemgroup)
(items :containing item)
(some-slot :initarg :some-slot
:initform 12))
(:default-initargs . (:some-slot 12))
(:documentation "let's test this
thing"))))
(DEFCLASS ITEMS
(NAME-CONTAINER)
((GROUPS :ACCESSOR GROUPS :INITFORM (MAKE-HASH-TABLE :TEST
#'EQUAL))
(ITEMS :ACCESSOR ITEMS :INITFORM (MAKE-HASH-TABLE :TEST #'EQUAL))
(SOME-SLOT :INITARG :SOME-SLOT :INITFORM 12)
(CONTAINER-SLOTS :ACCESSOR CONTAINER-SLOTS :INITFORM '((GROUPS .
ITEMGROUP) (ITEMS . ITEM))))
(:DEFAULT-INITARGS :SOME-SLOT 12)
(:DOCUMENTATION "let's test this thing"))
>> (:default-initargs . (:some-slot
>> 12))
>
> Ooops, still changing :default-initargs syntax.
oh i guess i was misunderstanding the hyperspec
class-option::= (:default-initargs . initarg-list) |
(:documentation string) |
(:metaclass class-name)
anyways
(:default-initargs . (:some-slot 12))
and
(:default-initargs :some-slot 12)
both evaluate to the same list anyways ... granted the later looks better.
I'll post a (hopefully) very last revision in a little bit.
taking into account both your and Pascal Costanza's remarks.
Sacha
Sacha wrote:
>>> (:default-initargs . (:some-slot
>>>12))
>>
>>Ooops, still changing :default-initargs syntax.
>
>
> oh i guess i was misunderstanding the hyperspec
>
> class-option::= (:default-initargs . initarg-list) |
> (:documentation string) |
> (:metaclass class-name)
Oh, I never saw that. I am just completely unused to that notation, tho
I recognize it when others use it. Just never saw anyone do that in
order to /add/ parens around a list. I always took it to be a cute way
to avoid saying &rest in a lambda list.
ken
Ken Tilton <·········@gmail.com> writes:
> when (getf ....)
> collect (cons (first slot-def) it) ;; "it" = obscure loop trick
IT works only immediately after another loop keyword; not when
shielded from sight by parentheses.
* (loop for x on '(a nil c) when (car x) collect (cons x it))
debugger invoked on a UNBOUND-VARIABLE in thread #<THREAD "initial thread" {9003299}>:
The variable IT is unbound.
* (loop for x on '(a nil c) when (car x) collect :it)
(A C)
I think there would (years ago) have been two ways to make LOOP
support IT inside forms:
(a) Don't recognize IT based on the symbol-name. Instead, export
COMMON-LISP:IT and make LOOP always bind it lexically when
the if/when/unless loop keywords are used. Let the compiler
optimize the binding out if it is not used. If someone
defined a macro like
(defmacro (foo (y z))
(let ((x (gensym)))
`(loop for ,x in ,y if ,x do ,z)))
then users of FOO would have to know that it expands to a
LOOP form, so that they wouldn't try to access any outer
CL:IT bindings from Z. However, this is already the case
because of LOOP-FINISH.
(b) Use a code walker, like Iterate has been trying to do
(<···················@Astalo.kon.iki.fi>, c.l.l 2004-11-23).
Kalle Olavi Niemitalo wrote:
> Ken Tilton <·········@gmail.com> writes:
>
>
>> when (getf ....)
>> collect (cons (first slot-def) it) ;; "it" = obscure loop trick
>
>
> IT works only immediately after another loop keyword; not when
> shielded from sight by parentheses.
>
Worked for me, but what you say makes sense. Might be an implementation
thing. Thx.
ken
Ken Tilton <·········@gmail.com> wrote:
+---------------
| Kalle Olavi Niemitalo wrote:
| > Ken Tilton <·········@gmail.com> writes:
| >> when (getf ....)
| >> collect (cons (first slot-def) it) ;; "it" = obscure loop trick
| >
| > IT works only immediately after another loop keyword; not when
| > shielded from sight by parentheses.
|
| Worked for me, but what you say makes sense. Might be an implementation
| thing. Thx.
+---------------
Maybe another one of those CLtL2 thingies...? The CLHS is
pretty explicit about IT being usable in only two places:
6.1.6 Conditional Execution Clauses
...
The loop keyword IT can be used to refer to the result of the
test expression in a clause. Use the loop keyword IT in place
of the form in a RETURN clause or an accumulation clause that
is inside a conditional execution clause.
An even further restriction:
If multiple clauses are connected with AND, the IT construct
must be in the first clause in the block.
-Rob
-----
Rob Warnock <····@rpw3.org>
627 26th Avenue <URL:http://rpw3.org/>
San Mateo, CA 94403 (650)572-2607
Rob Warnock wrote:
> Ken Tilton <·········@gmail.com> wrote:
> +---------------
> | Kalle Olavi Niemitalo wrote:
> | > Ken Tilton <·········@gmail.com> writes:
> | >> when (getf ....)
> | >> collect (cons (first slot-def) it) ;; "it" = obscure loop trick
> | >
> | > IT works only immediately after another loop keyword; not when
> | > shielded from sight by parentheses.
> |
> | Worked for me, but what you say makes sense. Might be an implementation
> | thing. Thx.
> +---------------
>
> Maybe another one of those CLtL2 thingies...?
No, my bad, my test to remind myself how "it" worked did not include the
essential element (unknown to me) of "it" not being inside a form.
kt
In article <··················@fe12.lga>,
Ken Tilton <·········@gmail.com> wrote:
> Rob Warnock wrote:
> > Ken Tilton <·········@gmail.com> wrote:
> > +---------------
> > | Kalle Olavi Niemitalo wrote:
> > | > Ken Tilton <·········@gmail.com> writes:
> > | >> when (getf ....)
> > | >> collect (cons (first slot-def) it) ;; "it" = obscure loop trick
> > | >
> > | > IT works only immediately after another loop keyword; not when
> > | > shielded from sight by parentheses.
> > |
> > | Worked for me, but what you say makes sense. Might be an implementation
> > | thing. Thx.
> > +---------------
> >
> > Maybe another one of those CLtL2 thingies...?
>
> No, my bad, my test to remind myself how "it" worked did not include the
> essential element (unknown to me) of "it" not being inside a form.
The thing to realize is that IT is not a variable, it's another LOOP
keyword. Once you're inside a form you're just doing normal Lisp
evaluation, not subject to any special LOOP parsing.
--
Barry Margolin, ······@alum.mit.edu
Arlington, MA
*** PLEASE post questions in newsgroups, not directly to me ***
*** PLEASE don't copy me on replies, I'll read them in the group ***
Sacha wrote:
> With your help, here's what the macro now looks like
> There's no more need for additional functions.
>
> I'm looping twice across the slots list, is there a way for loop to collect
> two lists in a single pass ?
(loop for slot-def in slots
for contained = (getf ...)
collect (if ...) into slot-forms
when contained collect (cons ...) into initforms
finally (return `(defclass ...
,@slot-forms
...
,@initforms
...)))
> Thanks for your help.
>
> (defmacro defcontainer (name (&rest super-classes) (&rest slots) &body body)
> `(defclass ,name
> ,(if (member 'name-container super-classes)
> super-classes
> (append super-classes (list 'name-container)))
> ;slots are next
> (,@(loop for slot-def
> in slots
> collecting
> (if (getf (rest slot-def) :containing)
> (let ((slot-name (first slot-def)))
> `(,slot-name
> :accessor ,slot-name
> :initform (make-hash-table :test #'equal)))
> slot-def))
> (container-slots
> :accessor container-slots
> :initform
> ',(loop with contained = nil
> for slot-def
> in slots
> do (setf contained (getf (rest slot-def) :containing))
> when contained
> collect (cons (first slot-def) contained))))
> ,@body))
Pascal
--
My website: http://p-cos.net
Closer to MOP & ContextL:
http://common-lisp.net/project/closer/
>> I'm looping twice across the slots list, is there a way for loop to
>> collect two lists in a single pass ?
>
> (loop for slot-def in slots
> for contained = (getf ...)
> collect (if ...) into slot-forms
> when contained collect (cons ...) into initforms
> finally (return `(defclass ...
> ,@slot-forms
> ...
> ,@initforms
> ...)))
>
Easy enough, thanks again !
Sacha
Sacha wrote:
>>>(loop for slot-def in slots
>>> for contained = (getf ...)
>>> collect (if ...) into slot-forms
>>> when contained collect (cons ...) into initforms
>>> finally (return `(defclass ...
>>> ,@slot-forms
>>> ...
>>> ,@initforms
>>> ...)))
>>>
>
>
> and there is the (hopefully final) result
>
> (defmacro defcontainer (name (&rest super-classes) (&rest slots) &body body)
> (loop for slot-def in slots
> for contained = (getf (rest slot-def) :containing)
> for slot-name = (first slot-def)
> collect (if contained `(,slot-name
> :accessor ,slot-name
> :initform (make-hash-table :test #'equal))
> slot-def)
> into slot-forms
> when contained collect (cons slot-name contained) into init-forms
> finally return
> `(defclass ,name
> ,(if (member 'name-container super-classes)
> super-classes
> (append super-classes (list 'name-container)))
> ( ,@slot-forms
> (container-slots :accessor container-slots :initform
> ',init-forms))
> ,@body)))
Nice. Two things:
- A slot form may be just a symbol, it doesn't need to be a list. For
example, the following defclass form is acceptable:
(defclass some-class ()
((a :initarg :a)
b))
This means that (first slot-def) might break.
- It has to be "finally (return ...)", not "finally return ...". After
"finally", the loop macro expects regular Lisp code, not loop keywords.
Pascal
--
3rd European Lisp Workshop
July 3-4 - Nantes, France - co-located with ECOOP 2006
http://lisp-ecoop06.bknr.net/
> - A slot form may be just a symbol, it doesn't need to be a list. For
> example, the following defclass form is acceptable:
>
> (defclass some-class ()
> ((a :initarg :a)
> b))
> This means that (first slot-def) might break.
That bug would never have surfaced as i ignored one could declare a slot
that way
That's annoying, but easily fixed :
(loop for slot-def in slots
for contained = (if (symbolp slot-def)
nil
(getf (rest slot-def) :containing))
for slot-name = (if (symbolp slot-def)
slot-def
(first slot-def))
......
I'm afraid this doesn't look as nice as it did.
Those two tests look very much alike.
>
> - It has to be "finally (return ...)", not "finally return ...". After
> "finally", the loop macro expects regular Lisp code, not loop keywords.
>
Oh that's strange, i tested this before sending it and it worked.
Actually it works both with "finally return" and "finally (return"
I wonder why ... return is supposed to be a macro so it would require a
parenthesis, wouldn't it ?
Is this *yet another* cryptographicaly-dark-sided property of the loop
facility ?
Sacha
Sacha wrote:
>>- A slot form may be just a symbol, it doesn't need to be a list. For
>>example, the following defclass form is acceptable:
>>
>>(defclass some-class ()
>> ((a :initarg :a)
>> b))
>>This means that (first slot-def) might break.
>
>
> That bug would never have surfaced as i ignored one could declare a slot
> that way
> That's annoying, but easily fixed :
>
> (loop for slot-def in slots
> for contained = (if (symbolp slot-def)
> nil
> (getf (rest slot-def) :containing))
> for slot-name = (if (symbolp slot-def)
> slot-def
> (first slot-def))
> ......
>
> I'm afraid this doesn't look as nice as it did.
> Those two tests look very much alike.
You could introduce a helper function:
(defun normalize-slot-definition (slot-definition)
(if (symbolp slot-definition)
(list slot-definition)
slot-definition))
...and then work with that.
>>- It has to be "finally (return ...)", not "finally return ...". After
>>"finally", the loop macro expects regular Lisp code, not loop keywords.
>
> Oh that's strange, i tested this before sending it and it worked.
> Actually it works both with "finally return" and "finally (return"
> I wonder why ... return is supposed to be a macro so it would require a
> parenthesis, wouldn't it ?
> Is this *yet another* cryptographicaly-dark-sided property of the loop
> facility ?
I think some CL implementations are just forgiving enough to let this go
through. It would actually be a nice and cheap extension to the loop
macro because it seems to me that this mistake is easily made...
Pascal
--
3rd European Lisp Workshop
July 3-4 - Nantes, France - co-located with ECOOP 2006
http://lisp-ecoop06.bknr.net/
Pascal Costanza <··@p-cos.net> writes:
>>> - It has to be "finally (return ...)", not "finally return
>>> ...". After "finally", the loop macro expects regular Lisp code,
>>> not loop keywords.
>> Oh that's strange, i tested this before sending it and it worked.
>> Actually it works both with "finally return" and "finally (return"
>> I wonder why ... return is supposed to be a macro so it would
>> require a parenthesis, wouldn't it ?
>> Is this *yet another* cryptographicaly-dark-sided property of the
>> loop facility ?
>
> I think some CL implementations are just forgiving enough to let this
> go through. It would actually be a nice and cheap extension to the
> loop macro because it seems to me that this mistake is easily made...
The fact is that it's a CLtL2-ism. It has been removed from the standard.
Only implementations compatible with CLtL2 accept it.
--
__Pascal Bourguignon__ http://www.informatimago.com/
You're always typing.
Well, let's see you ignore my
sitting on your hands.
On Fri, 10 Mar 2006 13:31:51 +0100, Pascal Bourguignon
<······@informatimago.com> tried to confuse everyone with this message:
>Pascal Costanza <··@p-cos.net> writes:
>
>>>> - It has to be "finally (return ...)", not "finally return
>>>> ...". After "finally", the loop macro expects regular Lisp code,
>>>> not loop keywords.
>>> Oh that's strange, i tested this before sending it and it worked.
>>> Actually it works both with "finally return" and "finally (return"
>>> I wonder why ... return is supposed to be a macro so it would
>>> require a parenthesis, wouldn't it ?
>>> Is this *yet another* cryptographicaly-dark-sided property of the
>>> loop facility ?
>>
>> I think some CL implementations are just forgiving enough to let this
>> go through. It would actually be a nice and cheap extension to the
>> loop macro because it seems to me that this mistake is easily made...
>
>The fact is that it's a CLtL2-ism. It has been removed from the standard.
>Only implementations compatible with CLtL2 accept it.
>
I'm sure that CLISP at some point supported it, but now they removed it
for some reason...
--
|WAR HAS NEVER SOLVED ANYTHING|,----- Timofei Shatrov aka Grue---------.
|(except for ending slavery, ||mail: grue at mail.ru ================ |
| fascism and communism) ||============= http://grue3.tripod.com |
|...and Saddam's dictatorship |`----------------------------------[4*72]
Sacha wrote:
>>- A slot form may be just a symbol, it doesn't need to be a list. For
>>example, the following defclass form is acceptable:
>>
>>(defclass some-class ()
>> ((a :initarg :a)
>> b))
>>This means that (first slot-def) might break.
>
>
> That bug would never have surfaced as i ignored one could declare a slot
> that way
> That's annoying, but easily fixed :
>
> (loop for slot-def in slots
> for contained = (if (symbolp slot-def)
> nil
> (getf (rest slot-def) :containing))
> for slot-name = (if (symbolp slot-def)
> slot-def
> (first slot-def))
> ......
>
> I'm afraid this doesn't look as nice as it did.
Well, there /is/ a point of diminishing return on such fussing, tho the
spirit remains pedagogic so no harm in going a little too far.
> Those two tests look very much alike.
Well, they are doing the same thing, compensating for incompatible
representations of a slot. If you looked at my deftk macro, you will see
a place I normalized the widget configuration options, since they could
be specified -width or (lisp-width -width) if "width" caused a name
clash. I did that precisely to avoid what you just noticed. In your
case, you can just start with:
(mapl (lambda (slots) ;;normalize slot definitions
(when (symbolp (car slots))
(rplaca slots (list (car slots)))) slots))
ken
>> (loop for slot-def in slots
>> for contained = (if (symbolp slot-def)
>> nil
>> (getf (rest slot-def) :containing))
>> for slot-name = (if (symbolp slot-def)
>> slot-def
>> (first slot-def))
>> ......
>>
>> I'm afraid this doesn't look as nice as it did.
>
> Well, there /is/ a point of diminishing return on such fussing, tho the
> spirit remains pedagogic so no harm in going a little too far.
> (mapl (lambda (slots) ;;normalize slot definitions
> (when (symbolp (car slots))
> (rplaca slots (list (car slots)))) slots))
ok then...
for normalized-slot-def = (if (symbolp slot-def)
(list slot-def)
slot-def)
for contained = (getf (rest normalized-slot-def) :containing)
for slot-name = (first normalized-slot-def)
Since i'm already in a loop, there's no need for the map function.
>Well, there /is/ a point of diminishing return on such fussing, tho the
>spirit remains pedagogic so no harm in going a little too far.
I don't know but , i'm sure having great fun with all this...
I'll tell my grand-children about the loop war and how i lost my left lobe
to a macro =P
Sacha
Sacha wrote:
>>> (loop for slot-def in slots
>>> for contained = (if (symbolp slot-def)
>>> nil
>>> (getf (rest slot-def) :containing))
>>> for slot-name = (if (symbolp slot-def)
>>> slot-def
>>> (first slot-def))
>>> ......
>>>
>>>I'm afraid this doesn't look as nice as it did.
>>
>>Well, there /is/ a point of diminishing return on such fussing, tho the
>>spirit remains pedagogic so no harm in going a little too far.
>>(mapl (lambda (slots) ;;normalize slot definitions
>> (when (symbolp (car slots))
>> (rplaca slots (list (car slots)))) slots))
>
>
> ok then...
>
> for normalized-slot-def = (if (symbolp slot-def)
> (list slot-def)
> slot-def)
> for contained = (getf (rest normalized-slot-def) :containing)
> for slot-name = (first normalized-slot-def)
>
> Since i'm already in a loop, there's no need for the map function.
Good point. deftk took several passes at the list of configuration items.
>
>
>>Well, there /is/ a point of diminishing return on such fussing, tho the
>>spirit remains pedagogic so no harm in going a little too far.
>
>
> I don't know but , i'm sure having great fun with all this...
We'll cross-index you under "The Hedonists" in the Road to Lisp Survey.
:)
ken
Ken Tilton <·········@gmail.com> writes:
> Sacha wrote:
>>> - A slot form may be just a symbol, it doesn't need to be a list.
>>> For example, the following defclass form is acceptable:
>>>
>>>(defclass some-class ()
>>> ((a :initarg :a)
>>> b))
>>>This means that (first slot-def) might break.
>> That bug would never have surfaced as i ignored one could declare a
>> slot that way
>> That's annoying, but easily fixed :
>> (loop for slot-def in slots
>> for contained = (if (symbolp slot-def)
>> nil
>> (getf (rest slot-def) :containing))
>> for slot-name = (if (symbolp slot-def)
>> slot-def
>> (first slot-def))
>> ......
>> I'm afraid this doesn't look as nice as it did.
>
> Well, there /is/ a point of diminishing return on such fussing, tho
> the spirit remains pedagogic so no harm in going a little too far.
>
>> Those two tests look very much alike.
>
> Well, they are doing the same thing, compensating for incompatible
> representations of a slot. If you looked at my deftk macro, you will
> see a place I normalized the widget configuration options, since they
> could be specified -width or (lisp-width -width) if "width" caused a
> name clash. I did that precisely to avoid what you just noticed. In
> your case, you can just start with:
>
> (mapl (lambda (slots) ;;normalize slot definitions
> (when (symbolp (car slots))
> (rplaca slots (list (car slots)))) slots))
Except, as I think Pascal C. pointed out, if this is operating on
forms that are part of the macro call you probably don't want to be
destructively modifying them. So maybe better:
(mapcar #'mklist slots)
where MKLIST is the well-known utility:
(defun mklist (thing)
(if (listp thing) thing (list thing)))
-Peter
--
Peter Seibel * ·····@gigamonkeys.com
Gigamonkeys Consulting * http://www.gigamonkeys.com/
Practical Common Lisp * http://www.gigamonkeys.com/book/
Peter Seibel <·····@gigamonkeys.com> writes:
> where MKLIST is the well-known utility:
>
> (defun mklist (thing)
> (if (listp thing) thing (list thing)))
Is it not called ENSURE-LIST ? ;-)
--
__Pascal Bourguignon__ http://www.informatimago.com/
Nobody can fix the economy. Nobody can be trusted with their finger
on the button. Nobody's perfect. VOTE FOR NOBODY.
> > where MKLIST is the well-known utility:
> >
> > (defun mklist (thing)
> > (if (listp thing) thing (list thing)))
>
> Is it not called ENSURE-LIST ? ;-)
Or as-list ?
Daniel
Daniel Trstenjak wrote:
>>>where MKLIST is the well-known utility:
>>>
>>> (defun mklist (thing)
>>> (if (listp thing) thing (list thing)))
>>
>>Is it not called ENSURE-LIST ? ;-)
>
>
> Or as-list ?
>
> Daniel
"as-" would be fine, but "ensure-" is the Lisp tradition.
kt
Pascal Bourguignon <······@informatimago.com> writes:
> Peter Seibel <·····@gigamonkeys.com> writes:
>
>> where MKLIST is the well-known utility:
>>
>> (defun mklist (thing)
>> (if (listp thing) thing (list thing)))
>
> Is it not called ENSURE-LIST ? ;-)
LIST-OF-THINGS-FROM-LIST-OF-THINGS-DESIGNATOR?
Christophe
"Pascal Bourguignon" <······@informatimago.com> wrote in message
···················@thalassa.informatimago.com...
> Peter Seibel <·····@gigamonkeys.com> writes:
>
>> where MKLIST is the well-known utility:
>>
>> (defun mklist (thing)
>> (if (listp thing) thing (list thing)))
>
> Is it not called ENSURE-LIST ? ;-)
Yes, and the parameter should be list, just because.
(defun mklist (list)
(if (listp list) list (list list)))
--
Coby Beck
(remove #\Space "coby 101 @ bigpond . com")