Common Lisp provides a number of functions for copying objects; namely, copy-list, copy-alist, copy-seq, copy-structure, copy-tree, and copy-symbol. However, copy-symbol seems to operate somewhat differently than the others. All the others (most notably copy-structure) succeed with a general pattern like:
(setq riddle "gifted magician") ;set some value for Tom Riddle
"gifted magician"
(setf (get 'riddle :school) "Hogwarts") ;install a property for him
"Hogwarts"
(setq voldemort (copy-symbol 'riddle t)) ;attempt to clone him
#:RIDDLE
(get 'voldemort :school) ;failed magic
NIL
Can I give voldemort everything riddle has (except his symbol-name) at once, or is it necessary to copy over symbol-value, symbol-plist, symbol-package, and symbol-function from riddle separately? (The HyperSpec gives examples of use, but they do not deal with interning the copied symbol under a new name.)
What is copy-symbol normally used for (and what else could it perhaps be used for)?
The (setf (get symbol key) new-value) sets a property on a symbol object. Thus every place the symbol riddle is used it is the same symbol and thus it will have the same property list. The property list is used for implementation aspects of the language and it is not a way to make objects. Early lisps used it to store global functions, global value, global macro. Moderns lisps us it very little, but it stays for backward compatibility.
(setq riddle "gifted magician")
This updates an already existing variable riddle to be asociated with the string "gifted magician"
(setf (get 'riddle :school) "Hogwarts")
This has nothing to do with the variable riddle (the string "gifted magician") but you make a property on the global symbol riddle. CL uses property lists to store debug information and early lisps used it as the global scope. It's not a way to create an object.
(setq voldemort (copy-symbol 'riddle t))
This makes a copy of the symbol riddle with the property list and the symbolic value is associated with voldemort, thus:
voldemort ; ==> riddle (looks the same, but is a copy)
(eq voldemort 'riddle) ; ==> nil
(get voldemort :school) ; ==> "Hogwarts"
Here is how to do this with classes and objects:
(defclass magician ()
((name :initarg :name)
(description :initarg :description :initform "")
(school :initarg :school :initform nil)))
(defparameter *riddle*
(make-instance 'magician :name "Tom Riddle"
:description "gifted magician")
(setf (slot-value *riddle* 'school) "Hogwarts")
; see http://stackoverflow.com/questions/11067899/is-there-a-generic-method-for-cloning-clos-objects
(defparameter *voldemort* (shallow-copy-object *riddle*))
(slot-value *voldemort* 'school) ; ==> "Hogwarts"
(setf (slot-value *riddle* 'school) "Other")
(slot-value *voldemort* 'school) ; ==> "Hogwarts"
(slot-value *riddle* 'school) ; ==> "Other"
How to do it with structures:
Structures does more behind the scene, like make accessors and constructors, but they are less flexible than CLOS classes and they only have single inheritance. In the example it will almost work the same.
(defstruct magician name (description "") (school nil))
(defparameter *riddle* (make-magician :name "Tom Riddle"
:description "Gifted magician"))
(setf (magician-school *riddle*) "Hogwarts")
(defparameter *voldemort* (copy-structure *riddle*))
(magician-school *voldemort*) ; ==> "Hogwarts"
(setf (magician-school *riddle*) "Other")
(magician-school *voldemort*) ; ==> "Hogwarts"
(magician-school *riddle*) ; ==> "Other"
Related
This function resets the value for each of the specified parts of speech to NIL using putp.
The first argument is a hashtable, for this example, lets call it word-dict.
There are a variable number of parts of speech passed to resetPartsOfSpeech.
Example:
(resetPartsOfSpeech word-dict 'subject 'verb 'prep 'directObj)
(defun resetPartsOfSpeech(word-dict &rest parts)
(do ((partsVar parts (cdr partsVar)))
( (null partsVar) T)
;;; procces the car
(putp NIL word-dict (car partsVar))
))
; here is the results of the function
#S(HASH-TABLE :TEST FASTHASH-EQL (NIL . VERB) (LICKED . VERB) (HAS . VERB) (ATE . VERB) (RAN . VERB) (TAUGHT . VERB)
As you see, it only adds the NIL variable to the list, not clearing them all out.
Helper Functions I Have, The job of these two functions is to put and get data from the hashtable created.
; creating the hash table
(setf word-dict (MAKE-HASH-TABLE))
(defun putp (symbol ht value)
(if (ATOM symbol)
(setf (gethash symbol ht) value)
(ERROR "~s is not a valid symbol for putp" symbol)
))
(defun getp (symbol ht)
(gethash symbol ht) )
(defun isa(word partOfSpeech) ; this function returns T if the specified word is that specified partOfSpeech,
; otherwise, NIL is returned.
(eql (getp word word-dict) partOfSpeech))
(defun set_isa (partOfSpeech &rest words) ; this function defines each
word in the list of words to the specified partOfSpeech
; in the dictionary (hard code word-dict).
(do ((wordVar words (cdr wordVar)) )
( (NULL wordVar ) T)
;;; proccess the CAR
(putp (car wordVar) word-dict partOfSpeech)
(print (car wordVar))))
What I am having trouble understanding is that how I should go about itterating thru each value in the hash table. What I was considering was doing a nested do or dolist loop but can't quite figure out how to go about that with the values from the table, or if that is even possible.
The fundamental problem is with:
(putp NIL word-dict (car partsVar))
When putp is called, nil is bound to symbol, word-dict is bound to ht, and (car partsVar), i.e. the next symbol in the list of parts of speech, is bound to value. Within putp the expression:
(setf (gethash symbol ht) value)
becomes:
(setf (gethash 'nil word-dict) (car partsVar))
Here, (gethash 'nil word-dict) is the place that is set to the value (car partsVar). Since there is no 'nil key in the hash table yet, a new key is created and given the value (car partsVar), which is 'verb in the OP example.
In the original putp expression, (car partsVal) should have been in the symbol position as that is the key which should be updated:
(defun resetPartsOfSpeech (word-dict &rest parts)
(do ((partsVar parts (cdr partsVar)))
((null partsVar) t)
(putp (car partsVar) word-dict 'nil)))
Although this solves the problem, there is a better solution.
(defun reset-parts-of-speech (word-dict &rest parts)
(dolist (part parts)
(putp part word-dict 'nil)))
When you want to do a simple iteration over a list of elements, symbols for parts of speech in this case, just use a simple dolist. Additionally, it would be good to get into better habits with respect to Lisp style. Prefer kebab-case to camel-case; put all closing parentheses on one line (almost always); use proper indentation to make program structure clear. A good lisp-aware text editor can be most helpful for the last two.
Here is some testing in the REPL using a set-isa function based on the previous question by OP:
SCRATCH> (defvar *word-dict* (make-hash-table))
*WORD-DICT*
SCRATCH> (set-isa 'verb 'eat 'sleep 'walk)
NIL
SCRATCH> (set-isa 'noun 'cake 'ice-cream 'pizza)
NIL
SCRATCH> (gethash 'verb *word-dict*)
(WALK SLEEP EAT)
T
SCRATCH> (gethash 'noun *word-dict*)
(PIZZA ICE-CREAM CAKE)
T
SCRATCH> (set-isa 'adjective 'delicious 'sweet 'crispy)
NIL
SCRATCH> (gethash 'adjective *word-dict*)
(CRISPY SWEET DELICIOUS)
T
SCRATCH> (resetPartsOfSpeech *word-dict* 'verb)
T
SCRATCH> (gethash 'verb *word-dict*)
NIL
T
SCRATCH> (gethash 'noun *word-dict*)
(PIZZA ICE-CREAM CAKE)
T
SCRATCH> (reset-parts-of-speech *word-dict* 'adjective 'noun)
NIL
SCRATCH> (gethash 'noun *word-dict*)
NIL
T
SCRATCH> (gethash 'adjective *word-dict*)
NIL
T
Update
The above was predicated on OP statement: "This function resets the value for each of the specified parts of speech to NIL...," which seemed to suggest that OP wants the hash table to store parts of speech as keys and lists of words as the associated values. This also seems to align with a previous question posted by OP. But, after an exchange of comments, it seems that OP may prefer a hash table with individual words as keys and parts of speech as the associated values. It is unclear how words which may be associated with multiple parts of speech should be handled.
The hash table shown in OP example code #S(HASH-TABLE :TEST FASTHASH-EQL (NIL . VERB) (LICKED . VERB) ;..., along with OP comments, supports this second interpretation. If this is the case, then what does it mean to "reset each value" in the hash table to 'nil? Perhaps the sensible thing to do is to remove each entry entirely which has a value that matches a provided part-of-speech argument.
This can easily be accomplished by using dolist to loop over the list of parts of speech, and subsequently mapping over the hash table with maphash and a function that removes any entry holding a matching value:
(defun remove-parts-of-speech (word-dict &rest parts)
(dolist (part parts)
(maphash #'(lambda (k v) (if (eql v part) (remhash k word-dict)))
word-dict)))
Here is another REPL demonstration using OP's current set-isa function which populates a hash table with words for keys and parts of speech for values. After populating the hash table with nine words which are 'nouns, 'verbs, and 'adjectives, the remove-parts-of-speech function is used to remove all entries which are nouns or verbs from *word-dict*. After this, only the three adjective entries remain in the hash table.
CL-USER> (defvar *word-dict* (make-hash-table))
*WORD-DICT*
CL-USER> (set-isa 'verb 'run 'jump 'climb)
RUN
JUMP
CLIMB
T
CL-USER> (set-isa 'noun 'hat 'shoe 'scarf)
HAT
SHOE
SCARF
T
CL-USER> (set-isa 'adjective 'salty 'spicy 'sour)
SALTY
SPICY
SOUR
T
CL-USER> *word-dict*
#<HASH-TABLE :TEST EQL :COUNT 9 {1003CE10C3}>
CL-USER> (hash-table-count *word-dict*)
9
CL-USER> (remove-parts-of-speech *word-dict* 'noun 'verb)
NIL
CL-USER> (hash-table-count *word-dict*)
3
CL-USER> (gethash 'spicy *word-dict*)
ADJECTIVE
T
Suppose I have a class class with slots first and second. Inside my function I can bind a variable to one of those slots like
(symbol-macrolet ((var (first cls)))
....)
Obviously I can also bind the second slot to smth.
Questions is, let's say that first and second are either some number or nil. Let's also say that if second is non-nil, first is always nil. Now, can I bind my var to a non-nil one with just one macro? So it just looks at instance of the class given and then check if second is nil. If no, it binds var to second, otherwise to first.
Seems complicated, but I'm pretty sure it can be done, just don't know where to start.
To further generalize -- is it possible to bond a variable not to a single place, but to one of a specific set, depending on some state?
I think this is not quite simple. You could do something like this which works for reading only (I've used a fake toy structure so my code works, which is given here):
(defstruct toy
(first nil)
(second nil))
(defun foo (a-toy)
(symbol-macrolet ((x (or (toy-first a-toy) (toy-second a-toy))))
...))
But now (setf x ...) is horribly illegal. You can get around this, once you've decided what (setf x ...) should do, by defining some local functions. I've decided here that it should set the non-nil slot, as that makes sense to me.
(defun bar (a-toy)
(flet ((toy-slot (the-toy)
(or (toy-first the-toy) (toy-second the-toy)))
((setf toy-slot) (new the-toy)
(if (toy-first the-toy)
(setf (toy-first the-toy) new)
(setf (toy-second the-toy) new))))
(symbol-macrolet ((x (toy-slot a-toy)))
(setf x 2)
a-toy)))
And now you can wrap this all in a single macro:
(defmacro binding-toy-slot ((x toy) &body forms)
(let ((tsn (make-symbol "TOY-SLOT")))
`(flet ((,tsn (the-toy)
(or (toy-first the-toy) (toy-second the-toy)))
((setf ,tsn) (new the-toy)
(if (toy-first the-toy)
(setf (toy-first the-toy) new)
(setf (toy-second the-toy) new))))
(symbol-macrolet ((,x (,tsn ,toy)))
,#forms))))
(defun bar (a-toy)
(binding-toy-slot (x a-toy)
(setf x 3)
a-toy))
Obviously you might want to generalise binding-toy-slot, so it, for instance, takes a list of slot accessor names or something like that.
There may also be better ways of doing this I haven't thought of: there might be clever tricks with setf-expansions that let you do it without the little helper functions. You could also have global helper functions which get passed an object and a list of accessors to try which would make the code slightly smaller (although you can probably achieve similarly small code in any serious implementation by declaring the helpers inline which should cause them to be completely compiled away).
An alternative, and perhaps better, approach, is to define the protocol you want to achieve using generic functions. This means things are defined globally, and it's related to but not quite the same as Kaz's answer.
So again, let's say I have some class (this can be a structure, but making it a fully-fledged standard-class lets us have unbound slots, which is nice):
(defclass toy ()
((first :initarg :first)
(second :initarg :second)))
Now you could either define generic functions with names like appropriate-slot-value & (setf appropriate-slot-value), or you could define GF which returns the name of the appropriate slot, like so:
(define-condition no-appropriate-slot (unbound-slot)
;; this is not the right place in the condition heirarchy probably
()
(:report "no appropriate slot was bound"))
(defgeneric appropriate-slot-name (object &key for)
(:method :around (object &key (for ':read))
(call-next-method object :for for)))
(defmethod appropriate-slot-name ((object toy) &key for)
(let ((found (find-if (lambda (slot)
(slot-boundp object slot))
'(first second))))
(ecase for
((:read)
(unless found
(error 'no-appropriate-slot :name '(first second) :instance object))
found)
((:write)
(or found 'first)))))
And now the accessor function pair can be plain functions which will work for any class where there is a method for appropriate-slot-name:
(defun appropriate-slot-value (object)
(slot-value object (appropriate-slot-name object :for ':read)))
(defun (setf appropriate-slot-value) (new object)
;; set the bound slot, or the first slot
(setf (slot-value object (appropriate-slot-name object :for ':write)) new))
Finally, we can now have functions which just use symbol-macrolet in the obvious way:
(defun foo (something)
(symbol-macrolet ((s (appropriate-slot-value something)))
... s ... (setf s ...) ...))
So, that's another approach.
Simple, inefficient way with defsetf:
(defun second-or-first (list)
(or (second list) (first list)))
(defun set-second-or-first (list val)
(if (second list)
(setf (second list) val)
(setf (first list) val)))
(defsetf second-or-first set-second-or-first)
(defun test ()
(let ((list (list nil nil)))
(symbol-macrolet ((sof (second-or-first list)))
(flet ((prn ()
(prin1 list) (terpri)
(prin1 sof) (terpri)))
(prn)
(setf sof 0)
(prn)
(setf sof 1)
(prn)
(setf (second list) 3)
(prn)
(setf sof nil)
(prn)
(setf sof nil)
(prn)))))
If it is okay that update expressions like (incf sof) wastefully traverse the structure twice, this is adequate.
Otherwise a more sophisticated implementation is required using define-setf-expander. The gist of such a solution is that the generated code has to calculate which of the two cons cells of the list holds the current place, storing that cons cell in a temporary variable #:temp. Then the place we are interested in is denoted by (car #:temp). If #:temp is the second cell, avoiding two accesses to are tricky (one access to determine it's the one we want, then the other to get the prior value). Basically what we can do is have another temp variable which holds the value of the place that we obtained as a side effect of checking whether it is not nil. Then designate that temporary variable as the access form for getting the prior value.
Here’s how you might not use symbol macros without any huge loss:
(defgeneric firsty-secondy (thing))
(defgeneric (setf firsty-secondy) (newval thing))
(defmethod firsty-secondy ((x my-class))
(or (secondy x) (firsty x)))
(defmethod (setf firsty-secondy) (nv (x my-class))
(if (secondy x)
(setf (secondy x) nv)
(setf (firsty x) nv)))
You may find that the compiler does better with these because within the methods it can be more sure about where the slots for the fields are in memory.
Here is a way to structure your object to not need to do this and enforce your invariant a bit better:
(defclass my-class
((is-first :initform nil)
(thingy :initform nil)))
Here is a comparison:
first=nil,second=nil : is-first=nil,thingy=nil
first=123,second=nil : is-first=t ,thingy=123
first=nil,second=123 : is-first=nil,thingy=123
first=123,second=456 : unrepresentable
I'm writing a toy interpreter for a Lisp language, in which I have the following CL code:
(defun mal-list (&rest args)
(make-mal :type 'list
:value args))
(register-fun '|list| #'mal-list)
(defun mal-list? (arg)
(eq (mal-type arg) 'list))
(register-fun '|list?| #'mal-list?)
However, I'd rather simply write something like this:
(defmal list (&rest args)
(make-mal :type 'list
:value args))
(defmal list? (arg)
(eq (mal-type arg) 'list))
I tried to write a macro to do this, but I had problems with the symbols with the bars (I'm pretty confused as to what this is!). This is what I tried:
(defmacro defmal (name args &body body )
(let ((funsym (intern (format nil "~{~a~}" `(mal- ,name)))))
`(register-fun `|,name| (defun ,funsym ,args ,#body))))
which didn't work out, because `|,name| literaly meant |,name|, and not |list|
I'm guessing this is an XY problem, but I'm not sure how to approach this otherwise.
The |...| syntax is just one of the ways that the Lisp printer can print symbols that have characters in their name that need to be escaped (and that the reader can read symbols with those kinds of characters in their names):
(print (intern "foo"))
;=> |foo|
There are other ways, too, including escaping individual characters:
(print '|FOO|)
;=> FOO
(print '\f\o\o)
;=> |foo|
What you're trying to do is simply create a symbol whose name includes lower case letters. That's easy enough, as shown above. Part of your issue, though, is that you're getting as input a symbol whose name is full of capital letters, so you'll need to downcase first:
CL-USER> (symbol-name 'FOO)
;=> "FOO"
CL-USER> (intern (symbol-name 'FOO))
;=> FOO
CL-USER> (string-downcase (symbol-name 'FOO))
;=> "foo"
CL-USER> (intern (string-downcase (symbol-name 'FOO)))
;=> |foo|
In fact, because string-downcase takes string designators, not just strings, you can pass the symbol in directly:
CL-USER> (intern (string-downcase 'BaR))
;=> |bar|
So, after all that string processing, we can move to the macro.
It sounds like you're looking for something like this:
(defmacro defmal (name lambda-list &body body)
(let ((mal-name (intern (concatenate 'string "MAL-" (symbol-name name))))
(mal-norm (intern (string-downcase name))))
`(progn
(defun ,mal-name ,lambda-list
,#body)
(register-function ',mal-norm #',mal-name))))
CL-USER> (pprint (macroexpand-1 '(defmal list? (arg)
(eq (mal-type arg) 'list))))
(PROGN
(DEFUN MAL-LIST? (ARG) (EQ (MAL-TYPE ARG) 'LIST))
(REGISTER-FUNCTION '|list?| #'MAL-LIST?))
It's generally a good idea to avoid using format in generating symbol names, because the specific output can change, depending on other variables. E.g.:
(loop for case in '(:upcase :downcase :capitalize)
collect (let ((*print-case* case))
(format nil "~a" 'foo)))
;=> ("FOO" "foo" "Foo")
Instead, you can use concatenate with a string (or the symbol name of a symbol). Because the reader can also have different settings for case sensitivity, sometimes I'll even do (but not everyone likes this):
(concatenate 'string (symbol-name '#:mal-) (symbol-name name))
This way, if the reader does anything unusual (e.g., preserves case, so that the symbol name of mal- is "mal-), you can preserve it in your own generated symbol, too.
In addition to Joshua's detailed answer, consider using a function from the Alexandria library:
format-symbol is like format, but inside with-standard-io-syntax. Here, t stands for the current package and name is downcased:
(format-symbol t "mal-~(~A~)" name)
=> |mal-list|
symbolicate concatenates and interns in current package:
(symbolicate '#:mal- name)
You can end-up with either |MAL-LIST| or |mal-list| if your current readtable preserves case or not. For completeness, note that readtable-case can be set to the following values: :upcase, :downcase, :preserve or :invert (this one I find quite interesting).
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>