I'm having trouble writing some macros (code below). The first macro,
my-define, allows the use of simplified expressions for defclass
(based on Marty Hall's define-class). The second, my-redefine, allows
modifications to superclasses, documentation, and/or slots. It fills
in any arguments that weren't provided as arguments and calls
my-define. Then there's the function, my-add-slot, which adds its
argument to existing slots of a class, and calls my-redefine.
When compiling my-add-slot, I get:
;; Error: Argument CLASSNAME-1 to FIND-CLASS does not name a class.
I've tried rewriting the code in various ways, all providing various
errors, but to keep things simple, the code below (and the error
above) is what I started out with. I've looked in a number of texts
available to me here, but there's not very much detail on the various
ways of defining macros. It seems to me that the problem is in my use
of non-backquoted expressions before the backquoted-expression in
definition of my-redefine.
I've seen the use of (let ((c (gensym))) ... ) in the code for
Graham's On Lisp, but unfortunately I don't have access to his text
right now. None of my available texts mention this technique so I'm
not sure if it should be used here.
Any clarification of these defmacro issues would be greatly
appreciated. Thanks.
(defmacro my-define (classname
&key superclass-list doc-string slot-entry-list)
"A macro for simplifying def-class input."
`(defclass ,classname (,@superclass-list My-Mixin-Class)
,(if slot-list (expand-slot-entries slot-entry-list) ())
(:documentation ,doc-string)))
(defmacro my-redefine (classname &key superclasses doc slot-entries)
"If superclasses, doc, or slots are not provided, get their
existing values for classname. Then, call define-class with classname
and the arguments."
(let ((c (find-class classname)))
(unless superclasses
(setq superclasses
(remove 'My-Mixin-Class (direct-superclasses c))))
(unless doc (setq doc (documentation c)))
(unless slot-entries
(setq slot-entries
(mapcar #'expand-slot-definition
(class-direct-slots c))))
`(my-define ,classname
:superclass-list ,superclasses
:doc-string ,doc
:slot-entry-list ,slot-entries)))
(defun my-add-slot (classname-1 slot-entry)
"Add slot to existing slots and send to my-redefine."
(let* ((class (find-class classname-1))
(existing-slots (mapcar #'expand-slot-definition
(class-direct-slots class))))
(my-redefine classname-1
:slot-entries (cons slot-entry existing-slots))))
;;;
;;; A slot entry looks like ((my-slot 99 :type integer))
;;;
;;; (expand-slot-entries '((my-slot 99 :type integer)))
;;; returns ((my-slot :initform 99 :initarg :my-slot
;;; :accessors my-slot :type integer))
;;;
;;; (expand-slot-definition <the-slot-defined-by-the-above>
;;; returns the slot-entry expression ((my-slot 99 :type integer))
;;;
;;; Shouldn't need their code, but it is below if you want.
;;;
; ----------------------
(defun expand-slot-definition (slot)
"Returns a list for the slot-definition that can be used with
define-class."
(let ((expr
(append
(funcall
(if (slot-definition-initform slot) #'list #'cons)
(slot-definition-name slot)
(slot-definition-initform slot))
(unless (eql (slot-definition-type slot) t)
(list :type (slot-definition-type slot)))
(unless (eql (slot-definition-allocation slot) :instance)
(list :allocation (slot-definition-allocation slot)))
(when (documentation slot)
(list :documentation (documentation slot)))
;; Not using other slot options here.
;; :initargs, :accessor, are set automatically.
)))
(if (cdr expr) expr (car expr))))
(defun expand-slot-entries (slot-entries)
(when slot-entries
(let ((slot-entry (first slot-entries))
expansion)
(cond ((atom slot-entry) ; slot-entry will be a slotname.
(setq expansion (list slot-entry
:accessor slot-entry
:initarg (add-colon slot-entry))))
((listp slot-entry)
(let* ((slotname (first slot-entry))
;; Don't have to give a slot-value if using
;; slot keywords. But this does mean the
;; value of a slot cannot be a keyword.
(slot-value (if (keywordp (second slot-entry))
NIL
(second slot-entry)))
(other-keywords-and-values
;; Not (if slot-value (cddr slot-entry)
;; (cdr slot-entry))
;; b/c NIL may have been supplied explicitly.
(if (keywordp (second slot-entry))
(cdr slot-entry)
(cddr slot-entry))))
(when (eql slotname 'draw-color)
(setq other-keywords-and-values
(append other-keywords-and-values
(list :allocation :class))))
(setq expansion (list* slotname :accessor slotname
:initarg (add-colon slotname)
:initform slot-value
other-keywords-and-values)))))
(cons expansion (expand-slot-entries (cdr slot-entries))))))
--------------------------------Bermuda Massive
Kevin Mayall ·······@uwaterlooREMOVETHIS.ca
School of Planning
University of Waterloo
In article <·················@news.uwaterloo.ca>,
<·······@uwaterlooREMOVETHIS.ca> wrote:
>When compiling my-add-slot, I get:
>;; Error: Argument CLASSNAME-1 to FIND-CLASS does not name a class.
MY-ADD-SLOT contains (my-redefine classname-1 ...). Since MY-REDEFINE is a
macro, this expression is expanded at compile time, and CLASSNAME-1 isn't
evaluated.
In general, you're trying to do lots of things at macro expansion time that
depend on runtime values, such as the class hierarchy. I don't fully
understand what your code is trying to do, but it looks pretty hopeless to
me.
--
Barry Margolin, ······@bbnplanet.com
GTE Internetworking, Powered by BBN, Cambridge, MA
*** DON'T SEND TECHNICAL QUESTIONS DIRECTLY TO ME, post them to newsgroups.
On Wed, 18 Mar 1998 08:16:52 GMT, Barry Margolin
<······@bbnplanet.com> wrote:
>MY-ADD-SLOT contains (my-redefine classname-1 ...). Since MY-REDEFINE is a
>macro, this expression is expanded at compile time, and CLASSNAME-1 isn't
>evaluated.
>In general, you're trying to do lots of things at macro expansion time that
>depend on runtime values, such as the class hierarchy. I don't fully
>understand what your code is trying to do, but it looks pretty hopeless to
>me.
I'm sorry, let me try again. As I said, I have rewritten this in
various ways, and maybe that was a bad one to post. This should be
clearer...
(defmacro my-define (classname
&key superclass-list doc-string slot-list)
"A macro for simplifying defclass input."
`(defclass ,classname (,@superclass-list My-Mixin-Class)
,(if slot-list (expand-slot-entries slot-list) ())
(:documentation ,doc-string)))
Example:
(my-define House :superclass-list (Building)
:doc-string "A residential building"
:slot-list ((completed t) (paid-for nil))
expands to
(defclass House (Building My-Mixin-Class)
((completed :accessor completed :initarg :completed :initform t)
(paid-for :accessor paid-for :initarg :paid-for :initform nil))
(:documentation "A residential building"))
This works fine for me from the command line. No problems. Now, I am
writing functions whereby a user can *change* the class definition.
e.g. new slots, new documentation string, add a superclass.
(defun my-redefine (classname-1 superclasses documentation slots)
;; Argument manipulation omitted here for clarity...
;; Going straight to my-define...
(my-define classname-1 superclasses documentation slots))
I realize classname-1 isn't being evaluated. Neither is superclasses,
which is used with ,@ which expects a cons, thus prompting a
compilation error:
;; Error: Argument SUPERCLASSES given to RPLACA or RPLACD should have
;; been a cons in ACL::APPEND2
I understand what it is doing. But, when my-redefine is called at
runtime the value of superclasses will be some list. I guess I'm
incorrectly treating the macro as a function. But I'm confused about
what I should be doing *instead* in order to implement my-redefine?
Can I not use my-define at all, and should use defclass directly?
Thanks,
Kevin
--------------------------------Bermuda Massive
Kevin Mayall ·······@uwaterlooREMOVETHIS.ca
School of Planning
University of Waterloo
In article <················@news.uwaterloo.ca>,
<·······@uwaterlooREMOVETHIS.ca> wrote:
>This works fine for me from the command line. No problems. Now, I am
>writing functions whereby a user can *change* the class definition.
>e.g. new slots, new documentation string, add a superclass.
>
>(defun my-redefine (classname-1 superclasses documentation slots)
> ;; Argument manipulation omitted here for clarity...
> ;; Going straight to my-define...
> (my-define classname-1 superclasses documentation slots))
>
>I realize classname-1 isn't being evaluated. Neither is superclasses,
>which is used with ,@ which expects a cons, thus prompting a
>compilation error:
>;; Error: Argument SUPERCLASSES given to RPLACA or RPLACD should have
>;; been a cons in ACL::APPEND2
>
>I understand what it is doing. But, when my-redefine is called at
>runtime the value of superclasses will be some list. I guess I'm
>incorrectly treating the macro as a function. But I'm confused about
>what I should be doing *instead* in order to implement my-redefine?
>Can I not use my-define at all, and should use defclass directly?
There's two ways to solve your problem.
The "right way" to solve it is to make a function variant of MY-DEFINE. It
would accept parameters in the normal way (i.e. they're evaluated before
calling it) and do what's necessary to the class. It can use the functions
in the Meta-Object Protocol to accomplish this. If you don't want to be
dependent on the MOP (it's not really a standard) then it can do:
(eval `(defclass ...))
The easy, but "less right", way would be for MY-REDEFINE to evaluate a
MY-DEFINE form, i.e.:
(eval `(my-define ,classname-1 ,superclasses ,documentation ,slots))
--
Barry Margolin, ······@bbnplanet.com
GTE Internetworking, Powered by BBN, Cambridge, MA
*** DON'T SEND TECHNICAL QUESTIONS DIRECTLY TO ME, post them to newsgroups.