Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
297 views
in Technique[技术] by (71.8m points)

common lisp - combining two variables into one function name in macro

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))
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

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"

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...