I am trying the following code to write a macro that, given a name of a class, automatically creates a class with a name instance variable and an accessor for it in the form of classname-name.
(defmacro def-named-class (class-name)
`(defclass ,class-name ()
((name :accessor ,(intern (format nil "~A-~A" class-name "name"))
:initarg :name
:initform ""))))
The problem here is that, when the macro runs, say with an argument foo, the name of the accessor function comes as |FOO-name|, but I would want it to be just foo-name. The reason is, (intern "foo-name") returns a symbol |foo-name|. However, if I try to do the same with a normal function, like this:
(defmacro def-hyp (name1 name2 arg-list &body body)
`(defun ,(intern (format nil "~A-~A" name1 name2))
,arg-list
,#body))
And then call it like (def-hyp foo name () 'foo-name) it correctly produces a function with name foo-name. So I'm wondering if there's any method to get the exact same symbol from the string representation inside the first macro. I am using Clozure CL.
Note that a class already has a name.
CL-USER 19 > (defclass foo () ())
#<STANDARD-CLASS FOO 415040BE6B>
CL-USER 20 > (class-name *)
FOO
Isn't it better solved by inheritance? Here is your mixin:
(defclass named ()
((name :initarg :name :accessor name-of)))
... and you can use it for all other classes that define objects which have a name:
(defclass this (named) ...)
(defclass that (named) ...)
You should convert the name to upper case:
(defmacro def-named-class (class-name)
`(defclass ,class-name ()
((name :accessor ,(intern (format nil "~A-~A" (string-upcase class-name) "NAME"))
:initarg :name
:initform ""))))
Another possibility, as suggested in a comment by jkiiski, is to change only the format string:
...
((name :accessor ,(intern (format nil "~:#(~A-~A~)" class-name "name"))
...
The reason is that the default behaviour of the Common Lisp reader is to transform any symbol in upper-case on reading it. So, when you write foo-name, it is automatically transformed into FOO-NAME. To obtain it, you should use (intern "FOO-NAME"). However, if you want, you can change the default behaviour of the reader (see the manual).
Related
I try to write a macro, which given a name could be supplied in the function myfunc to create a class and make an instance of this class.
Here is the code:
(defmacro define-class (class-name)
`(eval
`(progn
(defclass ,,class-name () ())
(make-instance ,class-name))))
(defun myfunc (name)
(define-class name))
I can compile successfully the macro but not the function. In this case I get a warning at compilation time saying that:
undefined variable: CLASS-NAME
If I modify a bit the macro so that instead of writing
(make-instance ,class-name)
I write
(make-instance ,,class-name)
Then in this case I can compile both, but when running (myfunc 'toto) I get the following error:
The variable TOTO is unbound.
I try to figure out how the macro is expanded with macroexpand-1. With the first macro which is defined with (make-instance ,class-name) it gave me the following result:
(EVAL `(PROGN (DEFCLASS ,'TOTO NIL NIL) (MAKE-INSTANCE ,CLASS-NAME)))
Whereas in the second macro which is defined with *(make-instance ,,class-name) it gave me the following result:
(EVAL `(PROGN (DEFCLASS ,'TOTO NIL NIL) (MAKE-INSTANCE ,'TOTO)))
But I guess the right expansion in my case would be something like:
(EVAL `(PROGN (DEFCLASS ,'TOTO NIL NIL) (MAKE-INSTANCE 'TOTO)))
How could I modify or re-write the macro so that it works?
You want to write code like this:
(defun myfunc (name)
(define-class name))
This would actually be similar to this:
(defun myfunc (name)
(let ((name name))
(eval `(defclass ,name () ()))
(make-instance name)))
Thus the DEFINE-CLASS macro should generate something like above code.
(defmacro define-class (name)
(let ((name-sym (gensym "CLASS-NAME")))
`(let ((,name-sym ,name))
(eval `(defclass ,,name-sym () ()))
(make-instance ,name-sym))))
Using it:
CL-USER 21 > (pprint (macroexpand-1 '(define-class name)))
(LET ((#:CLASS-NAME22897 NAME))
(EVAL `(DEFCLASS ,#:CLASS-NAME22897 NIL NIL))
(MAKE-INSTANCE #:CLASS-NAME22897))
CL-USER 22 > (myfunc 'baz42)
#<BAZ42 40202BBE73>
But then, there is no reason that it should be a macro!
A normal function is just fine...
(defun create-class-and-instance (name)
(eval `(defclass ,name () ()))
(make-instance name))
The defclass macro generally expands into a call to the actual implementation-dependent function that creates the class. If you can call that function instead, you can get rid of eval. This is a little more direct and keeps the current lexical environment.
If you load the closer-mop system, you can write your function as follows:
(defun make-instance-from-new-class (class-name)
(make-instance (closer-mop:ensure-class class-name)))
Based on the example provide in the practical common lisp reference, I define a macro to create a class as followed.
(defmacro define-class (class-name class-slot)
`(defclass ,class-name ()
,(mapcar #'slot->defclass-slot class-slot))))
The function slot->declass-slot take a single argument and generate a standard line describing a slot in a class. The code is the following:
(defun slot->defclass-slot (spec)
`(,spec :initarg ,(as-keyword spec) :accessor ,spec :initform 0))
For example,
(slot->defclass-slot 'nom)
(NOM :INITARG :NOM :ACCESSOR NOM :INITFORM 0)
All this work fine, when I create a class 'model' as follow:
(define-class model (nom id))
But suppose that I define a parameter instead.
(defparameter *test* '(nom id))
(define-class model *test*)
Then, the code end-up in an error:
The value *TEST* is not of type LIST.
What is wrong?
Your define-class macro does not evaluate its class-slots argument.
You can "fix" your code like this:
(defmacro define-class (class-name class-slots)
`(eval
`(defclass ,',class-name ()
,#(mapcar #'slot->defclass-slot ,class-slots))))
(macroexpand-1 '(define-class model '(nom id)))
(defparameter *test* '(nom id))
(define-class model *test*)
Note that you now have to quote the literal second argument to define-class.
Note also that you are now using eval (for a good reason, in this case).
Note finally that I seriously doubt that you truly want to do this. Chances are you don't need this level of dynamism, and you are just complicating your life for no good reason.
E.g., if you just want to get the list of class slots (using your *test* variable), you should use MOP instead.
In fact you can make your macro expand to the function ensure-class:
> (mop:ensure-class 'foo :direct-slots '((:name a)))
#<STANDARD-CLASS FOO>
but this relies on a somewhat brazen assumption that your implementation is MOP-compliant.
(defparameter *test* '(nom id))
(define-class model *test*)
You shouldn't try to do this, for the same reason that you never try to do:
(with-open-file '(...)
...)
The point of the macro is to not evaluate the arguments in order that you can do something with them. What you can do instead, if you do for some reason, need both a macro- version and non-macro- version, is to define the macro functionality in terms of a function, and then wrap the function in a macro when you need a macro. E.g., (for a not-particularly robust) with-open-file):
(defun %with-open-file (filename function &rest args)
(let ((file (apply 'open filename args)))
(prog1 (funcall function file)
(close file))))
(defmacro with-open-file ((var filename &rest args) &body body)
`(%with-open-file ,filename
(lambda (,var) ,#body)
,#args))
Then you can use the macro-version when you want it, and the function-version when you want it. In your case, though, that's not a perfect solution, since you're expanding to another macro call.
I was toying around with macros and clos, where I created an "object" macro to create instances
(defmacro object (class &rest args)
`(make-instance ',class ,#args))
Now doing this, I also ended up kind of wanting to do something similar for accessor functions created by clos. Example:
(defclass person () ((name :accessor person-name :initarg :name)))
then creating the instance
(setf p1 (object person :name "tom"))
now to get the name from the object obviously I would call person-name, however just as with the object macro, I wanted to create a "gets" macro to do this. So ideally:
(gets person name p1) which then would return the name.
The problem then is the binding of person and name (person-name) and how to do that. Is there anyway to get those two arguments bound together in the macro? sort of like:
(defmacro gets (class var object)
`(,class-,var ,object))
I think I may have misunderstood the original intent. At first I thought you were asking how to generate the accessor names for the class definition, which third part of the answer addresses. After reading through a second time, it actually sounds like you want to generate a new symbol and call it with some argument. That's easy enough too, and is given in the second part of this answer. Both the second and third parts depend on being able to create a symbol with a name that's built from the names of other symbols, and that's what we start with.
"Concatenating" symbols
Each symbol has a name (a string) that you can obtain with symbol-name. You can use concatenate to create a new string from some old strings, and then use intern to get a symbol with the new name.
(intern (concatenate 'string
(symbol-name 'person)
"-"
(symbol-name 'name)))
;=> PERSON-NAME
Reconstructing an accessor name
(defmacro gets (class-name slot-name object)
(let ((accessor-name
(intern (concatenate 'string
(symbol-name class-name)
"-"
(symbol-name slot-name))
(symbol-package class-name))))
`(,accessor-name ,object)))
(macroexpand-1 '(gets person name some-person))
;=> (PERSON-NAME SOME-PERSON)
For a number of reasons, though, this isn't very robust. (i) You don't know whether or not the slot has an accessor of the form <class-name>-<slot-name>. (ii) Even if the slot does have an accessor of the form <class-name>-<slot-name>, you don't know what package it's in. In the code above, I made the reasonable assumption that it's the same as the package of the class name, but that's not at all required. You could have, for instance:
(defclass a:person ()
((b:name :accessor c:person-name)))
and then this approach wouldn't work at all. (iii) This doesn't work with inheritance very well. If you subclass person, say with north-american-person, then you can still call person-name with a north-american-person, but you can't call north-american-person-name with anything. (iv) This seems to be reïnventing slot-value. You can already access the value of a slot using the name of the slot alone with (slot-value object slot-name), and I don't see any reason that your gets macro shouldn't just expand to that. There you wouldn't have to worry about the particular name of the accessor (if it even has one), or the package of the class name, but just the actual name of the slot.
Generating accessor names
You just need to extract the names of the symbols and to generate a new symbol with the desired name.
If you want to automatically generate accessors with defstruct style names, you can do it like this:
(defmacro define-class (name direct-superclasses slots &rest options)
(flet ((%slot (slot)
(destructuring-bind (slot-name &rest options)
(if (listp slot) slot (list slot))
`(,slot-name ,#options :accessor ,(intern (concatenate 'string
(symbol-name name)
"-"
(symbol-name slot-name)))))))
`(defclass ,name ,direct-superclasses
,(mapcar #'%slot slots)
,#options)))
You can check that this produces the kind of code that you'd expect by looking at the macroexpansion:
(pprint (macroexpand-1 '(define-class person ()
((name :type string :initarg :name)
(age :type integer :initarg :age)
home))))
(DEFCLASS PERSON NIL
((NAME :TYPE STRING :INITARG :NAME :ACCESSOR PERSON-NAME)
(AGE :TYPE INTEGER :INITARG :AGE :ACCESSOR PERSON-AGE)
(HOME :ACCESSOR PERSON-HOME)))
And we can see that it works as expected:
(define-class person ()
((name :type string :initarg :name)
(age :type integer :initarg :age)
home))
(person-name (make-instance 'person :name "John"))
;=> "John"
Other comments on your code
(defmacro object (class &rest args)
`(make-instance ',class ,#args))
As Rainer pointed out this isn't very useful. For most cases, it's the same as
(defun object (class &rest args)
(apply 'make-instance class args))
except that you can (funcall #'object …) and (apply #'object …) with the function, but you can't with the macro.
Your gets macro isn't really any more useful than slot-value, which takes an object and the name of a slot. It doesn't require the name of the class, and it will work even if the class doesn't have a reader or accessor.
Don't (naïvely) create symbol names with format
I've been creating symbol names with concatenate and symbol-name. Sometimes you'll see people use format to construct the names, e.g., (format nil "~A-~A" 'person 'name), but that's prone to issues with capitalization settings that can be changed. For instance, in the following, we define a function foo-bar, and note that the format based approach fails, but the concatenate based approach works.
CL-USER> (defun foo-bar ()
(print 'hello))
FOO-BAR
CL-USER> (foo-bar)
HELLO
HELLO
CL-USER> (setf *print-case* :capitalize)
:Capitalize
CL-USER> (funcall (intern (concatenate 'string (symbol-name 'foo) "-" (symbol-name 'bar))))
Hello
Hello
CL-USER> (format nil "~a-~a" 'foo 'bar)
"Foo-Bar"
CL-USER> (intern (format nil "~a-~a" 'foo 'bar))
|Foo-Bar|
Nil
CL-USER> (funcall (intern (format nil "~a-~a" 'foo 'bar)))
; Evaluation aborted on #<Undefined-Function Foo-Bar {1002BF8AF1}>.
The issue here is that we're not preserving the case of the symbol names of the arguments. To preserve the case, we need to explicitly extract the symbol names, rather than letting the print functions map the symbol name to some other string. To illustrate the problem, consider:
CL-USER> (setf (readtable-case *readtable*) :preserve)
PRESERVE
;; The symbol-names of foo and bar are "foo" and "bar", but
;; you're upcasing them, so you end up with the name "FOO-BAR".
CL-USER> (FORMAT NIL "~{~A~^-~}" (MAPCAR 'STRING-UPCASE '(foo bar)))
"FOO-BAR"
;; If you just concatenate their symbol-names, though, you
;; end up with "foo-bar".
CL-USER> (CONCATENATE 'STRING (SYMBOL-NAME 'foo) "-" (SYMBOL-NAME 'bar))
"foo-bar"
;; You can map symbol-name instead of string-upcase, though, and
;; then you'll get the desired result, "foo-bar"
CL-USER> (FORMAT NIL "~{~A~^-~}" (MAPCAR 'SYMBOL-NAME '(foo bar)))
"foo-bar"
This function creates symbols from string designators:
(defun symb (&rest args)
(intern (format nil "~{~a~^-~}" (mapcar #'string args))))
The function uses format, yet passes Joshua's test:
CL-USER> (symb 'foo :bar "BAZ")
FOO-BAR-BAZ
NIL
CL-USER> (defun foo-bar ()
(print 'hello))
FOO-BAR
CL-USER> (foo-bar)
HELLO
HELLO
CL-USER> (setf *print-case* :capitalize)
:Capitalize
CL-USER> (funcall (symb 'foo 'bar))
Hello
Hello
If you want your gets to use accessor methods:
(defmacro gets (class var object)
`(,(intern (format nil "~a-~a" (symbol-name class) (symbol-name var))) ,object))
In general, what you're trying to accomplish is not really useful. make-instance is a well known symbol, easily greppable, part of the standard and optimized by some implementations when the class name is constant. So with your object macro, you're just saving a few characters and a single-quote. Usually, one hides make-instance in specific cases where you don't want to provide a direct way to initialize instances, or more likely, when you want to provide layers of initialization (e.g. phases of initialization, Lisp slots and foreign objects).
PS: I remember vaguely that someone prominent in the standardization of Common Lisp argued in favor of always wrapping/hiding make-instance in a function (e.g. make-<class-name>), but I can't find either a reference or the reasoning.
PPS: Here's a rather old discussion (2004) about it in comp.lang.lisp (and another one from 2002). The main reasons people cite in favor of constructor functions are:
Required arguments; achievable at runtime instead of at compile-time with :initform (error ...) in a slot that requires a provided initial value
Generally, hide implementation details: class instance, structure instance, cons, something else
2.1. Not wanting to export the actual class name
2.2. Being able to return an instance of some other class, usually a subclass
Convenient shorthand for a specific class
I striked always, because it seems proponents to constructor functions for CLOS objects don't necessarily want to hide the protocol that make-instance follows (allocate-instance, initialize-instance → shared-initialize) to implementers or extenders of the API or framework, although they might want to hide it to the consumers of the API or framework.
For something faster, you might want to access slots directly, but that doesn't use accessor methods, and hence doesn't support side-effects, e.g. :before and :after methods:
(defmacro gets (class var object)
(let ((object-var (gensym)))
`(let ((,object-var ,object))
(declare (optimize (speed 3) (safety 0) (debug 0))
(type ,class ,object-var))
(slot-value ,object-var ',var))))
This might be a direct slot access on some implementations.
Finally, you also have with-slots and with-accessors in the standard.
Try playing with something like this:
(let ((a 'a)
(dash '-)
(b 'b))
`(,a,dash,b))
The other possibilities is to use intern, or more user friendly, alexandria's symbolicate.
I would like to initiate dynamically a hash table with defmethod or defun using one of the arguments to create the name. For instance:
(defun foo (arg)
(let ((NAME (read-from-string (format nil "\*~S\*" arg))))
(defparameter NAME (make-hash-table))))
Of course, foo create hash table with the symbol NAME, instead of the value of NAME in let. What can I do to get the value of NAME to create this hash table?
General Remarks
It is almost always wrong to create global variables in functions.
It is also almost always wrong to create new symbols using read-from-string instead of intern.
Use a Macro
What you probably want is
(defmacro def-ht (name)
(let ((var (intern (concatenate 'string "*" (symbol-name name) "*")
(symbol-package name))))
`(defparameter ,var (make-hash-table))))
(def-ht foo)
Use a Function
You might be able to do it in a function too - by inspecting the macroexpansion of a defparameter form and placing the needed stuff in the function:
(defun make-ht-var (name)
(let ((var (intern (concatenate 'string "*" (symbol-name name) "*")
(symbol-package name))))
(setf (symbol-value var) (make-hash-table))
(proclaim (list var 'special))))
(make-ht-var 'foo)
Note that the argument to the function is quoted, but the argument to the macro is not.
You need to use a macro instead of a function. DEFPARAMETER will bind value of MAKE-HASH-TABLE to the symbol NAME because it evaluates at macro-expansion time which occurs earlier than run-time, which is when the function FOO binds the lexical value of NAME.
Look up the CL evaluation model for a deeper understanding.
(defmacro foo (arg)
(let ((name (read-from-string (format nil "*~S*" arg))))
`(defparameter ,name (make-hash-table))))
(foo "my-hash")
=> <hash-table 0x121>
*my-hash*
=> <hash-table 0x121>
I was working with common lisp, and found myself typing up slot definitions of the following form quite a lot:
(name :initarg :name :accessor name)
And so I thought to concoct a macro to speed up this. I came up with the following:
(defmacro quickslot (name)
`(,name :initarg ,(intern (string-upcase name) "KEYWORD") :accessor ,name))
A dirty hack, no doubt, but functional. Or so I thought. When I tried to run my code, I cam across a snag: since defclass is a macro, the arguments are passed to it unevaluated. That means, instead of seeing
(x :initarg :x :accessor x)
It sees
(quickslot x)
Which, of course, signals an error.
The answer, it seems to me, would be to somehow control the order of macro expansion in order to make sure quickslot is expanded before defclass. Which brings me to my question: how would one accomplish this? Or, if you have a different solution to my initial conundrum, that would not go unappreciated either.
That's not really worthy of a macro. Macros typically take literal Lisp source code as their input.
Instead you could just use a function. From Practical Common Lisp, Ch.24:
(defun as-keyword (sym) (intern (string sym) :keyword))
(defun slot->defclass-slot (spec)
(let ((name (first spec)))
`(,name :initarg ,(as-keyword name) :accessor ,name)))
Then you could do something like (again adapted from PCL):
(defmacro my-defclass (name slots)
`(defclass ,name ()
,(mapcar #'slot->defclass-slot slots)))
No, you can't do it. You could write a macro around defclass instead though (that has some special syntax for your quickslots).
You could approach the problem entirely differently and come up with a reader-macro that instructs the reader to call macroexpand on the code that follows it, that would be more generic then just the one purpose for slots declaration in the class. But the complete solution would be somewhat involved, because you'd had to account for many peculiarities and demands of the reader, however, even something as ugly as this would do the job:
(defmacro quickslot (name)
`(,name :initarg ,(intern (string-upcase name) "KEYWORD") :accessor ,name))
(macroexpand '(defclass test-class ()
(#.(macroexpand '(quickslot some-slot)))))
So, what you'd have to do would be something like an alias to #.(macroexpand ...)
And... here you go:
(set-macro-character
#\{
#'(lambda (str char)
(declare (ignore char))
(let ((*readtable* (copy-readtable *readtable* nil))
(reading-p t))
(set-macro-character
#\}
#'(lambda (stream char)
(declare (ignore char stream))
(setf reading-p nil)))
(loop for exp = (read str nil nil t)
while reading-p
collect (macroexpand exp)))))
(read-from-string "'(defclass test-class ()
{(quickslot some-slot)
(quickslot some-other-slot)})")
'(DEFCLASS TEST-CLASS NIL
((SOME-SLOT :INITARG :SOME-SLOT :ACCESSOR SOME-SLOT)
(SOME-OTHER-SLOT :INITARG :SOME-OTHER-SLOT :ACCESSOR
SOME-OTHER-SLOT)))
:)